Mathematica Asked by user49919 on March 1, 2021
I have been working on $$mathcal{L} psi =f$$ $$mathcal{L} f =0$$
$$frac{partial{psi(r,theta)}}{partial r}|_{r=1}=0$$ $$frac{partial{psi(r,theta)}}{partial r}|_{r=3}=-frac{20(sin[theta])^{2}}{9}=mu(theta)$$ $$psi(r=1,theta)=0$$
$$psi(r=3,theta)=frac{7}{3}(sin(theta))^{2}$$ where $$mathcal{L}u=triangledown.(triangledown u)-frac{2cot(theta)}{r^{2}}frac{partial u}{partial theta} -frac{2}{r}{frac{partial u}{partial r}}$$ such that u is a scalar function given in spherical coordinates.
We need to put this set of pde in flux form to figure out the NeumanValues: then you obtain:
$$mathcal{L}psi=triangledown.(-ctriangledownpsi -alphatriangledownpsi)$$
You find out $$c=-1,$$ $$alpha =big(frac{2}{r},frac{2cot(theta)}{r},0big)$$ Therefore $$vec{n} .(c.triangledown psi +alpha psi)=-psi_{r}(r,theta)+frac{2}{r}psi(r,theta)$$
We also have the following exact solution: $$psi(r,theta)=frac{1}{4}(2r^{2}-3r+frac{1}{r})sin{(theta)^{2}}.$$ I have the following mathematica script :
c = 1;
d = 3;
eqn11 = D[D[ps[r, t], r], r] +
Sin[t]/r^2*
D[1/Sin[t]*D[ps[r, t], t], t];
eqn21 = D[D[w[r, t], r], r] +
Sin[t]/r^2*
D[1/Sin[t]*D[w[r, t],t], t];
W = Rectangle[{c, 0}, {d, Pi}];
astream[r_, t_] := 1/4*(2*r^2 - 3*r + 1/r)*(Sin[t])^2;
N1 =
NeumannValue[(-(1/4) (-3 - 1/r^2 + 4 r) *(Sin[t])^2 +
2/r*(astream[r, t])), r == 1];
N2 =
NeumannValue[(-(1/4) (-3 - 1/r^2 + 4 r) *(Sin[t])^2 +
2/r*(astream[r, t])), r == d];
bcs = {DirichletCondition[ps[r, t] == astream[r, t],
r == 1 || r == d]};
ui = NDSolveValue[
{eqn11 == w[r,t] +N1 +
N2, eqn21 == 0, bcs},
{ps, w}, Element[{r,t}, W],
Method -> {"PDEDiscretization" -> {"FiniteElement",
"MeshOptions" -> {"MaxCellMeasure" -> 0.0005},
"IntegrationOrder" -> 5}}
]
To visualize the output:
streamfunction =
TransformedField["Polar" -> "Cartesian",
ui[[1]][r, t], {r, t} -> {x, z}];
ContourPlot[streamfunction, {x, -3, 3}, {z, 0, 3},
ColorFunction -> "Temperature", Contours -> 50,
PlotLegends -> Automatic, PlotRange -> All, Exclusions -> None]
Here is the exact solution in cartesian coordinates:
ContourPlot[(
z^2 (1 - 3 x^2 - 3 z^2 + 2 x^2 Sqrt[x^2 + z^2] +
2 z^2 Sqrt[x^2 + z^2]))/(
4 (x^2 + z^2)^(3/2)), {x, -3, 3}, {z, 0, 3},
ColorFunction -> "Temperature", PlotLegends -> Automatic,
Contours -> 50,
RegionFunction -> Function[{x, z}, 1 < x^2 + z^2 < 3^2],
PlotRange -> All]
If you compare the exact solution with the numerical solution for a specific value of $theta$ you have :
Plot[(1/4*(2*r^2 - 3*r + 1/r)*(Sin[t])^2 /. {r ->
q, t -> Pi/4}) - (ui[[1]][
r, t] /. {r -> q, t-> Pi/4}), {q, 1, 3},
PlotRange -> All]
I could not get a convergent numerical solution to the exact solution. I was wondering what is that I am doing wrong. What also came to my attention is that the first Neumann boundary condition is not really effecting the output at all. I just did not understand. I would be so happy to know the reason of this awkward behavior of the solution.
Consider the following 1D analogue of the PDE in the question:
N1 = NeumannValue[0, x == 0]; N2 = NeumannValue[1, x == 1];
s3 = Flatten@NDSolveValue[{ps''[x] == w[x] + N1 + N2, w''[x] == 0,
DirichletCondition[ps[x] == 0, x == 0],
DirichletCondition[ps[x] == 1, x == 1]}, {ps[x], w[x]}, {x, 0, 1}];
NDSolveValue::femibcnd: No DirichletCondition or Robin-type NeumannValue was specified for {w}; the result is not unique up to a constant.
which is the same error message received when running the code in the question. The solution obtained is,
Plot[s3, {x, 0, 1}]
This problem can be solved without DirichletCondition
and NeumannValue
as follows.
s2 = Flatten@NDSolveValue[{ps''[x] == w[x], w''[x] == 0, ps[0] == 0, ps'[0] == 0,
ps[1] == 1, ps'[1] == 1}, {ps[x], w[x]}, {x, 0, 1}];
Plot[s2, {x, 0, 1}]
It yields the correct answer, and no error message.
Edit: paragraph added. Evidently, NDSolveValue
becomes confused by this particular fourth-order ODE system, in which all boundary conditions are applied to one of the two ODEs, but only when using DirichletCondition
and NeumannValue
. According to the documentation for NeumannValue
, when no boundary condition is provided for part of the boundary of a differential equation, a homogeneous Neumann boundary condition is assumed. Since the ODE for w[x]
has no associated boundary conditions in the s3
computation, NDSolveValue
may make that assumption. Then, with a homogeneous ODE and homogeneous boundary conditions, the solution obviously is a constant, taken by NDSolveValue
to be 0
. This line of thought would explain both the error message and the w[x] == 0
solution obtained in the s3
computation. Then, when NDSolveValue
turns to the ps[x]
ODE, it encounters too many boundary conditions. It appears simply to ignore two of them, namely N2
and DirichletCondition[ps[x] == 1, x == 1]
. Admittedly, this final paragraph is but a plausibility argument, but it seems reasonable.
In any case, I believe that the same thing is happening with the fourth-order PDE system in the question, especially because plotting w[r,t]
from the code in the question shows it to be of order 10^-8
.
Addendum: Attempted 2D Work-Arounds
Not using DirichletCondition
and NeumannValue
for the 1D example presented above led to the correct answer. Unfortunately, trying to do the same in 2D is unsuccessful.
bcs = {ps[1, t] == astream[1, t], ps[d, t] == astream[d, t],
(D[ps[r, t], r] /. r -> 1) == 0, (D[ps[r, t], r] /. r -> d) == -2 Sin[t]^2/3};
ui = NDSolveValue[{eqn11 == w[r, t] , eqn21 == 0, bcs}, {ps, w}, {r, 1, d}, {t, 0, Pi}]
returns unevaluated with the error message,
NDSolveValue::fembdnl: The dependent variable in (ps^(1,0))[1,t]==0 in the boundary condition DirichletCondition[(ps^(1,0))[1,t]==0,r==1.] needs to be linear.
(This error message makes no sense, again suggesting that NDSolveValue
is confused by the PDE system.) Combining the two second order PDEs into one fourth-order PDE also fails.
eqn = D[D[(D[D[ps[r, t], r], r] + Sin[t]/r^2*D[1/Sin[t]*D[ps[r, t], t], t]), r], r] +
Sin[t]/r^2*D[1/Sin[t]*D[(D[D[ps[r, t], r], r] +
Sin[t]/r^2*D[1/Sin[t]*D[ps[r, t], t], t]), t], t];
ui = NDSolveValue[{eqn == 0, bcs}, {ps}, {r, 1, d}, {t, 0, Pi}]]
NDSolveValue::femcmsd: The spatial derivative order of the PDE may not exceed two.
It may be that NDSolve
and its variants simply are unable to solve the PDE system in the question.
I would welcome comments on whether the situation described here is a bug.
Answered by bbgodfrey on March 1, 2021
Here is a partial solution; especially to the issues of @bbgodfrey 's answer. Let's look at the fourth-order ODE:
s1 = Flatten@
NDSolveValue[{ps''''[x] == 0, ps[0] == 0, ps'[0] == 0, ps[1] == 1,
ps'[1] == 1}, {ps[x]}, {x, 0, 1}];
Plot[s1, {x, 0, 1}]
This fourth-order ODE can be re-written as a system of two coupled second-order ODEs.
s2 = Flatten@
NDSolveValue[{ps''[x] == w[x], w''[x] == 0, ps[0] == 0,
ps'[0] == 0, ps[1] == 1, ps'[1] == 1}, {ps[x], w[x]}, {x, 0,
1}];
Plot[s2, {x, 0, 1}]
Plot[s1[[1]] - s2[[1]], {x, 0, 1}, PlotRange -> All]
Now, bbgodfrey proposed the following:
N1 = NeumannValue[0, x == 0]; N2 = NeumannValue[1, x == 1];
s3 = Flatten@
NDSolveValue[{ps''[x] == w[x] + N1 + N2, w''[x] == 0,
DirichletCondition[ps[x] == 0, x == 0],
DirichletCondition[ps[x] == 1, x == 1]}, {ps[x], w[x]}, {x, 0,
1}];
Plot[s3, {x, 0, 1}]
This works as it should but does not give the intended solution. What happens is that at the end points we have multiple boundary conditions, one DirichletCondition
and a NeumannValue
at each end. One thing to remember with the Finite Element Method is that NeumannValue
is not really equal to the Derivative of a function. The NeumannValue
is satisfied in a weak sense (see the section The Relation between NeumannValue and Boundary Derivatives). When you have a DirichletCondition
and a NeumannValue
at a boundary then the DirichletCondition
will overwrite the NeumannValue
.
How can we word around that? Two ways. One is if you have additional information you may be able to specify an additional DirichletCondition
on the auxiliary equation like so:
s4 = Flatten@NDSolveValue[{ps''[x] == w[x],
w''[x] == 0,
DirichletCondition[ps[x] == 0, x == 0],
DirichletCondition[ps[x] == 1, x == 1],
DirichletCondition[w[x] == 4, x == 0],
DirichletCondition[w[x] == -2, x == 1]
}, {ps[x], w[x]}, {x, 0, 1}];
Plot[s4, {x, 0, 1}]
Plot[s2 - s4, {x, 0, 1}]
Note that this also got rid of the warning that the solution is not unique.
Another way to do it is the following trick to decouple the overlapping boundary conditions:
s5 = Flatten@NDSolveValue[{
ps''[x] ==
w[x] - NeumannValue[0, x == 0] - NeumannValue[1, x == 1],
w''[x] ==
DirichletCondition[ps[x] == 0, x == 0] +
DirichletCondition[ps[x] == 1, x == 1]
}, {ps[x], w[x]}, {x, 0, 1}, Method -> "FiniteElement"];
Plot[s5, {x, 0, 1}]
NDSolveValue::femibcnd: No DirichletCondition or Robin-type NeumannValue was specified for {ps}; the result may not be unique.
Plot[s1[[1]] - s5[[1]], {x, 0, 1}]
OK, what is this doing? One can associate DirichletConditions
to a specific equation in exactly the same way as NeumannValues
are. The reason that this functionality is undocumented is that I never had an application for it - now it seems we have that. This works by applying the NeumannValue
and the DirichletCondition
at different positions in the global stiffness matrix. If you like to know more about that, let me know and I'll extend the post.
Regarding the warning message: In some cases not specifying a DirichletConditon
or a Robin-type NeumannValue
on some of the equations will deliver a solution with is correct but only up to a constant value - it's a bit like an integration constant. I am not aware of any analysis where I can tell reliably that this such and such a case this is or is not going to happen, that's why the warning is there. In this case it's benign I think. In a future version I have reworded the warning message a bit and it will read:
NDSolveValue::femibcnd: No DirichletCondition or Robin-type NeumannValue was specified for {ps}; the result may not be unique.
This, I think, makes it clearer that this a warning and things may go south but don't have to.
Very unfortunately, when using this technique on the original problem it does not quite work:
c = 1;
d = 3;
eqn11 = D[D[ps[r, t], r], r] +
Sin[t]/r^2*D[1/Sin[t]*D[ps[r, t], t], t];
eqn21 = D[D[w[r, t], r], r] +
Sin[t]/r^2*D[1/Sin[t]*D[w[r, t], t], t];
W = Rectangle[{c, 0}, {d, Pi}];
astream[r_, t_] := 1/4*(2*r^2 - 3*r + 1/r)*(Sin[t])^2;
N2 = NeumannValue[(-(1/4) (-3 - 1/r^2 + 4 r)*(Sin[t])^2 +
2/r*(astream[r, t])), r == 1 || r == d];
ui = NDSolveValue[{eqn11 == w[r, t] + N2,
eqn21 ==
DirichletCondition[ps[r, t] == astream[r, t],
r == 1 || r == d]}, {ps, w}, Element[{r, t}, W]]
opts = {ColorFunction -> "Temperature", Contours -> 50,
PlotLegends -> Automatic, PlotRange -> All, Exclusions -> None,
AspectRatio -> Automatic};
streamfunction =
TransformedField["Polar" -> "Cartesian",
ui[[1]][r, t], {r, t} -> {x, z}];
anasol = TransformedField["Polar" -> "Cartesian",
astream[r, t], {r, t} -> {x, z}];
(*ContourPlot[streamfunction,{x,-3,3},{z,0,3},Evaluate[opts]]*)
Plot3D[streamfunction - anasol, {x, -3, 3}, {z, 0, 3}, Evaluate[opts]]
It seems the boundary conditions are OK, but some energy is generated in the region. I don't know the reason for that; I have trouble following the derivation in the question and see how it relates the the implementation. There might be an issue here. An alternative thing to check is if this cases needs Inactive
equations - discussed in the NeumannValue and Formal Partial Differential Equations section.
Answered by user21 on March 1, 2021
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP