Better Accuracy for ContourPlot

Questions
1

Hi,

Is it possible somehow to improve ContourPlot accuracy?
Here is the example when accuracy is not high enough.

InvatiantJ = J + 0.13143284265648159 J^(3/2) Cos[3 \[Phi]];
JDA = 25.728216396172527;
InvatiantJDA = 8.576072132057504;

Show[
 ContourPlot[{InvatiantJ}, {\[Phi], 0, 2 Pi}, {J, 0, JDA},PerformanceGoal -> "Quality"], 
 ContourPlot[{InvatiantJDA == InvatiantJ}, {\[Phi], 0, 2 Pi}, {J, 0,JDA}, PerformanceGoal -> "Quality"]
 ]

All peaks for the curve “InvatiantJDA == InvatiantJ” should be of the same heights, but they are not.

bad.jpeg
bad.jpeg324×325 18.6 KB

I still can obtain a nice result with NSolve, but it’s too slow.

Off[Solve::ratnz];
\[Phi]Tab = data = Table[2 Pi i/300, {i, 1, 300}];
Do[data[[i]] = {\[Phi]Tab[[i]], 
   NSolve[InvatiantJDA == InvatiantJ /. \[Phi] -> \[Phi]Tab[[i]], J, 
     Reals][[1, 1, 2]]}, {i, 1, Length[\[Phi]Tab]}]
ListPlot[data];

good.jpg
good.jpg360×360 20.3 KB

Thanks,
I.M.

2

Try increasing PlotPoints and MaxRecursion, for example

Show[ContourPlot[{InvatiantJ}, {\[Phi], 0, 2 Pi}, {J, 0, JDA}, PerformanceGoal -> "Quality"], ContourPlot[{InvatiantJDA == InvatiantJ}, {\[Phi], 0, 2 Pi}, {J, 0, JDA}, PerformanceGoal -> "Quality", PlotPoints -> 100, MaxRecursion -> 2]]
3

Thanks, Ilian.