How to obtain accurate plot curves in Mathematica?

Run the following code In Mathematica:

r=6197/3122;
p[k_,w_]:=Sqrt[w^2/r^2-k^2];q[k_,w_]:=Sqrt[w^2-k^2];
a[k_,w_,p_,q_]:=(k^2-q^2)^2 Sin[p]Cos[q]+4k^2 p q Cos[p]Sin[q]
a[k_,w_]:开发者_JS百科=a[k,w,p[k,w],q[k,w]];
ContourPlot[a[k,w]==0,{w,0,6},{k,0,14}]

This gives me very inaccurate curves:

I have tried setting the PlotPoints and WorkingPrecision options of ContourPlot to 30 and 20 respectively, to no avail. You will also notice that the only numerical parameter, r, is an exact rational number. I don't know what else to try. Thanks.

Edit: The curves I expect to get are the three black ones (marked A1, A2, and A3) on the following picture

---

Are you sure about the picture and/or the definition for a? From the definition of a it follows that a[k,w]==0 on k==w but that curve doesn't appear in your picture.

Anyway, assuming that the definition of a is right, the problem with plotting the contours is that in the domain w^2/r^2-k^2<0, both p[k,w] and Sin[p[k,w]] become purely imaginary which means that a[k,w] becomes purely imaginary as well. Since ContourPlot doesn't like complex valued functions only the parts of the contours in the domain w^2/r^2>=k^2 are plotted.

Not that Sin[p[k,w]]/p[k,w] is real for all values of k and w (and it's nicely behaved in the limit p[k,w]->0). Therefore, to get around the problem of a becoming complex you could plot the contours a[k,w]/p[k,w]==0 instead:

ContourPlot[a[k, w]/p[k, w] == 0, {w, 0, 6}, {k, 0, 14}]

Result

---

I have got something very similar to what you expect by separate plotting of real and imaginary parts of the l.h.s. of the equation:

ContourPlot[{Re@a[k, w] == 0, Im@a[k, w] == 0}, {w, 0, 6}, {k, 0, 14},
  MaxRecursion -> 7]

---

Your function gives complex numbers in the region of the contour lines you show. Is that what you expect? You can see the region that is real here:

ContourPlot[a[k, w], {w, 0, 6}, {k, 0, 14}]

I get something in some ways closer to your lines if I use:

ContourPlot[a[w, k] == 0, {w, 0, 6}, {k, 0, 14}]

Is it possible there is a transcription error?

(My apologies if this is unhelpful.)

---

p ans q will be real valued only if w^2 - k^2 and w^2/r^2 - k^2 are both nonnegative. w^2 / r^2 - k^2 will only be nonnegative in the following area of your plot region:

Therefore everything else will be cut off by ContourPlot. Perhaps you need to make some corrections to the equations (you only need the real part? magnitude?) I don't believe the curves Mathematica gives you are very inaccurate. Otherwise the way to go to increase accuracy of the contours if increasing PlotPoints and MaxRecursion (say, to 50 and 4).

---

Try to play with the parametrization of your equations. For example, define a=w^2-k^2 and b=w^2/r^2-k^2, then solve for a and b and map them onto k and w