Nonlinear PDE solving in Mathematica - wolfram-mathematica

I am trying to solve the following non linear coupled PDE equation related with ginzburg landau using NDsolve.I am new to Mathematica. I am getting the following error.What is the mistake I am doing?
pde = {D[u[t, x, y], t] ==
D[u[t, x, y], {x, x}] +
D[u[t, x, y], {y,
y}] - (1/u[t, x, y])^3*(D[v[t, x, y], y]^2 +
D[v[t, x, y], x]^2) - u[t, x, y] + u[t, x, y]^3,
D[v[t, x, y], t] ==
D[v[t, x, y], {x, x}] + D[v[t, x, y], {y, y}] -
v[t, x, y]*u[t, x, y] +
(2/u[t, x, y])*(D[u[t, x, y], x]*D[v[t, x, y], x] -
D[u[t, x, y], y]*D[v[t, x, y], y])};bc = {u[0, x, y] == 0, v[0, x, y]== 0, u[t, 5, y] == 1, u[t, x, 5] == 1, D[v[t, 0, y], x] == 0, D[v[t, x, 0], y] == 0};
NDSolve[{pde, bc}, {u, v}, {x, 0, 5}, {y, 0, 5}, {t, 0, 2}]
'Error: NDSolve::deqn: Equation or list of equations expected instead of True in the first argument {{(u^(1,0,0))[t,x,y]==-u[t,x,y]+u[t,x,y]^3+(u^(0,0,y))[t,x,y]-((<<1>>^(<<3>>))[<<3>>]^2+(<<1>>^(<<3>>))[<<3>>]^2)/u[t,x,y]^3+(u^(0,x,0))[t,x,y],(v^(1,0,0))[t,x,y]==-u[t,x,y] v[t,x,y]+(v^(0,0,y))[t,x,y]+(2 (-(<<1>>^(<<3>>))[<<3>>] (<<1>>^(<<3>>))[<<3>>]+(<<1>>^(<<3>>))[<<3>>] (<<1>>^(<<3>>))[<<3>>]))/u[t,x,y]+(v^(0,x,0))[t,x,y]},{u[0,x,y]==0,v[0,x,y]==0,u[t,5,y]==1,u[t,x,5]==1,True,True}}.
NDSolve[{{Derivative[1, 0, 0][u][t, x, y] == -u[t, x, y] +
u[t, x, y]^3 + Derivative[0, 0, y][u][t, x, y] -
(Derivative[0, 0, 1][v][t, x, y]^2 +
Derivative[0, 1, 0][v][t, x, y]^2)/u[t, x, y]^3 +
Derivative[0, x, 0][u][t, x, y],
Derivative[1, 0, 0][v][t, x, y] == (-u[t, x, y])*v[t, x, y] +
Derivative[0, 0, y][v][t, x, y] +
(2*((-Derivative[0, 0, 1][u][t, x, y])*
Derivative[0, 0, 1][v][t, x, y] +
Derivative[0, 1, 0][u][t, x, y]*
Derivative[0, 1, 0][v][t, x, y]))/u[t, x, y] +
Derivative[0, x, 0][v][t, x, y]}, {u[0, x, y] == 0,
v[0, x, y] == 0, u[t, 5, y] == 1, u[t, x, 5] == 1, True,
True}}, {u, v}, {x, 0, 5}, {y, 0, 5}, {t, 0, 2}]

If you look at the value of bc you will see
bc = {u[0, x, y] == 0, v[0, x, y] == 0, u[t, 5, y] == 1,
u[t, x, 5] == 1, D[v[t, 0, y], x] == 0, D[v[t, x, 0], y] == 0}
gives you
{u[0, x, y] == 0, v[0, x, y] == 0, u[t, 5, y] == 1, u[t, x, 5] == 1, True, True}
That is where your error message about True is coming from.
What you were doing was differentiating an expression with respect to x, but the expression had no x in it, thus the result was zero. And 0==0 is always True. Likewise with y. So let's change the way you are trying to tell it the boundary conditions.
bc = {u[0, x, y] == 0, v[0, x, y] == 0, u[t, 5, y] == 1, u[t, x, 5] == 1,
Derivative[0, 1, 0][v][t, 0, y] == 0, Derivative[0, 0, 1][v][t, x, 0] == 0}
or
bc = {u[0, x, y] == 0, v[0, x, y] == 0, u[t, 5, y] == 1, u[t, x, 5] == 1,
D[v[t, x, y], x] == 0/.x->0, D[v[t, x, y], y] == 0/.y->0}
either of which I think should give you what you are looking for.
Once you fix those then you get a different error about Derivative order and non-negative integer.
I believe you fix that by changing your pde from {x,x} and {y,y} to {x,2} and {y,2} like this
pde = {D[u[t, x, y], t] == D[u[t, x, y], {x, 2}] + D[u[t, x, y], {y, 2}] -
(1/u[t, x, y])^3*(D[v[t, x, y], y]^2 + D[v[t, x, y], x]^2) - u[t, x, y] +
u[t, x, y]^3,
D[v[t, x, y], t] == D[v[t, x, y], {x, 2}] + D[v[t, x, y], {y, 2}] - v[t, x, y]*
u[t, x, y] + (2/u[t, x, y])*(D[u[t, x, y], x]*D[v[t, x, y], x] - D[u[t, x, y], y]*
D[v[t, x, y], y])};
Which makes that error go away.
Once you have fixed that and try your NDSolve then zeros in your denominators start to bite you.
Fixing those looks like more than just understanding MMA syntax. That may require understanding your problem and seeing if you can eliminate those zero denominators.

