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

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.

Related

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.

Why does this pde give Boundary and initial conditions are inconsistent error? (1D heat pde)

I have been staring at this simple pde for last 20 minutes and can't find why I am getting this error
Boundary and initial conditions are inconsistent
it is that standard 1D heat equation
eq = Derivative[2, 0][u][x, t] == Derivative[0, 1][u][x, t]
and boundary conditions are (notice they are both spatial derivatives)
u'(0,t)=0 (derivative here w.r.t. x )
u'(Pi,t)=0 (derivative here w.r.t. x )
and initial conditions are
u(x,0) = cos(2 x)
So at initial condition, u'(x,0) = -2 sin(2 x), which is zero at both x=0 and x=Pi.
So it seems to me to be consistent with boundary conditions, right? or Am I missing something?
Here is the actual Mathematica code:
ClearAll[u, x, t]
eq = Derivative[2, 0][u][x, t] == Derivative[0, 1][u][x, t]
sol = NDSolve[{eq,
Derivative[1, 0][u][0, t] == 0,
Derivative[1, 0][u][Pi, t] == 0,
u[x, 0] == Cos[2 x]},
u, {t, 0, 12}, {x, 0, Pi}
]
I have a feeling since it is a numerical solver, using Pi in the above, become Real Pi=3.1415... and so at exactly this value the initial and boundary conditions do not match? (floating point comparison somewhere?)
I know about the trick to resolve such an error from help ref/message/NDSolve/ibcinc but my question is really why I am getting this error in the first place, since it seems on the face of it, they are consistent. If it is due to the floating point issue with Pi, then how to resolve this? I tried to use the trick shown in help on this one (i.e. the use of exp(-1000 t) but did not help in removing this error.
question: Why I am getting this error message ?
version 8.04, on windows.
Actually I have been trying to get this solution shown here (also using Mathematica)
http://en.wikipedia.org/wiki/File:Heatequation_exampleB.gif
but the BC and IC shown in the above example gave me this error also, so I made the change in the BC in the hope they become consistent now.
thanks.
edit(1)
Here are the commands I used to plot the plot the solution, and it looks ok
eq = Derivative[2, 0][u][x, t] == Derivative[0, 1][u][x, t]
sol = u /.
First#NDSolve[{eq, Derivative[1, 0][u][0, t] == 0,
Derivative[1, 0][u][Pi, t] == 0, u[x, 0] == Cos[2 x]},
u, {t, 0, 1.5}, {x, 0, Pi}]
Animate[Plot[sol[x, t], {x, 0, Pi},
PlotRange -> {{0, Pi}, {-1, 1}}], {t, 0, 1.5}]
edit(3)
I am still little confused (also did not have coffee yet, which does not help).
I changed the IC so that it is not derivative any more so that the IC (non-derivative) now agrees with the BC's (but those are kept as derivatives). But I still get the same error:
eq = Derivative[2, 0][u][x, t] == Derivative[0, 1][u][x, t]
sol = u /.
First#NDSolve[{eq,
Derivative[1, 0][u][0, t] == 0,
Derivative[1, 0][u][Pi, t] == 0,
u[x, 0] == Sin[2 x]},
u, {t, 0, 1.5}, {x, 0, Pi}
]
NDSolve::ibcinc: Warning: Boundary and initial conditions are inconsistent. >>
Also the solution appears ok when plotted
Animate[Plot[sol[x, t], {x, 0, Pi},
PlotRange -> {{0, Pi}, {-1, 1}}], {t, 0, 1.5}]
What IC is needed for this problem to eliminate this erorr, or is it the case then that only essential BC must be used? and also non-derivative IC's be used, and only after that, I worry on the consistency part?
Szabolcs gave the right hint (See inconsistent boundary condition section in http://reference.wolfram.com/mathematica/tutorial/NDSolvePDE.html)
eq = Derivative[2, 0][u][x, t] == Derivative[0, 1][u][x, t]
sol = u /.
First#NDSolve[{eq, Derivative[1, 0][u][0, t] == 0,
Derivative[1, 0][u][Pi, t] == 0, u[x, 0] == Cos[2 x]},
u, {t, 0, 1.5}, {x, 0, Pi},
Method -> {"MethodOfLines",
"SpatialDiscretization" -> {"TensorProductGrid",
"MinPoints" -> 100}}]
I have filed a suggestion, that the link to the tutorial be added to the NDSolve::ibcinc message page.

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.

How to "embed" Piecewise in NDSolve in Mathematica

I am using NDSolve to solve a non-linear partial differential
equation.
I'd like one of the variables (Kvar) to be a function
of the time step currently being solved and hence and using
Piecewise.
Mathematica generates an error message saying:
SetDelayed::write: Tag Real in 0.05[t_] is Protected. >>
NDSolve::deqn: Equation or list of equations expected instead of
$Failed in the first argument ....
ReplaceAll::reps: ....
I haven't included the entire error message for ease of reading.
My code is as follows:
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]];
And the second cell where I am trying to implement Piecewise in NDSolve:
L = 318; TMax = 7.0;
Off[NDSolve::mxsst];
(*Ktemp = Array[0.001+0.001#^2&,13]*)
hSol = h /. NDSolve[{
(*S,G,E,K,D,VR,M*)
Kvar[t_] := Piecewise[{{0.01, t <= 4}, {0.05, t > 4}}],
EvapThickFilm[1, 3, 0.1, Kvar[t], 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}
][[1]]
hGrid = InterpolatingFunctionGrid[hSol];
PS: I am sorry but the first cell block doesn't display so well here. And thanks to not having enough "reputation", I can't post images.
The error message occurs when using the NDSolve cell block.
Define the function Kvar outside of a set of equations in NDSolve, like
Off[NDSolve::mxsst];
(*Ktemp=Array[0.001+0.001#^2&,13]*)
Kvar[t_] := Piecewise[{{0.01, t <= 4}, {0.05, t > 4}}];
hSol = ...
and remove it from the list in NDSolve, so that it starts as NDSolve[{(*S,G,E,K,D,VR,M*)EvapThickFilm[..., and it will work. It gives warnings, but those are related to possible singularities in your equation.
Also, your original error indicates that your Kvar was assigned a value of 0.05. So, add Clear[Kvar] before anything else in the second cell.

Resources