Skip to main content

finite element method - how to create a FEM mesh with "RegionPlot" where the sample points are a function of the position



I need to resolve the diffusion equation in a domain with circular sources (holes).


I've tried defining the whole region with holes but the result is very mesh-dependent and not symmetric, so at the moment I'm imposing the symmetry myself by only solving 1/4th of the system.


cords = Table[{i, 0}, {i, {0, 5}}];
Ω = Apply[And, Norm[{x, y} - #]^2 > 1 & /@ cords]

mesh2 = ToElementMesh[
ImplicitRegion[
And[x > 0 &&
y > 0 && ( x - 2)^2 + y^2 <= 900, Ω], {x, y}],
"MaxBoundaryCellMeasure" -> .5, "ImproveBoundaryPosition" -> False,

"MaxCellMeasure" -> 10,
"BoundaryMeshGenerator" -> {"RegionPlot",
"SamplePoints" -> 300}];

This looks like this:


enter image description here


Having so many sample points makes the mesh creation really slow, so I would like to have a way to make the resolution position-dependent, having more resolution on the region plot near the centre and less in the outer border.


EDIT:


The problem I have is that I need to go to relatively large regions, and if I use the mesh refining option as user21 recommends, I end up with something like this:


zoom in for the region user21 proposes but with a 2 outer radius



A coarse approximation to the solution is two logarithmic decays from the centre of each particle, so I'd like the resolution of the boundary to go like that.


EDIT2:


somebody should have told me, "don't try FEM in V10.0", most of the other problems I was having disappeared after updating.


Not only the MeshRefinementFunction works as expected in 10.3 but also the solution is much more symmetric and continuous for the cases I'm looking at. I don't think it's only because the mesh is better made in the new version, seems like a more robust solver, at least from the user side of it.


Despite "MaxBoundaryCellMeasure" not accepting a function of position, the MeshRefinementFunction can be used to refine wherever one wants to. In my case I'm looking at something like this:


MeshRefinementFunction -> 
Function[{vertices, area},
area > 0.0125 (0.1 +
If[Norm[Mean[vertices] - {2.5, 0}] < 5, 4,
4 + Norm[Mean[vertices] - {2.5, 0}]^2])


Which is pretty much exactly what I wanted to achieve when i posed the question. Thanks user21!


Update


The problem seems to persist in mma 11, at least in my mac.


enter image description here


Even thought the refinement function is quite fine:


enter image description here



Answer



You could use:


Needs["NDSolve`FEM`"]

ToElementMesh[
RegionDifference[
RegionDifference[Disk[{0, 0}, 1, {0, \[Pi]/2}],
Disk[{0, 0}, 1/25]], Disk[{3/10, 0}, 1/25]],
MeshRefinementFunction ->
Function[{vertices, area},
area > 0.0005 (0.1 + 2 Norm[Mean[vertices]])]]["Wireframe"]

enter image description here


For a larger domain:



Needs["NDSolve`FEM`"]
mesh = ToElementMesh[
RegionDifference[
RegionDifference[Disk[{0, 0}, 5, {0, \[Pi]/2}],
Disk[{0, 0}, 1/25]], Disk[{3/10, 0}, 1/25]],
MeshRefinementFunction ->
Function[{vertices, area},
area > 0.0005 (0.1 + Norm[Mean[vertices]])]];
mesh["Wireframe"[PlotRange -> {{-0.1, 1}, {-0.1, 1}}]]


enter image description here


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...

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[ ...