Related

About NDsolve which may be asked several times, but I still failed to solve it

the error is At t == 0.030451749711041764`, step size is effectively zero;singularity or stiff system suspected
my calculation time is around 6000 seconds, however.
And the warning is like
Warning: scaled local spatial error estimate of 6884.220329195682 at t = 0.030451749711041764 in the direction of independent variable x is much greater than the prescribed error tolerance. Grid spacing with 25 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 option.
I tried to using
Method -> {"PDEDiscretization" -> {"MethodOfLines", "SpatialDiscretization" -> "TensorProductGrid", "MinPoints" -> 100}}}
and increasing the "minpoints", but the promblem was still existed.
CAN anyone help me with that?
my code be like solving an deviation equation
bound1 = {FEND[t] == 2*krec [t]*GEND[t]^2, F[t] == -Fb[t], FbEND[t] == 0, G[t] == Gb[t]/1};
bc1 = {y[0, x] == 0., yb[0, x] == 0., ytA1[0, x] == 0., ytA2[0, x] == 0.};
equ1 = {D[y[t, x], t] == Cdif[t] D[y[t, x], x, x] + SRC[t, x] - D[ytA1[t, x], t],
D[yb[t, x], t] == (Cdif[t]/fac^2) D[yb[t, x], x, x]-D[ytA2[t, x], t],
D[ytA1[t, x], t] == ktAT0[t] y[t, x] TRPA1[t, x] - ktATd0[t] ytA1[t, x],
D[ytA2[t, x], t] == ktAT0[t] yb[t, x] TRPA2[t, x] - ktATd0[t] ytA2[t, x]};
Sol1 = NDSolve[{equ1, bound1, bc1}, {y, yb, ytA1, ytA2}, {t, 0, tmax}, {x, 0, xmax}, MaxSteps -> Infinity, StartingStepSize -> 0.001, MaxStepSize -> 1, Method -> {"PDEDiscretization" -> {"MethodOfLines", "SpatialDiscretization" -> {"TensorProductGrid",
"MinPoints" -> 100}}}];

2D Heat Equation Mathematica not solving analitically (DSolve) or numerically (NDSolve), what am I doing wrong?

my goal is to solve the following 2d heat conduction equation, along with initial and boundary conditions:
pde = D[u[x, y, t], t] == (c^2)*(D[u[x, y, t], {x, 2}] + D[u[x, y, t], {y, 2}]);
ic = {u[x,y,0] == 0};
bc = {Derivative[1, 0, 0][u][0, y, t] == k, u[x, 0, t] == 0, u[x, b, t] == 0,
u[a, y, t] == 0};
...but something always goes wrong when i input
sol = DSolve[{pde, bc, ic}, u[x, y, t], {x, y, t}]
I tried changing the conditions a bit to see if that is a problem on mathematica, and sometimes it works (example of this guy). I suspect there is something wrong with the derivative, but I tried using D[u[x,y,t],x]./x->0 == k but still it doesnt work. Is it even possible to solve this in Mathematica?

Mathematica about NDsolve PDE set

I am trying to use NDsolve function to solve a PDE set.
I am pretty new to mathematica and here is the code I put in.
NDSolve[{D[Cm[t, x], t] == Dm*D[Cm[t, x], x, x] + Kg*Cs[t, x] - Ka*Cm[t, x],
D[Cs[t, x], t] == Ds*D[Cs[t, x], x, x] + Ka*Cm[t, x] - Kg*Cs[t, x],
Cm[0, x] == Cm0,
Cs[0, x] == Cs0,
Dm*ND[Cm[t, 0]] == 0.5*FT,
Ds*ND[Cs[t, 0]] == 0.5*FT,
Cm[t, Infinity] == Cm0,
Cs[t, Infinity] == Cs0}
{Cm[t, x], Cs[t, x]}, {t, 0, 1000}, {x, 0, Infinity}];
plot3D[Cs, {t, 0, 1000}, {x, 0, 10000}]
Dm = 9 e - 8;
Ds = 5 e - 9;
Cm0 = 1.276 e + 15;
Cs0 = 1.276 e + 20;
Ka = 1;
Kg = 1 e - 5;
FT = 1 e + 11;
So, basically, we have two PDEs, 2 initial conditions and 4 boundary conditions(two constant B.C. two flux B.C.). We know all the values of parameters. I am not sure if its a formatting problem or boundary choosing problem. The system gives
"Thread::tdlen: Objects of unequal length in "
"NDSolve::argmu: NDSolve called with 1 argument; 3 or more arguments are expected."
Could somebody give some valuable suggestions?
Thanks
Update
Dm = 9*10^-8;
Ds = 5*10^-9;
Cm0 = 1.276*10^+15;
Cs0 = 1.276*10^+20;
Ka = 1;
Kg = 1*10^-5;
FT = 1*10^+11;
NDSolve[{D[Cm[t, x], t] ==
Dm*D[Cm[t, x], x, x] + Kg*Cs[t, x] - Ka*Cm[t, x],
D[Cs[t, x], t] == Ds*D[Cs[t, x], x, x] + Ka*Cm[t, x] - Kg*Cs[t, x],
Cm[0, x] == Cm0,
Cs[0, x] == Cs0,
Dm*(D[Cm[t, x], x] /. x -> 0) == 0.7*FT,
Ds*(D[Cs[t, x], x] /. x -> 0) == 0.3*FT,
Cs[t, 10000] == Cs0,
Cm[t, 10000] == Cm0},
{Cm[t, x], Cs[t, x]}, {t, 0, 1000}, {x, 0, 10001},
PrecisionGoal -> 2];
Animate[Plot[Cs[t, x], {x, 0, 10000},
PlotRange -> {{0, 1000}, {0, 5*10^20}}], {t, 0, 1000}]
The "unequal" error was because you are missing a comma between } and { on your 8th and 9th line.
But that isn't your only problem. This fixes some other, but not all problems.
Dm = 9*10^-8;
Ds = 5 *10^-9;
Cm0 = 1.276*10^+15;
Cs0 = 1.276*10^+20;
Ka = 1;
Kg = 1*10^-5;
FT = 1*10^+11;
NDSolve[{D[Cm[t, x], t] == Dm*D[Cm[t, x], x, x] + Kg*Cs[t, x] - Ka*Cm[t, x],
D[Cs[t, x], t] == Ds*D[Cs[t, x], x, x] + Ka*Cm[t, x] - Kg*Cs[t, x],
Cm[0, x] == Cm0, Cs[0, x] == Cs0, Dm*ND[Cm[t, 0]] == 0.5*FT,
Ds*ND[Cs[t, 0]] == 0.5*FT, Cm[t, Infinity] == Cm0,
Cs[t, Infinity] == Cs0}, {Cm[t, x], Cs[t, x]}, {t, 0, 1000}, {x, 0, Infinity}];
plot3D[Cs, {t, 0, 1000}, {x, 0, 10000}]
Everything (except for the functions you are solving for and the independent variables) inside an NDSolve must be initialized to numeric values before starting the NDSolve, so I moved your assignments up. Mathematica has its' own way of writing exponents.
Now for bigger issues.
You have an ND function that you haven't defined. That is going to have to be defined before the NDSolve starts.
It is possible, maybe even likely that NDSolve is going to be less than cooperative with limits of Infinity for your x variable. It may work, but I wouldn't bet on that. You might try a smaller finite value, maybe 10^4 because that is bigger than your 10^3, and see if that will work if Infinity doesn't.
I don't spot any other big problems at the moment, but without knowing what your ND function is I can't begin to test this and perhaps flush out the next layer or two or three of problems to look for.
But this is actually pretty good if this is your first try at Mathematica.

Free boundary conditions in MATHEMATICA - is this right? Second opinion

I'm trying to prescribe free boundary conditions for a non-linear evolution equation in mathematica and I wanted as second opinion on whether or not what I am doing is right.
The boundary conditions have been marked with a comment, viz., (FREE BOUNDARY CONDITIONS)
I'd also like to run this for pinned boundary conditions.
Needs["VectorAnalysis`"]
Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];
Clear[Eq5, Complete, h, S, G, E1, K1, D1, VR, M]
Eq5[h_, {S_, G_, E1_, K1_, D1_, VR_, M_}] := \!\(
\*SubscriptBox[\(\[PartialD]\), \(t\)]h\) +
Div[-h^3 G Grad[h] +
h^3 S Grad[Laplacian[h]] + (VR E1^2 h^3)/(D1 (h + K1)^3)
Grad[h] + M (h/(1 + h))^2 Grad[h]] + E1/(h + K1) == 0;
SetCoordinates[Cartesian[x, y, z]];
Complete[S_, G_, E1_, K1_, D1_, VR_, M_] :=
Eq5[h[x, y, t], {S, G, E1, K1, D1, VR, M}];
TraditionalForm[Complete[S, G, E1, K1, D1, VR, M]]
L = 185.62; TMax = 100; km = 0.0381;
Off[NDSolve::mxsst];
Off[NDSolve::ibcinc];
hSol = h /. NDSolve[{Complete[100, 0, 0, 0, 0.001, 0, 5],
(*FREE BOUNDARY CONDITIONS*)
Derivative[2, 0, 0][h][0, y, t] == 0,
Derivative[2, 0, 0][h][L, y, t] == 0,
Derivative[0, 2, 0][h][x, 0, t] == 0,
Derivative[0, 2, 0][h][x, L, t] == 0,
Derivative[3, 0, 0][h][0, y, t] == 0,
Derivative[3, 0, 0][h][L, y, t] == 0,
Derivative[0, 3, 0][h][x, 0, t] == 0,
Derivative[0, 3, 0][h][x, L, t] == 0,
(*FREE BOUNDARY CONDITIONS*)
h[x, y, 0] == 1 + (-0.05*Cos[2*Pi*(x/L)] - 0.05*Sin[2*Pi*(x/L)])*
Cos[2*Pi*(y/L)]},
h, {x, 0, L}, {y, 0, L}, {t, 0, TMax}][[1]]
hGrid = InterpolatingFunction[hSol];
{TMin, TRup} = InterpolatingFunctionDomain[hSol][[3]]
The consensus achieved from reading the comments is that the implementation of free boundary conditions in the code above is correct.
More detail should be available in books dealing with mechanics of materials or strength of materials in chapters referring to Bending moments and shear stress diagrams where very often free-free or free-fixed or fixed-fixed boundary conditions are used.

