Skip to main content

finite element method - Numerically solving the Laplace equation in a 2d cylinder


Consider the following Laplace equation and boundary condition $$\begin{equation}\begin{cases} \Delta \theta(r,\phi)=0 \\ \int d \vec{\ell}\cdot\nabla \theta(r,\phi)=2\pi \end{cases} \end{equation}$$ where $\phi\in[0,2\pi)$, $r\in[0,\infty)$ and the integral is over a circular contour of constant $r$ around the origin such that $d\vec{\ell}=rd\phi \hat{\phi}$ with $\hat{\phi}$ a unit vector in direction $\phi$. The solution to this equation is simply $\theta(r,\phi)=\phi$.


I want to learn how to solve this equation numerically in Mathematica and (approximately) recreate the solution in Cartesian coordinates. To this end, I'm taking a cylindrical domain with an annulus to avoid problems at $r=0$. The outer radius is $R_{1}=1$ and the inner radius is $R_{0}=0.1$. The domain looks like this


enter image description here


Following Solve Laplace equation in Cylindrical - Polar Coordinates, I seem to get the correct solution in polar coordinates but not in Cartesian coordinates and I don't understand why.


Any help is appreciated.


In Polar coordinates I get


enter image description here


and in Cartesian coordinates I get


enter image description here



This is the code in polar coordinates


R1 = 1; R0 = 0.1;
regionCyl =
DiscretizeRegion[
RegionDifference[
ImplicitRegion[
0 <= r <= R1 && 0 <= \[Phi] <= 2 \[Pi], {r, \[Phi]}],
ImplicitRegion[
0 <= r <= R0 && 0 <= \[Phi] <= 2 \[Pi], {r, \[Phi]}]],
PrecisionGoal -> 6];

laplacianCil = Laplacian[\[Theta][r, \[Phi]], {r, \[Phi]}, "Polar"];
boundaryConditionCil = {DirichletCondition[\[Theta][
r, \[Phi]] == \[Phi], {r == R0, 0 <= \[Phi] <= 2 \[Pi]}],
DirichletCondition[\[Theta][r, \[Phi]] == \[Phi], {r == R1,
0 <= \[Phi] <= 2 \[Pi]}]};
solCyl = NDSolveValue[{laplacianCil == 0,
boundaryConditionCil}, \[Theta], {r, \[Phi]} \[Element] regionCyl,
MaxSteps -> Infinity];
potentialSquareRepresentation =
ContourPlot[

solCyl[r, \[Phi]], {r, \[Phi]} \[Element] solCyl["ElementMesh"],
ColorFunction -> "Temperature", Contours -> 20,
PlotLegends -> Automatic];
potentialCylindricalRepresentation =
Show[potentialSquareRepresentation /.
GraphicsComplex[array1_, rest___] :>
GraphicsComplex[(#[[1]] {Cos[#[[2]]], Sin[#[[2]]]}) & /@ array1,
rest], PlotRange -> Automatic]

and this is the code in Cartesian coordinates



R1 = 1; R0 = 0.1;
regionCyl =
DiscretizeRegion[
RegionDifference[ImplicitRegion[Sqrt[x^2 + y^2] <= R1, {x, y}],
ImplicitRegion[Sqrt[x^2 + y^2] <= R0, {x, y}]],
PrecisionGoal -> 7];
laplacian = Laplacian[\[Theta][x, y], {x, y}];
boundaryCondition = {DirichletCondition[\[Theta][x, y] ==
ArcSin[y/Sqrt[x^2 + y^2]], {Sqrt[x^2 + y^2] == R0,
0 <= y/Sqrt[x^2 + y^2] <= 2 \[Pi]}],

DirichletCondition[\[Theta][x, y] ==
ArcSin[y/Sqrt[x^2 + y^2]], {Sqrt[x^2 + y^2] == R1,
0 <= y/Sqrt[x^2 + y^2] <= 2 \[Pi]}]};
sol = NDSolveValue[{laplacian == 0,
boundaryCondition}, \[Theta], {x, y} \[Element] regionCyl,
MaxSteps -> Infinity];
DensityPlot[sol[x, y], {x, y} \[Element] regionCyl,
ColorFunction -> "TemperatureMap", PlotLegends -> Automatic,
ImageSize -> Medium]

Answer




In Cartesian coordinates, the solution $\theta $ has a gap on the line $y=0$.To get a solution, you need to make a cut and define a solution on both sides of the cut, for example:


R1 = 1; y0 = 0.01;
regionCyl =
DiscretizeRegion[
RegionDifference[ImplicitRegion[Sqrt[x^2 + y^2] <= R1, {x, y}],
ImplicitRegion[-R1 <= x <= 0 && -y0 <= y <= y0, {x, y}]]];
laplacian = Laplacian[\[Theta][x, y], {x, y}];
boundaryCondition = {DirichletCondition[\[Theta][x, y] ==
ArcTan[x, y], x^2 + y^2 == R1^2],
DirichletCondition[\[Theta][x, y] == Pi, y == y0],

DirichletCondition[\[Theta][x, y] == -Pi, y == -y0]};
sol = NDSolveValue[{laplacian == 0,
boundaryCondition}, \[Theta], {x, y} \[Element] regionCyl,
Method -> {"FiniteElement",
"InterpolationOrder" -> {\[Theta] -> 2},
"MeshOptions" -> {"MaxCellMeasure" -> 0.0001}}];


{DensityPlot[sol[x, y], {x, y} \[Element] regionCyl,
ColorFunction -> "TemperatureMap", PlotLegends -> Automatic,

ImageSize -> Medium],
ContourPlot[sol[x, y], {x, y} \[Element] regionCyl,
ColorFunction -> "TemperatureMap", PlotLegends -> Automatic,
ImageSize -> Medium, Contours -> 20]}

fig1


Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...