Kinematics 2021

Curvilinear system defs

Clear[FF,HH,DF,GG,κκ];

FF[r_,{α_,β_,γ_},cnd_]:=Module[{eα,eβ,eγ,hα,hβ,hγ},
eα =(∂_α)r; 
hα =Simplify[Sqrt[eα.eα ]];
eα =Simplify[eα/hα]; 
eβ =(∂_β)r;
If[AllTrue[PossibleZeroQ[eβ],#&],
eβ =(∂_α)eα;
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=eβ/hβ,
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=Simplify[eβ/hβ]];  
eγ =(∂_γ)r;
If[AllTrue[PossibleZeroQ[eγ ],#&],
eγ =Simplify[eα\[Cross]eβ],
hγ=Simplify[Sqrt[eγ.eγ ]];
eγ=Simplify[eγ/hγ]];
Simplify[{eα,eβ,eγ},cnd]];

DF[r_,var_,cnd_]:=Module[{FFT,FFTINV},
FFT=FF[r,var,cnd];
FFTINV=Inverse[FFT];
Return[Simplify[Map[D[FFT,#].FFTINV&,var],cnd]]];

HH[r_,{α_,β_,γ_},cnd_]:=Module[{eα,eβ,eγ,hα,hβ,hγ,rr},
rr=r;
eα =(∂_α)r; 
hα =Simplify[Sqrt[eα.eα ]];
eα =Simplify[eα/hα]; 
eβ =(∂_β)r;
If[AllTrue[PossibleZeroQ[eβ],#&],
eβ =(∂_α)eα;
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=eβ/hβ;rr=rr+β eβ,
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=Simplify[eβ/hβ]];  
eγ =(∂_γ)r;
If[AllTrue[PossibleZeroQ[eγ ],#&],
eγ =Simplify[eα\[Cross]eβ]; rr=rr+γ eγ,
hγ=Simplify[Sqrt[eγ.eγ ]];
eγ=Simplify[eγ/hγ]];
Return[Simplify[Transpose[D[rr ,{{α,β,γ}}]],cnd]]];

GG[r_,{α_,β_,γ_},cnd_]:=Module[{eα,eβ,eγ,hα,hβ,hγ,rr,FFT,HHT},
rr=r;
eα =(∂_α)r; 
hα =Simplify[Sqrt[eα.eα ]];
eα =Simplify[eα/hα]; 
eβ =(∂_β)r;
If[AllTrue[PossibleZeroQ[eβ],#&],
eβ =(∂_α)eα;
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=eβ/hβ;rr=rr+β eβ,
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=Simplify[eβ/hβ]];  
eγ =(∂_γ)r;
If[AllTrue[PossibleZeroQ[eγ ],#&],
eγ =Simplify[eα\[Cross]eβ]; rr=rr+γ eγ,
hγ=Simplify[Sqrt[eγ.eγ ]];
eγ=Simplify[eγ/hγ]];
FFT={eα,eβ,eγ};
HHT= Transpose[D[rr ,{{α,β,γ}}]];
Return[Simplify[Inverse[HHT. Transpose[FFT]],cnd]]];

κκ[r_,var_,cnd_]:=Module[{GGT,DFT,GN,eβ}, 
DFT=DF[r,var,cnd];
eβ =D[r,var[[2]]];
GN=If[AllTrue[PossibleZeroQ[eβ],#&],
{DFT[[1,2]],DFT[[2,2]],DFT[[3,2]]},
{DFT[[1,3]],DFT[[2,3]],DFT[[3,3]]}];
GGT=GG[r,var,cnd];
Return[Simplify[Transpose[GGT.GN]]]];

Coordinate graphics defs

SURFACEPLOT[r0_,αdom_,βdom_,γdom_] :=Module[{α,β,γ,rr,eα,hα ,eβ,hβ,eγ,hγ,DIM},
{α,β,γ}={αdom[[1]],βdom[[1]],γdom[[1]]};
rr=r0;
eα =(∂_α)rr; 
hα =Simplify[Sqrt[eα.eα ]];
eα =Simplify[eα/hα]; 
eβ =(∂_β)rr;
If[AllTrue[PossibleZeroQ[eβ],#&],
DIM =1;eβ =(∂_α)eα; 
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=eβ/hβ;rr=rr+β eβ,DIM=2;
hβ=Simplify[Sqrt[eβ.eβ ]];
eβ=Simplify[eβ/hβ]];
eγ =(∂_γ)rr;
If[AllTrue[PossibleZeroQ[eγ ],#&],
 eγ =Simplify[eα\[Cross]eβ]; rr=rr+γ eγ,DIM=3;
hγ=Simplify[Sqrt[eγ.eγ ]];
eγ=Simplify[eγ/hγ]];

(*surfaces*)
domainpoints=Table[(rr /.γ->0),αdom,βdom];
outerpoints=Table[(rr/.γ->γdom[[3]]),αdom,βdom];
innerpoints=Table[(rr/.γ->γdom[[2]]),αdom,βdom];
lowerpoints=Table[(rr/.β->βdom[[2]]),αdom,γdom];
upperpoints=Table[(rr/.β->βdom[[3]]),αdom,γdom];

domain =MAKESURFACE[domainpoints,0.6];
outer = MAKESURFACE[outerpoints,0.5];
inner = MAKESURFACE[innerpoints,0.5];
lower = MAKESURFACE[lowerpoints,0.5];
upper= MAKESURFACE[upperpoints,0.5];

(*arrows*)
doma =αdom;doma[[4]]=(αdom[[3]]-αdom[[2]])/10;
domb =βdom;domb[[4]]=(βdom[[3]]-βdom[[2]])/10;
{arr1 ,arr2 ,arr3}=Which[
DIM==1,
{{Table[({rr,rr+eα/20}/.{ γ->0, β->0}),Evaluate[doma]]},{Table[({rr,rr+eβ/20}/. { γ->0, β->0}),Evaluate[doma]]},{Table[({rr,rr+eγ/20}/.{ γ->0, β->0}),Evaluate[doma]]}},
DIM==2 ,
{Table[({rr,rr+eα/20}/. γ->0),Evaluate[doma],Evaluate[domb]],Table[({rr,rr+eβ/20}/. γ->0),Evaluate[doma],Evaluate[domb]],Table[({rr,rr+eγ/20}/.γ->0),Evaluate[doma],Evaluate[domb]]},
DIM==3 ,
{Table[({rr,rr+eα/20}/. γdom[[1]]->0.),Evaluate[doma],Evaluate[domb]],Table[({rr,rr+eβ/20}*1./. γdom[[1]]->0),Evaluate[doma],Evaluate[domb]],Table[({rr,rr+eγ/20}*1./.γdom[[1]]->0),Evaluate[doma],Evaluate[domb]]}];

arrows1=Join[{Arrowheads[Tiny],Red},Map[Arrow[#]&,Flatten[arr1,1]]];
arrows2=Join[{Arrowheads[Tiny],Green},Map[Arrow[#]&,Flatten[arr2,1]]];
arrows3=Join[{Arrowheads[Tiny],Blue},Map[Arrow[#]&,Flatten[arr3,1]]];
(* SHOW ACTIVES *)
Print[Show[Graphics3D[inner],Graphics3D[outer],Graphics3D[lower],Graphics3D[upper],Graphics3D[arrows1],Graphics3D[arrows2],Graphics3D[arrows3],Axes->True,AxesLabel->{X,Y,Z},Lighting->"Neutral",Boxed->False]]];


SURFACEPLOT[rr_,{eα_,eβ_,eγ_},αdom_,βdom_,γdom_] :=Module[{},
(* SURFACES *)
domainpoints=Table[(rr /.γdom[[1]]->0),αdom,βdom];
outerpoints=Table[(rr/.γdom[[1]]->γdom[[3]]),αdom,βdom];
innerpoints=Table[(rr/.γdom[[1]]->γdom[[2]]),αdom,βdom];
lowerpoints=Table[(rr/.βdom[[1]]->βdom[[2]]),αdom,γdom];
upperpoints=Table[(rr/.βdom[[1]]->βdom[[3]]),αdom,γdom];

domain =MAKESURFACE[domainpoints,0.6];
outer = MAKESURFACE[outerpoints,0.5];
inner = MAKESURFACE[innerpoints,0.5];
lower = MAKESURFACE[lowerpoints,0.5];
upper= MAKESURFACE[upperpoints,0.5];
(* ARROWS *)
doma =αdom;doma[[4]]=(αdom[[3]]-αdom[[2]])/10;
domb =βdom;domb[[4]]=(βdom[[3]]-βdom[[2]])/10;
arr1 =Table[({rr,rr+eα/20}/. γdom[[1]]->0.),Evaluate[doma],Evaluate[domb]];
arr2 =Table[({rr,rr+eβ/20}*1./. γdom[[1]]->0),Evaluate[doma],Evaluate[domb]];
arr3 =Table[({rr,rr+eγ/20}*1./.γdom[[1]]->0),Evaluate[doma],Evaluate[domb]];
arrows1=Join[{Arrowheads[Tiny],Red},Map[Arrow[#]&,Flatten[arr1,1]]];
arrows2=Join[{Arrowheads[Tiny],Green},Map[Arrow[#]&,Flatten[arr2,1]]];
arrows3=Join[{Arrowheads[Tiny],Blue},Map[Arrow[#]&,Flatten[arr3,1]]];
(* SHOW ACTIVES *)
Show[Graphics3D[inner],Graphics3D[outer],Graphics3D[lower],Graphics3D[upper],Graphics3D[arrows1],Graphics3D[arrows2],Graphics3D[arrows3],Axes->True,AxesLabel->{X,Y,Z},Lighting->"Neutral",Boxed->False] ];

MAKESURFACE[points_,opacity_]:=
{EdgeForm[],Opacity[opacity,Gray],Polygon[Flatten[Table[Flatten[{points [[ii,{jj,jj+1}]],Reverse[points [[ii+1,{jj,jj+1}]]] },1],
{ii,1,Length[points ]-1},{jj,1,Length[points [[1]]]-1}],1]]};

Coordinate systems

THEORY IN A NUTSHELL

Solid mapping: (OverVector[r])(α,β,γ)=(((({{x(α,β,γ)}, {({{y(α,β,γ)}, {z(α,β,γ)}})}})))^T)(({{(OverVector[i])}, {({{(OverVector[j])}, {(OverVector[k])}})}})),
Plate mapping: (OverVector[r])(α,β,γ)=(Subscript[(OverVector[r]), 0])(α,β)+n(Subscript[(OverVector[e]), n])

Beam mapping: (OverVector[r])(α)=(Subscript[(OverVector[r]), 0])(α)+n(Subscript[(OverVector[e]), n])+b(Subscript[(OverVector[e]), b])

Basis vectors: (({{(Subscript[(OverVector[e]), α])}, {({{(Subscript[(OverVector[e]), β])}, {(Subscript[(OverVector[e]), γ])}})}}))=[FF](({{(OverVector[i])}, {({{(OverVector[j])}, {(OverVector[k])}})}})), (∂/(∂η))(({{(Subscript[(OverVector[e]), α])}, {({{(Subscript[(OverVector[e]), β])}, {(Subscript[(OverVector[e]), γ])}})}}))=((((∂/(∂η))[FF])[FF])^(-1))(({{(Subscript[(OverVector[e]), α])}, {({{(Subscript[(OverVector[e]), β])}, {(Subscript[(OverVector[e]), γ])}})}})),
Hessian: (({{∂(OverVector[r])/∂α}, {({{∂(OverVector[r])/∂β}, {∂(OverVector[r])/∂γ}})}}))=[HH](({{(OverVector[i])}, {({{(OverVector[j])}, {(OverVector[k])}})}}))
Gradient:   ∇=(((({{(Subscript[(OverVector[e]), α])}, {({{(Subscript[(OverVector[e]), β])}, {(Subscript[(OverVector[e]), γ])}})}})))^T)[GG](({{∂/∂α}, {({{∂/∂β}, {∂/∂γ}})}})), [GG]=((((([HH][FF])^T)))^(-1))

Curvature: κκ=(Subscript[((Subscript[∇, 0])(Subscript[(OverVector[e]), n])), c])

Cylindrical solid system

rr={r Cos[ϕ],r Sin[ϕ],z};   
var={r,ϕ,z};
cnd= r>0;

MatrixForm[FF[rr,var,cnd]]
MatrixForm/@ DF[rr,var,cnd]
MatrixForm[GG[rr,var,cnd]]

Spherical solid system

rr=r {Sin[θ] Cos[ϕ],Sin[θ] Sin[ϕ],Cos[θ]};   
var={θ,ϕ,r};
cnd= r>0&& θ>0 && θ<Pi;

MatrixForm[FF[rr,var,cnd]]
MatrixForm/@ DF[rr,var,cnd]
MatrixForm[GG[rr,var,cnd]]

Circular beam system

r0={R Cos[α],R Sin[α],0};  
var={α,n,b};
cnd= R>0;

MatrixForm[FF[r0,var,cnd]]
MatrixForm/@ DF[r0,var,cnd]
MatrixForm[GG[r0,var,cnd]]
MatrixForm[κκ[r0,var,cnd]]

Spring beam system

r0={R Cos[(s/(Sqrt[(R^2)+(h^2)]))],R Sin[(s/(Sqrt[(R^2)+(h^2)]))],h(s/(Sqrt[(R^2)+(h^2)]))};  
var={s,n,b};
cnd= R>0 && ((R^2)+(h^2))>0;

MatrixForm[FF[r0,var,cnd]]
MatrixForm/@ DF[r0,var,cnd]
MatrixForm[GG[r0,var,cnd]]
MatrixForm[κκ[r0,var,cnd] /. n->0]

Cylindrical plate system

r0={R Cos[ϕ],R Sin[ϕ],z};   
var={z,ϕ,n};
cnd= R>0;

MatrixForm[FF[r0,var,cnd]]
MatrixForm/@ DF[r0,var,cnd]
MatrixForm[GG[r0,var,cnd]]
MatrixForm[κκ[r0,var,cnd] /. n->0]

Spherical plate system

r0=R {Sin[θ] Cos[ϕ],Sin[θ] Sin[ϕ],Cos[θ]};   
var={ϕ,θ,n};
cnd= R>0&& θ>0 && θ<Pi;

MatrixForm[FF[r0,var,cnd]]
MatrixForm/@ DF[r0,var,cnd]
MatrixForm[GG[r0,var,cnd]]
MatrixForm[κκ[r0,var,cnd] /. n->0]

Toroidal plate system

(*Toroidal shell domain*)
r0=(R+r Cos[θ]) {Cos[ϕ],Sin[ϕ],0}+r Sin[θ] {0,0,1};  
var={ϕ,θ,n};
cnd=r>0&& R>0&& θ>0 && R+r Cos[θ]>0;

MatrixForm[FF[r0,var,cnd]]
MatrixForm/@ DF[r0,var,cnd]
MatrixForm[GG[r0,var,cnd]]
MatrixForm[κκ[r0,var,cnd] /. n->0]

Conical plate system

r0=z {Cos[ϕ],Sin[ϕ],ϵ};  
var={z,ϕ,n}; 
cnd=z>0;

MatrixForm[FF[r0,var,cnd]]
MatrixForm/@ DF[r0,var,cnd]
MatrixForm[GG[r0,var,cnd]]
MatrixForm[κκ[r0,var,cnd] /. n->0]

Graphics

Cylindrical plate graphics

(*Cylindrical shell domain*)
r0={R Cos[ϕ],R Sin[ϕ],z} /. R->0.5;   

zdom ={z,0,1,1/2};
ϕdom ={ϕ,0,Pi,Pi/32};
ndom={n,-1/20,1/20,1/40}/1;
SURFACEPLOT[r0,zdom,ϕdom,ndom]

Cylindrical plate graphics

(*Cylindrical shell domain*)
r0={R Cos[s/R],R Sin[s/R],z} /. R->0.5;   

zdom ={z,0,1,1/2};
sdom ={s,0,Pi*0.5,Pi/32*0.5};
ndom={n,-1/20,1/20,1/40}/1;
SURFACEPLOT[r0,sdom,zdom,ndom]

Conical plate graphics

(*conical shell domain*)
r0={(R-z/3) Cos[ϕ],(R-z/3) Sin[ϕ],z}/.R->0.5;

zdom ={z,0,1,1/2};
ϕdom ={ϕ,0,3Pi/2,Pi/64};
ndom={n,-1/40,1/40,1/80};
SURFACEPLOT[r0,zdom,ϕdom,ndom]

Spherical plate graphics

(*spherical shell domain*)
r0=R {Sin[θ] Cos[ϕ],Sin[θ] Sin[ϕ],Cos[θ]} /.R->0.5;   

ϕdom ={ϕ,0,2Pi,Pi/32};
θdom ={θ,Pi/6,5Pi/6,Pi/32};
ndom={n,-1/40,1/40,1/80};
SURFACEPLOT[r0,ϕdom,θdom,ndom]

Toroidal plate graphics

(*Toroidal shell domain*)
r0=(R+r Cos[θ]) {Cos[ϕ],Sin[ϕ],0}+r Sin[θ] {0,0,1} /.{R->0.5,r->0.2};  

ϕdom ={ϕ,0,3Pi/2,Pi/32};
θdom ={θ,0,3Pi/2,Pi/16};
ndom={n,-1/40,1/40,1/80};
SURFACEPLOT[r0,ϕdom,θdom,ndom]

Coil beam graphics

(*Coil beam domain*)
r0={R Cos[(s/(Sqrt[(R^2)+(h^2)]))],R Sin[(s/(Sqrt[(R^2)+(h^2)]))],h(s/(Sqrt[(R^2)+(h^2)]))} /.{R->0.3,h->0.025};  

sdom ={s,0,10,0.0125};
ndom ={n,-0.025,0.025,0.025};
bdom={b,-0.025,0.025,0.025};
SURFACEPLOT[r0,sdom,ndom,bdom]