It's not exactly what was asked for but it's another way to display the sought-after deformation. I thought I would share it because it's probably not well known how it can be done, and it seems appropriate to the problem at hand.
First the OP's code computed this displacement:
displacement
(* (0.0001 (-125 x + 10 x^3 - x^4))/(5 + x)^3 *)
Here is an image of the beam. I did not see where the parameters (other than the length L = 5
) were specified. So I made some of it up.
Needs["NDSolve`FEM`"];
mesh = ToElementMesh[FullRegion[2], {{0, L}, {-1, 1}/2}];
u = Function[{x, y}, 0];
v = Function[{x, y}, y (x - L)/20];
uif = ElementMeshInterpolation[{mesh}, u @@@ mesh["Coordinates"]];
vif = ElementMeshInterpolation[{mesh}, v @@@ mesh["Coordinates"]];
mesh = ElementMeshDeformation[mesh, {uif, vif}];
mesh["Wireframe"]
Then we can deform the mesh according to displacement
using ElementMeshDeformation
. I magnified the displacement by 1000
to make the deformation perceptible. The beam can be colored by the magnitude of the displacement at each point.
u = Function[{x, y}, 0];
v = Function @@ {{x, y}, 1000 displacement};
uif = ElementMeshInterpolation[{mesh}, u @@@ mesh["Coordinates"]];
vif = ElementMeshInterpolation[{mesh}, v @@@ mesh["Coordinates"]];
dmesh = ElementMeshDeformation[mesh, {uif, vif}];
deform = (Norm[{0, v @@ #}] & /@ mesh["Coordinates"])
Legended[
Show[
Graphics@ElementMeshToGraphicsComplex[dmesh, All,
VertexColors -> ColorData["Rainbow"] /@ Rescale[deform]],
dmesh["Wireframe"]],
Placed[BarLegend[{"Rainbow", Through[{Min, Max}[deform]]},
LegendLayout -> "Row"], Below]
]
If the arrows are standard in the industry/field, then perhaps something like this:
Show[
BoundaryMeshRegion[mesh],
Graphics[Table[Arrow@Thread[{x, 5000 displacement {-1, 1}}], {x, 0.5, 4.5, 0.5}]]
]
A combination of arrows and coloring. The legend is scaled by 10^6
.
u = Function[{x, y}, 0];
v = Function @@ {{x, y}, displacement};
deform = (Norm[{u @@ #, v @@ #}] & /@ mesh["Coordinates"]);
Legended[
Show[
Graphics[
ElementMeshToGraphicsComplex[mesh, All,
VertexColors -> (ColorData["Rainbow"] /@ Rescale[deform])]],
Graphics[Table[Arrow@Thread[{x, 5000 displacement {-1, 1}}], {x, 0.5, 4.5, 0.5}]]
],
Placed[BarLegend[{"Rainbow", 10^6 Through[{Min, Max}[deform]]},
LegendLayout -> "Row"], Below]
]
VectorPlot issue
VectorPlot
with a variable domain for x2
just hangs on me for reasons I don't understand (bug, maybe?). You can use RegionFunction
instead:
VectorPlot[u, {x, 0, L}, {x2, -t[L]/2, t[L]/2},
PlotLabel -> "vektoros", AspectRatio -> Automatic,
RegionFunction -> Function[{x, x2}, -t[x]/2 < x2 < t[x]/2]]