Guest User

Untitled

a guest
Nov 24th, 2017
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.17 KB | None | 0 0
  1. ClearAll[x, t]
  2. amp = 5787/1000;
  3. tmax = 1000;
  4. L = 20;
  5. vdh[x_?NumericQ, t_?NumericQ] := 1/(1 + h[x, t]) - h[x, t] + Log[h[x, t]/(1 + h[x, t])];
  6. [Lambda][t_Real] := -(1/L)*NIntegrate[vdh[x, t], {x, 0, L}];
  7.  
  8. myfunel = First[h /. NDSolve[{
  9. D[h[x, t], t] == D[h[x, t], {x, 2}] - vdh[x, t] - [Lambda][t],
  10. h[0, t] == h[L, t],
  11. Derivative[1, 0][h][0, t] == Derivative[1, 0][h][L, t],
  12. Derivative[2, 0][h][0, t] == Derivative[2, 0][h][L, t],
  13. h[x, 0] == 1 + 1/Sqrt[2*[Pi]]*Exp[-((x - 10)^2/2)],
  14. WhenEvent[h[L/2, t] >= amp, "StopIntegration"]},
  15. h, {x, 0, L}, {t, 0, tmax},
  16. Method -> {"MethodOfLines",
  17. "SpatialDiscretization" -> {"TensorProductGrid",
  18. "MinPoints" -> 101, "MaxPoints" -> 101,
  19. "DifferenceOrder" -> 4}}, AccuracyGoal -> 20,
  20. WorkingPrecision -> MachinePrecision, StepMonitor :> Print[t]]]
  21.  
  22. f[t_] := NIntegrate[h[x, t]^2 + 1/2*(D[h[x, t], x])^2, {x, 0, L}]
  23. Plot[Evaluate[f[t]/.myfunel], {t, 0, tstop}, PlotRange -> All]
  24.  
  25. vdh = {x, t} [Function] 1/(1 + h[x, t]) - h[x, t] + Log[h[x, t]/(1 + h[x, t])];
  26. λ = t [Function] -(1/L) int@t;
  27. eqn = D[h[x, t], t] == D[h[x, t], {x, 2}] - vdh[x, t] - λ[t];
  28.  
  29. ic = h[x, 0] == 1 + 1/Sqrt[2*π]*Exp[-((x - 10)^2/2)];
  30.  
  31. amp = 5787/1000; tmax = 1000; L = 20;
  32.  
  33. points = 25; difforder = 4; domain = {0, L};
  34.  
  35. {nodes, weights} = Most[NIntegrate`GaussRuleData[points, MachinePrecision]];
  36.  
  37. midgrid = Rescale[nodes, {0, 1}, domain];
  38.  
  39. intrule = int@t -> -Subtract @@ domain weights.Map[Function[x, vdh[x, t]], midgrid] /.
  40. h[x_, t] :> h[x][t];
  41.  
  42. grid = Flatten[{0, midgrid, L}];
  43.  
  44. (*Definition of pdetoode isn't included in this post,
  45. please find it in the link above.*)
  46. fdd[a__] := NDSolve`FiniteDifferenceDerivative[a, PeriodicInterpolation -> True];
  47. ptoofunc = pdetoode[h[x, t], t, grid, difforder];
  48.  
  49. ode = ptoofunc[eqn] /. intrule;
  50. odeic = ptoofunc@ic;
  51. hmid = h@grid[[Length@grid/2 // Round]];
  52.  
  53. sollst = NDSolveValue[{ode, odeic,
  54. WhenEvent[hmid[t] >= amp // Evaluate, "StopIntegration"]}, h /@ grid, {t, 0, tmax}];
  55. {{tmin, trealmax}} = sollst[[1]]["Domain"];
  56. sol = ListInterpolation[
  57. Developer`ToPackedArray@#["ValuesOnGrid"] & /@ sollst, {grid,
  58. sollst[[1]]["Coordinates"][[1]]}];
  59. Plot3D[sol[x, t], {x, 0, L}, {t, tmin, trealmax}, PlotRange -> All]
Add Comment
Please, Sign In to add comment