2
$\begingroup$

Aim: solve coupled heat equation with cubic source, use DensityPlot and observe how system will react to changes in parameter(like kand kc (0 for now)) values.

Clear[func, y]
kc = 0; 
func[k_] :=
 NDSolve[{
   D[y[t, x], t] == D[D[y[t, x], x], x] + y[t, x]^3 - z[t, x],
   D[z[t, x], t] == D[D[z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
   y[0, x] == 0.3, z[0, x] == 0,
   y[t, -2] == 0, z[t, -2] == 0,
   y[t, 2] == 1, z[t, 2] == 0
   },
  {y, z}, {t, 0, 5}, {x, -2, 2}]
Manipulate[
 DensityPlot[
  ({y[tt, xx] /. func[l]}),
  {tt, 0, 5}, {xx, -2, 2}
  ],
 {l, 0, 3, 1}
 ]

Manipulate is not functioning well. I think manipulate computes func[k] each step and its super slow due to double derivative terms. Therefore I thought about the following "solutions":

Solution1 Assume k is a real parameter, and solve equation system once for k. So, for each manipulation step plot for a new k value.

Clear[func, y]
kc = 0; 
(*func[k_]:=
NDSolve[{
D[ y[t,x],t]\[Equal]D[D[ y[t,x],x],x]+y[t,x]^3-z[t,x],
D[ z[t,x],t]\[Equal]D[D[ z[t,x],x],x]+y[t,x]-k*z[t,x]+kc,
y[0,x]\[Equal]0.3,z[0,x]\[Equal]0,
y[t,-2]\[Equal]0,z[t,-2]\[Equal]0,
y[t,2]\[Equal]1,z[t,2]\[Equal]0
},
{y,z},{t,0,5},{x,-2,2}]*)
solfunc[k] := Assuming[k ∈ Reals,
   NDSolve[{
    D[ y[t, x], t] == z[t, x],
    D[ z[t, x], t] == 
     D[D[ z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
    y[0, x] == 0.3, z[0, x] == 0,
    y[t, -2] == 0, z[t, -2] == 0,
    y[t, 2] == 1, z[t, 2] == 0
    },
   {y, z}, {t, 0, 5}, {x, -2, 2}]]
plotme[k_] := y[tt, xx] /. solfunc[k]
Manipulate[
 DensityPlot[
  ({plotme[k]}),
  {tt, 0, 5}, {xx, -2, 2}
  ],
 {k, 0, 3, 1}
 ]

Not worked.

Question1 Does anyone have any thoughts on how to do this?

Solution2

Use Table the solutions of NDSolve. But table-ing a continuous solution in a discrete way should lose of information.

Question2 (I would appreciate if anyone can give a hint.)

Additional Question

Does anyone have any thoughts on how to use interpolate in this set up? (Later it turned out that PlotPoints -> 100 worked fine instead interpolate)

$\endgroup$
  • 1
    $\begingroup$ The issue is not Manipulate, but DensityPlot: If you wrap the first argument in Evaluate, the performance will be a lot better: DensityPlot[Evaluate[{plotme[k]}],...] - if you don't do this, plotme[k] is indeed reevaluated for every point of the plot $\endgroup$ – Lukas Lang Oct 1 at 13:51
  • $\begingroup$ Your initial and boundary condition contradict each other. E.g. y[0, x] == 0.3 and y[t, -2] == 0, and y[t, 2] == 1 $\endgroup$ – Daniel Huber Oct 1 at 14:00
  • $\begingroup$ @DanielHuber yes you are right. $\endgroup$ – confused Oct 1 at 14:15
4
$\begingroup$

With your revised initial and boundary conditions

$Version

(* "12.1.1 for Mac OS X x86 (64-bit) (June 19, 2020)" *)

Clear["Global`*"]

kc = 0;

eqns = {
    D[y[t, x], t] == D[D[y[t, x], x], x] + y[t, x]^3 - z[t, x],
    D[z[t, x], t] == D[D[z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
    y[0, x] == 0.3, z[0, x] == 0.1, y[t, -2] == 0.3, z[t, -2] == 0.1,
    y[t, 2] == 0.3, z[t, 2] == 0.1} // Rationalize;

Use ParametricNDSolve

sol = ParametricNDSolve[eqns, {y, z}, {t, 0, 5}, {x, -2, 2}, {k}]

enter image description here

Manipulate[
 yl = y[l] /. sol;
 DensityPlot[yl[t, x] /. sol, {t, 0, 5}, {x, -2, 2},
  FrameLabel -> (Style[#, 14, Bold] & /@ {t, x}),
  PlotLegends ->
   BarLegend[Automatic, LegendLabel -> "y(t,\[ThinSpace]x)"]],
 {{l, 1}, 0, 3, 1, ControlType -> SetterBar}]

enter image description here

| improve this answer | |
$\endgroup$
3
$\begingroup$

This is the well-functioning code due to changes made according to commentators. thank you for your time.

Clear["Global`*"]

kc = 0; 
func[k_] :=
 NDSolve[{
   D[ y[t, x], t] == D[D[ y[t, x], x], x] + y[t, x]^3 - z[t, x],
   D[ z[t, x], t] == D[D[ z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
   y[0, x] == 0.3, z[0, x] == 0.1,
   y[t, -2] == 0.3, z[t, -2] == 0.1,
   y[t, 2] == 0.3, z[t, 2] == 0.1
   },
  {y, z}, {t, 0, 5}, {x, -2, 2}]
plotme[k_] := y[tt, xx] /. func[k]
Manipulate[
 DensityPlot[Evaluate[plotme[k]],
  {tt, 0, 5}, {xx, -2, 2}],
 {k, 0, 3, 1}]```
| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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