1
$\begingroup$

I want plot results of numerical integration from NDSolveValue:

(*Equations*)
h[\[Rho]_, k_][u_, v_] = (\[Rho] u v)/(1 + u + k u^2);
f[a_, \[Rho]_, k_][u_, v_] = a - u - h[\[Rho], k][u, v];
g[\[Alpha]_, b_, \[Rho]_, k_][u_, v_] = \[Alpha] (b - v) - 
   h[\[Rho], k][u, v];

eqns[d_, \[Gamma]_, \[Alpha]_, \[Rho]_, k_, a_, 
   b_] = {Derivative[1, 0, 0][u][t, x, 
      y] - \[Gamma] f[a, \[Rho], k][u[t, x, y], v[t, x, y]] - 
     Inactive[Div][(Inactive[Grad][u[t, x, y], {x, y}]), {x, y}] == 0,
    Derivative[1, 0, 0][v][t, x, 
      y] - \[Gamma] g[\[Alpha], b, \[Rho], k][u[t, x, y], 
       v[t, x, y]] - 
     Inactive[Div][(d Inactive[Grad][v[t, x, y], {x, y}]), {x, y}] == 
    0};
(*Initial Conditions*)

horizontalPeriodicRandomField[{min_, max_}, pts_, L_] := 
 Block[{rand = RandomReal[{min, max}, {pts, pts}]}, 
  rand[[-1]] = rand[[1]];
  ListInterpolation[rand, {{-L, L}, {-L, L}}, 
   PeriodicInterpolation -> {True, False}]]

ics = {u[0, x, y] == 
    horizontalPeriodicRandomField[{0.01, 1}, 100, 5][x, y], 
   v[0, x, y] == 
    horizontalPeriodicRandomField[{0.01, 1}, 100, 5][x, y]};
(*Boundary Conditions*)

bcs = {PeriodicBoundaryCondition[u[t, x, y], x == -5, 
    TranslationTransform[{10, 0}]], 
   PeriodicBoundaryCondition[v[t, x, y], x == -5, 
    TranslationTransform[{10, 0}]]};

(*Solutions*)

Monitor[{ufun, vfun} = 
    NDSolveValue[{eqns[10, 9, 3/2, 37/2, 1/10, 92, 64], bcs, ics}, {u,
       v}, {x, y} \[Element] Rectangle[{-5, -5}, {5, 5}], {t, 0, 1}, 
     Method -> {"PDEDiscretization" -> {"MethodOfLines", 
         "SpatialDiscretization" -> {"FiniteElement", 
           "MeshOptions" -> {"MaxCellMeasure" -> 0.01}}}}, 
     EvaluationMonitor :> (currentTime = Row[{"t = ", CForm[t]}])];, 
  currentTime];

To visualizate 2D spatial for each time step, I have used ContorPlot. I would like to generate distinct snapshots with fixed interval in of PlotLegends, with bottom value fixed in zero and top value in 11.

Table[ContourPlot[ufun[t, x, y], {x, -5, 5}, {y, -5, 5}, 
  PlotRange -> All, PlotPoints -> 50, FrameLabel -> {"x", "y"}, 
  ColorFunction -> "Rainbow", PlotTheme -> "Monochrome", 
  PlotLegends -> 
  BarLegend[Automatic, LegendMarkerSize -> 180, LegendLabel -> "u"]], 
  PlotLabel -> Style[" t=" <> ToString[t]]], {t, 0, 1, 0.25}]

Note that the PlotLabel associated to spanschots doesn't are fixed between 0 and 11 (only the first is fixed, the others, doesn't). Besides that, there are mistakes as shown below:

enter image description here

Can anybody help me? Thanks in advance.

$\endgroup$

1 Answer 1

2
$\begingroup$
Clear["Global`*"]

(Equations)

h[ρ_, k_][u_, v_] = (ρ u v)/(1 + u + k u^2);
f[a_, ρ_, k_][u_, v_] = a - u - h[ρ, k][u, v];
g[α_, b_, ρ_, k_][u_, v_] = α (b - v) - h[ρ, k][u, v];

