WOLFRAM NOTEBOOK

In[]:=
$VersionNumber​​$OperatingSystem​​
Out[]=
13.1
Out[]=
Unix
In[]:=
Needs["NDSolve`FEM`"]​​region=Import[FileNameJoin[{NotebookDirectory[],"Magnet.stl"}],{"STL","BoundaryMeshRegion"}];​​vars={{u[x,y,z],v[x,y,z],w[x,y,z]},{x,y,z}};​​pars=<|"Material"
titanium
ELEMENT
|>;​​
Γ
force
=SolidBoundaryLoadValue[x==10,vars,pars,<|"Force"->{0,0,
-1000
N
}|>];​​
Γ
wall
=SolidFixedCondition[x==-10,vars,pars];​​op=SolidMechanicsPDEComponent[vars,pars];​​regionDisplacement=NDSolveValue[{op
Γ
force
,
Γ
wall
},{u[x,y,z],v[x,y,z],w[x,y,z]},{x,y,z}∈region];​​VectorDisplacementPlot3D[regionDisplacement,{x,y,z}∈region]
Out[]=
In[]:=
(*CalculationwithSTLfile*)​​(*ImportMagnet*)​​magnet=Import[FileNameJoin[{NotebookDirectory[],"Magnet.stl"}],{"STL","BoundaryMeshRegion"}];​​​​(*Settingupmesh*)​​mesh=ToElementMesh[Cuboid[{-20,-10,-10},{20,10,10}],MaxCellMeasure->1]​​(*Settingupvariables*)​​u={ux[x,y,z],uy[x,y,z],uz[x,y,z]};​​​​(*Settingupmagnetizationviaapproximation*)​​appro=With[{k=2.10^4},ArcTan[k#]/Pi+1/2&];​​mx=Simplify`PWToUnitStep@PiecewiseExpand[If[RegionMember[magnet,{x,y,z}],1,0],Reals]/.UnitStep->appro;bmx[x_,y_,z_]:=Curl[{mx,0,0},{x,y,z}]​​(*SettingupPDEandboundaryconditions*)​​pde=Inactivate[Laplacian[u,{x,y,z}],Laplacian];​​bcs=DirichletCondition[{ux[x,y,z]==0,uy[x,y,z]==0,uz[x,y,z]==0},True];​​​​(*SolveandPlotSystem*)​​{Ax,Ay,Az}=NDSolveValue[{bcs,Table[Activate[pde][[i]]==-bmx[x,y,z][[i]],{i,3}]},{ux,uy,uz},{x,y,z}∈mesh]​​B=Evaluate[Curl[{Ax[x,y,z],Ay[x,y,z],Az[x,y,z]},{x,y,z}]];​​VectorPlot3D[{Ax[x,y,z],Ay[x,y,z],Az[x,y,z]},{x,y,z}∈mesh,VectorStyle->Arrowheads[0.01],VectorPoints->Fine]​​
Out[]=
ElementMesh[{{-20.,20.},{-10.,10.},{-10.,10.}},{HexahedronElement[<16000>]}]
Out[]=
InterpolatingFunction
Domain: {{-20.,20.},{-10.,10.},{-10.,10.}}
Output: scalar
Data not in notebook. Store now
,
InterpolatingFunction
Domain: {{-20.,20.},{-10.,10.},{-10.,10.}}
Output: scalar
Data not in notebook. Store now
,
InterpolatingFunction
Domain: {{-20.,20.},{-10.,10.},{-10.,10.}}
Output: scalar
Data not in notebook. Store now
Out[]=
In[]:=
​
In[]:=
(*Calculationwithdummiecuboidregion*)​​mesh=ToElementMesh[Cuboid[{-20,-10,-10},{20,10,10}],MaxCellMeasure->1]​​u={ux[x,y,z],uy[x,y,z],uz[x,y,z]};​​​​appro=With[{k=2.10^4},ArcTan[k#]/Pi+1/2&];​​mx=Simplify`PWToUnitStep@PiecewiseExpand[If[RegionMember[Cuboid[{-10,-4,-4},{10,4,4}],{x,y,z}],1,0],Reals]/.UnitStep->appro;bmx[x_,y_,z_]:=Curl[{mx,0,0},{x,y,z}]​​​​​​pde=Inactivate[Laplacian[u,{x,y,z}],Laplacian];​​​​bcs=DirichletCondition[{ux[x,y,z]==0,uy[x,y,z]==0,uz[x,y,z]==0},True];​​{Ax,Ay,Az}=NDSolveValue[{bcs,Table[Activate[pde][[i]]==-bmx[x,y,z][[i]],{i,3}]},{ux,uy,uz},{x,y,z}∈mesh]​​​​B=Evaluate[Curl[{Ax[x,y,z],Ay[x,y,z],Az[x,y,z]},{x,y,z}]];​​VectorPlot3D[{Ax[x,y,z],Ay[x,y,z],Az[x,y,z]},{x,y,z}∈mesh,VectorStyle->Arrowheads[0.01],VectorPoints->Fine]
Out[]=
ElementMesh[{{-20.,20.},{-10.,10.},{-10.,10.}},{HexahedronElement[<16000>]}]
Out[]=
InterpolatingFunction
Domain: {{-20.,20.},{-10.,10.},{-10.,10.}}
Output: scalar
Data not in notebook. Store now
,
InterpolatingFunction
Domain: {{-20.,20.},{-10.,10.},{-10.,10.}}
Output: scalar
Data not in notebook. Store now
,
InterpolatingFunction
Domain: {{-20.,20.},{-10.,10.},{-10.,10.}}
Output: scalar
Data not in notebook. Store now
Out[]=
Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.