How to get accurate graph curves in Mathematica?

Question

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 pq Cos[p]Sin[q] a[k_,w_]:=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 tried setting the PlotPoints and WorkingPrecision ContourPlot to 30 and 20 respectively, to no avail. You will also notice that the only numerical parameter r is the exact rational number. I do not know what else to try. Thanks.

Edit: The curves I expect to get are the three black ones (labeled A1, A2, and A3) in the following figure

Answer 1

Are you sure the image and / or definition for a ? It follows from the definition of a that a[k,w]==0 on k==w , but this curve does not appear in your picture.

In any case, assuming the definition of a correct, the problem with constructing the contours is that in the region 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. Since ContourPlot does not satisfy complex-valued functions, only parts of the contours are superimposed in the region w^2/r^2>=k^2 .

Not that Sin[p[k,w]]/p[k,w] is real for all values ​​of k and w (and this behaves perfectly in the limit p[k,w]->0 ). Therefore, in order to get around the problem of a , becoming complicated, you could construct the contours a[k,w]/p[k,w]==0 instead of:

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

Result

Answer 2

I have something very similar to what you would expect from a separate construction of the real and imaginary parts of the lhs equation:

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

Answer 3

Your function gives complex numbers in the area of ​​the displayed contour lines. Is that what you expect? Here you can see the real area:

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

I am bringing something closer to your lines if I use:

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

Is it possible that a transcription error exists?

(My apologies if this is useless.)

Answer 4

p ans q is real if only w^2 - k^2 and w^2/r^2 - k^2 are non-negative. w^2 / r^2 - k^2 will be non-negative in the following area of ​​your plot:

Therefore, everything else will be trimmed to ContourPlot . Perhaps you need to make some corrections to the equations (do you only need the real part?)? I do not believe that Mathematica curves give you very inaccurate. Otherwise, you can increase the accuracy of the contours when increasing PlotPoints and MaxRecursion (say, to 50 and 4).

Answer 5

Try playing with the parameterization 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 draw them on k and w