2
$\begingroup$

I am trying to solve this following 2D-Diffusion equation (I wrote it in Word, so it looks nice)

enter image description here

(Note: I am solving this for a 100x100 mesh point)

I tried to solve the above equation using the following code:

s1 = NDSolve[{D[u[t, x, y], t] == 
D[u[t, x, y], x, x] + D[u[t, x, y], y, y] + 3*Tanh[u[t, x, y]], 
u[0, x, y] == Sin[(\[Pi] x)/5] Sin[(2 \[Pi] y)/5], 
u[t, -5, y] == 0, u[t, 5, y] == 0, u[t, x, -5] == 0, 
u[t, x, 5] == 0}, u, {t, 0, 6}, {x, -5, 5}, {y, -5, 5}, 
Method -> {"FixedStep", Method -> "ExplicitEuler"}, 
MaxStepFraction -> 10000, WorkingPrecision -> MachinePrecision]

This results in the consistent error of:

NDSolve::eerr
Warning: scaled local spatial error estimate of 26.30473550335526` at \
t = 6.` in the direction of independent variable x is much greater \
than the prescribed error tolerance. Grid spacing with 15 points may
be too large to achieve the desired accuracy or precision. A
singularity may have formed or a smaller grid spacing can be
specified using the MaxStepSize or MinPoints method options. 

I also want to visualize the above equation in such a way that it is appropriate to show for a professional presentation (preferably as a movie)

This is the code that I came up with for the following problem:

a = Table[
Plot3D[u[t, x, y] /. s1, {x, -5, 5}, {y, -5, 5}, Mesh -> 100, 
PlotRange -> All, 
ColorFunction -> Function[{x, y, z}, Hue[.3 (1 - z)]]], {t, 0, 6}]

In summary, I cannot solve the above equation because of an error and I don't know how to visualize equations similar to it properly.

$\endgroup$
  • 7
    $\begingroup$ "What are the best practices when numerical solving PDEs in Mathematica?" Best practice is to not use explicit Euler because they require tiny time step sizes. It is much better to use implicit solvers. $\endgroup$ – Henrik Schumacher Apr 22 '19 at 23:31
  • 1
    $\begingroup$ I actually used the very same code to approximate using 4th order Runge Kutta, and it worked fine. Funnily enough, the less robust method (Forward Euler) is refusing to work as highlighted in the post. The reason I am doing an Explicit Euler is to compare it with other numerical methods! Moreover, the question is meant to ask in terms of code as I feel I am always under Mathematica's will when I use NDSolve, and I want to know how to navigate its built-in AI. {Sorry for my bad English. I am not a native English speaker!} $\endgroup$ – H. Alanzi Apr 22 '19 at 23:37
  • 1
    $\begingroup$ @H.Alanzi if you edit the question to be more concise and request that which you desire, it will be easier to find it offered in an answer. I am curious about the outcomes, so this is my recommendation $\endgroup$ – CA Trevillian Apr 23 '19 at 8:00
  • $\begingroup$ Alright. I will edit it shortly. Any specific edit in particular? $\endgroup$ – H. Alanzi Apr 23 '19 at 19:54
4
$\begingroup$

Rule of thumb: if NDSolve doesn't work well on solving PDE, usually the problem lies in spatial discretization.

When solving spatially 2D problem, the default grid points in each spatial dimension of TensorProductGrid is 15, which may be a bit small in many cases. So let's make the grid denser:

sref = NDSolveValue[{D[u[t, x, y], t] == 
    D[u[t, x, y], x, x] + D[u[t, x, y], y, y] + 3*Tanh[u[t, x, y]], 
   u[0, x, y] == Sin[(π x)/5] Sin[(2 π y)/5], u[t, -5, y] == 0, u[t, 5, y] == 0, 
   u[t, x, -5] == 0, u[t, x, 5] == 0}, u, {t, 0, 6}, {x, -5, 5}, {y, -5, 5}, 
  Method -> {"MethodOfLines", 
    "SpatialDiscretization" -> {"TensorProductGrid", "MaxPoints" -> 50, 
      "MinPoints" -> 50, "DifferenceOrder" -> 4}}]; //AbsoluteTiming
(* {0.601145, Null} *)

The problem is solved without warning. ExplicitEuler can be used of course. We just need to make the StartingStepSize small enough.

s1 = NDSolveValue[{D[u[t, x, y], t] == 
    D[u[t, x, y], x, x] + D[u[t, x, y], y, y] + 3*Tanh[u[t, x, y]], 
   u[0, x, y] == Sin[(π x)/5] Sin[(2 π y)/5], u[t, -5, y] == 0, u[t, 5, y] == 0, 
   u[t, x, -5] == 0, u[t, x, 5] == 0}, u, {t, 0, 6}, {x, -5, 5}, {y, -5, 5}, 
  Method -> {"MethodOfLines", 
    "SpatialDiscretization" -> {"TensorProductGrid", "MaxPoints" -> 50, 
      "MinPoints" -> 50, "DifferenceOrder" -> 4}, 
    Method -> {"FixedStep", Method -> "ExplicitEuler"}}, 
  StartingStepSize -> {0.007, Automatic, Automatic}]; //AbsoluteTiming
(* {0.833146, Null} *)
Plot[{s1[t, 1, 1], sref[t, 1, 1]}, {t, 0, 6}, PlotStyle -> {Automatic, {Thick, Dashed}}]

enter image description here

Animation is easy:

ListAnimate@
 Table[Plot3D[s1[t, x, y], {x, -5, 5}, {y, -5, 5}, PlotRange -> 2], {t, 0, 1, 1/25}]

enter image description here

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

I can offer this implementation explicitly Euler

Lx = 5; Ly = 5; h = .1; t0 = h^2/2; n = 1200;
reg = DiscretizeRegion[Rectangle[{-Lx, -Ly}, {Lx, Ly}], 
  MaxCellMeasure -> h]
Us[0][x_, y_] := Sin[Pi*x/Lx]*Sin[2*Pi*y/Ly]
Do[Us[i] = 
    NDSolveValue[{(u[x, y] - Us[i - 1][x, y])/t0 == 
       D[u[x, y], x, x] + D[u[x, y], y, y] + 3*Tanh[Us[i - 1][x, y]], 
      DirichletCondition[u[x, y] == 0, True]}, 
     u, {x, y} \[Element] reg], {i, 1, n}]; // AbsoluteTiming
Manipulate[
 Plot3D[Us[i][x, y], {x, y} \[Element] reg, Mesh -> None, 
  ColorFunction -> Hue, PlotRange -> {-2, 2}], {i, 0, n, 10}]

fig1

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thank you for this! I was wondering if there is a way to make this code quicker? As it does take a while to compute. $\endgroup$ – H. Alanzi Apr 24 '19 at 3:44
  • $\begingroup$ @H.Alanzi You can make the code faster by using Assemble[]. See Henrik Schumacher post at mathematica.stackexchange.com/questions/193700/… $\endgroup$ – Alex Trounev Apr 24 '19 at 10:55
  • $\begingroup$ We can also make the code faster by putting h=.2; n=300, as in answer @xzczd $\endgroup$ – Alex Trounev Apr 24 '19 at 11:15

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.