Animate and Plot3D not working together [duplicate]

Question

I made a simulator for a 2D quantum harmonic oscilator and want to display an animation of the particles moviment. For this I animated a Plot3D, but whenever the animation starts the image quality drops drasticaly. If I pause the animation and wait a few seconds the image gets better again. A link to a video showing the problem is included bellow.

https://www.dropbox.com/s/c1zgz0yc53vl4pj/Video_1494955312.wmv?dl=0

My code:

mol[n_Integer, o_: "Pseudospectral"] := {"MethodOfLines", 
   "SpatialDiscretization" -> {"TensorProductGrid", "MaxPoints" -> n, 
     "MinPoints" -> n, "DifferenceOrder" -> o}}(*: is for optional input*);
wx = wy = 2;
ic[x_, y_] := (wx wy/Pi/Pi)^(1/
      4) Exp[-(wx (x - 1)^2./2 + wy (y)^2./2)] ;
L = 4;
tf = 1;
eq = I D[u[t, x, y], t] + 
    1/2 (D[u[t, x, y], {x, 2}] + D[u[t, x, y], {y, 2}]) == (wy^2 y^2 +
        wx^2 x^2)/2 u[t, x, y];
init = u[0., x, y] == ic[x, y];
bcs = {
   u[t, - L, y] == ic[-L, y],
   u[t, L, y] == ic[L, y],
   u[t, x, - L] == ic[x, -L],
   u[t, x, L] == ic[x, L]
   };
sys = Flatten@{eq, init, bcs};
\[Psi] = NDSolveValue[sys, u, {t, 0., tf}, {x, - L, L}, {y, - L, L}, 
  Method -> mol[53], MaxSteps -> 10^6];

Animate[Plot3D[Abs@\[Psi][t, x, y]^2, {x, -3, 3}, {y, - 3, 3}, 
  PlotRange -> {0, 1.2}, AxesLabel -> {x, y, p}], {t, 0, tf}, 
 AnimationRunning -> False, DisplayAllSteps -> True]

Anyone can explain why the image quality drops like this? How to fix it?

Also, possibly related, when I try to generate a .gif animation with

tst= Table[
   Plot3D[Abs[\[Psi][t, x, y]], {x, -3, 3}, {y, - 3, 3}, 
    PlotRange -> {0, 1.2}, AxesLabel -> {x, y, p}], {t, 0, tf, .1}];

I get no error messages, but the end result is like a ClearAll["Global`*"], all my variables are empty of content.

I am using Mathematica 10 on a win8 computer.

Answer 1

The answer should be set PerformanceGoal -> "Quality". Otherwise PerformanceGoal options is set to global $PerformanceGoal which switches to "Speed" if the evaluation is done on a preemptive link. (default for most of gui/Dynamic etc).

See more in linked duplicate.

However, there appears to be a bug in 11+ which makes this option being ignored, fortunately Mathematica is great in workingaround bugs it introduces. So instead using the option we can Block the $PerformanceGoal:

Animate[
    Block[{$PerformanceGoal = "Quality"}
      ,  Plot3D[Sin[t x y], {x, -3, 3}, {y, -3, 3}, PlotRange -> {0, 1.2}]
    ]
  , {t, 0, 2}
  , AnimationRunning -> False
  , DisplayAllSteps -> True

]