eqns[d_, γ_, α_, ρ_, k_, a_, 
   b_] = {Derivative[1, 0, 0][u][t, x, 
      y] - γ f[a, ρ, k][u[t, x, y], v[t, x, y]] - 
     Inactive[Div][(Inactive[Grad][u[t, x, y], {x, y}]), {x, y}] == 0, 
   Derivative[1, 0, 0][v][t, x, 
      y] - γ g[α, b, ρ, k][u[t, x, y], v[t, x, y]] - 
     Inactive[Div][(d Inactive[Grad][v[t, x, y], {x, y}]), {x, y}] == 0};

(Initial Conditions)

horizontalPeriodicRandomField[{min_, max_}, pts_, L_] := 
 Block[{rand = RandomReal[{min, max}, {pts, pts}]}, rand[[-1]] = rand[[1]];
  ListInterpolation[rand, {{-L, L}, {-L, L}}, 
   PeriodicInterpolation -> {True, False}]]

ics = {u[0, x, y] == horizontalPeriodicRandomField[{0.01, 1}, 100, 5][x, y], 
   v[0, x, y] == horizontalPeriodicRandomField[{0.01, 1}, 100, 5][x, y]};

(Boundary Conditions)

bcs = {PeriodicBoundaryCondition[u[t, x, y], x == -5, 
    TranslationTransform[{10, 0}]], 
   PeriodicBoundaryCondition[v[t, x, y], x == -5, 
    TranslationTransform[{10, 0}]]};

(Solutions)

Monitor[{ufun, vfun} = 
    NDSolveValue[{eqns[10, 9, 3/2, 37/2, 1/10, 92, 64], bcs, ics}, {u, 
      v}, {x, y} ∈ Rectangle[{-5, -5}, {5, 5}], {t, 0, 1}, 
     Method -> {"PDEDiscretization" -> {"MethodOfLines", 
         "SpatialDiscretization" -> {"FiniteElement", 
           "MeshOptions" -> {"MaxCellMeasure" -> 0.01}}}}, 
     EvaluationMonitor :> (currentTime = Row[{"t = ", CForm[t]}])];, 
  currentTime];

The range of ufun is

{uMin, uMax} =
 (#[{ufun[t, x, y], -5 <= x <= 5, -5 <= y <= 5, 0 <= t <= 1},
     {t, x, y}] & /@ {MinValue, MaxValue})

(* {-0.0566, 9.97146} *)

Manipulate[
 Plot3D[
  ufun[t, x, y], {x, -5, 5}, {y, -5, 5},
  PlotRange -> {uMin, uMax},
  PlotPoints -> 100,
  MaxRecursion -> 2],
 {{t, 0}, 0, 1, 0.025, Appearance -> "Labeled"},
 SynchronousUpdating -> False]

enter image description here

For a given value of t there is limited variation.

For all of the plots to have a common legend scale

legd = BarLegend[{"Rainbow", {uMin, uMax}},
   LegendMarkerSize -> 180,
   LegendLabel -> "u"];

Partition[
   Table[
    {utMin, utMax} =
     NumberForm[#, {5, 2}] & /@
      (#[{ufun[t, x, y], -5 <= x <= 5, -5 <= y <= 5},
          {x, y}] & /@ {MinValue, MaxValue});
    Legended[
     ContourPlot[
      ufun[t, x, y], {x, -5, 5}, {y, -5, 5},
      PlotRange -> All,
      PlotPoints -> 50,
      FrameLabel -> {"x", "y"},
      ColorFunction ->
       (ColorData["Rainbow"][1 - (uMax - #1)/(uMax - uMin)] &),
      ColorFunctionScaling -> False,
      PlotTheme -> "Monochrome",
      PlotLabel -> StringForm["t = ``\n`` <= u <= ``", t, utMin, utMax],
      PlotPoints -> 100,
      MaxRecursion -> 2],
     legd],
    {t, 0, 1, 0.25}],
   UpTo[2]] // Grid // Quiet

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.