Skip to main content
for better readability
Source Link

Here is a brute-force solution consisting in integrating the problem with stepsizes divided by 2, 4, 8, 16... until the absolute difference between two consecutive solutions goes below a tolerance threshold:

reg = Line[{{0}, {1}}];
shape = Cos[16 π (x - 0.5)] D[0.125 Erf[(x - 0.5)/0.125], x];
op = D[u[t, x], {x, 2}] - D[u[t, x], {t, 2}];
ics = {u[0, x] == shape, Derivative[1, 0][u][0, x] == 0};
sol[maxCellMeasure_] := NDSolveValue[{op == 0, ics}, u, {t, 0, 2}, {x} \[Element] reg, 
      Method -> {"FiniteElement",
                 "MeshOptions" -> {"MaxCellMeasure" -> maxCellMeasure_}}];

decreaseStep[{maxCellMeasure_, so_}, print_: False] := 
  Block[{}, 
   If[print, Print["maxCellMeasure=" <> ToString[maxCellMeasure/2]]];
   {maxCellMeasure/2, sol[maxCellMeasure/2]}]

compare[sol1_, sol2_] := 
  Block[{points = sol1[Grid][[-1]]},
    ( (sol2[Sequence @@ #] & /@ points)
    - (sol1[Sequence @@ #] & /@ points)) // Abs // Max]

solu[initialMaxCellMeasure_, tol_, maxSteps_: 10, print_: False] :=
  NestWhileList[decreaseStep[#, print] &,
                {initialMaxCellMeasure, 
  sol[initialMaxCellMeasure]},  
               sol[initialMaxCellMeasure]}, (compare[#1[[2]], #2[[2]]] > tol)&,
                2, maxSteps][[-1]]
solu0 = solu[0.05, 0.001, 10, True]

enter image description here

Any more elegant solution would be appreciated.

Denis

Here is a brute-force solution consisting in integrating the problem with stepsizes divided by 2, 4, 8, 16... until the absolute difference between two consecutive solutions goes below a tolerance threshold:

reg = Line[{{0}, {1}}];
shape = Cos[16 π (x - 0.5)] D[0.125 Erf[(x - 0.5)/0.125], x];
op = D[u[t, x], {x, 2}] - D[u[t, x], {t, 2}];
ics = {u[0, x] == shape, Derivative[1, 0][u][0, x] == 0};
sol[maxCellMeasure_] := NDSolveValue[{op == 0, ics}, u, {t, 0, 2}, {x} \[Element] reg, 
      Method -> {"FiniteElement",
                 "MeshOptions" -> {"MaxCellMeasure" -> maxCellMeasure_}}];

decreaseStep[{maxCellMeasure_, so_}, print_: False] := 
  Block[{}, 
   If[print, Print["maxCellMeasure=" <> ToString[maxCellMeasure/2]]];
   {maxCellMeasure/2, sol[maxCellMeasure/2]}]

compare[sol1_, sol2_] := 
  Block[{points = sol1[Grid][[-1]]},
    ( (sol2[Sequence @@ #] & /@ points)
    - (sol1[Sequence @@ #] & /@ points)) // Abs // Max]

solu[initialMaxCellMeasure_, tol_, maxSteps_: 10, print_: False] :=
  NestWhileList[decreaseStep[#, print] &,
                {initialMaxCellMeasure, 
                  sol[initialMaxCellMeasure]}, (compare[#1[[2]], #2[[2]]] > tol)&,
                2, maxSteps][[-1]]
solu0 = solu[0.05, 0.001, 10, True]

enter image description here

Any more elegant solution would be appreciated.

Denis

Here is a brute-force solution consisting in integrating the problem with stepsizes divided by 2, 4, 8, 16... until the absolute difference between two consecutive solutions goes below a tolerance threshold:

reg = Line[{{0}, {1}}];
shape = Cos[16 π (x - 0.5)] D[0.125 Erf[(x - 0.5)/0.125], x];
op = D[u[t, x], {x, 2}] - D[u[t, x], {t, 2}];
ics = {u[0, x] == shape, Derivative[1, 0][u][0, x] == 0};
sol[maxCellMeasure_] := NDSolveValue[{op == 0, ics}, u, {t, 0, 2}, {x} \[Element] reg, 
      Method -> {"FiniteElement",
                 "MeshOptions" -> {"MaxCellMeasure" -> maxCellMeasure_}}];

decreaseStep[{maxCellMeasure_, so_}, print_: False] := 
  Block[{}, 
   If[print, Print["maxCellMeasure=" <> ToString[maxCellMeasure/2]]];
   {maxCellMeasure/2, sol[maxCellMeasure/2]}]

compare[sol1_, sol2_] := 
  Block[{points = sol1[Grid][[-1]]},
    ( (sol2[Sequence @@ #] & /@ points)
    - (sol1[Sequence @@ #] & /@ points)) // Abs // Max]

solu[initialMaxCellMeasure_, tol_, maxSteps_: 10, print_: False] :=
  NestWhileList[decreaseStep[#, print] &,
                {initialMaxCellMeasure, sol[initialMaxCellMeasure]},  
                (compare[#1[[2]], #2[[2]]] > tol)&,
                2, maxSteps][[-1]]
solu0 = solu[0.05, 0.001, 10, True]

enter image description here

Any more elegant solution would be appreciated.

Denis

Source Link

Here is a brute-force solution consisting in integrating the problem with stepsizes divided by 2, 4, 8, 16... until the absolute difference between two consecutive solutions goes below a tolerance threshold:

reg = Line[{{0}, {1}}];
shape = Cos[16 π (x - 0.5)] D[0.125 Erf[(x - 0.5)/0.125], x];
op = D[u[t, x], {x, 2}] - D[u[t, x], {t, 2}];
ics = {u[0, x] == shape, Derivative[1, 0][u][0, x] == 0};
sol[maxCellMeasure_] := NDSolveValue[{op == 0, ics}, u, {t, 0, 2}, {x} \[Element] reg, 
      Method -> {"FiniteElement",
                 "MeshOptions" -> {"MaxCellMeasure" -> maxCellMeasure_}}];

decreaseStep[{maxCellMeasure_, so_}, print_: False] := 
  Block[{}, 
   If[print, Print["maxCellMeasure=" <> ToString[maxCellMeasure/2]]];
   {maxCellMeasure/2, sol[maxCellMeasure/2]}]

compare[sol1_, sol2_] := 
  Block[{points = sol1[Grid][[-1]]},
    ( (sol2[Sequence @@ #] & /@ points)
    - (sol1[Sequence @@ #] & /@ points)) // Abs // Max]

solu[initialMaxCellMeasure_, tol_, maxSteps_: 10, print_: False] :=
  NestWhileList[decreaseStep[#, print] &,
                {initialMaxCellMeasure, 
                  sol[initialMaxCellMeasure]}, (compare[#1[[2]], #2[[2]]] > tol)&,
                2, maxSteps][[-1]]
solu0 = solu[0.05, 0.001, 10, True]

enter image description here

Any more elegant solution would be appreciated.

Denis