Memory exhaustion while running NDSolve

I run into the "No more memory available" error message in Mathematica. I understand that "Parallelize[]" isn't (obviously) going to help me. Neither has "ClearSystemCache[]".
What gives? Do I just need more RAM?
My Code
Needs["VectorAnalysis`"]
Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];
Clear[Eq4, EvapThickFilm, h, S, G, E1, K1, D1, VR, M, R]
Eq4[h_, {S_, G_, E1_, K1_, D1_, VR_, M_, R_}] := \!\(
\*SubscriptBox[\(\[PartialD]\), \(t\)]h\) +
Div[-h^3 G Grad[h] +
h^3 S Grad[Laplacian[h]] + (VR E1^2 h^3)/(D1 (h + K1)^3)
Grad[h] + M (h/(1 + h))^2 Grad[h]] + E1/(
h + K1) + (R/6) D[D[(h^2/(1 + h)), x] h^3, x] == 0;
SetCoordinates[Cartesian[x, y, z]];
EvapThickFilm[S_, G_, E1_, K1_, D1_, VR_, M_, R_] :=
Eq4[h[x, y, t], {S, G, E1, K1, D1, VR, M, R}];
TraditionalForm[EvapThickFilm[S, G, E1, K1, D1, VR, M, R]];
L = 318; TMax = 10;
Off[NDSolve::mxsst];
Clear[Kvar];
Kvar[t_] := Piecewise[{{1, t <= 1}, {2, t > 1}}]
(*Ktemp = Array[0.001+0.001#^2&,13]*)
hSol = h /. NDSolve[{
(*S,G,E,K,D,VR,M*)
EvapThickFilm[1, 3, 0.1, 7, 0.01, 0.1, 0, 160],
h[0, y, t] == h[L, y, t],
h[x, 0, t] == h[x, L, t],
(*h[x,y,0] == 1.1+Cos[x] Sin[2y] *)
h[x, y, 0] ==
1 + (-0.25 Cos[2 \[Pi] x/L] - 0.25 Sin[2 \[Pi] x/L]) Cos[
2 \[Pi] y/L]
},
h,
{x, 0, L},
{y, 0, L},
{t, 0, TMax},
MaxStepSize -> 0.1
][[1]]
hGrid = InterpolatingFunctionGrid[hSol];
Error message
No more memory available.
Mathematica kernel has shut down.
Try quitting other applications and then retry.
My OS specs
Intel Core 2 Duo with 4.00 GB ram, 64 bit OS (Windows 7)
Here you may get a taste of what is happening:
Replace
MaxStepSize -> 0.1
by
MaxStepFraction -> 1/30
And run your code.
Then:
p = Join[#,Reverse##]&#
Table[Plot3D[hSol[x, y, i], {x, 0, L}, {y, 0, L},
PlotRange -> {All, All, {0, 4}}],
{i, 7, 8, .1}]
Export["c:\\plot.gif", p]
So, Mma is trying to refine the solution at those peaks, to no avail.

Resources