Skip to main content

Solving the nonlinear Cahn-Hilliard equation


I am trying to solve the Cahn-Hilliard equation with a "random" initial condition and boundary conditions as described below:


$$h_t = \nabla^2\left(-\gamma \nabla^2 h + h^3 - h\right)$$ Boundary conditions:


$$h^{(1,0,0)}(0,y,t)=0,h^{(1,0,0)}(L,y,t)=0$$ $$h^{(3,0,0)}(0,y,t)=0,h^{(3,0,0)}(L,y,t)=0$$ $$h^{(0,1,0)}(x,0,t)=0,h^{(0,1,0)}(x,L,t)=0$$ $$h^{(0,3,0)}(x,0,t)=0,h^{(0,3,0)}(x,L,t)=0$$


For now, I am using a "sine wave" initial condition (yes, the initial and boundary conditions are not compatible). My Mathematica code for this is as follows:


Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];

Clear[Eq5, Complete]
Eq5[h_, {γ_}] := \!\(
\*SubscriptBox[\(∂\), \(t\)]h\) -
Laplacian[-γ Laplacian[h, {x, y}] + h^3 - h, {x, y}] == 0;
SetCoordinates[Cartesian[x, y, z]];
Complete[γ_] := Eq5[h[x, y, t], {γ}];
TraditionalForm[Complete[γ]]


L = 1.; TMax = 1.;

bsf = Interpolation@
Flatten[Table[{{x, y}, 1 + .05*RandomReal[{-1, 1}]}, {x, 0,
L + 1}, {y, 0, L + 1}], 1];
Off[NDSolve::mxsst];
Off[NDSolve::ibcinc];
hSol = h /. NDSolve[{
Complete[0.001],
h[x, y, 0] == 1 + 0.5 Sin[2 π x/L] Cos[2 π y/L],
(*h[x,y,0]\[Equal]bsf[x,y],*)
Derivative[1, 0, 0][h][0, y, t] == 0,

Derivative[1, 0, 0][h][L, y, t] == 0,
Derivative[3, 0, 0][h][0, y, t] == 0,
Derivative[3, 0, 0][h][L, y, t] == 0,

Derivative[0, 1, 0][h][x, 0, t] == 0,
Derivative[0, 1, 0][h][x, L, t] == 0,
Derivative[0, 3, 0][h][x, 0, t] == 0,
Derivative[0, 3, 0][h][x, L, t] == 0
},
h,

{x, 0, L},
{y, 0, L},
{t, 0, TMax}, Method -> "LSODA"
][[1]]

This takes forever to run (>5 min on a machine with 32 gigs of ram, I quit it). Are there any tuning parameters that I should use for this equation for it to run smoothly without warnings? It is a stiff equation and hence the choice of LSODA (mma would have chosen this automatically anyway?)


I do notice that for negative values of $\gamma$, stiffness is arrived at sooner and code terminates within 1-2 seconds on my computer.


I also have the warning: "Requested order is too high; order has been reduced to {2,2}."



Answer



I tried a slightly different boundary conditions, mainly since the solution with this conditions is easier:



     Clear[s, eq, bc1, bc2, ic, Lx1, Ly, \[Eta], x, y, t];
Ly = 1;
Lx = 1;

eq=D[\[Eta][t, x, y],t] == -Laplacian[Laplacian[\[Eta][t, x, y], {x, y}], {x, y}] -Laplacian[\[Eta][t, x, y], {x, y}] +
Laplacian[\[Eta][t, x, y]^3, {x, y}];

bc1P = \[Eta][t, x, -Ly] == \[Eta][t, x, Ly];
bc2P = \[Eta][t, -Lx, y] == \[Eta][t, Lx, y];
ic = \[Eta][0, x, y] == 0.5*Exp[-4 (x^2 + y^2)];


and the MethodOfLines


    mol = {"MethodOfLines", "SpatialDiscretization" -> {"TensorProductGrid", 
"DifferenceOrder" -> "Pseudospectral"}};

sol = NDSolve[{eq, bc1P, bc2P, ic}, \[Eta], {t, 0, 1}, {x, -Lx,
Lx}, {y, -Ly, Ly}, Method -> mol] // AbsoluteTiming

It took 703.5 s, but the solution was obtained. Here is its visualization


Grid@Partition[

Table[Plot3D[\[Eta][T, x, y] /. sol[[2, 1, 1]], {x, -Lx,
Lx}, {y, -Ly, Ly}, PlotRange -> All,
AxesLabel -> {"x", "y", "\[Eta]"}, PlotPoints -> 31,
PlotLabel ->
Row[{Style["T=", Italic, 12], Style[T, Italic, 12]}]], {T, {0,
0.005, 0.01, 0.05, 0.07, 0.09, 0.1, 0.2, 0.3, 0.4, 0.5, 1}}], 3]

yielding this:


enter image description here


I hope it helps. On the other hand the solution does not look like a spinodal decomposition, at least at the first glance.



Have fun!


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...