For a better animation of the solution from NDSolve

Question

I obtained a numerical solution from the following code with NDSolve

L = 20;
tmax = 27;
\[Sigma] = 2;
myfun = First[h /. NDSolve[{D[h[x, y, t], t] +
Div[h[x, y, t]^3*Grad[Laplacian[h[x, y, t], {x, y}], {x, y}], {x, y}] + 
Div[h[x, y, t]^3*Grad[h[x, y, t], {x, y}], {x, y}] == 0, 
h[x, y, 0] == 1 +
1/(2*\[Pi]*\[Sigma]^2)*Exp[-((x - 10)^2/(2*\[Sigma]^2) + (y - 10)^2/(2*\[Sigma]^2))],
h[0, y, t] == h[L, y, t], h[x, 0, t] == h[x, L, t]}, 
h, {x, 0, L}, {y, 0, L}, {t, 0, tmax}, 
Method -> {"MethodOfLines", 
"SpatialDiscretization" -> {"TensorProductGrid", "MinPoints" -> 60, "MaxPoints" -> 60, 
"DifferenceOrder" -> 4}}, StepMonitor :> Print[t]]]

(It took about 7 sec to be solved on my old laplop.)

Next, I am trying to make an animation and export a .gif file to present its evolution as follows: (taking about 50 sec)

mpl = Table[Plot3D[myfun[x, y, t], {x, 0, L}, {y, 0, L}, PlotRange -> All, 
PlotPoints -> 40, ImageSize -> 400, 
PlotLabel -> Style["t = " <> ToString[t], Bold, 18]], {t, 0, 27, 1}];
Export["test.gif", mpl, "DisplayDurations" -> 1, "AnimationRepetitions" -> Infinity]

Here are my questions:

As you may see, during the evolution (1) the box(frame) of the animation is shrinking and expanding, though slightly, (2) the augment in the amplitude is shown through increasing the vertical coordinate. If one neglects the scaling in this coordinate and only observe the middle peak, he may do not feel its growth. This is a problem in make a presentation.

I don't know the reason for the fist observation, for the second one, while, I think MMA try to highlight the surface variation at every instant by scaling the vertical axis synchronously.

Can anyone please help me to suppress the oscillation of the 3Dbox and hold the coordinate of vertical axis as the final frame at $t_\text{max}=27$ (i.e. about z=6 here) because I want to show the surface evolution form a small fluctuation to the final big amplitude. Thanks!

Answer 1

To prevent shaking, try to add ImagePadding and for the other issue, you can fix the vertical plot range.

mpl = Table[
   Plot3D[myfun[x, y, t], {x, 0, L}, {y, 0, L}, 
    PlotRange -> {Automatic, Automatic, {0, 6}}, PlotPoints -> 40, 
    ImageSize -> 400, 
    PlotLabel -> Style["t = " <> ToString[t], Bold, 18], 
    ImagePadding -> 30], {t, 0, 27, 1}];

Answer 2

I only post this as a way (without distortion or dealing with multiple scales)to illustrate the initial Gaussian (flat relative to final range) with MeshFunctions and using ColorFunction. I have voted for Nasser's answer.

fun[t_] := Legended[Show[
   Plot3D[myfun[x, y, t], {x, 0, 20}, {y, 0, 20}, 
    MeshFunctions -> (#3 &), Mesh -> {{0, 1, 1.1, 1.2, 2, 3, 4, 5}}, 
    MeshStyle -> Thick, 
    ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z/6]],
    ColorFunctionScaling -> False,
    PlotRange -> {0, 6},
    PlotPoints -> 40,
    PerformanceGoal -> "Quality",
    PlotLabel -> Style[Row[{"t= ", t}], 20, White, Bold]], 
   Background -> Black], BarLegend[{"Rainbow", {0, 6}}]]

The gif was exported from fun/@Range[0,27,0.5] at 8 frames per second (using "DisplayDurations".