MEC-E8001 Finite Element Analysis 2019 code

FEM DEFINITIONS

DEFS defs

Off[General::spell];
Off[General::spell1];

Clear[δ];

δ[exp_]:=exp/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any],
(Subscript[u, X])[any__]->(Subscript[δu, X])[any],(Subscript[u, Y])[any__]->(Subscript[δu, Y])[any],(Subscript[u, Z])[any__]->(Subscript[δu, Z])[any],
(Subscript[θ, X])[any__]->(Subscript[δθ, X])[any],(Subscript[θ, Y])[any__]->(Subscript[δθ, Y])[any],(Subscript[θ, Z])[any__]->(Subscript[δθ, Z])[any],
(Subscript[u, x])[any__]->(Subscript[δu, x])[any],(Subscript[u, y])[any__]->(Subscript[δu, y])[any],(Subscript[u, z])[any__]->(Subscript[δu, z])[any],
(Subscript[θ, x])[any__]->(Subscript[δθ, x])[any],(Subscript[θ, y])[any__]->(Subscript[δθ, y])[any],(Subscript[θ, z])[any__]->(Subscript[δθ, z])[any],
ux[any__]->δux[any],uy[any__]->δuy[any],uz[any__]->δuz[any],
θx[any__]->δθx[any],θy[any__]->δθy[any],θz[any__]->δθz[any],
uX[any__]->δuX[any],uY[any__]->δuY[any],uZ[any__]->δuZ[any],
θX[any__]->δθX[any],θY[any__]->δθY[any],θZ[any__]->δθZ[any],
Fx[any__]->δFx[any],Fy[any__]->δFy[any],Fz[any__]->δFz[any],
Mx[any__]->δMx[any],My[any__]->δMy[any],Mz[any__]->δMz[any],
FX[any__]->δFX[any],FY[any__]->δFY[any],FZ[any__]->δFZ[any],
MX[any__]->δMX[any],MY[any__]->δMY[any],MZ[any__]->δMZ[any],
ϑ[any__]->δϑ[any]};

δUN[exp_]:=exp/.{δa[any__] -> a[any],δb[any__] -> b[any], δc[any__] ->c[any],
 (Subscript[δu, X])[any__]->(Subscript[u, X])[any], (Subscript[δu, Y])[any__]->(Subscript[u, Y])[any], (Subscript[δu, Z])[any__]->(Subscript[u, Z])[any],
 (Subscript[δθ, X])[any__]->(Subscript[θ, X])[any], (Subscript[δθ, Y])[any__]->(Subscript[θ, Y])[any], (Subscript[δθ, Z])[any__]->(Subscript[θ, Z])[any],
 (Subscript[δu, x])[any__]->(Subscript[u, x])[any], (Subscript[δu, y])[any__]->(Subscript[u, y])[any], (Subscript[δu, z])[any__]->(Subscript[u, z])[any],
 (Subscript[δθ, x])[any__]->(Subscript[θ, x])[any], (Subscript[δθ, y])[any__]->(Subscript[θ, y])[any], (Subscript[δθ, z])[any__]->(Subscript[θ, z])[any],
 δux[any__]->ux[any], δuy[any__]->uy[any], δuz[any__]->uz[any],
 δθx[any__]->θx[any], δθy[any__]->θy[any], δθz[any__]->θz[any],
 δuX[any__]->uX[any], δuY[any__]->uY[any], δuZ[any__]->uZ[any],
 δθX[any__]->θX[any], δθY[any__]->θY[any], δθZ[any__]->θZ[any],
 δFx[any__]->Fx[any], δFy[any__]->Fy[any], δFz[any__]->Fz[any],
 δMx[any__]->Mx[any], δMy[any__]->My[any], δMz[any__]->Mz[any],
 δFX[any__]->FX[any], δFY[any__]->FY[any], δFZ[any__]->FZ[any],
 δMX[any__]->MX[any], δMY[any__]->MY[any], δMZ[any__]->MZ[any],
 δϑ[any__]->ϑ[any]};

DOFS[exp_] :=Union[Cases[exp,a[__]|b[__]|c[__] |(Subscript[u, X])[__]|(Subscript[u, Y])[__]|(Subscript[u, Z])[__]| (Subscript[θ, X])[__]| (Subscript[θ, Y])[__]|(Subscript[θ, Z])[__]|(Subscript[u, x])[__]|(Subscript[u, y])[__]|(Subscript[u, z])[__]| (Subscript[θ, x])[__]| (Subscript[θ, y])[__]|(Subscript[θ, z])[__]|uX[__]|uY[__]|uZ[__]| θX[__]| θY[__]|θZ[__]|ux[__]|uy[__]|uz[__]| θx[__]| θy[__]|θz[__]|FX[__]|FY[__]|FZ[__]| MX[__]| MY[__]|MZ[__]|Fx[__]|Fy[__]|Fz[__]| Mx[__]| My[__]|Mz[__]| ϑ[__],Infinity]];

DFFS[exp_] :=Union[Cases[exp,FX[__]|FY[__]|FZ[__]| MX[__]| MY[__]|MZ[__]|Fx[__]|Fy[__]|Fz[__]| Mx[__]| My[__]|Mz[__],Infinity]];

δDFFS[exp_] :=Union[Cases[exp,δFX[__]|δFY[__]|δFZ[__]| δMX[__]| δMY[__]|δMZ[__]|δFx[__]|δFy[__]|δFz[__]| δMx[__]| δMy[__]|δMz[__],Infinity]];

δDOFS[exp_] :=Union[Cases[exp,δa[__]|δb[__]|δc[__] |(Subscript[δu, X])[__]|(Subscript[δu, Y])[__]|(Subscript[δu, Z])[__]| (Subscript[δθ, X])[__]| (Subscript[δθ, Y])[__]|(Subscript[δθ, Z])[__]|(Subscript[δu, x])[__]|(Subscript[δu, y])[__]|(Subscript[δu, z])[__]| (Subscript[δθ, x])[__]| (Subscript[δθ, y])[__]|(Subscript[δθ, z])[__]|δuX[__]|δuY[__]|δuZ[__]| δθX[__]| δθY[__]|δθZ[__]|δux[__]|δuy[__]|δuz[__]| δθx[__]| δθy[__]|δθz[__]|δFX[__]|δFY[__]|δFZ[__]| δMX[__]| δMY[__]|δMZ[__]|δFx[__]|δFy[__]|δFz[__]| δMx[__]| δMy[__]|δMz[__]| δϑ[__],Infinity]];

DOFS[exp_,n_] :=Union[Cases[exp,a[__,n]|b[__,n]|c[__,n] |(Subscript[u, X])[__,n]|(Subscript[u, Y])[__,n]|(Subscript[u, Z])[__,n]| (Subscript[θ, X])[__,n]| (Subscript[θ, Y])[__,n]|(Subscript[θ, Z])[__,n]|(Subscript[u, x])[__,n]|(Subscript[u, y])[__,n]|(Subscript[u, z])[__,n]| (Subscript[θ, x])[__,n]| (Subscript[θ, y])[__,n]|(Subscript[θ, z])[__,n]|uX[__,n]|uY[__,n]|uZ[__,n]| θX[__,n]| θY[__,n]|θZ[__,n]|ux[__,n]|uy[__,n]|uz[__,n]| θx[__,n]| θy[__,n]|θz[__,n]|FX[__,n]|FY[__,n]|FZ[__,n]| MX[__,n]| MY[__,n]|MZ[__,n]|Fx[__,n]|Fy[__,n]|Fz[__,n]| Mx[__,n]| My[__,n]|Mz[__,n]| ϑ[__,n],Infinity]];

δDOFS[exp_,n_] :=Union[Cases[exp,δa[__,n]|δb[__,n]|δc[__,n] |(Subscript[δu, X])[__,n]|(Subscript[δu, Y])[__,n]|(Subscript[δu, Z])[__,n]| (Subscript[δθ, X])[__,n]| (Subscript[δθ, Y])[__,n]|(Subscript[δθ, Z])[__,n]|(Subscript[δu, x])[__,n]|(Subscript[δu, y])[__,n]|(Subscript[δu, z])[__,n]| (Subscript[δθ, x])[__,n]| (Subscript[δθ, y])[__,n]|(Subscript[δθ, z])[__,n]|δuX[__,n]|δuY[__,n]|δuZ[__,n]| δθX[__,n]| δθY[__,n]|δθZ[__,n]|δux[__,n]|δuy[__,n]|δuz[__,n]| δθx[__,n]| δθy[__,n]|δθz[__,n]|δFX[__,n]|δFY[__,n]|δFZ[__,n]| δMX[__,n]| δMY[__,n]|δMZ[__,n]|δFx[__,n]|δFy[__,n]|δFz[__,n]| δMx[__,n]| δMy[__,n]|δMz[__,n]| δϑ[__,n],Infinity]];

DRULE[n_]:= {a[any__]-> a[any,n],b[any__]-> b[any,n],b[any__]-> a[any,n],uX[any__]-> uX[any,n],uY[any__]-> uY[any,n],uZ[any__]-> uZ[any,n],
θX[any__]-> θX[any,n],θY[any__]-> θY[any,n],θZ[any__]-> θZ[any,n],
ux[any__]-> ux[any,n],uy[any__]-> uy[any,n],uz[any__]-> uz[any,n],
θx[any__]-> θx[any,n],θy[any__]-> θy[any,n],θz[any__]-> θz[any,n],
 ϑ[any__]-> ϑ[any,n],
FX[any__]-> FX[any,n],FY[any__]-> FY[any,n],FZ[any__]-> FZ[any,n],
MX[any__]-> MX[any,n],MY[any__]-> MY[any,n],MZ[any__]-> MZ[any,n]};


δδ[u_]:=Module[{dof},dof=DOFS[u];
If[dof=={} ,u,D[u,{dof}].δ[dof]]];

SHAPE defs

SHAPES1[h_]:= {1-(x/h),(x/h)};

SHAPES11[h_]:= {(((1-x/h))^2) (1+2 x/h),h(((1-x/h))^2) (x/h),(3-2 x/h) (((x/h))^2),h(((x/h))^2) (-1+x/h)};

LAGRANGE[n_,h_]:= Simplify[MapIndexed[(#1/(#1/.x->h*(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[x-h*(ii-1)/(n-1),{ii,1,n}]]/(x-h*(jj-1)/(n-1)),{jj,1,n}]]];

LAGRANGE[n_,{x0_,x1_}]:= Simplify[MapIndexed[(#1/(#1/.x->x0+(x1-x0)*(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[x-(x0+(x1-x0)*(ii-1)/(n-1)),{ii,1,n}]]/(x-(x0+(x1-x0)*(jj-1)/(n-1))),{jj,1,n}]]];

LAGRANGE[n_,{x,{x0_,x1_}}]:= Simplify[MapIndexed[(#1/(#1/.x->x0+(x1-x0)*(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[x-(x0+(x1-x0)*(ii-1)/(n-1)),{ii,1,n}]]/(x-(x0+(x1-x0)*(jj-1)/(n-1))),{jj,1,n}]]];

SHAPES1[bas_,ver_]:= Simplify[bas . Inverse[Flatten[Map[{bas}/. {x->#[[1]]}&, ver],1]]];

SHAPES11[bas_,ver_]:= bas . Inverse[Flatten[Map[{bas,(∂_x)bas}/. {x->#[[1]]}&, ver],1]];

SHAPES2[bas_,ver_]:= bas . Inverse[Flatten[Map[{bas}/. {x->#[[1]],y->#[[2]]}&, ver],1]];

SHAPES21[{{x1_,y1_},{x2_,y2_}}]:= Module[{Nx,Ny},
Nx= SHAPES11[{1,x,x^2,x^3},{{x1},{x2}}];
Ny= SHAPES11[{1,x,x^2,x^3},{{y1},{y2}}] /. x->y;
Return[{Nx[[1]]*Ny[[1]],Nx[[2]]*Ny[[1]],Nx[[1]]*Ny[[2]],Nx[[3]]*Ny[[1]],Nx[[4]]*Ny[[1]],Nx[[3]]*Ny[[2]],Nx[[1]]*Ny[[3]],Nx[[2]]*Ny[[3]],Nx[[1]]*Ny[[4]],Nx[[3]]*Ny[[3]],Nx[[4]]*Ny[[3]],Nx[[3]]*Ny[[4]]}]];

SHAPES3[bas_,ver_]:= bas . Inverse[Flatten[Map[{bas}/. {x->#[[1]],y->#[[2]],z->#[[3]]}&, ver],1]];

SHAPES1[h_]:= {1-(x/h),(x/h)};

SHAPES11[h_]:= {(((1-x/h))^2) (1+2 x/h),h(((1-x/h))^2) (x/h),(3-2 x/h) (((x/h))^2),h(((x/h))^2) (-1+x/h)};

LAGRANGE[n_,h_]:= Simplify[MapIndexed[(#1/(#1/.x->h*(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[x-h*(ii-1)/(n-1),{ii,1,n}]]/(x-h*(jj-1)/(n-1)),{jj,1,n}]]];

LAGRANGE[{{n_,r_}}]:= Simplify[MapIndexed[(#1/(#1/.r->(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[r-(ii-1)/(n-1),{ii,1,n}]]/(r-(jj-1)/(n-1)),{jj,1,n}]]];

LAGRANGE[{{n_,r_},{m_,s_}}]:= Flatten[Outer[Times,LAGRANGE[{{m,s}}],LAGRANGE[{{n,r}}]],1];

LAGRANGE[{{n_,r_},{m_,s_},{k_,t_}}]:= Flatten[Outer[Times,LAGRANGE[{{k,t}}],LAGRANGE[{{m,s}}],LAGRANGE[{{n,r}}]],2];

LAGRANGE[n_,{x0_,x1_}]:= Simplify[MapIndexed[(#1/(#1/.x->x0+(x1-x0)*(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[x-(x0+(x1-x0)*(ii-1)/(n-1)),{ii,1,n}]]/(x-(x0+(x1-x0)*(jj-1)/(n-1))),{jj,1,n}]]];

LAGRANGE[n_,{x,{x0_,x1_}}]:= Simplify[MapIndexed[(#1/(#1/.x->x0+(x1-x0)*(#2[[1]]-1)/(n-1)))&,Table[Apply[Times,Table[x-(x0+(x1-x0)*(ii-1)/(n-1)),{ii,1,n}]]/(x-(x0+(x1-x0)*(jj-1)/(n-1))),{jj,1,n}]]];

SHAPES1[bas_,ver_]:= Simplify[bas . Inverse[Flatten[Map[{bas}/. {x->#[[1]]}&, ver],1]]];

SHAPES11[bas_,ver_]:= bas . Inverse[Flatten[Map[{bas,(∂_x)bas}/. {x->#[[1]]}&, ver],1]];

SHAPES2[bas_,ver_]:= bas . Inverse[Flatten[Map[{bas}/. {x->#[[1]],y->#[[2]]}&, ver],1]];

SHAPES21[{{x1_,y1_},{x2_,y2_}}]:= Module[{Nx,Ny},
Nx= SHAPES11[{1,x,x^2,x^3},{{x1},{x2}}];
Ny= SHAPES11[{1,x,x^2,x^3},{{y1},{y2}}] /. x->y;
Return[{Nx[[1]]*Ny[[1]],Nx[[2]]*Ny[[1]],Nx[[1]]*Ny[[2]],Nx[[3]]*Ny[[1]],Nx[[4]]*Ny[[1]],Nx[[3]]*Ny[[2]],Nx[[1]]*Ny[[3]],Nx[[2]]*Ny[[3]],Nx[[1]]*Ny[[4]],Nx[[3]]*Ny[[3]],Nx[[4]]*Ny[[3]],Nx[[3]]*Ny[[4]]}]];

SHAPES3[bas_,ver_]:= bas . Inverse[Flatten[Map[{bas}/. {x->#[[1]],y->#[[2]],z->#[[3]]}&, ver],1]];

QUAD defs

QUAD[LIN1,exp_,var_]:=Module[{w,p},
p={{1}}/2;
w={1};
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[LIN2,exp_,var_]:=Module[{w,p},
p={{0},{1}}/2;
w={1,1}/2;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[LIN3,exp_,var_]:=Module[{w,p},
p={{0},{1},{2}}/2;
w={1,4,1}/6;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[LIN5,exp_,var_]:=Module[{w,p},
p={{0},{1},{2},{3},{4}}/4;
w={7,32,12,32,7}/90;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[LIN7,exp_,var_]:=Module[{w,p},
p={{0},{1},{2},{3},{4},{5},{6}}/6;
w={41,216,27,272,27,216,41}/840;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[LIN14,exp_,var_]:=Module[{w,p},
p=Table[ii,{ii,0,13}]/13;
w={(8181904909/402361344000),(56280729661/402361344000),-(1737125143/22353408000),(11148172711/28740096000),-(6066382933/16094453760),(22964826443/44706816000),-(3592666051/33530112000),-(3592666051/33530112000),(22964826443/44706816000),-(6066382933/16094453760),(11148172711/28740096000),-(1737125143/22353408000),(56280729661/402361344000),(8181904909/402361344000)};
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[TET5,exp_,var_]:=Module[{
w={-16,9,9,9,9}/120,p=Transpose[{{1/4,1/2,1/6,1/6,1/6},{1/4,1/6,1/6,1/6,1/2},{1/4,1/6,1/6,1/2,1/6}}]},
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[TRI3,exp_,var_]:=Module[{w,p},
p={{0,1},{1,0},{1,1}}/2;
w={1,1,1}/6;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[TRI4,exp_,var_]:=Module[{w,p},
p={{0,0},{1,0},{0,1},{1,1}/3};
w=1/24*{1,1,1,9};
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[TRI7,exp_,var_]:=Module[{w,p},
p={{0,0},{1/2,0},{1,0},{1/2,1/2},{0,1},{0,1/2},{1/3,1/3}};
w={1/40,1/15,1/40,1/15,1/40,1/15,9/40};
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[TRI12,exp_,var_]:=Module[{w,p},
p={{0,1},{0,2},{0,3},{1,0},{1,1},{1,2},{1,3},{2,0},{2,1},{2,2},{3,0},{3,1}}/4;
w={4,-1,4,4,8,8,4,-1,8,-1,4,4}/90;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[TRI28,exp_,var_]:=Module[{w,p},
p={{0,0},{0,1},{0,2},{0,3},{0,4},{0,5},{0,6},{1,0},{1,1},{1,2},{1,3},{1,4},{1,5},{2,0},{2,1},{2,2},{2,3},{2,4},{3,0},{3,1},{3,2},{3,3},{4,0},{4,1},{4,2},{5,0},{5,1},{6,0}}/6;
w={0,36,-27,64,-27,36,0,36,72,72,72,72,36,-27,72,-54,72,-27,64,72,72,64,-27,72,-27,36,36,0}/(3.*560);
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[REC9,exp_,var_]:=Module[{w,p},
p={{0,0},{0,1},{0,2},{1,0},{1,1},{1,2},{2,0},{2,1},{2,2}}/2;
w={1,4,1,4,16,4,1,4,1}/36;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

QUAD[HEX27,exp_,var_]:=Module[{w,p},
p={{0,0,0},{0,0,1},{0,0,2},{0,1,0},{0,1,1},{0,1,2},{0,2,0},{0,2,1},{0,2,2},{1,0,0},{1,0,1},{1,0,2},{1,1,0},{1,1,1},{1,1,2},{1,2,0},{1,2,1},{1,2,2},{2,0,0},{2,0,1},{2,0,2},{2,1,0},{2,1,1},{2,1,2},{2,2,0},{2,2,1},{2,2,2}}/2;
w={1,4,1,4,16,4,1,4,1,4,16,4,16,64,16,4,16,4,1,4,1,4,16,4,1,4,1}/6^3;
Apply[Plus,MapIndexed[w[[#2[[1]]]]*exp /.Thread[var->#1]&,p]]];

INTEGRATE defs

INTEGRATE[{LINE,exp_},{ele_,fun_}]:=
Apply[Plus,Map[QUAD[{LINLINE,exp},#]&,ele]];

RULE[{LINE,{iy_},list_}]:= Module[{ix,iz,hx,nn},
{ix,hx} = UNIT[XYZ[Last[list]]-XYZ[First[list]]];
iz = CROSS[ix,iy];
nn = Length[list];
xrule = Table[x[ii]-> ix.XYZ[list[[ii]]],{ii,1,nn}];
yrule = Table[y[ii]-> iy.XYZ[list[[ii]]],{ii,1,nn}];
zrule = Table[z[ii]-> iz.XYZ[list[[ii]]],{ii,1,nn}];
Flatten[Join[xrule,yrule,zrule]]];

QUAD[{LINLINE,exp_},element_]:= Module[{NN,rule,xx,yy,zz,J,int},
NN = {1-ξ,ξ};
rule = RULE[element];
xx = NN.{x[1],x[2]} /. rule;
yy = NN.{y[1],y[2]} /. rule;
zz = NN.{z[1],z[2]} /. rule;
J = Sqrt[((∂_ξ)xx)^2+((∂_ξ)yy)^2+((∂_ξ)zz)^2];
int = J*exp /. {x->xx, y->yy, z->zz};
QUADE[QTYPE,(int /. ξ-> #1)&]];

QUADE[LINE1,exp_]:= exp[{1/2}].{1};
QUADE[LINE2,exp_]:= exp[{0,1}].{1,1}/2;
QUADE[LINE3,exp_]:= exp[{0,1,2}/2].{1,4,1}/6;

ELEMENT

FORCE ELEMENT defs

δW[DISP ,{FORCE,{FX_,FY_,FZ_},Point[{I1_}]},fun_]:=
δW[DISP,{FORCE,{FX,FY,FZ,0,0,0},Point[{I1}]},fun];

δW[DISP,{FORCE,{FX_,FY_,FZ_,MX_,MY_,MZ_},Point[{I1_}]},fun_]:=
{FX,FY,FZ}.δ[fun[[I1,2]]]+{MX,MY,MZ}.δ[fun[[I1,3]]];

δW[{STAB,prule_} ,{FORCE,{FX_,FY_,FZ_},Point[{I1_}]},fun_]:=
δW[{STAB,prule} ,{FORCE,{FX,FY,FZ,0,0,0},Point[{I1}]},fun];

δW[{STAB,prule_},{FORCE,{FX_,FY_,FZ_,MX_,MY_,MZ_},Point[{I1_}]},fun_]:=
{FX,FY,FZ}.δ[fun[[I1,2]]]+{MX,MY,MZ}.δ[fun[[I1,3]]];

δW[NONL,{FORCE,{FX_,FY_,FZ_},Point[{I1_}]},fun_]:=
δW[NONL,{FORCE,{FX,FY,FZ,0,0,0},Point[{I1}]},fun];

δW[NONL,{FORCE,{FX_,FY_,FZ_,MX_,MY_,MZ_},Point[{I1_}]},fun_]:=
{FX,FY,FZ}.δ[fun[[I1,2]]]+{MX,MY,MZ}.δ[fun[[I1,3]]];

δW[{FORCE,{{fX1_,fX2_},{fY1_,fY2_},{fZ1_,fZ2_}},Line[{I1_,I2_}]}]:=
δW[DISP,{FORCE,{{fX1,fX2},{fY1,fY2},{fZ1,fZ2}},Line[{I1,I2}]},fun];

δW[{FORCE,{{fX1_,fX2_},{fY1_,fY2_},{fZ1_,fZ2_}},Line[{I1_,I2_}]}]:=
δW[DISP,{FORCE,{{fX1,fX2},{fY1,fY2},{fZ1,fZ2}},Line[{I1,I2}]},fun];

δW[DISP,{FORCE,{{fX1_,fX2_},{fY1_,fY2_},{fZ1_,fZ2_}} ,Line[{I1_,I2_}]},fun_]:=Module[{nl,r0,h0},
r0=fun[[I2,1]]-fun[[I1,1]];
h0=Simplify[Sqrt[r0.r0],L>0&&h>0];

h0/6*(δ[fun[[{I1,I2},2,1]]].{{2,1},{1,2}}.{fX1,fX2} +δ[fun[[{I1,I2},2,2]]].{{2,1},{1,2}}.{fY1,fY2}+
δ[fun[[{I1,I2},2,3]]].{{2,1},{1,2}}.{fZ1,fZ2}) ];

δW[VIBR,{FORCE,{{m_},{FX_,FY_,FZ_}},Point[{n1_}]},fun_]:=
({FX,FY,FZ}-m  fun[[n1,2]]/.DRULE[2]). δ[fun[[n1,2]] /.DRULE[0]];

δW[VIBR,{FORCE,{{m_,J_},{FX_,FY_,FZ_,MX_,MY_,MZ_}},Point[{n1_}]},fun_]:=
({FX,FY,FZ}-m  fun[[n1,2]]/.DRULE[2]).( δ[fun[[n1,2]]/.DRULE[0]])+
({MX,MY,MZ}-J.fun[[n1,3]]/.DRULE[2]).(δ[fun[[n1,3]]/.DRULE[0]]);

RIGID ELEMENT defs

(*force 2 to be 1*)
δW[DISP,{RIGID,any_,Point[{n1_,n2_}]},fun_]:=
δ[(fun[[n2,2]]-fun[[n1,2]])].{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}+
(fun[[n2,2]]-fun[[n1,2]]).δ[{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}]+

δ[(fun[[n2,3]]-fun[[n1,3]])].{MX[{n2,n1}],MY[{n2,n1}],MZ[{n2,n1}]} +
(fun[[n2,3]]-fun[[n1,3]]).δ[{MX[{n2,n1}],MY[{n2,n1}],MZ[{n2,n1}]}];

(*force 2 to be 1 modulo rigid body motion*)
δW[{STAB,prule_},{RIGID,{},Line[{I1_,I2_}]},fun_]:=δW[DISP,{RIGID,{},Line[{I1,I2}]},fun];

δW[DISP,{RIGID,{},Line[{n1_,n2_}]},fun_]:=
δ[(fun[[n2,2]]-fun[[n1,2]]-fun[[n1,3]]\[Cross](fun[[n2,1]]-fun[[n1,1]]))].{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}+
(fun[[n2,2]]-fun[[n1,2]]-fun[[n1,3]]\[Cross](fun[[n2,1]]-fun[[n1,1]])).δ[{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}]+
δ[(fun[[n2,3]]-fun[[n1,3]])].({MX[{n2,n1}],MY[{n2,n1}],MZ[{n2,n1}]} +
{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}\[Cross](fun[[n2,1]]-fun[[n1,1]]))+
(fun[[n2,3]]-fun[[n1,3]]).δ[({MX[{n2,n1}],MY[{n2,n1}],MZ[{n2,n1}]} +
{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}\[Cross](fun[[n2,1]]-fun[[n1,1]]))];

δW[VIBR,{RIGID,{},Line[{n1_,n2_}]},fun_]:=
δ[(fun[[n2,2]]-fun[[n1,2]]-fun[[n1,3]]\[Cross](fun[[n2,1]]-fun[[n1,1]]))/.DRULE[0]].({FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}/.DRULE[0])+
((fun[[n2,2]]-fun[[n1,2]]-fun[[n1,3]]\[Cross](fun[[n2,1]]-fun[[n1,1]]))/.DRULE[0]).δ[{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}/.DRULE[0]] +
δ[(fun[[n2,3]]-fun[[n1,3]])/.DRULE[0]].(({MX[{n2,n1}],MY[{n2,n1}],MZ[{n2,n1}]} +
{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}\[Cross](fun[[n2,1]]-fun[[n1,1]]))/.DRULE[0])+
((fun[[n2,3]]-fun[[n1,3]])/.DRULE[0]).δ[({MX[{n2,n1}],MY[{n2,n1}],MZ[{n2,n1}]} +
{FX[{n2,n1}],FY[{n2,n1}],FZ[{n2,n1}]}\[Cross](fun[[n2,1]]-fun[[n1,1]]))/.DRULE[0]];

δW[DISP,{CONST,{{uX1_,uY1_,uZ1_},{θX1_,θY1_,θZ1_}},Point[{I1_}]},fun_]:=
δ[(fun[[I1,2]]-{uX1,uY1,uZ1})].{FX[I1],FY[I1],FZ[I1]}+
(fun[[I1,2]]-{uX1,uY1,uZ1}).δ[{FX[I1],FY[I1],FZ[I1]}]+
δ[(fun[[I1,3]]-{θX1,θY1,θZ1})].{MX[I1],MY[I1],MZ[I1]}+
(fun[[I1,3]]-{θX1,θY1,θZ1}).δ[{MX[I1],MY[I1],MZ[I1]}] ;

BAR ELEMENT (static) defs

δW[DISP,{BAR,{{EE_},{AA_},{fx_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,ix0,ux,δux,EE1,EE2,EE3,AA1,AA2,AA3,fx1,fx2,fx3,nl,rule},

nl={n1,n2};
r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0], L>0&&h>0];
ix0=r0/h0;

ux[i_]:=ix0.fun[[nl[[i]],2]];
δux[i_]:=δ[ux[i]];

rule :={{a1_,a2_,a3_}->{a1,a2,a3},{a1_,a2_}->{a1,(a1+a2)/2,a2},a1_->{a1,a1,a1}};

{EE1,EE2,EE3}=EE /.rule;
{AA1,AA2,AA3}=AA /.rule;
{fx1,fx2,fx3}=fx /.rule;

(1/(30 (h0^2)))(-(AA1 (4 EE1+2 EE2-EE3)+2 AA2 (EE1+8 EE2+EE3)+AA3 (-EE1+2 EE2+4 EE3)) h0 (-ux[1]+ux[2]) (-δux[1]+δux[2])+5 (h0^3) (fx1 δux[1]+fx3 δux[2]+2 fx2 (δux[1]+δux[2])))];

δW[DISP,{BAR,{{EE_},{AA_},{fx_}},Line[{n1_,n2_,n3_}]},fun_]:=Module[{r0,h0,ix0,ux,δux,EE1,EE2,EE3,AA1,AA2,AA3,fx1,fx2,fx3,nl,rule},

nl ={n1,n2,n3};
r0=fun[[n3,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0], L>0&&h>0];
ix0=r0/h0;

ux[i_]:=ix0.fun[[nl[[i]],2]];
δux[i_]:=δ[ux[i]];

rule :={{a1_,a2_,a3_}->{a1,a2,a3},{a1_,a2_}->{a1,(a1+a2)/2,a2},a1_->{a1,a1,a1}};

{EE1,EE2,EE3}=EE /.rule;
{AA1,AA2,AA3}=AA /.rule;
{fx1,fx2,fx3}=fx /.rule;

-(1/(210 h0))(7 fx3 (h0^2) δux[1]+184 AA1 EE1 ux[1] δux[1]+94 AA2 EE1 ux[1] δux[1]-19 AA3 EE1 ux[1] δux[1]+94 AA1 EE2 ux[1] δux[1]+176 AA2 EE2 ux[1] δux[1]-18 AA3 EE2 ux[1] δux[1]-19 AA1 EE3 ux[1] δux[1]-18 AA2 EE3 ux[1] δux[1]+16 AA3 EE3 ux[1] δux[1]-228 AA1 EE1 ux[2] δux[1]-104 AA2 EE1 ux[2] δux[1]+24 AA3 EE1 ux[2] δux[1]-104 AA1 EE2 ux[2] δux[1]-128 AA2 EE2 ux[2] δux[1]+8 AA3 EE2 ux[2] δux[1]+24 AA1 EE3 ux[2] δux[1]+8 AA2 EE3 ux[2] δux[1]-60 AA3 EE3 ux[2] δux[1]+44 AA1 EE1 ux[3] δux[1]+10 AA2 EE1 ux[3] δux[1]-5 AA3 EE1 ux[3] δux[1]+10 AA1 EE2 ux[3] δux[1]-48 AA2 EE2 ux[3] δux[1]+10 AA3 EE2 ux[3] δux[1]-5 AA1 EE3 ux[3] δux[1]+10 AA2 EE3 ux[3] δux[1]+44 AA3 EE3 ux[3] δux[1]-14 fx3 (h0^2) δux[2]-228 AA1 EE1 ux[1] δux[2]-104 AA2 EE1 ux[1] δux[2]+24 AA3 EE1 ux[1] δux[2]-104 AA1 EE2 ux[1] δux[2]-128 AA2 EE2 ux[1] δux[2]+8 AA3 EE2 ux[1] δux[2]+24 AA1 EE3 ux[1] δux[2]+8 AA2 EE3 ux[1] δux[2]-60 AA3 EE3 ux[1] δux[2]+288 AA1 EE1 ux[2] δux[2]+96 AA2 EE1 ux[2] δux[2]-48 AA3 EE1 ux[2] δux[2]+96 AA1 EE2 ux[2] δux[2]+256 AA2 EE2 ux[2] δux[2]+96 AA3 EE2 ux[2] δux[2]-48 AA1 EE3 ux[2] δux[2]+96 AA2 EE3 ux[2] δux[2]+288 AA3 EE3 ux[2] δux[2]-60 AA1 EE1 ux[3] δux[2]+8 AA2 EE1 ux[3] δux[2]+24 AA3 EE1 ux[3] δux[2]+8 AA1 EE2 ux[3] δux[2]-128 AA2 EE2 ux[3] δux[2]-104 AA3 EE2 ux[3] δux[2]+24 AA1 EE3 ux[3] δux[2]-104 AA2 EE3 ux[3] δux[2]-228 AA3 EE3 ux[3] δux[2]+(-28 fx3 (h0^2)+AA1 (44 EE1 ux[1]+10 EE2 ux[1]-5 EE3 ux[1]-60 EE1 ux[2]+8 EE2 ux[2]+24 EE3 ux[2]+(16 EE1-18 EE2-19 EE3) ux[3])+2 AA2 (5 EE1 ux[1]-24 EE2 ux[1]+5 EE3 ux[1]+4 EE1 ux[2]-64 EE2 ux[2]-52 EE3 ux[2]+(-9 EE1+88 EE2+47 EE3) ux[3])+AA3 (EE1 (-5 ux[1]+24 ux[2]-19 ux[3])+2 (2 EE3 (11 ux[1]-57 ux[2]+46 ux[3])+EE2 (5 ux[1]-52 ux[2]+47 ux[3])))) δux[3]+7 fx1 (h0^2) (-4 δux[1]-2 δux[2]+δux[3])-14 fx2 (h0^2) (δux[1]+8 δux[2]+δux[3]))];

δW[DISP,{BAR,{{EE_},{AA_},{fX_,fY_,fZ_}},Line[node_]},fun_]:=
δW[DISP,{BAR,{{EE},{AA,{0,1,0}},{fX,fY,fZ}},Line[node]},fun];

δW[DISP,{BAR,{{EE_},{AA_,iy0_},{fX_,fY_,fZ_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,ix0,iz0,ux,δux,uy,δuy,uz,δuz},

r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0], L>0&&h>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1],uy[1],uz[1]}={ix0,iy0,iz0}.fun[[n1,2]];
{ux[2],uy[2],uz[2]}={ix0,iy0,iz0}.fun[[n2,2]];
{δux[1],δuy[1],δuz[1]}=δ[{ux[1],uy[1],uz[1]}];
{δux[2],δuy[2],δuz[2]}=δ[{ux[2],uy[2],uz[2]}];

(1/(2 h0))(-2 AA EE (ux[1]-ux[2]) (δux[1]-δux[2])+fX (h0^2) (δux[1]+δux[2])+(h0^2) (fY (δuy[1]+δuy[2])+fZ (δuz[1]+δuz[2])))];

δW[DISP,{GENERICBAR,{{EE_},{A_},{fx_}},Line[node_]},fun_]:=Module[{NN,ξ,r,rξ,h0,iξ,s,x,uu,δuu,F,δwint,δwext},
(*shape functions*)
NN= LAGRANGE[{{Length[node],ξ}}];
(*mapping to material system*)
r=ξ*(fun[[Last[node],1]]-fun[[First[node],1]]);
rξ=(∂_ξ)r;
h0=Simplify[Sqrt[rξ.rξ],L>0&&h>0];
iξ =rξ/h0;
s=iξ .r;
x=fun[[First[node],1]].iξ+s ;
(*approximation*)
uu= iξ.(NN.fun[[node,2]]);
(*stress resultant*)
F =EE[x]*A[x] *(∂_ξ)uu/h0;
δwint=-δ[(∂_ξ)uu/h0]*F ;
δwext=δ[uu]*fx[x] ;
Simplify[Integrate[(δwint+δwext)*h0,{ξ,0,1}], L>0&&h>0]
];

BAR ELEMENT (dynamic) defs

δW[VIBR,{BAR,{{EE_,ρρ_},{AA_},{fx_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,ix0,ux,δux,EE1,EE2,EE3,AA1,AA2,AA3,fx1,fx2,fx3,nl,rule},

nl={n1,n2};
r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0], L>0&&h>0];
ix0=r0/h0;

ux[1,0]=ix0.fun[[n1,2]]/.DRULE[0];
ux[1,2]=ix0.fun[[n1,2]]/.DRULE[2];
ux[2,0]=ix0.fun[[n2,2]]/.DRULE[0];
ux[2,2]=ix0.fun[[n2,2]]/.DRULE[2];
δux[1,0]=δ[ux[1,0]];
δux[2,0]=δ[ux[2,0]];

(1/(6 h0))(3 fx (h0^2) (δux[1,0]+δux[2,0])-AA (6 EE (ux[1,0]-ux[2,0]) (δux[1,0]-δux[2,0])+(h0^2) ρρ (ux[1,2] (2 δux[1,0]+δux[2,0])+ux[2,2] (δux[1,0]+2 δux[2,0]))))];

δW[VIBR,{GENERICBAR,{{EE_,ρρ_},{AA_},{ff_}},Line[node_]},fun_]:=Module[{NN,ξ,r,rξ,h0,iξ,s,x,uu,u0,u2,δuu,F,δwint,δwext,δwine,AAA,EEE,ρρρ,fff},
(*shape functions*)
NN= LAGRANGE[{{Length[node],ξ}}];
(*mapping to material system*)
r=ξ*(fun[[Last[node],1]]-fun[[First[node],1]]);
rξ=(∂_ξ)r;
h0=Simplify[Sqrt[rξ.rξ], L>0&&h>0];
iξ =rξ/h0;
s=iξ .r;
x=fun[[First[node],1]].iξ+s ;
(*approximation*)
uu= iξ.(NN.fun[[node,2]]);
u0= uu/.DRULE[0];
u2= uu /.DRULE[2];
(*stress resultant*)
F =EE[x] AA[x]  (∂_ξ)u0/h0;
δwint=-δ[(∂_ξ)u0/h0] F ;
δwext=δ[u0] ff[x] ;
δwine=-δ[u0] ρρ[x] AA[x] u2;
Integrate[(δwint+δwext+δwine)*h0,{ξ,0,1}]
];

BAR ELEMENT (stability) defs

δW[{STAB,rule_},{BAR,{{EE_},{AA_},{fx_}},Line[{n1_,n2_}]},fun_]:=
δW[DISP,{BAR,{{EE},{AA},{fx}},Line[{n1,n2}]},fun];

BAR ELEMENT (nonlinear) defs

δW[NONL,{BAR,{{CC_},{AA_,iy_},{fx_,fy_,fz_}},Line[{I1_,I2_}]},fun_]:=Module[{Δh,h0,ix,iz,NN,x,uu,vv,ww,EE,δEE,δwint,δwext},
Δh=fun[[I2,1]]-fun[[I1,1]];
h0=Simplify[Sqrt[Δh.Δh], L>0&&h>0];
ix=Δh/h0;
iz=ix\[Cross]iy;
NN= {1-x/h0,x/h0};

uu= NN.{fun[[I1,2]].ix,fun[[I2,2]].ix} ;
vv= NN.{fun[[I1,2]].iy,fun[[I2,2]].iy};
ww= NN.{fun[[I1,2]].iz,fun[[I2,2]].iz};
EE= (∂_x)uu+(((∂_x)uu)^2+((∂_x)vv)^2+((∂_x)ww)^2)/2;
δEE=δ[(∂_x)uu]+(∂_x)uu δ[(∂_x)uu]+(∂_x)vv δ[(∂_x)vv]+(∂_x)ww δ[(∂_x)ww];
δwint=-δEE CC AA EE;
δwext=δ[uu] fx+δ[vv] fy+δ[ww] fz;
Return[Integrate[δwint+δwext,{x,0,h0}]]
];

BAR ELEMENT (thermomechanic) defs

δW[DISP,{BAR,{{EE_,αα_,kk_},{AA_},{ff_,ss_,ϑ0_}},Line[node_]},fun_]:=Module[{NN,ξ,r,rξ,h0,iξ,s,x,uu,ϑϑ,F,Q,δw,δp,AAA,EEE,fff,kkk,sss,ααα},
(*shape functions*)
NN= LAGRANGE[{{Length[node],ξ}}];
(*mapping to material system*)
r=ξ*(fun[[Last[node],1]]-fun[[First[node],1]]);
rξ=(∂_ξ)r;
h0=Simplify[Sqrt[rξ.rξ], L>0&&h>0];
iξ =rξ/h0;
s=iξ .r;
x=fun[[First[node],1]].iξ+s;
(*approximation*)
uu= iξ.(NN.fun[[node,2]]);
ϑϑ= NN.fun[[node,4]];
(*stress resultant*)
AAA=If[Head[AA]===Function,AA[x],AA];
EEE=If[Head[EE]===Function,EE[x],EE];
ααα=If[Head[αα]===Function,αα[x],αα];
kkk=If[Head[kk]===Function,kk[x],kk];
fff=If[Head[ff]===Function,ff[x],ff];
sss=If[Head[ss]===Function,ss[x],ss];
F =EEE AAA ((∂_ξ)uu/h0-ααα (ϑϑ-ϑ0));
Q=-kkk AAA (∂_ξ)ϑϑ/h0;
δw=-δδ[(∂_ξ)uu/h0] F+δδ[uu] fff;
δp=δδ[(∂_ξ)ϑϑ/h0] Q +δδ[ϑϑ] sss;
Integrate[(δw+δp) h0,{ξ,0,1}]
];

BEAM ELEMENT (static) defs

δW[DISP,{BEAM,{{EE_,GG_},{AA_,II_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,II,II,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,iy0},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz,mx,my,mz}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz,fx1,fx2,fy1,fy2,fz1,fz2,mx1,mx2,my1,my2,mz1,mz2,EEm,GGm,AAm,Iyym,Izzm},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0],L>0&&h>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1],uy[1],uz[1]}={ix0,iy0,iz0}.fun[[n1,2]];
{ux[2],uy[2],uz[2]}={ix0,iy0,iz0}.fun[[n2,2]];
{θx[1],θy[1],θz[1]}={ix0,iy0,iz0}.fun[[n1,3]];
{θx[2],θy[2],θz[2]}={ix0,iy0,iz0}.fun[[n2,3]];
{δux[1],δuy[1],δuz[1]}=δ[{ux[1],uy[1],uz[1]}];
{δux[2],δuy[2],δuz[2]}=δ[{ux[2],uy[2],uz[2]}];
{δθx[1],δθy[1],δθz[1]}=δ[{θx[1],θy[1],θz[1]}];
{δθx[2],δθy[2],δθz[2]}=δ[{θx[2],θy[2],θz[2]}];

EEm={1,1}.({1,1}*EE)/2;
GGm={1,1}.({1,1}*GG)/2;
AAm={1,1}.({1,1}*AA)/2;
Iyym={1,1}.({1,1}*Iyy)/2;
Izzm={1,1}.({1,1}*Izz)/2;
{fx1,fx2}={1,1}*fx;
{fy1,fy2}={1,1}*fy;
{fz1,fz2}={1,1}*fz;
{mx1,mx2}={1,1}*mx;
{my1,my2}={1,1}*my;
{mz1,mz2}={1,1}*mz;

(1/(60 (h0^3)))(-60 AAm EEm (h0^2) ux[1] δux[1]+60 AAm EEm (h0^2) ux[2] δux[1]+60 AAm EEm (h0^2) ux[1] δux[2]-60 AAm EEm (h0^2) ux[2] δux[2]+10 fx1 (h0^4) (2 δux[1]+δux[2])+10 fx2 (h0^4) (δux[1]+2 δux[2])+21 fy1 (h0^4) δuy[1]+9 fy2 (h0^4) δuy[1]-30 (h0^3) mz1 δuy[1]-30 (h0^3) mz2 δuy[1]-720 EEm Izzm uy[1] δuy[1]+720 EEm Izzm uy[2] δuy[1]+9 fy1 (h0^4) δuy[2]+21 fy2 (h0^4) δuy[2]+30 (h0^3) mz1 δuy[2]+30 (h0^3) mz2 δuy[2]+720 EEm Izzm uy[1] δuy[2]-720 EEm Izzm uy[2] δuy[2]+21 fz1 (h0^4) δuz[1]+9 fz2 (h0^4) δuz[1]+30 (h0^3) my1 δuz[1]+30 (h0^3) my2 δuz[1]-720 EEm Iyym uz[1] δuz[1]+720 EEm Iyym uz[2] δuz[1]+9 fz1 (h0^4) δuz[2]+21 fz2 (h0^4) δuz[2]-30 (h0^3) my1 δuz[2]-30 (h0^3) my2 δuz[2]+720 EEm Iyym uz[1] δuz[2]-720 EEm Iyym uz[2] δuz[2]+20 (h0^4) mx1 δθx[1]+10 (h0^4) mx2 δθx[1]+10 (h0^4) mx1 δθx[2]+20 (h0^4) mx2 δθx[2]-3 fz1 (h0^5) δθy[1]-2 fz2 (h0^5) δθy[1]+5 (h0^4) my1 δθy[1]-5 (h0^4) my2 δθy[1]+360 EEm h0 Iyym uz[1] δθy[1]-360 EEm h0 Iyym uz[2] δθy[1]+2 fz1 (h0^5) δθy[2]+3 fz2 (h0^5) δθy[2]-5 (h0^4) my1 δθy[2]+5 (h0^4) my2 δθy[2]+360 EEm h0 Iyym uz[1] δθy[2]-360 EEm h0 Iyym uz[2] δθy[2]+3 fy1 (h0^5) δθz[1]+2 fy2 (h0^5) δθz[1]+5 (h0^4) mz1 δθz[1]-5 (h0^4) mz2 δθz[1]-360 EEm h0 Izzm uy[1] δθz[1]+360 EEm h0 Izzm uy[2] δθz[1]-2 fy1 (h0^5) δθz[2]-3 fy2 (h0^5) δθz[2]-5 (h0^4) mz1 δθz[2]+5 (h0^4) mz2 δθz[2]-360 EEm h0 Izzm uy[1] δθz[2]+360 EEm h0 Izzm uy[2] δθz[2]-60 GGm (h0^2) Iyym δθx[1] θx[1]-60 GGm (h0^2) Izzm δθx[1] θx[1]+60 GGm (h0^2) Iyym δθx[2] θx[1]+60 GGm (h0^2) Izzm δθx[2] θx[1]+60 GGm (h0^2) Iyym δθx[1] θx[2]+60 GGm (h0^2) Izzm δθx[1] θx[2]-60 GGm (h0^2) Iyym δθx[2] θx[2]-60 GGm (h0^2) Izzm δθx[2] θx[2]+360 EEm h0 Iyym δuz[1] θy[1]-360 EEm h0 Iyym δuz[2] θy[1]-240 EEm (h0^2) Iyym δθy[1] θy[1]-120 EEm (h0^2) Iyym δθy[2] θy[1]+360 EEm h0 Iyym δuz[1] θy[2]-360 EEm h0 Iyym δuz[2] θy[2]-120 EEm (h0^2) Iyym δθy[1] θy[2]-240 EEm (h0^2) Iyym δθy[2] θy[2]-360 EEm h0 Izzm δuy[1] θz[1]+360 EEm h0 Izzm δuy[2] θz[1]-240 EEm (h0^2) Izzm δθz[1] θz[1]-120 EEm (h0^2) Izzm δθz[2] θz[1]-360 EEm h0 Izzm δuy[1] θz[2]+360 EEm h0 Izzm δuy[2] θz[2]-120 EEm (h0^2) Izzm δθz[1] θz[2]-240 EEm (h0^2) Izzm δθz[2] θz[2])];

δW[DISP,{GENERICBEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{GENERICBEAM,{{EE,GG},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{GENERICBEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[node_]},fun_]:=δW[DISP,{GENERICBEAM,{{EE,GG},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,mx,my,mz}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Sy_,Sz_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{GENERICBEAM,{{EE,GG},{AA,Sy,Sz,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{GENERICBEAM,{{EE_,GG_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{NN,r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,FF,FFINV,PP,ns,u,v,w,ϕ,Θ,ψ,EEEE,AE,CE,BE,ϵ,κ,Irr,F,M,δwint,δwext,δwbrn,δWW,equ,sol,bl,EEE,GGG,κκκ,AAA,SSz,SSy,IIyy,IIzz,IIyz,ffx,ffy,ffz,mmx,mmy,mmz},

(*mapping to material system*)
r0=α*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_α)r0;
hα0=Simplify[Sqrt[rα0.rα0],L>0&&h>0];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];
PP=LeviCivitaTensor[3];

(*use two internal nodes*)
NN= LAGRANGE[{{4,α}}];
{u,v,w}=NN.{fun[[n1,2]],{b[1],b[2],b[3]} ,{b[4],b[5],b[6]},fun[[n2,2]]};
{ϕ,Θ,ψ}=NN.{fun[[n1,3]],{b[7],b[8],b[9]} ,{b[10],b[11],b[12]},fun[[n2,3]]};

(*transform to material system*)
{u,v,w}={u,v,w}.FFINV;
{ϕ,Θ,ψ}={ϕ,Θ,ψ}.FFINV;

(*elasticity dyad and cross-section properties are known in the material system*)
EEE=If[Head[EE]===Function,EE[x],EE];
GGG=If[Head[GG]===Function,GG[x],GG];
AAA=If[Head[AA]===Function,AA[x],AA];
SSz=If[Head[Sz]===Function,Sz[x],Sz];
SSy=If[Head[Sy]===Function,Sy[x],Sy];
IIyy=If[Head[Iyy]===Function,Iyy[x],Iyy];
IIzz=If[Head[Izz]===Function,Izz[x],Izz];
IIyz=If[Head[Iyz]===Function,Iyz[x],Iyz];
ffx=If[Head[fx]===Function,fx[x],fx];
ffy=If[Head[fy]===Function,fy[x],fy];
ffz=If[Head[fz]===Function,fz[x],fz];
mmx=If[Head[mx]===Function,mx[x],mx];
mmy=If[Head[my]===Function,my[x],my];
mmz=If[Head[mz]===Function,mz[x],mz];

(*elasticity dyad and cross-section properties are known in the material system*)
AE={{EEE AAA,0,0},{0,GGG AAA,0},{0,0,GGG AAA}};
CE={{0,EEE SSy,-EEE SSz},{-GGG SSy,0,0},{GGG SSz,0,0}};
BE={{GGG IIyy+GGG IIzz,0,0},{0,EEE IIyy,-EEE IIyz},{0,-EEE IIyz,EEE IIzz}};

(*strain measures*)
ϵ=(∂_α){u,v,w}/hα0+{1,0,0}\[Cross]{ϕ,Θ,ψ};
κ=(∂_α){ϕ,Θ,ψ}/hα0;

(*stress resultants*)
F=AE.ϵ+CE.κ;
M=Transpose[CE].ϵ+BE.κ;

(*virtual work expressions*)
δwint=-δ[ϵ].F-δ[κ].M;
δwext=δ[{u,v,w}].{ffx,ffy,ffz}+δ[{ϕ,Θ,ψ}].{mmx,mmy,mmz};
δwbrn=δ[ϵ[[2;;3]]].ϵ[[2;;3]]*bl;

(*δWW=QUAD[LIN7,(δwint+δwext+δwbrn)*jac,{α}];*)
δWW=Integrate[(δwint+δwext+δwbrn)*jac,{α,0,1}];

(*eliminate internals*)
equ=D[δWW,{Table[δb[ii],{ii,1,12}]}];
sol=Solve[Thread[equ==0],Table[b[ii],{ii,1,12}]][[1]];

(*go to the Bernoulli limit*)
δWW=Limit[δWW /.sol,bl->Infinity]
];


(*
δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,Ip_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,{0,1,0},Ip},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,iy0_,Ip_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,h,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz,fx1,fx2,fy1,fy2,fz1,fz2,mx1,mx2,my1,my2,mz1,mz2,EEm,GGm,AAm,Iyym,Izzm},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=h=Simplify[Sqrt[r0.r0],L>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1],uy[1],uz[1]}={ix0,iy0,iz0}.fun[[n1,2]];
{ux[2],uy[2],uz[2]}={ix0,iy0,iz0}.fun[[n2,2]];
{θx[1],θy[1],θz[1]}={ix0,iy0,iz0}.fun[[n1,3]];
{θx[2],θy[2],θz[2]}={ix0,iy0,iz0}.fun[[n2,3]];
{δux[1],δuy[1],δuz[1]}=δ[{ux[1],uy[1],uz[1]}];
{δux[2],δuy[2],δuz[2]}=δ[{ux[2],uy[2],uz[2]}];
{δθx[1],δθy[1],δθz[1]}=δ[{θx[1],θy[1],θz[1]}];
{δθx[2],δθy[2],δθz[2]}=δ[{θx[2],θy[2],θz[2]}];

EEm={1,1}.({1,1}*EE)/2;
GGm={1,1}.({1,1}*GG)/2 ;
AAm={1,1}.({1,1}*AA)/2;
Iyym={1,1}.({1,1}*Iyy)/2;
Izzm={1,1}.({1,1}*Izz)/2;
{fx1,fx2}={1,1}*fx;
{fy1,fy2}={1,1}*fy;
{fz1,fz2}={1,1}*fz;
{mx1,mx2}={1,1}*mx;
{my1,my2}={1,1}*my;
{mz1,mz2}={1,1}*mz;

GGm=GGm*Ip/(Iyym+Izzm);

(1/(60 (h^3)))(-60 AAm EEm (h^2) ux[1] δux[1]+60 AAm EEm (h^2) ux[2] δux[1]+60 AAm EEm (h^2) ux[1] δux[2]-60 AAm EEm (h^2) ux[2] δux[2]+10 fx1 (h^4) (2 δux[1]+δux[2])+10 fx2 (h^4) (δux[1]+2 δux[2])+21 fy1 (h^4) δuy[1]+9 fy2 (h^4) δuy[1]-30 (h^3) mz1 δuy[1]-30 (h^3) mz2 δuy[1]-720 EEm Izzm uy[1] δuy[1]+720 EEm Izzm uy[2] δuy[1]+9 fy1 (h^4) δuy[2]+21 fy2 (h^4) δuy[2]+30 (h^3) mz1 δuy[2]+30 (h^3) mz2 δuy[2]+720 EEm Izzm uy[1] δuy[2]-720 EEm Izzm uy[2] δuy[2]+21 fz1 (h^4) δuz[1]+9 fz2 (h^4) δuz[1]+30 (h^3) my1 δuz[1]+30 (h^3) my2 δuz[1]-720 EEm Iyym uz[1] δuz[1]+720 EEm Iyym uz[2] δuz[1]+9 fz1 (h^4) δuz[2]+21 fz2 (h^4) δuz[2]-30 (h^3) my1 δuz[2]-30 (h^3) my2 δuz[2]+720 EEm Iyym uz[1] δuz[2]-720 EEm Iyym uz[2] δuz[2]+20 (h^4) mx1 δθx[1]+10 (h^4) mx2 δθx[1]+10 (h^4) mx1 δθx[2]+20 (h^4) mx2 δθx[2]-3 fz1 (h^5) δθy[1]-2 fz2 (h^5) δθy[1]+5 (h^4) my1 δθy[1]-5 (h^4) my2 δθy[1]+360 EEm h Iyym uz[1] δθy[1]-360 EEm h Iyym uz[2] δθy[1]+2 fz1 (h^5) δθy[2]+3 fz2 (h^5) δθy[2]-5 (h^4) my1 δθy[2]+5 (h^4) my2 δθy[2]+360 EEm h Iyym uz[1] δθy[2]-360 EEm h Iyym uz[2] δθy[2]+3 fy1 (h^5) δθz[1]+2 fy2 (h^5) δθz[1]+5 (h^4) mz1 δθz[1]-5 (h^4) mz2 δθz[1]-360 EEm h Izzm uy[1] δθz[1]+360 EEm h Izzm uy[2] δθz[1]-2 fy1 (h^5) δθz[2]-3 fy2 (h^5) δθz[2]-5 (h^4) mz1 δθz[2]+5 (h^4) mz2 δθz[2]-360 EEm h Izzm uy[1] δθz[2]+360 EEm h Izzm uy[2] δθz[2]-60 GGm (h^2) Iyym δθx[1] θx[1]-60 GGm (h^2) Izzm δθx[1] θx[1]+60 GGm (h^2) Iyym δθx[2] θx[1]+60 GGm (h^2) Izzm δθx[2] θx[1]+60 GGm (h^2) Iyym δθx[1] θx[2]+60 GGm (h^2) Izzm δθx[1] θx[2]-60 GGm (h^2) Iyym δθx[2] θx[2]-60 GGm (h^2) Izzm δθx[2] θx[2]+360 EEm h Iyym δuz[1] θy[1]-360 EEm h Iyym δuz[2] θy[1]-240 EEm (h^2) Iyym δθy[1] θy[1]-120 EEm (h^2) Iyym δθy[2] θy[1]+360 EEm h Iyym δuz[1] θy[2]-360 EEm h Iyym δuz[2] θy[2]-120 EEm (h^2) Iyym δθy[1] θy[2]-240 EEm (h^2) Iyym δθy[2] θy[2]-360 EEm h Izzm δuy[1] θz[1]+360 EEm h Izzm δuy[2] θz[1]-240 EEm (h^2) Izzm δθz[1] θz[1]-120 EEm (h^2) Izzm δθz[2] θz[1]-360 EEm h Izzm δuy[1] θz[2]+360 EEm h Izzm δuy[2] θz[2]-120 EEm (h^2) Izzm δθz[1] θz[2]-240 EEm (h^2) Izzm δθz[2] θz[2])];

*)


δW[DISP,{BEAM,{{EE_,GG_,κκ_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[DISP,{BEAM,{{EE,GG,κκ},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz}},Line[{n1,n2}]},fun];

δW[DISP,{BEAM,{{EE_,GG_,κκ_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0],L>0&&h>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;
ux[1]=fun[[n1,2]].ix0; ux[2]=fun[[n2,2]].ix0;
uy[1]=fun[[n1,2]].iy0; uy[2]=fun[[n2,2]].iy0;
uz[1]=fun[[n1,2]].iz0; uz[2]=fun[[n2,2]].iz0;
θx[1]=fun[[n1,3]].ix0; θx[2]=fun[[n2,3]].ix0;
θy[1]=fun[[n1,3]].iy0; θy[2]=fun[[n2,3]].iy0;
θz[1]=fun[[n1,3]].iz0; θz[2]=fun[[n2,3]].iz0;
δux[1]=δ[fun[[n1,2]]].ix0; δux[2]=δ[fun[[n2,2]]].ix0;
δuy[1]=δ[fun[[n1,2]]].iy0; δuy[2]=δ[fun[[n2,2]]].iy0;
δuz[1]=δ[fun[[n1,2]]].iz0; δuz[2]=δ[fun[[n2,2]]].iz0;
δθx[1]=δ[fun[[n1,3]]].ix0; δθx[2]=δ[fun[[n2,3]]].ix0;
δθy[1]=δ[fun[[n1,3]]].iy0; δθy[2]=δ[fun[[n2,3]]].iy0;
δθz[1]=δ[fun[[n1,3]]].iz0; δθz[2]=δ[fun[[n2,3]]].iz0;

((AA^2) (GG^2) (h0^4) ((κκ)^2) (6 fx (h0^2) (δux[1]+δux[2])+6 fz (h0^2) δuz[1]+6 fz (h0^2) δuz[2]-fz (h0^3) δθy[1]+fz (h0^3) δθy[2]+fy (h0^2) (6 δuy[1]+6 δuy[2]+h0 δθz[1]-h0 δθz[2])-12 GG Iyy δθx[1] θx[1]-12 GG Izz δθx[1] θx[1]+12 GG Iyy δθx[2] θx[1]+12 GG Izz δθx[2] θx[1]+12 GG Iyy δθx[1] θx[2]+12 GG Izz δθx[1] θx[2]-12 GG Iyy δθx[2] θx[2]-12 GG Izz δθx[2] θx[2])-1728 (EE^3) Iyy Izz (AA (ux[1]-ux[2]) (δux[1]-δux[2])+Izz (δθy[1]-δθy[2]) (θy[1]-θy[2])+Iyy (δθz[1]-δθz[2]) (θz[1]-θz[2]))+144 (EE^2) (-(AA^2) GG (h0^2) (Iyy+Izz) κκ (ux[1]-ux[2]) (δux[1]-δux[2])+6 fx (h0^2) Iyy Izz (δux[1]+δux[2])+Iyy Izz (fz (h0^2) (6 δuz[1]+6 δuz[2]-h0 δθy[1]+h0 δθy[2])+fy (h0^2) (6 δuy[1]+6 δuy[2]+h0 δθz[1]-h0 δθz[2])-12 GG (Iyy+Izz) (δθx[1]-δθx[2]) (θx[1]-θx[2]))-AA GG κκ ((h0^2) (Izz^2) (δθy[1]-δθy[2]) (θy[1]-θy[2])+(h0^2) (Iyy^2) (δθz[1]-δθz[2]) (θz[1]-θz[2])+2 Iyy Izz (6 uz[1] δuz[1]-6 uz[2] δuz[1]-6 uz[1] δuz[2]+6 uz[2] δuz[2]-3 h0 uz[1] δθy[1]+3 h0 uz[2] δθy[1]-3 h0 uz[1] δθy[2]+3 h0 uz[2] δθy[2]+3 uy[1] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))-3 uy[2] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))-3 h0 δuz[1] θy[1]+3 h0 δuz[2] θy[1]+2 (h0^2) δθy[1] θy[1]+(h0^2) δθy[2] θy[1]-3 h0 δuz[1] θy[2]+3 h0 δuz[2] θy[2]+(h0^2) δθy[1] θy[2]+2 (h0^2) δθy[2] θy[2]+3 h0 δuy[1] θz[1]-3 h0 δuy[2] θz[1]+2 (h0^2) δθz[1] θz[1]+(h0^2) δθz[2] θz[1]+3 h0 δuy[1] θz[2]-3 h0 δuy[2] θz[2]+(h0^2) δθz[1] θz[2]+2 (h0^2) δθz[2] θz[2])))-12 AA EE GG (h0^2) κκ ((AA^2) GG (h0^2) κκ (ux[1]-ux[2]) (δux[1]-δux[2])-6 fx (h0^2) (Iyy+Izz) (δux[1]+δux[2])-(Iyy+Izz) (fz (h0^2) (6 δuz[1]+6 δuz[2]-h0 δθy[1]+h0 δθy[2])+fy (h0^2) (6 δuy[1]+6 δuy[2]+h0 δθz[1]-h0 δθz[2])-12 GG (Iyy+Izz) (δθx[1]-δθx[2]) (θx[1]-θx[2]))+2 AA GG κκ (Izz (-3 uz[1] (-2 δuz[1]+2 δuz[2]+h0 (δθy[1]+δθy[2]))+3 uz[2] (-2 δuz[1]+2 δuz[2]+h0 (δθy[1]+δθy[2]))+h0 (-3 δuz[1] (θy[1]+θy[2])+3 δuz[2] (θy[1]+θy[2])+h0 (δθy[1] (2 θy[1]+θy[2])+δθy[2] (θy[1]+2 θy[2]))))+Iyy (3 uy[1] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))-3 uy[2] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))+h0 (3 δuy[1] (θz[1]+θz[2])-3 δuy[2] (θz[1]+θz[2])+h0 (δθz[1] (2 θz[1]+θz[2])+δθz[2] (θz[1]+2 θz[2])))))))/(12 h0 (12 EE Iyy+AA GG (h0^2) κκ) (12 EE Izz+AA GG (h0^2) κκ))];

δW[DISP,{GENERICBEAM,{{EE_,GG_,κκ_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{α,NN,r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,FF,FFINV,PP,ns,u,v,w,ϕ,Θ,ψ,AE,CE,BE,ϵ,κ,Irr,F,M,δwint,δwext,δWW,equ,sol,bl,EEE,GGG,κκκ,AAA,SSz,SSy,IIyy,IIzz,IIyz,ffx,ffy,ffz,mmx,mmy,mmz},

(*mapping to material system*)
r0=α*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_α)r0;
hα0=Simplify[Sqrt[rα0.rα0],{L>0,h>0}];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];
PP=LeviCivitaTensor[3];

NN= LAGRANGE[{{4,α}}];
{u,v,w}=NN.{fun[[n1,2]],{b[1],b[2],b[3]} ,{b[4],b[5],b[6]},fun[[n2,2]]};
{ϕ,Θ,ψ}=NN.{fun[[n1,3]],{b[7],b[8],b[9]} ,{b[10],b[11],b[12]},fun[[n2,3]]};

(*transform to material system*)
{u,v,w}={u,v,w}.FFINV;
{ϕ,Θ,ψ}={ϕ,Θ,ψ}.FFINV;

(*elasticity dyad and cross-section properties are known in the material system*)
EEE=If[Head[EE]===Function,EE[x],EE];
GGG=If[Head[GG]===Function,GG[x],GG];
κκκ=If[Head[κκ]===Function,κκ[x],κκ];
AAA=If[Head[AA]===Function,AA[x],AA];
SSz=If[Head[Sz]===Function,Sz[x],Sz];
SSy=If[Head[Sy]===Function,Sy[x],Sy];
IIyy=If[Head[Izz]===Function,Izz[x],Izz];
IIzz=If[Head[Iyy]===Function,Iyy[x],Iyy];
IIyz=If[Head[Iyz]===Function,Iyz[x],Iyz];
ffx=If[Head[fx]===Function,fx[x],fx];
ffy=If[Head[fy]===Function,fy[x],fy];
ffz=If[Head[fz]===Function,fz[x],fz];
mmx=If[Head[mx]===Function,mx[x],mx];
mmy=If[Head[my]===Function,my[x],my];
mmz=If[Head[mz]===Function,mz[x],mz];

AE={{EEE AAA,0,0},{0,κκκ GGG AAA,0},
{0,0,κκκ GGG AAA}};
CE={{0,EEE SSy,-EEE SSz},{-GGG SSy,0,0},{GGG SSz,0,0}};
BE={{GGG (IIyy+IIzz),0,0},{0,EEE IIyy,-EEE IIyz},
{0,-EEE IIyz,EEE IIzz}};

(*strain measures*)
ϵ=(∂_α){u,v,w}/hα0+{1,0,0}\[Cross]{ϕ,Θ,ψ};
κ=(∂_α){ϕ,Θ,ψ}/hα0;

(*stress resultants*)
F=AE.ϵ+CE.κ;
M=Transpose[CE].ϵ+BE.κ;

(*virtual work expressions*)
δwint=-δ[ϵ].F-δ[κ].M;
δwext=δ[{u,v,w}].{ffx,ffy,ffz}+δ[{ϕ,Θ,ψ}].{mmx,mmy,mmz};

δWW=QUAD[LINE7,(δwint+δwext)*jac,{{α},{{0},{1}}}];
(*δWW=Integrate[(δwint+δwext)*jac,{α,0,1}];*)

(*eliminate internals*)
equ=D[δWW,{Table[δb[ii],{ii,1,12}]}];
sol=Solve[Thread[equ==0],Table[b[ii],{ii,1,12}]][[1]];
δWW /.sol
];

BEAM ELEMENT (dynamic) defs

δW[DISP,{BEAM,{{EE_,GG_},{AA_,II_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,II,II,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,iy0},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz,mx,my,mz}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz,fx1,fx2,fy1,fy2,fz1,fz2,mx1,mx2,my1,my2,mz1,mz2,EEm,GGm,AAm,Iyym,Izzm},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0],L>0&&h>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1],uy[1],uz[1]}={ix0,iy0,iz0}.fun[[n1,2]];
{ux[2],uy[2],uz[2]}={ix0,iy0,iz0}.fun[[n2,2]];
{θx[1],θy[1],θz[1]}={ix0,iy0,iz0}.fun[[n1,3]];
{θx[2],θy[2],θz[2]}={ix0,iy0,iz0}.fun[[n2,3]];
{δux[1],δuy[1],δuz[1]}=δ[{ux[1],uy[1],uz[1]}];
{δux[2],δuy[2],δuz[2]}=δ[{ux[2],uy[2],uz[2]}];
{δθx[1],δθy[1],δθz[1]}=δ[{θx[1],θy[1],θz[1]}];
{δθx[2],δθy[2],δθz[2]}=δ[{θx[2],θy[2],θz[2]}];

EEm={1,1}.({1,1}*EE)/2;
GGm={1,1}.({1,1}*GG)/2;
AAm={1,1}.({1,1}*AA)/2;
Iyym={1,1}.({1,1}*Iyy)/2;
Izzm={1,1}.({1,1}*Izz)/2;
{fx1,fx2}={1,1}*fx;
{fy1,fy2}={1,1}*fy;
{fz1,fz2}={1,1}*fz;
{mx1,mx2}={1,1}*mx;
{my1,my2}={1,1}*my;
{mz1,mz2}={1,1}*mz;

(1/(60 (h0^3)))(-60 AAm EEm (h0^2) ux[1] δux[1]+60 AAm EEm (h0^2) ux[2] δux[1]+60 AAm EEm (h0^2) ux[1] δux[2]-60 AAm EEm (h0^2) ux[2] δux[2]+10 fx1 (h0^4) (2 δux[1]+δux[2])+10 fx2 (h0^4) (δux[1]+2 δux[2])+21 fy1 (h0^4) δuy[1]+9 fy2 (h0^4) δuy[1]-30 (h0^3) mz1 δuy[1]-30 (h0^3) mz2 δuy[1]-720 EEm Izzm uy[1] δuy[1]+720 EEm Izzm uy[2] δuy[1]+9 fy1 (h0^4) δuy[2]+21 fy2 (h0^4) δuy[2]+30 (h0^3) mz1 δuy[2]+30 (h0^3) mz2 δuy[2]+720 EEm Izzm uy[1] δuy[2]-720 EEm Izzm uy[2] δuy[2]+21 fz1 (h0^4) δuz[1]+9 fz2 (h0^4) δuz[1]+30 (h0^3) my1 δuz[1]+30 (h0^3) my2 δuz[1]-720 EEm Iyym uz[1] δuz[1]+720 EEm Iyym uz[2] δuz[1]+9 fz1 (h0^4) δuz[2]+21 fz2 (h0^4) δuz[2]-30 (h0^3) my1 δuz[2]-30 (h0^3) my2 δuz[2]+720 EEm Iyym uz[1] δuz[2]-720 EEm Iyym uz[2] δuz[2]+20 (h0^4) mx1 δθx[1]+10 (h0^4) mx2 δθx[1]+10 (h0^4) mx1 δθx[2]+20 (h0^4) mx2 δθx[2]-3 fz1 (h0^5) δθy[1]-2 fz2 (h0^5) δθy[1]+5 (h0^4) my1 δθy[1]-5 (h0^4) my2 δθy[1]+360 EEm h0 Iyym uz[1] δθy[1]-360 EEm h0 Iyym uz[2] δθy[1]+2 fz1 (h0^5) δθy[2]+3 fz2 (h0^5) δθy[2]-5 (h0^4) my1 δθy[2]+5 (h0^4) my2 δθy[2]+360 EEm h0 Iyym uz[1] δθy[2]-360 EEm h0 Iyym uz[2] δθy[2]+3 fy1 (h0^5) δθz[1]+2 fy2 (h0^5) δθz[1]+5 (h0^4) mz1 δθz[1]-5 (h0^4) mz2 δθz[1]-360 EEm h0 Izzm uy[1] δθz[1]+360 EEm h0 Izzm uy[2] δθz[1]-2 fy1 (h0^5) δθz[2]-3 fy2 (h0^5) δθz[2]-5 (h0^4) mz1 δθz[2]+5 (h0^4) mz2 δθz[2]-360 EEm h0 Izzm uy[1] δθz[2]+360 EEm h0 Izzm uy[2] δθz[2]-60 GGm (h0^2) Iyym δθx[1] θx[1]-60 GGm (h0^2) Izzm δθx[1] θx[1]+60 GGm (h0^2) Iyym δθx[2] θx[1]+60 GGm (h0^2) Izzm δθx[2] θx[1]+60 GGm (h0^2) Iyym δθx[1] θx[2]+60 GGm (h0^2) Izzm δθx[1] θx[2]-60 GGm (h0^2) Iyym δθx[2] θx[2]-60 GGm (h0^2) Izzm δθx[2] θx[2]+360 EEm h0 Iyym δuz[1] θy[1]-360 EEm h0 Iyym δuz[2] θy[1]-240 EEm (h0^2) Iyym δθy[1] θy[1]-120 EEm (h0^2) Iyym δθy[2] θy[1]+360 EEm h0 Iyym δuz[1] θy[2]-360 EEm h0 Iyym δuz[2] θy[2]-120 EEm (h0^2) Iyym δθy[1] θy[2]-240 EEm (h0^2) Iyym δθy[2] θy[2]-360 EEm h0 Izzm δuy[1] θz[1]+360 EEm h0 Izzm δuy[2] θz[1]-240 EEm (h0^2) Izzm δθz[1] θz[1]-120 EEm (h0^2) Izzm δθz[2] θz[1]-360 EEm h0 Izzm δuy[1] θz[2]+360 EEm h0 Izzm δuy[2] θz[2]-120 EEm (h0^2) Izzm δθz[1] θz[2]-240 EEm (h0^2) Izzm δθz[2] θz[2])];

δW[DISP,{GENERICBEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{GENERICBEAM,{{EE,GG},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{GENERICBEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[node_]},fun_]:=δW[DISP,{GENERICBEAM,{{EE,GG},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,mx,my,mz}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Sy_,Sz_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{GENERICBEAM,{{EE,GG},{AA,Sy,Sz,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{GENERICBEAM,{{EE_,GG_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{NN,r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,FF,FFINV,PP,ns,u,v,w,ϕ,Θ,ψ,EEEE,AE,CE,BE,ϵ,κ,Irr,F,M,δwint,δwext,δwbrn,δWW,equ,sol,bl,EEE,GGG,κκκ,AAA,SSz,SSy,IIyy,IIzz,IIyz,ffx,ffy,ffz,mmx,mmy,mmz},

(*mapping to material system*)
r0=α*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_α)r0;
hα0=Simplify[Sqrt[rα0.rα0],L>0&&h>0];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];
PP=LeviCivitaTensor[3];

(*use two internal nodes*)
NN= LAGRANGE[{{4,α}}];
{u,v,w}=NN.{fun[[n1,2]],{b[1],b[2],b[3]} ,{b[4],b[5],b[6]},fun[[n2,2]]};
{ϕ,Θ,ψ}=NN.{fun[[n1,3]],{b[7],b[8],b[9]} ,{b[10],b[11],b[12]},fun[[n2,3]]};

(*transform to material system*)
{u,v,w}={u,v,w}.FFINV;
{ϕ,Θ,ψ}={ϕ,Θ,ψ}.FFINV;

(*elasticity dyad and cross-section properties are known in the material system*)
EEE=If[Head[EE]===Function,EE[x],EE];
GGG=If[Head[GG]===Function,GG[x],GG];
AAA=If[Head[AA]===Function,AA[x],AA];
SSz=If[Head[Sz]===Function,Sz[x],Sz];
SSy=If[Head[Sy]===Function,Sy[x],Sy];
IIyy=If[Head[Iyy]===Function,Iyy[x],Iyy];
IIzz=If[Head[Izz]===Function,Izz[x],Izz];
IIyz=If[Head[Iyz]===Function,Iyz[x],Iyz];
ffx=If[Head[fx]===Function,fx[x],fx];
ffy=If[Head[fy]===Function,fy[x],fy];
ffz=If[Head[fz]===Function,fz[x],fz];
mmx=If[Head[mx]===Function,mx[x],mx];
mmy=If[Head[my]===Function,my[x],my];
mmz=If[Head[mz]===Function,mz[x],mz];

(*elasticity dyad and cross-section properties are known in the material system*)
AE={{EEE AAA,0,0},{0,GGG AAA,0},{0,0,GGG AAA}};
CE={{0,EEE SSy,-EEE SSz},{-GGG SSy,0,0},{GGG SSz,0,0}};
BE={{GGG IIyy+GGG IIzz,0,0},{0,EEE IIyy,-EEE IIyz},{0,-EEE IIyz,EEE IIzz}};

(*strain measures*)
ϵ=(∂_α){u,v,w}/hα0+{1,0,0}\[Cross]{ϕ,Θ,ψ};
κ=(∂_α){ϕ,Θ,ψ}/hα0;

(*stress resultants*)
F=AE.ϵ+CE.κ;
M=Transpose[CE].ϵ+BE.κ;

(*virtual work expressions*)
δwint=-δ[ϵ].F-δ[κ].M;
δwext=δ[{u,v,w}].{ffx,ffy,ffz}+δ[{ϕ,Θ,ψ}].{mmx,mmy,mmz};
δwbrn=δ[ϵ[[2;;3]]].ϵ[[2;;3]]*bl;

(*δWW=QUAD[LIN7,(δwint+δwext+δwbrn)*jac,{α}];*)
δWW=Integrate[(δwint+δwext+δwbrn)*jac,{α,0,1}];

(*eliminate internals*)
equ=D[δWW,{Table[δb[ii],{ii,1,12}]}];
sol=Solve[Thread[equ==0],Table[b[ii],{ii,1,12}]][[1]];

(*go to the Bernoulli limit*)
δWW=Limit[δWW /.sol,bl->Infinity]
];


(*
δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,Ip_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[DISP,{BEAM,{{EE,GG},{AA,Iyy,Izz,{0,1,0},Ip},{fx,fy,fz,0,0,0}},Line[node]},fun];

δW[DISP,{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,iy0_,Ip_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,h,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz,fx1,fx2,fy1,fy2,fz1,fz2,mx1,mx2,my1,my2,mz1,mz2,EEm,GGm,AAm,Iyym,Izzm},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=h=Simplify[Sqrt[r0.r0],L>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1],uy[1],uz[1]}={ix0,iy0,iz0}.fun[[n1,2]];
{ux[2],uy[2],uz[2]}={ix0,iy0,iz0}.fun[[n2,2]];
{θx[1],θy[1],θz[1]}={ix0,iy0,iz0}.fun[[n1,3]];
{θx[2],θy[2],θz[2]}={ix0,iy0,iz0}.fun[[n2,3]];
{δux[1],δuy[1],δuz[1]}=δ[{ux[1],uy[1],uz[1]}];
{δux[2],δuy[2],δuz[2]}=δ[{ux[2],uy[2],uz[2]}];
{δθx[1],δθy[1],δθz[1]}=δ[{θx[1],θy[1],θz[1]}];
{δθx[2],δθy[2],δθz[2]}=δ[{θx[2],θy[2],θz[2]}];

EEm={1,1}.({1,1}*EE)/2;
GGm={1,1}.({1,1}*GG)/2 ;
AAm={1,1}.({1,1}*AA)/2;
Iyym={1,1}.({1,1}*Iyy)/2;
Izzm={1,1}.({1,1}*Izz)/2;
{fx1,fx2}={1,1}*fx;
{fy1,fy2}={1,1}*fy;
{fz1,fz2}={1,1}*fz;
{mx1,mx2}={1,1}*mx;
{my1,my2}={1,1}*my;
{mz1,mz2}={1,1}*mz;

GGm=GGm*Ip/(Iyym+Izzm);

(1/(60 (h^3)))(-60 AAm EEm (h^2) ux[1] δux[1]+60 AAm EEm (h^2) ux[2] δux[1]+60 AAm EEm (h^2) ux[1] δux[2]-60 AAm EEm (h^2) ux[2] δux[2]+10 fx1 (h^4) (2 δux[1]+δux[2])+10 fx2 (h^4) (δux[1]+2 δux[2])+21 fy1 (h^4) δuy[1]+9 fy2 (h^4) δuy[1]-30 (h^3) mz1 δuy[1]-30 (h^3) mz2 δuy[1]-720 EEm Izzm uy[1] δuy[1]+720 EEm Izzm uy[2] δuy[1]+9 fy1 (h^4) δuy[2]+21 fy2 (h^4) δuy[2]+30 (h^3) mz1 δuy[2]+30 (h^3) mz2 δuy[2]+720 EEm Izzm uy[1] δuy[2]-720 EEm Izzm uy[2] δuy[2]+21 fz1 (h^4) δuz[1]+9 fz2 (h^4) δuz[1]+30 (h^3) my1 δuz[1]+30 (h^3) my2 δuz[1]-720 EEm Iyym uz[1] δuz[1]+720 EEm Iyym uz[2] δuz[1]+9 fz1 (h^4) δuz[2]+21 fz2 (h^4) δuz[2]-30 (h^3) my1 δuz[2]-30 (h^3) my2 δuz[2]+720 EEm Iyym uz[1] δuz[2]-720 EEm Iyym uz[2] δuz[2]+20 (h^4) mx1 δθx[1]+10 (h^4) mx2 δθx[1]+10 (h^4) mx1 δθx[2]+20 (h^4) mx2 δθx[2]-3 fz1 (h^5) δθy[1]-2 fz2 (h^5) δθy[1]+5 (h^4) my1 δθy[1]-5 (h^4) my2 δθy[1]+360 EEm h Iyym uz[1] δθy[1]-360 EEm h Iyym uz[2] δθy[1]+2 fz1 (h^5) δθy[2]+3 fz2 (h^5) δθy[2]-5 (h^4) my1 δθy[2]+5 (h^4) my2 δθy[2]+360 EEm h Iyym uz[1] δθy[2]-360 EEm h Iyym uz[2] δθy[2]+3 fy1 (h^5) δθz[1]+2 fy2 (h^5) δθz[1]+5 (h^4) mz1 δθz[1]-5 (h^4) mz2 δθz[1]-360 EEm h Izzm uy[1] δθz[1]+360 EEm h Izzm uy[2] δθz[1]-2 fy1 (h^5) δθz[2]-3 fy2 (h^5) δθz[2]-5 (h^4) mz1 δθz[2]+5 (h^4) mz2 δθz[2]-360 EEm h Izzm uy[1] δθz[2]+360 EEm h Izzm uy[2] δθz[2]-60 GGm (h^2) Iyym δθx[1] θx[1]-60 GGm (h^2) Izzm δθx[1] θx[1]+60 GGm (h^2) Iyym δθx[2] θx[1]+60 GGm (h^2) Izzm δθx[2] θx[1]+60 GGm (h^2) Iyym δθx[1] θx[2]+60 GGm (h^2) Izzm δθx[1] θx[2]-60 GGm (h^2) Iyym δθx[2] θx[2]-60 GGm (h^2) Izzm δθx[2] θx[2]+360 EEm h Iyym δuz[1] θy[1]-360 EEm h Iyym δuz[2] θy[1]-240 EEm (h^2) Iyym δθy[1] θy[1]-120 EEm (h^2) Iyym δθy[2] θy[1]+360 EEm h Iyym δuz[1] θy[2]-360 EEm h Iyym δuz[2] θy[2]-120 EEm (h^2) Iyym δθy[1] θy[2]-240 EEm (h^2) Iyym δθy[2] θy[2]-360 EEm h Izzm δuy[1] θz[1]+360 EEm h Izzm δuy[2] θz[1]-240 EEm (h^2) Izzm δθz[1] θz[1]-120 EEm (h^2) Izzm δθz[2] θz[1]-360 EEm h Izzm δuy[1] θz[2]+360 EEm h Izzm δuy[2] θz[2]-120 EEm (h^2) Izzm δθz[1] θz[2]-240 EEm (h^2) Izzm δθz[2] θz[2])];

*)


δW[DISP,{BEAM,{{EE_,GG_,κκ_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[DISP,{BEAM,{{EE,GG,κκ},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz}},Line[{n1,n2}]},fun];

δW[DISP,{BEAM,{{EE_,GG_,κκ_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=Simplify[Sqrt[r0.r0],L>0&&h>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;
ux[1]=fun[[n1,2]].ix0; ux[2]=fun[[n2,2]].ix0;
uy[1]=fun[[n1,2]].iy0; uy[2]=fun[[n2,2]].iy0;
uz[1]=fun[[n1,2]].iz0; uz[2]=fun[[n2,2]].iz0;
θx[1]=fun[[n1,3]].ix0; θx[2]=fun[[n2,3]].ix0;
θy[1]=fun[[n1,3]].iy0; θy[2]=fun[[n2,3]].iy0;
θz[1]=fun[[n1,3]].iz0; θz[2]=fun[[n2,3]].iz0;
δux[1]=δ[fun[[n1,2]]].ix0; δux[2]=δ[fun[[n2,2]]].ix0;
δuy[1]=δ[fun[[n1,2]]].iy0; δuy[2]=δ[fun[[n2,2]]].iy0;
δuz[1]=δ[fun[[n1,2]]].iz0; δuz[2]=δ[fun[[n2,2]]].iz0;
δθx[1]=δ[fun[[n1,3]]].ix0; δθx[2]=δ[fun[[n2,3]]].ix0;
δθy[1]=δ[fun[[n1,3]]].iy0; δθy[2]=δ[fun[[n2,3]]].iy0;
δθz[1]=δ[fun[[n1,3]]].iz0; δθz[2]=δ[fun[[n2,3]]].iz0;

((AA^2) (GG^2) (h0^4) ((κκ)^2) (6 fx (h0^2) (δux[1]+δux[2])+6 fz (h0^2) δuz[1]+6 fz (h0^2) δuz[2]-fz (h0^3) δθy[1]+fz (h0^3) δθy[2]+fy (h0^2) (6 δuy[1]+6 δuy[2]+h0 δθz[1]-h0 δθz[2])-12 GG Iyy δθx[1] θx[1]-12 GG Izz δθx[1] θx[1]+12 GG Iyy δθx[2] θx[1]+12 GG Izz δθx[2] θx[1]+12 GG Iyy δθx[1] θx[2]+12 GG Izz δθx[1] θx[2]-12 GG Iyy δθx[2] θx[2]-12 GG Izz δθx[2] θx[2])-1728 (EE^3) Iyy Izz (AA (ux[1]-ux[2]) (δux[1]-δux[2])+Izz (δθy[1]-δθy[2]) (θy[1]-θy[2])+Iyy (δθz[1]-δθz[2]) (θz[1]-θz[2]))+144 (EE^2) (-(AA^2) GG (h0^2) (Iyy+Izz) κκ (ux[1]-ux[2]) (δux[1]-δux[2])+6 fx (h0^2) Iyy Izz (δux[1]+δux[2])+Iyy Izz (fz (h0^2) (6 δuz[1]+6 δuz[2]-h0 δθy[1]+h0 δθy[2])+fy (h0^2) (6 δuy[1]+6 δuy[2]+h0 δθz[1]-h0 δθz[2])-12 GG (Iyy+Izz) (δθx[1]-δθx[2]) (θx[1]-θx[2]))-AA GG κκ ((h0^2) (Izz^2) (δθy[1]-δθy[2]) (θy[1]-θy[2])+(h0^2) (Iyy^2) (δθz[1]-δθz[2]) (θz[1]-θz[2])+2 Iyy Izz (6 uz[1] δuz[1]-6 uz[2] δuz[1]-6 uz[1] δuz[2]+6 uz[2] δuz[2]-3 h0 uz[1] δθy[1]+3 h0 uz[2] δθy[1]-3 h0 uz[1] δθy[2]+3 h0 uz[2] δθy[2]+3 uy[1] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))-3 uy[2] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))-3 h0 δuz[1] θy[1]+3 h0 δuz[2] θy[1]+2 (h0^2) δθy[1] θy[1]+(h0^2) δθy[2] θy[1]-3 h0 δuz[1] θy[2]+3 h0 δuz[2] θy[2]+(h0^2) δθy[1] θy[2]+2 (h0^2) δθy[2] θy[2]+3 h0 δuy[1] θz[1]-3 h0 δuy[2] θz[1]+2 (h0^2) δθz[1] θz[1]+(h0^2) δθz[2] θz[1]+3 h0 δuy[1] θz[2]-3 h0 δuy[2] θz[2]+(h0^2) δθz[1] θz[2]+2 (h0^2) δθz[2] θz[2])))-12 AA EE GG (h0^2) κκ ((AA^2) GG (h0^2) κκ (ux[1]-ux[2]) (δux[1]-δux[2])-6 fx (h0^2) (Iyy+Izz) (δux[1]+δux[2])-(Iyy+Izz) (fz (h0^2) (6 δuz[1]+6 δuz[2]-h0 δθy[1]+h0 δθy[2])+fy (h0^2) (6 δuy[1]+6 δuy[2]+h0 δθz[1]-h0 δθz[2])-12 GG (Iyy+Izz) (δθx[1]-δθx[2]) (θx[1]-θx[2]))+2 AA GG κκ (Izz (-3 uz[1] (-2 δuz[1]+2 δuz[2]+h0 (δθy[1]+δθy[2]))+3 uz[2] (-2 δuz[1]+2 δuz[2]+h0 (δθy[1]+δθy[2]))+h0 (-3 δuz[1] (θy[1]+θy[2])+3 δuz[2] (θy[1]+θy[2])+h0 (δθy[1] (2 θy[1]+θy[2])+δθy[2] (θy[1]+2 θy[2]))))+Iyy (3 uy[1] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))-3 uy[2] (2 δuy[1]-2 δuy[2]+h0 (δθz[1]+δθz[2]))+h0 (3 δuy[1] (θz[1]+θz[2])-3 δuy[2] (θz[1]+θz[2])+h0 (δθz[1] (2 θz[1]+θz[2])+δθz[2] (θz[1]+2 θz[2])))))))/(12 h0 (12 EE Iyy+AA GG (h0^2) κκ) (12 EE Izz+AA GG (h0^2) κκ))];




δW[DISP,{GENERICBEAM,{{EE_,GG_,κκ_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=

Module[{α,NN,r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,FF,FFINV,PP,ns,u,v,w,ϕ,Θ,ψ,AE,CE,BE,ϵ,κ,Irr,F,M,δwint,δwext,δWW,equ,sol,bl,EEE,GGG,κκκ,AAA,SSz,SSy,IIyy,IIzz,IIyz,ffx,ffy,ffz,mmx,mmy,mmz},

(*mapping to material system*)
r0=α*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_α)r0;
hα0=Simplify[Sqrt[rα0.rα0],{L>0,h>0}];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];
PP=LeviCivitaTensor[3];

NN= LAGRANGE[{{4,α}}];
{u,v,w}=NN.{fun[[n1,2]],{b[1],b[2],b[3]} ,{b[4],b[5],b[6]},fun[[n2,2]]};
{ϕ,Θ,ψ}=NN.{fun[[n1,3]],{b[7],b[8],b[9]} ,{b[10],b[11],b[12]},fun[[n2,3]]};

(*transform to material system*)
{u,v,w}={u,v,w}.FFINV;
{ϕ,Θ,ψ}={ϕ,Θ,ψ}.FFINV;

(*elasticity dyad and cross-section properties are known in the material system*)
EEE=If[Head[EE]===Function,EE[x],EE];
GGG=If[Head[GG]===Function,GG[x],GG];
κκκ=If[Head[κκ]===Function,κκ[x],κκ];
AAA=If[Head[AA]===Function,AA[x],AA];
SSz=If[Head[Sz]===Function,Sz[x],Sz];
SSy=If[Head[Sy]===Function,Sy[x],Sy];
IIyy=If[Head[Izz]===Function,Izz[x],Izz];
IIzz=If[Head[Iyy]===Function,Iyy[x],Iyy];
IIyz=If[Head[Iyz]===Function,Iyz[x],Iyz];
ffx=If[Head[fx]===Function,fx[x],fx];
ffy=If[Head[fy]===Function,fy[x],fy];
ffz=If[Head[fz]===Function,fz[x],fz];
mmx=If[Head[mx]===Function,mx[x],mx];
mmy=If[Head[my]===Function,my[x],my];
mmz=If[Head[mz]===Function,mz[x],mz];

AE={{EEE AAA,0,0},{0,κκκ GGG AAA,0},
{0,0,κκκ GGG AAA}};
CE={{0,EEE SSy,-EEE SSz},{-GGG SSy,0,0},{GGG SSz,0,0}};
BE={{GGG (IIyy+IIzz),0,0},{0,EEE IIyy,-EEE IIyz},
{0,-EEE IIyz,EEE IIzz}};

(*strain measures*)
ϵ=(∂_α){u,v,w}/hα0+{1,0,0}\[Cross]{ϕ,Θ,ψ};
κ=(∂_α){ϕ,Θ,ψ}/hα0;

(*stress resultants*)
F=AE.ϵ+CE.κ;
M=Transpose[CE].ϵ+BE.κ;

(*virtual work expressions*)
δwint=-δ[ϵ].F-δ[κ].M;
δwext=δ[{u,v,w}].{ffx,ffy,ffz}+δ[{ϕ,Θ,ψ}].{mmx,mmy,mmz};

δWW=QUAD[LINE7,(δwint+δwext)*jac,{{α},{{0},{1}}}];
(*δWW=Integrate[(δwint+δwext)*jac,{α,0,1}];*)

(*eliminate internals*)
equ=D[δWW,{Table[δb[ii],{ii,1,12}]}];
sol=Solve[Thread[equ==0],Table[b[ii],{ii,1,12}]][[1]];
δWW /.sol
];


δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[node_]},fun_]:=δW[VIBR,{BEAMB,{{EE,GG,ρρ},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[node]},fun];


δW[VIBR,{BEAMV,{{EE_,GG_,ρρ_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,Jp_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,NL,NQ,FF,FFINV,u,v,w,ϕ,θ,ψ,u0,v0,w0,ϕ0,θ0,ψ0,u2,v2,w2,ϕ2,θ2,ψ2,EEEE,AE,CE,BE,ϵ,κ,Irr,F,M,δwint,δwext,δwine,δwbrn,δWW,equ,sol,bl,EEE,GGG,ρρρ,κκκ,AAA,SSz,SSy,IIyy,IIzz,IIyz,JJp,ffx,ffy,ffz,mmx,mmy,mmz,Aρ,Bρ,Cρ,ϵ0,κ0},

(*mapping to material system*)
r0=ξ*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_ξ)r0;
hα0=Simplify[Sqrt[rα0.rα0],{L>0,h>0}];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];

(*use simple*)
NL={1-ξ,ξ};
NQ= {(((1-ξ))^2) (1+2 ξ),hα0(((1-ξ))^2) ξ,(3-2 ξ) (ξ^2),hα0 (ξ^2) ( ξ-1)};

u=NL.{fun[[n1,2,1]],fun[[n2,2,1]]};
ϕ=NL.{fun[[n1,3,1]],fun[[n2,3,1]]};
v=NQ.{fun[[n1,2,2]],fun[[n1,3,3]],fun[[n2,2,2]],fun[[n2,3,3]]};
w=NQ.{fun[[n1,2,3]],-fun[[n1,3,2]],fun[[n2,2,3]],-fun[[n2,3,2]]};
ψ=(∂_ξ)v/hα0;
θ=-(∂_ξ)w/hα0;

(*transform to material system*)
{u,v,w}={u,v,w}.FFINV;
{ϕ,θ,ψ}={ϕ,θ,ψ}.FFINV;
{u0,v0,w0}={u,v,w} /.rule[0];
{ϕ0,θ0,ψ0}={ϕ,θ,ψ} /.rule[0];
{u2,v2,w2}={u,v,w}/.rule[2];
{ϕ2,θ2,ψ2}={ϕ,θ,ψ} /.rule[2];

(*elasticity dyad and cross-section properties are known in the material system*)
EEE=If[Head[EE]===Function,EE[x],EE];
GGG=If[Head[GG]===Function,GG[x],GG];
ρρρ=If[Head[ρρ]===Function,ρρ[x],ρρ];
AAA=If[Head[AA]===Function,AA[x],AA];
SSz=If[Head[Sz]===Function,Sz[x],Sz];
SSy=If[Head[Sy]===Function,Sy[x],Sy];
IIyy=If[Head[Iyy]===Function,Iyy[x],Iyy];
IIzz=If[Head[Izz]===Function,Izz[x],Izz];
IIyz=If[Head[Iyz]===Function,Iyz[x],Iyz];
JJp=If[Head[Jp]===Function,Jp[x],Jp];
ffx=If[Head[fx]===Function,fx[x],fx];
ffy=If[Head[fy]===Function,fy[x],fy];
ffz=If[Head[fz]===Function,fz[x],fz];
mmx=If[Head[mx]===Function,mx[x],mx];
mmy=If[Head[my]===Function,my[x],my];
mmz=If[Head[mz]===Function,mz[x],mz];

(*elasticity dyad and cross-section properties are known in the material system*)
AE={{EEE AAA,0,0},{0,GGG AAA,0},{0,0,GGG AAA}};
CE={{0,EEE SSy,-EEE SSz},{-GGG SSy,0,0},{GGG SSz,0,0}};
BE={{GGG JJp ,0,0},{0,EEE IIyy,-EEE IIyz},{0,-EEE IIyz,EEE IIzz}};

(*inertia properties*)
Aρ=ρρρ {{AAA,0,0},{0,AAA,0},{0,0,AAA}};
Cρ=ρρρ {{0,SSy,-SSz},{-SSy,0,0},{SSz,0,0}};
Bρ=ρρρ  {{IIyy+IIzz,0,0},{0,IIyy,-IIyz},{0,-IIyz,IIzz}};

(*strain measures*)
ϵ0=(∂_ξ){u0,v0,w0}/hα0+{1,0,0}\[Cross]{ϕ0,θ0,ψ0};
κ0=(∂_ξ){ϕ0,θ0,ψ0}/hα0;

(*stress resultants*)
F=AE.ϵ0+CE.κ0;
M=Transpose[CE].ϵ0+BE.κ0;

(*virtual work expressions*)
δwint=-δδ[ϵ0].F-δδ[κ0].M;
δwext=δδ[{u0,v0,w0}].{ffx,ffy,ffz}+δδ[{ϕ0,θ0,ψ0}].{mmx,mmy,mmz};
δwine=-δδ[{u0,v0,w0}].(Aρ.{u2,v2,w2}+Cρ.{ϕ2,θ2,ψ2})-
δδ[{ϕ0,θ0,ψ0}].(-Cρ.{u2,v2,w2}+Bρ.{ϕ2,θ2,ψ2});

δWW=QUAD[LIN7,(δwint+δwext+δwine)*jac,{ξ}]
];


δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[VIBR,{BEAM,{{EE,GG,ρρ},{AA,Iyy,Izz,{0,1,0}},{fx,fy,fz,0,0,0}},Line[{n1,n2}]},fun];

δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,h,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=h=Simplify[Sqrt[r0.r0],L>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1,0],uy[1,0],uz[1,0]}=({ix0,iy0,iz0}.fun[[n1,2]])/.DRULE[0];
{ux[1,2],uy[1,2],uz[1,2]}=({ix0,iy0,iz0}.fun[[n1,2]])/.DRULE[2];
{ux[2,0],uy[2,0],uz[2,0]}=({ix0,iy0,iz0}.fun[[n2,2]])/.DRULE[0];
{ux[2,2],uy[1,2],uz[2,2]}=({ix0,iy0,iz0}.fun[[n2,2]])/.DRULE[2];
{θx[1,0],θy[1,0],θz[1,0]}=({ix0,iy0,iz0}.fun[[n1,3]])/.DRULE[0];
{θx[1,2],θy[1,2],θz[1,2]}=({ix0,iy0,iz0}.fun[[n1,3]])/.DRULE[2];
{θx[2,0],θy[2,0],θz[2,0]}=({ix0,iy0,iz0}.fun[[n2,3]])/.DRULE[0];
{θx[2,2],θy[2,2],θz[2,2]}=({ix0,iy0,iz0}.fun[[n2,3]])/.DRULE[2];
{δux[1,0],δuy[1,0],δuz[1,0]}=δ[{ux[1,0],uy[1,0],uz[1,0]}];
{δux[2,0],δuy[2,0],δuz[2,0]}=δ[{ux[2,0],uy[2,0],uz[2,0]}];
{δθx[1,0],δθy[1,0],δθz[1,0]}=δ[{θx[1,0],θy[1,0],θz[1,0]}];
{δθx[2,0],δθy[2,0],δθz[2,0]}=δ[{θx[2,0],θy[2,0],θz[2,0]}];

-(1/(420 (h^3)))(-210 fx (h^4) (δux[1,0]+δux[2,0])+AA (h^2) (420 EE (ux[1,0]-ux[2,0]) (δux[1,0]-δux[2,0])+(h^2) ρρ (70 ux[1,2] (2 δux[1,0]+δux[2,0])+70 ux[2,2] (δux[1,0]+2 δux[2,0])+156 uy[1,2] δuy[1,0]+54 uy[2,2] δuy[1,0]+54 uy[1,2] δuy[2,0]+156 uy[2,2] δuy[2,0]+156 uz[1,2] δuz[1,0]+54 uz[2,2] δuz[1,0]+54 uz[1,2] δuz[2,0]+156 uz[2,2] δuz[2,0]-22 h uz[1,2] δθy[1,0]-13 h uz[2,2] δθy[1,0]+13 h uz[1,2] δθy[2,0]+22 h uz[2,2] δθy[2,0]+22 h uy[1,2] δθz[1,0]+13 h uy[2,2] δθz[1,0]-13 h uy[1,2] δθz[2,0]-22 h uy[2,2] δθz[2,0]-22 h δuz[1,0] θy[1,2]-13 h δuz[2,0] θy[1,2]+4 (h^2) δθy[1,0] θy[1,2]-3 (h^2) δθy[2,0] θy[1,2]+13 h δuz[1,0] θy[2,2]+22 h δuz[2,0] θy[2,2]-3 (h^2) δθy[1,0] θy[2,2]+4 (h^2) δθy[2,0] θy[2,2]+22 h δuy[1,0] θz[1,2]+13 h δuy[2,0] θz[1,2]+4 (h^2) δθz[1,0] θz[1,2]-3 (h^2) δθz[2,0] θz[1,2]-13 h δuy[1,0] θz[2,2]-22 h δuy[2,0] θz[2,2]-3 (h^2) δθz[1,0] θz[2,2]+4 (h^2) δθz[2,0] θz[2,2]))+7 (720 EE (Izz (uy[1,0]-uy[2,0]) (δuy[1,0]-δuy[2,0])+Iyy (uz[1,0]-uz[2,0]) (δuz[1,0]-δuz[2,0]))+5 fz (h^5) (δθy[1,0]-δθy[2,0])-5 fy (h^4) (6 δuy[1,0]+6 δuy[2,0]+h (δθz[1,0]-δθz[2,0]))-360 EE h (Iyy (uz[1,0] (δθy[1,0]+δθy[2,0])-uz[2,0] (δθy[1,0]+δθy[2,0])+(δuz[1,0]-δuz[2,0]) (θy[1,0]+θy[2,0]))+Izz (-uy[1,0] (δθz[1,0]+δθz[2,0])+uy[2,0] (δθz[1,0]+δθz[2,0])-(δuy[1,0]-δuy[2,0]) (θz[1,0]+θz[2,0])))+12 (h^2) (Iyy (6 ρρ (uz[1,2]-uz[2,2]) (δuz[1,0]-δuz[2,0])+5 (GG (δθx[1,0]-δθx[2,0]) (θx[1,0]-θx[2,0])+2 EE (δθy[1,0] (2 θy[1,0]+θy[2,0])+δθy[2,0] (θy[1,0]+2 θy[2,0]))))+Izz (6 ρρ (uy[1,2]-uy[2,2]) (δuy[1,0]-δuy[2,0])+5 (GG (δθx[1,0]-δθx[2,0]) (θx[1,0]-θx[2,0])+2 EE (δθz[1,0] (2 θz[1,0]+θz[2,0])+δθz[2,0] (θz[1,0]+2 θz[2,0])))))-2 (h^4) (15 fz (δuz[1,0]+δuz[2,0])+15 mx (δθx[1,0]+δθx[2,0])-ρρ (Iyy (5 δθx[1,0] (2 θx[1,2]+θx[2,2])+5 δθx[2,0] (θx[1,2]+2 θx[2,2])+4 δθy[1,0] θy[1,2]-δθy[2,0] θy[1,2]-δθy[1,0] θy[2,2]+4 δθy[2,0] θy[2,2])+Izz (5 δθx[1,0] (2 θx[1,2]+θx[2,2])+5 δθx[2,0] (θx[1,2]+2 θx[2,2])+4 δθz[1,0] θz[1,2]-δθz[2,0] θz[1,2]-δθz[1,0] θz[2,2]+4 δθz[2,0] θz[2,2])))+6 (h^3) (10 mz (δuy[1,0]-δuy[2,0])-10 my (δuz[1,0]-δuz[2,0])+ρρ (Iyy (-uz[1,2] (δθy[1,0]+δθy[2,0])+uz[2,2] (δθy[1,0]+δθy[2,0])-(δuz[1,0]-δuz[2,0]) (θy[1,2]+θy[2,2]))+Izz (uy[1,2] (δθz[1,0]+δθz[2,0])-uy[2,2] (δθz[1,0]+δθz[2,0])+(δuy[1,0]-δuy[2,0]) (θz[1,2]+θz[2,2]))))))];


δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_,Jp_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=
δW[VIBR,{BEAM,{{EE,GG,ρρ},{AA,0,0,Iyy,Izz,0,Jp,{0,1,0}},{fx,fy,fz,0,0,0}},Line[{n1,n2}]},fun];

δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{AA_,Sy_,Sz_,Iyy_,Izz_,Ixy_,Jp_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,h,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=h=Simplify[Sqrt[r0.r0],L>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1,0],uy[1,0],uz[1,0]}=({ix0,iy0,iz0}.fun[[n1,2]])/.DRULE[0];
{ux[1,2],uy[1,2],uz[1,2]}=({ix0,iy0,iz0}.fun[[n1,2]])/.DRULE[2];
{ux[2,0],uy[2,0],uz[2,0]}=({ix0,iy0,iz0}.fun[[n2,2]])/.DRULE[0];
{ux[2,2],uy[1,2],uz[2,2]}=({ix0,iy0,iz0}.fun[[n2,2]])/.DRULE[2];
{θx[1,0],θy[1,0],θz[1,0]}=({ix0,iy0,iz0}.fun[[n1,3]])/.DRULE[0];
{θx[1,2],θy[1,2],θz[1,2]}=({ix0,iy0,iz0}.fun[[n1,3]])/.DRULE[2];
{θx[2,0],θy[2,0],θz[2,0]}=({ix0,iy0,iz0}.fun[[n2,3]])/.DRULE[0];
{θx[2,2],θy[2,2],θz[2,2]}=({ix0,iy0,iz0}.fun[[n2,3]])/.DRULE[2];
{δux[1,0],δuy[1,0],δuz[1,0]}=δ[{ux[1,0],uy[1,0],uz[1,0]}];
{δux[2,0],δuy[2,0],δuz[2,0]}=δ[{ux[2,0],uy[2,0],uz[2,0]}];
{δθx[1,0],δθy[1,0],δθz[1,0]}=δ[{θx[1,0],θy[1,0],θz[1,0]}];
{δθx[2,0],δθy[2,0],δθz[2,0]}=δ[{θx[2,0],θy[2,0],θz[2,0]}];

(1/(420 (h^3)))(210 fx (h^4) (δux[1,0]+δux[2,0])-AA (h^2) (420 EE (ux[1,0]-ux[2,0]) (δux[1,0]-δux[2,0])+(h^2) ρρ (70 ux[1,2] (2 δux[1,0]+δux[2,0])+70 ux[2,2] (δux[1,0]+2 δux[2,0])+156 uy[1,2] δuy[1,0]+54 uy[2,2] δuy[1,0]+54 uy[1,2] δuy[2,0]+156 uy[2,2] δuy[2,0]+156 uz[1,2] δuz[1,0]+54 uz[2,2] δuz[1,0]+54 uz[1,2] δuz[2,0]+156 uz[2,2] δuz[2,0]-22 h uz[1,2] δθy[1,0]-13 h uz[2,2] δθy[1,0]+13 h uz[1,2] δθy[2,0]+22 h uz[2,2] δθy[2,0]+22 h uy[1,2] δθz[1,0]+13 h uy[2,2] δθz[1,0]-13 h uy[1,2] δθz[2,0]-22 h uy[2,2] δθz[2,0]-22 h δuz[1,0] θy[1,2]-13 h δuz[2,0] θy[1,2]+4 (h^2) δθy[1,0] θy[1,2]-3 (h^2) δθy[2,0] θy[1,2]+13 h δuz[1,0] θy[2,2]+22 h δuz[2,0] θy[2,2]-3 (h^2) δθy[1,0] θy[2,2]+4 (h^2) δθy[2,0] θy[2,2]+22 h δuy[1,0] θz[1,2]+13 h δuy[2,0] θz[1,2]+4 (h^2) δθz[1,0] θz[1,2]-3 (h^2) δθz[2,0] θz[1,2]-13 h δuy[1,0] θz[2,2]-22 h δuy[2,0] θz[2,2]-3 (h^2) δθz[1,0] θz[2,2]+4 (h^2) δθz[2,0] θz[2,2]))+7 (-720 EE (Izz (uy[1,0]-uy[2,0]) (δuy[1,0]-δuy[2,0])+Ixy (uz[1,0] (δuy[1,0]-δuy[2,0])+uz[2,0] (-δuy[1,0]+δuy[2,0])+(uy[1,0]-uy[2,0]) (δuz[1,0]-δuz[2,0]))+Iyy (uz[1,0]-uz[2,0]) (δuz[1,0]-δuz[2,0]))+360 EE h (Iyy (uz[1,0] (δθy[1,0]+δθy[2,0])-uz[2,0] (δθy[1,0]+δθy[2,0])+(δuz[1,0]-δuz[2,0]) (θy[1,0]+θy[2,0]))+Ixy (uy[1,0] (δθy[1,0]+δθy[2,0])-uy[2,0] (δθy[1,0]+δθy[2,0])-uz[1,0] δθz[1,0]+uz[2,0] δθz[1,0]-uz[1,0] δθz[2,0]+uz[2,0] δθz[2,0]+δuy[1,0] θy[1,0]-δuy[2,0] θy[1,0]+δuy[1,0] θy[2,0]-δuy[2,0] θy[2,0]-δuz[1,0] θz[1,0]+δuz[2,0] θz[1,0]-δuz[1,0] θz[2,0]+δuz[2,0] θz[2,0])+Izz (-uy[1,0] (δθz[1,0]+δθz[2,0])+uy[2,0] (δθz[1,0]+δθz[2,0])-(δuy[1,0]-δuy[2,0]) (θz[1,0]+θz[2,0])))-12 (h^2) (6 Iyy ρρ uz[1,2] δuz[1,0]-6 Iyy ρρ uz[2,2] δuz[1,0]-6 Iyy ρρ uz[1,2] δuz[2,0]+6 Iyy ρρ uz[2,2] δuz[2,0]+5 EE Sy ux[1,0] δθy[1,0]-5 EE Sy ux[2,0] δθy[1,0]-5 EE Sy ux[1,0] δθy[2,0]+5 EE Sy ux[2,0] δθy[2,0]-5 EE Sz ux[1,0] δθz[1,0]+5 EE Sz ux[2,0] δθz[1,0]+5 EE Sz ux[1,0] δθz[2,0]-5 EE Sz ux[2,0] δθz[2,0]+5 GG Jp δθx[1,0] θx[1,0]-5 GG Jp δθx[2,0] θx[1,0]-5 GG Jp δθx[1,0] θx[2,0]+5 GG Jp δθx[2,0] θx[2,0]+5 EE Sy δux[1,0] θy[1,0]-5 EE Sy δux[2,0] θy[1,0]+20 EE Iyy δθy[1,0] θy[1,0]+10 EE Iyy δθy[2,0] θy[1,0]-5 EE Sy δux[1,0] θy[2,0]+5 EE Sy δux[2,0] θy[2,0]+10 EE Iyy δθy[1,0] θy[2,0]+20 EE Iyy δθy[2,0] θy[2,0]-5 EE Sz δux[1,0] θz[1,0]+5 EE Sz δux[2,0] θz[1,0]+5 EE Sz δux[1,0] θz[2,0]-5 EE Sz δux[2,0] θz[2,0]+2 Ixy (3 ρρ (uz[1,2] (δuy[1,0]-δuy[2,0])+uz[2,2] (-δuy[1,0]+δuy[2,0])+(uy[1,2]-uy[2,2]) (δuz[1,0]-δuz[2,0]))-5 EE (δθz[1,0] (2 θy[1,0]+θy[2,0])+δθz[2,0] (θy[1,0]+2 θy[2,0])+2 δθy[1,0] θz[1,0]+δθy[2,0] θz[1,0]+δθy[1,0] θz[2,0]+2 δθy[2,0] θz[2,0]))+2 Izz (3 ρρ (uy[1,2]-uy[2,2]) (δuy[1,0]-δuy[2,0])+5 EE (δθz[1,0] (2 θz[1,0]+θz[2,0])+δθz[2,0] (θz[1,0]+2 θz[2,0]))))-6 (h^3) (5 Sy ρρ uz[1,2] δux[1,0]-5 Sy ρρ uz[2,2] δux[1,0]+5 Sy ρρ uz[1,2] δux[2,0]-5 Sy ρρ uz[2,2] δux[2,0]+10 mz δuy[1,0]+5 Sz ρρ (uy[1,2] (δux[1,0]+δux[2,0])-uy[2,2] (δux[1,0]+δux[2,0])+(ux[1,2]+ux[2,2]) (δuy[1,0]-δuy[2,0]))-10 mz δuy[2,0]-10 my δuz[1,0]+5 Sy ρρ ux[1,2] δuz[1,0]+5 Sy ρρ ux[2,2] δuz[1,0]+10 my δuz[2,0]-5 Sy ρρ ux[1,2] δuz[2,0]-5 Sy ρρ ux[2,2] δuz[2,0]-Ixy ρρ uy[1,2] δθy[1,0]+Ixy ρρ uy[2,2] δθy[1,0]-Iyy ρρ uz[1,2] δθy[1,0]+Iyy ρρ uz[2,2] δθy[1,0]-Ixy ρρ uy[1,2] δθy[2,0]+Ixy ρρ uy[2,2] δθy[2,0]-Iyy ρρ uz[1,2] δθy[2,0]+Iyy ρρ uz[2,2] δθy[2,0]+Izz ρρ uy[1,2] δθz[1,0]-Izz ρρ uy[2,2] δθz[1,0]+Ixy ρρ uz[1,2] δθz[1,0]-Ixy ρρ uz[2,2] δθz[1,0]+Izz ρρ uy[1,2] δθz[2,0]-Izz ρρ uy[2,2] δθz[2,0]+Ixy ρρ uz[1,2] δθz[2,0]-Ixy ρρ uz[2,2] δθz[2,0]-Ixy ρρ δuy[1,0] θy[1,2]+Ixy ρρ δuy[2,0] θy[1,2]-Iyy ρρ δuz[1,0] θy[1,2]+Iyy ρρ δuz[2,0] θy[1,2]-Ixy ρρ δuy[1,0] θy[2,2]+Ixy ρρ δuy[2,0] θy[2,2]-Iyy ρρ δuz[1,0] θy[2,2]+Iyy ρρ δuz[2,0] θy[2,2]+Izz ρρ δuy[1,0] θz[1,2]-Izz ρρ δuy[2,0] θz[1,2]+Ixy ρρ δuz[1,0] θz[1,2]-Ixy ρρ δuz[2,0] θz[1,2]+Izz ρρ δuy[1,0] θz[2,2]-Izz ρρ δuy[2,0] θz[2,2]+Ixy ρρ δuz[1,0] θz[2,2]-Ixy ρρ δuz[2,0] θz[2,2])+(h^4) (30 fy (δuy[1,0]+δuy[2,0])+30 fz (δuz[1,0]+δuz[2,0])+30 mx δθx[1,0]+21 Sy ρρ uy[1,2] δθx[1,0]+9 Sy ρρ uy[2,2] δθx[1,0]-21 Sz ρρ uz[1,2] δθx[1,0]-9 Sz ρρ uz[2,2] δθx[1,0]+30 mx δθx[2,0]+9 Sy ρρ uy[1,2] δθx[2,0]+21 Sy ρρ uy[2,2] δθx[2,0]-9 Sz ρρ uz[1,2] δθx[2,0]-21 Sz ρρ uz[2,2] δθx[2,0]-5 Sy ρρ ux[1,2] δθy[1,0]+5 Sy ρρ ux[2,2] δθy[1,0]+5 Sy ρρ ux[1,2] δθy[2,0]-5 Sy ρρ ux[2,2] δθy[2,0]+5 Sz ρρ ux[1,2] δθz[1,0]-5 Sz ρρ ux[2,2] δθz[1,0]-5 Sz ρρ ux[1,2] δθz[2,0]+5 Sz ρρ ux[2,2] δθz[2,0]+21 Sy ρρ δuy[1,0] θx[1,2]+9 Sy ρρ δuy[2,0] θx[1,2]-21 Sz ρρ δuz[1,0] θx[1,2]-9 Sz ρρ δuz[2,0] θx[1,2]-20 Iyy ρρ δθx[1,0] θx[1,2]-20 Izz ρρ δθx[1,0] θx[1,2]-10 Iyy ρρ δθx[2,0] θx[1,2]-10 Izz ρρ δθx[2,0] θx[1,2]+9 Sy ρρ δuy[1,0] θx[2,2]+21 Sy ρρ δuy[2,0] θx[2,2]-9 Sz ρρ δuz[1,0] θx[2,2]-21 Sz ρρ δuz[2,0] θx[2,2]-10 Iyy ρρ δθx[1,0] θx[2,2]-10 Izz ρρ δθx[1,0] θx[2,2]-20 Iyy ρρ δθx[2,0] θx[2,2]-20 Izz ρρ δθx[2,0] θx[2,2]-5 Sy ρρ δux[1,0] θy[1,2]+5 Sy ρρ δux[2,0] θy[1,2]-8 Iyy ρρ δθy[1,0] θy[1,2]+2 Iyy ρρ δθy[2,0] θy[1,2]+8 Ixy ρρ δθz[1,0] θy[1,2]-2 Ixy ρρ δθz[2,0] θy[1,2]+5 Sy ρρ δux[1,0] θy[2,2]-5 Sy ρρ δux[2,0] θy[2,2]+2 Iyy ρρ δθy[1,0] θy[2,2]-8 Iyy ρρ δθy[2,0] θy[2,2]-2 Ixy ρρ δθz[1,0] θy[2,2]+8 Ixy ρρ δθz[2,0] θy[2,2]+5 Sz ρρ δux[1,0] θz[1,2]-5 Sz ρρ δux[2,0] θz[1,2]+8 Ixy ρρ δθy[1,0] θz[1,2]-2 Ixy ρρ δθy[2,0] θz[1,2]-8 Izz ρρ δθz[1,0] θz[1,2]+2 Izz ρρ δθz[2,0] θz[1,2]-5 Sz ρρ δux[1,0] θz[2,2]+5 Sz ρρ δux[2,0] θz[2,2]-2 Ixy ρρ δθy[1,0] θz[2,2]+8 Ixy ρρ δθy[2,0] θz[2,2]+2 Izz ρρ δθz[1,0] θz[2,2]-8 Izz ρρ δθz[2,0] θz[2,2])+(h^5) (-5 fz (δθy[1,0]-δθy[2,0])+5 fy (δθz[1,0]-δθz[2,0])+ρρ (Sz (δθy[1,0] (3 θx[1,2]+2 θx[2,2])-δθy[2,0] (2 θx[1,2]+3 θx[2,2])+3 δθx[1,0] θy[1,2]+2 δθx[2,0] θy[1,2]-2 δθx[1,0] θy[2,2]-3 δθx[2,0] θy[2,2])+Sy (δθz[1,0] (3 θx[1,2]+2 θx[2,2])-δθz[2,0] (2 θx[1,2]+3 θx[2,2])+3 δθx[1,0] θz[1,2]+2 δθx[2,0] θz[1,2]-2 δθx[1,0] θz[2,2]-3 δθx[2,0] θz[2,2])))))];


δW[STAB,{BEAMB,{{EE_,GG_,ρρ_},{AA_,Irr_,Iyy_,Izz_,iy_},{fx_,fy_,fz_}},Line[{I1_,I2_}]}]:=Module[{domx,NL,NC,uu,uup,δuu,vv,δvv,ww,δww,ϕϕ,δϕϕ,δwint,δwext,δwsta},
rule =RULE[{iy},{I1,I2}];
hx=(x[2]-x[1]) /. rule;
Ω ={{0},{hx}};

NL= SHAPES1[ {1,x},Ω ];
NC= SHAPES11[ {1,x,x^2,x^3},Ω];
uu=NL.{ux[1],ux[2]}/.rule;
δuu=uu/.{ a[any__] -> δa[any]};

uup =(uu /. PRULE);
vv=NC.{uy[1],Θz[1],uy[2],Θz[2]}/.rule;
δvv=vv/.{ a[any__] -> δa[any]};
ww=NC.{uz[1],-Θy[1],uz[2],-Θy[2]}/.rule;
δww=ww/.{ a[any__] -> δa[any]};
ϕϕ=NL.{Θx[1],Θx[2]}/.rule;
δϕϕ=ϕϕ/.{ a[any__] -> δa[any]};
δwint=-((∂_x)δuu*AA*EE*(∂_x)uu+(∂_x)(∂_x)δvv*Iyy*EE*(∂_x)(∂_x)vv+(∂_x)(∂_x)δww*Izz*EE*(∂_x)(∂_x)ww+(∂_x)δϕϕ*Irr*GG*(∂_x)ϕϕ);
δwext=δuu*fx+δvv*fy+δww*fz;
δwsta=-AA*EE*(∂_x)uup*((∂_x)δvv*(∂_x)vv+(∂_x)δww*(∂_x)ww);
Return[QUAD[LINEEXACT,δwint+δwext+δwsta,{{x},Ω}]]];


δW[{STAB,prule_},{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=
δW[{STAB,prule},{BEAMB,{{EE,GG},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[{n1,n2}]},fun];

δW[{STAB,prule_},{BEAMB,{{EE_,GG_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{NL,NQ,r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,FF,FFINV,ns,u,v,w,ϕ,θ,ψ,EEEE,AE,CE,BE,ϵ,κ,up,F,M,δwint,δwext,δwstb,δW,ux,uy,uz,θx,θy,θz},

(*mapping to material system*)
r0=α*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_α)r0;
hα0=Simplify[Sqrt[rα0.rα0],{L>0,h>0}];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];

(*sape functions*)
NL={1-α,α};
NQ= {(((1-α))^2) (1+2 α),hα0(((1-α))^2) α,(3-2 α) (α^2),hα0 (α^2) ( α-1)};

(*transform to material system*)
ux[1]=fun[[n1,2]].ix0; ux[2]=fun[[n2,2]].ix0;
uy[1]=fun[[n1,2]].iy0; uy[2]=fun[[n2,2]].iy0;
uz[1]=fun[[n1,2]].iz0; uz[2]=fun[[n2,2]].iz0;
θx[1]=fun[[n1,3]].ix0; θx[2]=fun[[n2,3]].ix0;
θy[1]=fun[[n1,3]].iy0; θy[2]=fun[[n2,3]].iy0;
θz[1]=fun[[n1,3]].iz0; θz[2]=fun[[n2,3]].iz0;

u=NL.{ux[1],ux[2]};
ϕ=NL.{θx[1],θx[2]};
v=NQ.{uy[1],θz[1],uy[2],θz[2]};
w=NQ.{uz[1],-θy[1],uz[2],-θy[2]};
ψ=(∂_α)v/hα0;
θ=-(∂_α)w/hα0;

(*elasticity dyad and cross-section properties are known in the material system*)
AE={{EE AA,0,0},{0,GG AA,0},{0,0,GG AA}};
CE={{0,EE Sy,-EE Sz},{-GG Sy,0,0},{GG Sz,0,0}};
BE={{GG Iyy+GG Izz,0,0},{0,EE Iyy,-EE Iyz},{0,-EE Iyz,EE Izz}};

(*strain measures*)
ϵ=(∂_α){u,v,w}/hα0+{1,0,0}\[Cross]{ϕ,θ,ψ};
κ=(∂_α){ϕ,θ,ψ}/hα0;

(*axial displacement of linear analysis*)
(* first step up = 0*)
up =u/.prule;

(*stress resultants*)
F=AE.ϵ+CE.κ;
M=Transpose[CE].ϵ+BE.κ;

(*virtual work expressions*)
δwint=-δ[ϵ].F-δ[κ].M;
δwext=δ[{u,v,w}].{fx,fy,fz}+δ[{ϕ,θ,ψ}].{mx,my,mz};
δwstb=-AA EE ((∂_α)up) ((∂_α)δ[v] (∂_α)v+(∂_α)δ[w] (∂_α)w)/(hα0)^3;
δW =QUAD[LIN7,(δwint+δwext+δwstb) jac,{α}]
];

BEAM ELEMENT (stability) defs

δW[STAB,{BEAMB,{{EE_,GG_,ρρ_},{AA_,Irr_,Iyy_,Izz_,iy_},{fx_,fy_,fz_}},Line[{I1_,I2_}]}]:=Module[{domx,NL,NC,uu,uup,δuu,vv,δvv,ww,δww,ϕϕ,δϕϕ,δwint,δwext,δwsta},
rule =RULE[{iy},{I1,I2}];
hx=(x[2]-x[1]) /. rule;
Ω ={{0},{hx}};

NL= SHAPES1[ {1,x},Ω ];
NC= SHAPES11[ {1,x,x^2,x^3},Ω];
uu=NL.{ux[1],ux[2]}/.rule;
δuu=uu/.{ a[any__] -> δa[any]};

uup =(uu /. PRULE);
vv=NC.{uy[1],Θz[1],uy[2],Θz[2]}/.rule;
δvv=vv/.{ a[any__] -> δa[any]};
ww=NC.{uz[1],-Θy[1],uz[2],-Θy[2]}/.rule;
δww=ww/.{ a[any__] -> δa[any]};
ϕϕ=NL.{Θx[1],Θx[2]}/.rule;
δϕϕ=ϕϕ/.{ a[any__] -> δa[any]};
δwint=-((∂_x)δuu*AA*EE*(∂_x)uu+(∂_x)(∂_x)δvv*Iyy*EE*(∂_x)(∂_x)vv+(∂_x)(∂_x)δww*Izz*EE*(∂_x)(∂_x)ww+(∂_x)δϕϕ*Irr*GG*(∂_x)ϕϕ);
δwext=δuu*fx+δvv*fy+δww*fz;
δwsta=-AA*EE*(∂_x)uup*((∂_x)δvv*(∂_x)vv+(∂_x)δww*(∂_x)ww);
Return[QUAD[LINEEXACT,δwint+δwext+δwsta,{{x},Ω}]]];


δW[{STAB,prule_},{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=
δW[{STAB,prule},{GENERICBEAM,{{EE,GG},{AA,0,0,Iyy,Izz,0,{0,1,0}},{fx,fy,fz,0,0,0}},Line[{n1,n2}]},fun];

δW[{STAB,prule_},{GENERICBEAM,{{EE_,GG_},{AA_,Sy_,Sz_,Iyy_,Izz_,Iyz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{NL,NQ,r0,rα0,hα0,iα0,ix0,iz0,s,x,jac,FF,FFINV,ns,u,v,w,ϕ,θ,ψ,EEEE,AE,CE,BE,ϵ,κ,up,F,M,NN,δwint,δwext,δwstb,δW,ux,uy,uz,θx,θy,θz},

(*mapping to material system*)
r0=α*(fun[[n2,1]]-fun[[n1,1]]);
rα0=(∂_α)r0;
hα0=Simplify[Sqrt[rα0.rα0],{L>0,h>0}];
ix0=iα0 =rα0/hα0;
iz0=ix0\[Cross]iy0;
s=iα0.r0;
x=fun[[n1,1]].ix0+s ;
jac =hα0;

(*simple metrics*)
FF={ix0,iy0,iz0};
FFINV =Inverse[FF];

(*shape functions*)
NL={1-α,α};
NQ= {(((1-α))^2) (1+2 α),hα0(((1-α))^2) α,(3-2 α) (α^2),hα0 (α^2) ( α-1)};

(*transform to material system*)
ux[1]=fun[[n1,2]].ix0; ux[2]=fun[[n2,2]].ix0;
uy[1]=fun[[n1,2]].iy0; uy[2]=fun[[n2,2]].iy0;
uz[1]=fun[[n1,2]].iz0; uz[2]=fun[[n2,2]].iz0;
θx[1]=fun[[n1,3]].ix0; θx[2]=fun[[n2,3]].ix0;
θy[1]=fun[[n1,3]].iy0; θy[2]=fun[[n2,3]].iy0;
θz[1]=fun[[n1,3]].iz0; θz[2]=fun[[n2,3]].iz0;

u=NL.{ux[1],ux[2]};
ϕ=NL.{θx[1],θx[2]};
v=NQ.{uy[1],θz[1],uy[2],θz[2]};
w=NQ.{uz[1],-θy[1],uz[2],-θy[2]};
ψ=(∂_α)v/hα0;
θ=-(∂_α)w/hα0;

(*elasticity dyad and cross-section properties are known in the material system*)
AE={{EE AA,0,0},{0,GG AA,0},{0,0,GG AA}};
CE={{0,EE Sy,-EE Sz},{-GG Sy,0,0},{GG Sz,0,0}};
BE={{GG Iyy+GG Izz,0,0},{0,EE Iyy,-EE Iyz},{0,-EE Iyz,EE Izz}};

(*strain measures*)
ϵ=(∂_α){u,v,w}/hα0+{1,0,0}\[Cross]{ϕ,θ,ψ};
κ=(∂_α){ϕ,θ,ψ}/hα0;

(*stress resultants*)
If[Length[prule]==0,NN=0];  (*first step*)
If[prule==Null,NN=AA EE (∂_α)u];  (*symbolic form*)
If[Length[prule]>0,NN=AA EE ((∂_α)(u/.prule))]; (*second step*)
F=AE.ϵ+CE.κ;
M=Transpose[CE].ϵ+BE.κ;

(*virtual work expressions*)
δwint=-δ[ϵ].F-δ[κ].M;
δwext=δ[{u,v,w}].{fx,fy,fz}+δ[{ϕ,θ,ψ}].{mx,my,mz};

δwstb=- NN*((∂_α)δ[v] (∂_α)v+(∂_α)δ[w] (∂_α)w)/(hα0)^3;
δW =QUAD[LIN7,(δwint+δwext+δwstb) jac,{α}]
];

BEAM ELEMENT (static curved) defs

δW[DISP,{CURVEDBEAM,{{EE_,GG_,ρρ_},{AA_,II_},{fs_,fn_,fb_}},{I1_,I2_,I3_}}]:=Module[{r,dr,h,es,en,eb,δW,rule,KK,FF,R},
(*                          *)
(* needs                    *)
(*                          *)
r={(1-ζ)*(1-2ζ),4(1-ζ)*ζ,ζ*(2ζ-1)}.{fun[[I1,1]],fun[[I2,1]],fun[[I3,1]]};
dr=D[r,ζ];
hh=Sqrt[dr.dr];
h=Abs[Simplify[((hh /.ζ->0)+4(hh /.ζ->1/2)+(hh /.ζ->1.))/6]];
es =dr/hh;
en =D[es,ζ]/hh;
κb=Sqrt[en.en];
en=en/κb;
eb = es\[Cross]en;
(*                          *)
basis={es,en,eb}  /.ζ->1/2.;
basis1={es,en,eb}  /.ζ->0;
basis2={es,en,eb}  /.ζ->1;
R=((1/κb)/. ζ->1/2.);
(*                          *)
(* needs                    *)
(*                          *)
δrule ={a[any__] -> δa[any],b[any__] -> δb[any]};
{us[1],un[1],ub[1]}=basis1.fun[[I1,2]];
{us[2],un[2],ub[2]}=basis2.fun[[I3,2]];
{Θs[1],Θn[1],Θb[1]}=basis1.fun[[I1,3]];
{Θs[2],Θn[2],Θb[2]}=basis2.fun[[I3,3]];
aa={us[1],un[1],ub[1],Θs[1],Θn[1],Θb[1],us[2],un[2],ub[2],Θs[2],Θn[2],Θb[2]} ;
δaa=aa /.δrule;
(*                          *)
(* ELEMENT CONTRIBUTION     *)
(*                          *)      
KK={{(2 AA EE GG II (2 EE (h^2) II+2 GG (h^2) II+2 AA GG (h^2) (R^2)-6 AA GG (R^4)+8 AA GG (R^4) Cos[(h/R)]-2 AA GG (R^4) Cos[((2 h)/R)]+EE h II R Sin[((2 h)/R)]-GG h II R Sin[((2 h)/R)]-AA GG h (R^3) Sin[((2 h)/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(16 AA EE GG II R Cos[(h/(2 R))] ((Sin[(h/(2 R))])^2) (h (EE II-GG (II+AA (R^2))) Cos[(h/(2 R))]+2 AA GG (R^3) Sin[(h/(2 R))]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(2 AA EE GG II R (-2 EE (h^2) II-2 GG (h^2) II-2 AA GG (h^2) (R^2)+EE II (R^2)-GG II (R^2)+5 AA GG (R^4)-8 AA GG (R^4) Cos[(h/R)]+(R^2) (-EE II+GG II+3 AA GG (R^2)) Cos[((2 h)/R)]+2 EE h II R Sin[(h/R)]+2 GG h II R Sin[(h/R)]+2 AA GG h (R^3) Sin[(h/R)]-EE h II R Sin[((2 h)/R)]+GG h II R Sin[((2 h)/R)]+AA GG h (R^3) Sin[((2 h)/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(4 AA EE GG II ((EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+R (3 AA GG (R^3)+AA GG (R^3) Cos[((2 h)/R)]+h (EE II-GG (II+AA (R^2))) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(4 AA EE GG II (EE (h^2) II+GG ((h^2) II+AA (h^2) (R^2)-2 AA (R^4))+2 AA GG (R^4) Cos[(h/R)]) Sin[(h/R)])/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(AA EE GG II R (2 (EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+R (-EE II R+GG II R+7 AA GG (R^3)+R (EE II-GG II+AA GG (R^2)) Cos[((2 h)/R)]-4 GG h (II+AA (R^2)) Sin[(h/R)])))/((EE (h^2) II+GG (h^2) II+AA GG (h^2) (R^2)-4 AA GG (R^4)+4 AA GG (R^4) Cos[(h/R)]+h R (-EE II+GG II+AA GG (R^2)) Sin[(h/R)]) (h (EE II+GG (II+AA (R^2)))-R (-EE II+GG (II+AA (R^2))) Sin[(h/R)]))},{(32 AA EE GG II R Cos[(h/(2 R))] ((Sin[(h/(2 R))])^2) (h (EE II-GG (II+AA (R^2))) Cos[(h/(2 R))]+2 AA GG (R^3) Sin[(h/(2 R))]) (Cos[((2 h)/R)]+I Sin[((2 h)/R)]))/((R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (-4 I AA (R^3)+h (II+AA (R^2))))+8 AA GG (R^4) (EE II (h-I R)+GG (h+I R) (II+AA (R^2))) (Cos[(h/R)]+I Sin[(h/R)])+2 h ((EE^2) (II^2) (2 (h^2)-(R^2))+2 EE GG II ((R^2) (II-3 AA (R^2))+2 (h^2) (II+AA (R^2)))+(GG^2) (II+AA (R^2)) (2 (h^2) (II+AA (R^2))-(R^2) (II+9 AA (R^2)))) (Cos[((2 h)/R)]+I Sin[((2 h)/R)])+8 AA GG (R^4) (EE II (h+I R)+GG (h-I R) (II+AA (R^2))) (Cos[((3 h)/R)]+I Sin[((3 h)/R)])+(R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (4 I AA (R^3)+h (II+AA (R^2)))) (Cos[((4 h)/R)]+I Sin[((4 h)/R)])),(4 AA EE GG II (Cos[((2 h)/R)]+I Sin[((2 h)/R)]) (2 (EE (h^2) II+GG (-AA (R^4)+(h^2) (II+AA (R^2))))+2 AA GG (R^4) Cos[((2 h)/R)]+h R (-EE II+GG (II+AA (R^2))) Sin[((2 h)/R)]))/((R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (-4 I AA (R^3)+h (II+AA (R^2))))+8 AA GG (R^4) (EE II (h-I R)+GG (h+I R) (II+AA (R^2))) (Cos[(h/R)]+I Sin[(h/R)])+2 h ((EE^2) (II^2) (2 (h^2)-(R^2))+2 EE GG II ((R^2) (II-3 AA (R^2))+2 (h^2) (II+AA (R^2)))+(GG^2) (II+AA (R^2)) (2 (h^2) (II+AA (R^2))-(R^2) (II+9 AA (R^2)))) (Cos[((2 h)/R)]+I Sin[((2 h)/R)])+8 AA GG (R^4) (EE II (h+I R)+GG (h-I R) (II+AA (R^2))) (Cos[((3 h)/R)]+I Sin[((3 h)/R)])+(R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (4 I AA (R^3)+h (II+AA (R^2)))) (Cos[((4 h)/R)]+I Sin[((4 h)/R)])),0,0,0,-(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2) (-2 GG h (II+AA (R^2))+h (EE II-GG (II+AA (R^2))) Cos[(h/R)]+(-EE II R+GG II R+3 AA GG (R^3)) Sin[(h/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(4 AA EE GG II (EE (h^2) II+GG ((h^2) II+AA (h^2) (R^2)-2 AA (R^4))+2 AA GG (R^4) Cos[(h/R)]) Sin[(h/R)])/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(4 AA EE GG II ((h^2) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+R Sin[(h/R)] (h (-EE II+GG II+AA GG (R^2))-2 AA GG (R^3) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(2 AA EE GG II R Sin[(h/(2 R))] ((EE II (2 (h^2)-(R^2))+GG ((R^2) (II-AA (R^2))+2 (h^2) (II+AA (R^2)))) Cos[(h/(2 R))]+R (R (EE II-GG II+AA GG (R^2)) Cos[((3 h)/(2 R))]-2 h (EE II+GG II+AA GG (R^2)) Sin[(h/(2 R))])))/((EE (h^2) II+GG (h^2) II+AA GG (h^2) (R^2)-4 AA GG (R^4)+4 AA GG (R^4) Cos[(h/R)]+h R (-EE II+GG II+AA GG (R^2)) Sin[(h/R)]) (h (EE II+GG (II+AA (R^2)))-R (-EE II+GG (II+AA (R^2))) Sin[(h/R)]))},{0,0,(2 AA GG II ((EE+2 GG) h+(EE-2 GG) R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),0,0,0,-(2 AA GG II ((EE+2 GG) h+(EE-2 GG) R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),0},{0,0,-(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(GG II (8 (EE^2) (h^2) II+16 EE GG (h^2) II+6 AA (EE^2) (h^2) (R^2)+16 AA EE GG (h^2) (R^2)+8 AA (GG^2) (h^2) (R^2)-9 AA (EE^2) (R^4)-4 AA EE GG (R^4)-4 AA (GG^2) (R^4)+16 AA (EE^2) (R^4) Cos[(h/R)]-AA (7 (EE^2)-4 EE GG-4 (GG^2)) (R^4) Cos[((2 h)/R)]-8 AA (EE^2) h (R^3) Sin[(h/R)]-16 AA EE GG h (R^3) Sin[(h/R)]-4 (EE^2) h II R Sin[((2 h)/R)]+8 EE GG h II R Sin[((2 h)/R)]-2 AA (EE^2) h (R^3) Sin[((2 h)/R)]+4 AA EE GG h (R^3) Sin[((2 h)/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),-(8 EE GG II R ((Sin[(h/(2 R))])^2) (2 h (EE II-2 GG II+AA EE (R^2))+(EE-2 GG) h (2 II+AA (R^2)) Cos[(h/R)]-AA (3 EE-2 GG) (R^3) Sin[(h/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0,0,0,(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(GG II (4 EE (2 GG (h^2) (2 II+AA (R^2))+EE (-4 AA (R^4)+(h^2) (2 II+AA (R^2)))) Cos[(h/R)]+R (AA R (EE GG (8 (h^2)-4 (R^2))+4 (GG^2) (2 (h^2)-(R^2))+(EE^2) (2 (h^2)+15 (R^2)))+AA (((EE+2 GG))^2) (R^3) Cos[((2 h)/R)]-4 EE h (2 EE II-4 GG II+3 AA EE (R^2)+2 AA GG (R^2)) Sin[(h/R)])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),(4 EE GG (EE+2 GG) II Sin[(h/(2 R))] ((-AA (R^4)+2 (h^2) (2 II+AA (R^2))) Cos[(h/(2 R))]+AA (R^3) (R Cos[((3 h)/(2 R))]-2 h Sin[(h/(2 R))])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0},{0,0,-(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(8 EE GG II R ((Sin[(h/(2 R))])^2) (2 h (EE II-2 GG II+AA EE (R^2))+(EE-2 GG) h (2 II+AA (R^2)) Cos[(h/R)]-AA (3 EE-2 GG) (R^3) Sin[(h/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),(2 EE GG II (4 EE (h^2) II+8 GG (h^2) II+2 AA EE (h^2) (R^2)+4 AA GG (h^2) (R^2)-2 AA EE (R^4)+2 AA EE (R^4) Cos[((2 h)/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[((2 h)/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0,0,0,(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(4 EE GG (EE+2 GG) II Sin[(h/(2 R))] ((-AA (R^4)+2 (h^2) (2 II+AA (R^2))) Cos[(h/(2 R))]+AA (R^3) (R Cos[((3 h)/(2 R))]-2 h Sin[(h/(2 R))])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),-(4 EE GG II ((EE+2 GG) (h^2) (2 II+AA (R^2)) Cos[(h/R)]+R Sin[(h/R)] ((EE-2 GG) h (2 II+AA (R^2))-2 AA EE (R^3) Sin[(h/R)])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0},{(2 AA EE GG II R (-2 EE (h^2) II-2 GG (h^2) II-2 AA GG (h^2) (R^2)+EE II (R^2)-GG II (R^2)+5 AA GG (R^4)-8 AA GG (R^4) Cos[(h/R)]+(R^2) (-EE II+GG II+3 AA GG (R^2)) Cos[((2 h)/R)]+2 EE h II R Sin[(h/R)]+2 GG h II R Sin[(h/R)]+2 AA GG h (R^3) Sin[(h/R)]-EE h II R Sin[((2 h)/R)]+GG h II R Sin[((2 h)/R)]+AA GG h (R^3) Sin[((2 h)/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2) (-2 GG h (II+AA (R^2))+h (EE II-GG (II+AA (R^2))) Cos[(h/R)]+(-EE II R+GG II R+3 AA GG (R^3)) Sin[(h/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(EE II (2 (EE^2) (h^2) (II^2)+4 EE GG (h^2) (II^2)+2 (GG^2) (h^2) (II^2)+8 AA EE GG (h^2) II (R^2)+8 AA (GG^2) (h^2) II (R^2)-(EE^2) (II^2) (R^2)+2 EE GG (II^2) (R^2)-(GG^2) (II^2) (R^2)+6 (AA^2) (GG^2) (h^2) (R^4)-2 AA EE GG II (R^4)+2 AA (GG^2) II (R^4)-9 (AA^2) (GG^2) (R^6)+16 (AA^2) (GG^2) (R^6) Cos[(h/R)]+(R^2) ((EE^2) (II^2)-2 EE GG II (II-AA (R^2))+(GG^2) ((II^2)-2 AA II (R^2)-7 (AA^2) (R^4))) Cos[((2 h)/R)]-8 AA EE GG h II (R^3) Sin[(h/R)]-8 AA (GG^2) h II (R^3) Sin[(h/R)]-8 (AA^2) (GG^2) h (R^5) Sin[(h/R)]+2 AA EE GG h II (R^3) Sin[((2 h)/R)]-2 AA (GG^2) h II (R^3) Sin[((2 h)/R)]-2 (AA^2) (GG^2) h (R^5) Sin[((2 h)/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(2 AA EE GG II R (2 (EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+R (-EE II R+GG II R+7 AA GG (R^3)+R (EE II-GG II+AA GG (R^2)) Cos[((2 h)/R)]-4 GG h (II+AA (R^2)) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(8 AA EE GG II R Sin[(h/(2 R))] ((EE II (2 (h^2)-(R^2))+GG ((R^2) (II-AA (R^2))+2 (h^2) (II+AA (R^2)))) Cos[(h/(2 R))]+R (R (EE II-GG II+AA GG (R^2)) Cos[((3 h)/(2 R))]-2 h (EE II+GG II+AA GG (R^2)) Sin[(h/(2 R))])) (Cos[((2 h)/R)]+I Sin[((2 h)/R)]))/((R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (-4 I AA (R^3)+h (II+AA (R^2))))+8 AA GG (R^4) (EE II (h-I R)+GG (h+I R) (II+AA (R^2))) (Cos[(h/R)]+I Sin[(h/R)])+2 h ((EE^2) (II^2) (2 (h^2)-(R^2))+2 EE GG II ((R^2) (II-3 AA (R^2))+2 (h^2) (II+AA (R^2)))+(GG^2) (II+AA (R^2)) (2 (h^2) (II+AA (R^2))-(R^2) (II+9 AA (R^2)))) (Cos[((2 h)/R)]+I Sin[((2 h)/R)])+8 AA GG (R^4) (EE II (h+I R)+GG (h-I R) (II+AA (R^2))) (Cos[((3 h)/R)]+I Sin[((3 h)/R)])+(R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (4 I AA (R^3)+h (II+AA (R^2)))) (Cos[((4 h)/R)]+I Sin[((4 h)/R)])),0,0,0,-(EE II (2 (EE^2) (h^2) (II^2)+4 EE GG (h^2) (II^2)+2 (GG^2) (h^2) (II^2)+4 AA EE GG (h^2) II (R^2)+4 AA (GG^2) (h^2) II (R^2)-(EE^2) (II^2) (R^2)+2 EE GG (II^2) (R^2)-(GG^2) (II^2) (R^2)+2 (AA^2) (GG^2) (h^2) (R^4)-2 AA EE GG II (R^4)+2 AA (GG^2) II (R^4)+15 (AA^2) (GG^2) (R^6)+4 AA GG (R^2) (EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+(R^2) (((EE II-GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-4 AA EE GG h II (R^3) Sin[(h/R)]-12 AA (GG^2) h II (R^3) Sin[(h/R)]-12 (AA^2) (GG^2) h (R^5) Sin[(h/R)]))/(2 (EE (h^2) II+GG (h^2) II+AA GG (h^2) (R^2)-4 AA GG (R^4)+4 AA GG (R^4) Cos[(h/R)]+h R (-EE II+GG II+AA GG (R^2)) Sin[(h/R)]) (h (EE II+GG (II+AA (R^2)))-R (-EE II+GG (II+AA (R^2))) Sin[(h/R)]))},{-(4 AA EE GG II ((EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+R (3 AA GG (R^3)+AA GG (R^3) Cos[((2 h)/R)]+h (EE II-GG (II+AA (R^2))) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(4 AA EE GG II (EE (h^2) II+GG ((h^2) II+AA (h^2) (R^2)-2 AA (R^4))+2 AA GG (R^4) Cos[(h/R)]) Sin[(h/R)])/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(2 AA EE GG II R (2 (EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+R (-EE II R+GG II R+7 AA GG (R^3)+R (EE II-GG II+AA GG (R^2)) Cos[((2 h)/R)]-4 GG h (II+AA (R^2)) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(2 AA EE GG II (2 Cos[((2 h)/R)]+2 I Sin[((2 h)/R)]) (2 EE (h^2) II+2 GG (h^2) II+2 AA GG (h^2) (R^2)-6 AA GG (R^4)+8 AA GG (R^4) Cos[(h/R)]-2 AA GG (R^4) Cos[((2 h)/R)]+EE h II R Sin[((2 h)/R)]-GG h II R Sin[((2 h)/R)]-AA GG h (R^3) Sin[((2 h)/R)]))/((R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (-4 I AA (R^3)+h (II+AA (R^2))))+8 AA GG (R^4) (EE II (h-I R)+GG (h+I R) (II+AA (R^2))) (Cos[(h/R)]+I Sin[(h/R)])+2 h ((EE^2) (II^2) (2 (h^2)-(R^2))+2 EE GG II ((R^2) (II-3 AA (R^2))+2 (h^2) (II+AA (R^2)))+(GG^2) (II+AA (R^2)) (2 (h^2) (II+AA (R^2))-(R^2) (II+9 AA (R^2)))) (Cos[((2 h)/R)]+I Sin[((2 h)/R)])+8 AA GG (R^4) (EE II (h+I R)+GG (h-I R) (II+AA (R^2))) (Cos[((3 h)/R)]+I Sin[((3 h)/R)])+(R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (4 I AA (R^3)+h (II+AA (R^2)))) (Cos[((4 h)/R)]+I Sin[((4 h)/R)])),-(16 AA EE GG II R Cos[(h/(2 R))] ((Sin[(h/(2 R))])^2) (h (EE II-GG (II+AA (R^2))) Cos[(h/(2 R))]+2 AA GG (R^3) Sin[(h/(2 R))]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(AA EE GG II R (-2 EE (h^2) II-2 GG (h^2) II-2 AA GG (h^2) (R^2)+EE II (R^2)-GG II (R^2)+5 AA GG (R^4)-8 AA GG (R^4) Cos[(h/R)]+(R^2) (-EE II+GG II+3 AA GG (R^2)) Cos[((2 h)/R)]+2 EE h II R Sin[(h/R)]+2 GG h II R Sin[(h/R)]+2 AA GG h (R^3) Sin[(h/R)]-EE h II R Sin[((2 h)/R)]+GG h II R Sin[((2 h)/R)]+AA GG h (R^3) Sin[((2 h)/R)]))/((EE (h^2) II+GG (h^2) II+AA GG (h^2) (R^2)-4 AA GG (R^4)+4 AA GG (R^4) Cos[(h/R)]+h R (-EE II+GG II+AA GG (R^2)) Sin[(h/R)]) (h (EE II+GG (II+AA (R^2)))-R (-EE II+GG (II+AA (R^2))) Sin[(h/R)]))},{(4 AA EE GG II (EE (h^2) II+GG ((h^2) II+AA (h^2) (R^2)-2 AA (R^4))+2 AA GG (R^4) Cos[(h/R)]) Sin[(h/R)])/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(4 AA EE GG II ((h^2) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+R Sin[(h/R)] (h (-EE II+GG II+AA GG (R^2))-2 AA GG (R^3) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(4 AA EE GG II R Sin[(h/(2 R))] ((EE II (-2 (h^2)+(R^2))-GG ((R^2) (II-AA (R^2))+2 (h^2) (II+AA (R^2)))) Cos[(h/(2 R))]+R (-R (EE II-GG II+AA GG (R^2)) Cos[((3 h)/(2 R))]+2 h (EE II+GG II+AA GG (R^2)) Sin[(h/(2 R))])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),-(32 AA EE GG II R Cos[(h/(2 R))] ((Sin[(h/(2 R))])^2) (h (EE II-GG (II+AA (R^2))) Cos[(h/(2 R))]+2 AA GG (R^3) Sin[(h/(2 R))]) (Cos[((2 h)/R)]+I Sin[((2 h)/R)]))/((R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (-4 I AA (R^3)+h (II+AA (R^2))))+8 AA GG (R^4) (EE II (h-I R)+GG (h+I R) (II+AA (R^2))) (Cos[(h/R)]+I Sin[(h/R)])+2 h ((EE^2) (II^2) (2 (h^2)-(R^2))+2 EE GG II ((R^2) (II-3 AA (R^2))+2 (h^2) (II+AA (R^2)))+(GG^2) (II+AA (R^2)) (2 (h^2) (II+AA (R^2))-(R^2) (II+9 AA (R^2)))) (Cos[((2 h)/R)]+I Sin[((2 h)/R)])+8 AA GG (R^4) (EE II (h+I R)+GG (h-I R) (II+AA (R^2))) (Cos[((3 h)/R)]+I Sin[((3 h)/R)])+(R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (4 I AA (R^3)+h (II+AA (R^2)))) (Cos[((4 h)/R)]+I Sin[((4 h)/R)])),(4 AA EE GG II (Cos[((2 h)/R)]+I Sin[((2 h)/R)]) (2 (EE (h^2) II+GG (-AA (R^4)+(h^2) (II+AA (R^2))))+2 AA GG (R^4) Cos[((2 h)/R)]+h R (-EE II+GG (II+AA (R^2))) Sin[((2 h)/R)]))/((R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (-4 I AA (R^3)+h (II+AA (R^2))))+8 AA GG (R^4) (EE II (h-I R)+GG (h+I R) (II+AA (R^2))) (Cos[(h/R)]+I Sin[(h/R)])+2 h ((EE^2) (II^2) (2 (h^2)-(R^2))+2 EE GG II ((R^2) (II-3 AA (R^2))+2 (h^2) (II+AA (R^2)))+(GG^2) (II+AA (R^2)) (2 (h^2) (II+AA (R^2))-(R^2) (II+9 AA (R^2)))) (Cos[((2 h)/R)]+I Sin[((2 h)/R)])+8 AA GG (R^4) (EE II (h+I R)+GG (h-I R) (II+AA (R^2))) (Cos[((3 h)/R)]+I Sin[((3 h)/R)])+(R^2) (-EE II+GG (II+AA (R^2))) (-EE h II+GG (4 I AA (R^3)+h (II+AA (R^2)))) (Cos[((4 h)/R)]+I Sin[((4 h)/R)])),0,0,0,(4 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2) (-2 GG h (II+AA (R^2))+h (EE II-GG (II+AA (R^2))) Cos[(h/R)]+(-EE II R+GG II R+3 AA GG (R^3)) Sin[(h/R)]))/((EE (h^2) II+GG (h^2) II+AA GG (h^2) (R^2)-4 AA GG (R^4)+4 AA GG (R^4) Cos[(h/R)]+h R (-EE II+GG II+AA GG (R^2)) Sin[(h/R)]) (h (EE II+GG (II+AA (R^2)))-R (-EE II+GG (II+AA (R^2))) Sin[(h/R)]))},{0,0,-(2 AA GG II ((EE+2 GG) h+(EE-2 GG) R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),0,0,0,(2 AA GG II ((EE+2 GG) h+(EE-2 GG) R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),0},{0,0,(2 AA GG (EE+2 GG) II R (-h+R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),-(GG II (4 EE (2 GG (h^2) (2 II+AA (R^2))+EE (-4 AA (R^4)+(h^2) (2 II+AA (R^2)))) Cos[(h/R)]+R (AA R (EE GG (8 (h^2)-4 (R^2))+4 (GG^2) (2 (h^2)-(R^2))+(EE^2) (2 (h^2)+15 (R^2)))+AA (((EE+2 GG))^2) (R^3) Cos[((2 h)/R)]-4 EE h (2 EE II-4 GG II+3 AA EE (R^2)+2 AA GG (R^2)) Sin[(h/R)])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),-(4 EE GG (EE+2 GG) II Sin[(h/(2 R))] ((-AA (R^4)+2 (h^2) (2 II+AA (R^2))) Cos[(h/(2 R))]+AA (R^3) (R Cos[((3 h)/(2 R))]-2 h Sin[(h/(2 R))])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0,0,0,(2 AA GG (EE+2 GG) II R (h-R Sin[(h/R)]))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(GG II (8 (EE^2) (h^2) II+16 EE GG (h^2) II+6 AA (EE^2) (h^2) (R^2)+16 AA EE GG (h^2) (R^2)+8 AA (GG^2) (h^2) (R^2)-9 AA (EE^2) (R^4)-4 AA EE GG (R^4)-4 AA (GG^2) (R^4)+16 AA (EE^2) (R^4) Cos[(h/R)]-AA (7 (EE^2)-4 EE GG-4 (GG^2)) (R^4) Cos[((2 h)/R)]-8 AA (EE^2) h (R^3) Sin[(h/R)]-16 AA EE GG h (R^3) Sin[(h/R)]-4 (EE^2) h II R Sin[((2 h)/R)]+8 EE GG h II R Sin[((2 h)/R)]-2 AA (EE^2) h (R^3) Sin[((2 h)/R)]+4 AA EE GG h (R^3) Sin[((2 h)/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),(8 EE GG II R ((Sin[(h/(2 R))])^2) (2 h (EE II-2 GG II+AA EE (R^2))+(EE-2 GG) h (2 II+AA (R^2)) Cos[(h/R)]-AA (3 EE-2 GG) (R^3) Sin[(h/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0},{0,0,-(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(4 EE GG (EE+2 GG) II Sin[(h/(2 R))] ((-AA (R^4)+2 (h^2) (2 II+AA (R^2))) Cos[(h/(2 R))]+AA (R^3) (R Cos[((3 h)/(2 R))]-2 h Sin[(h/(2 R))])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),-(4 EE GG II ((EE+2 GG) (h^2) (2 II+AA (R^2)) Cos[(h/R)]+R Sin[(h/R)] ((EE-2 GG) h (2 II+AA (R^2))-2 AA EE (R^3) Sin[(h/R)])))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0,0,0,(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2))/(2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)]),(8 EE GG II R ((Sin[(h/(2 R))])^2) (2 h (EE II-2 GG II+AA EE (R^2))+(EE-2 GG) h (2 II+AA (R^2)) Cos[(h/R)]-AA (3 EE-2 GG) (R^3) Sin[(h/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),(2 EE GG II (4 EE (h^2) II+8 GG (h^2) II+2 AA EE (h^2) (R^2)+4 AA GG (h^2) (R^2)-2 AA EE (R^4)+2 AA EE (R^4) Cos[((2 h)/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[((2 h)/R)]))/(((EE+2 GG) h-(EE-2 GG) R Sin[(h/R)]) (2 EE (h^2) II+4 GG (h^2) II+AA EE (h^2) (R^2)+2 AA GG (h^2) (R^2)-4 AA EE (R^4)+4 AA EE (R^4) Cos[(h/R)]+(EE-2 GG) h R (2 II+AA (R^2)) Sin[(h/R)])),0},{(2 AA EE GG II R (2 (EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+R (-EE II R+GG II R+7 AA GG (R^3)+R (EE II-GG II+AA GG (R^2)) Cos[((2 h)/R)]-4 GG h (II+AA (R^2)) Sin[(h/R)])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(4 AA EE GG II R Sin[(h/(2 R))] ((EE II (2 (h^2)-(R^2))+GG ((R^2) (II-AA (R^2))+2 (h^2) (II+AA (R^2)))) Cos[(h/(2 R))]+R (R (EE II-GG II+AA GG (R^2)) Cos[((3 h)/(2 R))]-2 h (EE II+GG II+AA GG (R^2)) Sin[(h/(2 R))])))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,-(EE II (2 (EE^2) (h^2) (II^2)+4 EE GG (h^2) (II^2)+2 (GG^2) (h^2) (II^2)+4 AA EE GG (h^2) II (R^2)+4 AA (GG^2) (h^2) II (R^2)-(EE^2) (II^2) (R^2)+2 EE GG (II^2) (R^2)-(GG^2) (II^2) (R^2)+2 (AA^2) (GG^2) (h^2) (R^4)-2 AA EE GG II (R^4)+2 AA (GG^2) II (R^4)+15 (AA^2) (GG^2) (R^6)+4 AA GG (R^2) (EE (h^2) II+GG (-4 AA (R^4)+(h^2) (II+AA (R^2)))) Cos[(h/R)]+(R^2) (((EE II-GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-4 AA EE GG h II (R^3) Sin[(h/R)]-12 AA (GG^2) h II (R^3) Sin[(h/R)]-12 (AA^2) (GG^2) h (R^5) Sin[(h/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(2 AA EE GG II R (-2 EE (h^2) II-2 GG (h^2) II-2 AA GG (h^2) (R^2)+EE II (R^2)-GG II (R^2)+5 AA GG (R^4)-8 AA GG (R^4) Cos[(h/R)]+(R^2) (-EE II+GG II+3 AA GG (R^2)) Cos[((2 h)/R)]+2 EE h II R Sin[(h/R)]+2 GG h II R Sin[(h/R)]+2 AA GG h (R^3) Sin[(h/R)]-EE h II R Sin[((2 h)/R)]+GG h II R Sin[((2 h)/R)]+AA GG h (R^3) Sin[((2 h)/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),(8 AA EE GG II (R^2) ((Sin[(h/(2 R))])^2) (-2 GG h (II+AA (R^2))+h (EE II-GG (II+AA (R^2))) Cos[(h/R)]+(-EE II R+GG II R+3 AA GG (R^3)) Sin[(h/R)]))/(2 (EE^2) (h^3) (II^2)+4 EE GG (h^3) (II^2)+2 (GG^2) (h^3) (II^2)+4 AA EE GG (h^3) II (R^2)+4 AA (GG^2) (h^3) II (R^2)-(EE^2) h (II^2) (R^2)+2 EE GG h (II^2) (R^2)-(GG^2) h (II^2) (R^2)+2 (AA^2) (GG^2) (h^3) (R^4)-6 AA EE GG h II (R^4)-10 AA (GG^2) h II (R^4)-9 (AA^2) (GG^2) h (R^6)+8 AA GG h (R^4) (EE II+GG (II+AA (R^2))) Cos[(h/R)]+h (R^2) (((-EE II+GG II+AA GG (R^2)))^2) Cos[((2 h)/R)]-8 AA EE GG II (R^5) Sin[(h/R)]+8 AA (GG^2) II (R^5) Sin[(h/R)]+8 (AA^2) (GG^2) (R^7) Sin[(h/R)]+4 AA EE GG II (R^5) Sin[((2 h)/R)]-4 AA (GG^2) II (R^5) Sin[((2 h)/R)]-4 (AA^2) (GG^2) (R^7) Sin[((2 h)/R)]),0,0,0,(EE II (2 (EE^2) (h^2) (II^2)+4 EE GG (h^2) (II^2)+2 (GG^2) (h^2) (II^2)+8 AA EE GG (h^2) II (R^2)+8 AA (GG^2) (h^2) II (R^2)-(EE^2) (II^2) (R^2)+2 EE GG (II^2) (R^2)-(GG^2) (II^2) (R^2)+6 (AA^2) (GG^2) (h^2) (R^4)-2 AA EE GG II (R^4)+2 AA (GG^2) II (R^4)-9 (AA^2) (GG^2) (R^6)+16 (AA^2) (GG^2) (R^6) Cos[(h/R)]+(R^2) ((EE^2) (II^2)-2 EE GG II (II-AA (R^2))+(GG^2) ((II^2)-2 AA II (R^2)-7 (AA^2) (R^4))) Cos[((2 h)/R)]-8 AA EE GG h II (R^3) Sin[(h/R)]-8 AA (GG^2) h II (R^3) Sin[(h/R)]-8 (AA^2) (GG^2) h (R^5) Sin[(h/R)]+2 AA EE GG h II (R^3) Sin[((2 h)/R)]-2 AA (GG^2) h II (R^3) Sin[((2 h)/R)]-2 (AA^2) (GG^2) h (R^5) Sin[((2 h)/R)]))/(2 (EE (h^2) II+GG (h^2) II+AA GG (h^2) (R^2)-4 AA GG (R^4)+4 AA GG (R^4) Cos[(h/R)]+h R (-EE II+GG II+AA GG (R^2)) Sin[(h/R)]) (h (EE II+GG (II+AA (R^2)))-R (-EE II+GG (II+AA (R^2))) Sin[(h/R)]))}};
FF={((fs h)/2)-((fn (EE+GG) (h^2))/(12 GG R)),((fn h)/2)+((fs (EE+GG) (h^2))/(12 EE R)),((fb h)/2),0,-((fb (h^2))/12),((fn (h^2))/12),-((fs h)/2)-((fn (EE+GG) (h^2))/(12 GG R)),-((fn h)/2)+((fs (EE+GG) (h^2))/(12 EE R)),-((fb h)/2),0,-((fb (h^2))/12),((fn (h^2))/12)};
Return[-δaa.(KK.aa-FF)]];

δW[DISP,{CURVEDBEAM,{{EE_,GG_,ρρ_},{AA_,II_,iy_},{fx_,fy_,fz_}},{I1_,I2_}}]:=Module[{h,δW,rule,KK,FF},
(*                          *)
(* needs                    *)
(*                          *)
δrule ={a[any__] -> δa[any],b[any__] -> δb[any]};
rule =RULE[{iy},{I1,I2}];
h=(x[2]-x[1]) /. rule;
aa={ux[1],uy[1],uz[1],Θx[1],Θy[1],Θz[1],ux[2],uy[2],uz[2],Θx[2],Θy[2],Θz[2]} /.rule;
δaa=aa /.δrule;
(*                          *)
(* ELEMENT CONTRIBUTION     *)
(*                          *)      
KK=-{{-((AA EE)/h),0,0,0,0,0,-((AA EE)/h),0,0,0,0,0},{0,-((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,-((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II)),0,-((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II))},{0,0,-((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II)),0,0,0,-((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,-((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II)),0},{0,0,0,-((2 GG II)/h),0,0,0,0,0,-((2 GG II)/h),0,0},{0,0,((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,-((48 AA EE GG (h^2) II+144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II))),0,0,0,((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,((24 AA EE GG (h^2) II-144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II))),0},{0,-((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,((-48 AA EE GG (h^2) II-144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II))),0,-((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,((24 AA EE GG (h^2) II-144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II)))},{((AA EE)/h),0,0,0,0,0,((AA EE)/h),0,0,0,0,0},{0,((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II)),0,((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,-((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II))},{0,0,((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,-((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II)),0,0,0,((24 AA EE GG II)/(2 AA GG (h^3)+24 EE h II)),0,((6 AA EE GG h II)/(AA GG (h^3)+12 EE h II)),0},{0,0,0,((2 GG II)/h),0,0,0,0,0,((2 GG II)/h),0,0},{0,0,((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,-((24 AA EE GG (h^2) II-144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II))),0,0,0,((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,((48 AA EE GG (h^2) II+144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II))),0},{0,-((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,((-24 AA EE GG (h^2) II+144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II))),0,-((12 AA EE GG h II)/(2 AA GG (h^3)+24 EE h II)),0,0,0,((48 AA EE GG (h^2) II+144 (EE^2) (II^2))/(12 (AA GG (h^3)+12 EE h II)))}};
KK = Re[KK];
FF={((fx h)/2),((AA fy GG (h^4)+12 EE fy (h^2) II)/(2 AA GG (h^3)+24 EE h II)),((AA fz GG (h^4)+12 EE fz (h^2) II)/(2 AA GG (h^3)+24 EE h II)),0,-((AA fz GG (h^5)+12 EE fz (h^3) II)/(12 (AA GG (h^3)+12 EE h II))),((AA fy GG (h^5)+12 EE fy (h^3) II)/(12 (AA GG (h^3)+12 EE h II))),-((fx h)/2),-((AA fy GG (h^4)+12 EE fy (h^2) II)/(2 AA GG (h^3)+24 EE h II)),((-AA fz GG (h^4)-12 EE fz (h^2) II)/(2 AA GG (h^3)+24 EE h II)),0,((-AA fz GG (h^5)-12 EE fz (h^3) II)/(12 (AA GG (h^3)+12 EE h II))),((AA fy GG (h^5)+12 EE fy (h^3) II)/(12 (AA GG (h^3)+12 EE h II)))};
Return[-δaa.(KK.aa-FF)]];

PLANE ELEMENT defs

δW[{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Triangle[node_]}]:=
δW[DISP,{PLANE,{{EE,νν},{tt},{fX,fY,fZ}},Triangle[node]},fun];

δW[{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Triangle[node_]}]:=
δW[DISP,{PLANE,{{EE,νν},{tt},{fX,fY,fZ,mX,mY,mZ}},Triangle[node]},fun];

δW[DISP,{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Triangle[{I1_,I2_,I3_}]},fun_]:=Module[{nl,NN,r,e1,e2,nn,FF,FFINV,jac,uvw,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,δwint,δwext},

(*shape functions*)
nl ={I1,I2,I3};
NN={α,β,1-α-β};

r=NN.fun[[nl,1]];  
e1=(∂_α)r;  e2=(∂_β)r; e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0&&Lx>0&&Ly>0];

FF={e1, e2,nn};
FFINV =Simplify[Inverse[FF],L>0&&Lx>0&&Ly>0];
jac=Simplify[Abs[Det[FF]],L>0&&Lx>0&&Ly>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];EEEE=tt*Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)];  

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δ[ϵ]].Flatten[σ];
δwext=δ[uvw].{fX,fY,fZ};

QUAD[TRI7,(δwext+δwint)*jac,{α,β}]
];


δW[{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Polygon[node_]}]:=
δW[DISP,{PLANE,{{EE,νν},{tt},{fX,fY,fZ}},Polygon[node]},fun];

δW[MODE_,{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Polygon[node_]},fun_]:=Module[{nl,NN,INT,MID,r,e1,e2,e3,nn,FF,FFINV,jac,uvw,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,δwint,δwext},

(*shape functions*)
nl=Length[node];
NN[3]={α,β,1-α-β};NN[4]={(1-α)(1-β),α(1-β),(1-α)β,α β};
INT[3]=TRI7;INT[4]=REC9;
MID[3]={α->1/3,β->1/3}; MID[4]={α->1/2,β->1/2};

r=NN[nl].fun[[node,1]];  
{e1,e2}={(∂_α)r,(∂_β)r} /.MID[nl];
 e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0&&h>0];

FF={e1, e2,nn};
FFINV =Simplify[Inverse[FF],L>0&&h>0];
jac=Simplify[Abs[Det[FF]],L>0&&h>0];

(*approximations in structural system*) 
uvw=NN[nl].fun[[node,2]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];EEEE=Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)];  

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

If[MODE===DISP,
δwint=-Flatten[δ[ϵ]].Flatten[σ]*tt;
δwext=δ[uvw].{fX,fY,fZ};
Return[QUAD[INT[nl],(δwext+δwint)*jac,{α,β}]],
Return[Simplify[σ /. MID[nl]]]]
];


δW[{TWODIM,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Triangle[node_]}]:=
δW[DISP,{TWODIM,{{EE,νν},{tt},{fX,fY,fZ}},Triangle[node]},fun];

δW[MODE_,{TWODIM,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Triangle[{I1_,I2_,I3_}]},fun_]:=Module[{nl,NN,r,e1,e2,nn,FF,FFINV,jac,uvw,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,δwint,δwext},

(*shape functions*)
nl ={I1,I2,I3};
NN={α,β,1-α-β};

r=NN.fun[[nl,1]];  
e1=(∂_α)r;  e2=(∂_β)r; e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0];

FF={e1, e2,nn};
FFINV =Simplify[Inverse[FF],L>0];
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

If[MODE===DISP,
δwint=-Flatten[δ[ϵ]].Flatten[σ]*tt;
δwext=δ[uvw].{fX,fY,fZ};
Return[QUAD[TRI7,(δwext+δwint)*jac,{α,β}]],
Return[Simplify[σ /.{α->1/3,β->1/3}]]]
];


δW[DISP,{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Triangle[{I1_,I2_,I3_}]},fun_]:=Module[{nl,NN,r,e1,e2,e3,nn,PP,FF,FFINV,jac,uvw,ϕθψ,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,EECC,CCEE,CCCC,δwint,δwext},

(*shape functions*)
nl ={I1,I2,I3};
NN={α,β,1-α-β};

r=NN.fun[[nl,1]];  
e1=(∂_α)r;  e2=(∂_β)r; e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0];

FF={e1, e2,nn};
FFINV =Inverse[FF];
jac=Simplify[Abs[Det[FF]],L>0];
PP=LeviCivitaTensor[3]; 

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];
ϕθψ=NN.fun[[nl,3]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw}-(PP.nn)*(nn.ϕθψ);

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]],ee[[2,1]]] +
GM[[1,1]]*Outer[Times,ee[[2,1]],ee[[1,2]]] +GM[[2,2]]*Outer[Times,ee[[2,3]],ee[[3,2]]] +
GM[[2,2]]*Outer[Times,ee[[3,2]],ee[[2,3]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]],ee[[1,3]]]+
GM[[3,3]]*Outer[Times,ee[[1,3]],ee[[3,1]]]];
EECC=Table[EEEE[[i,j,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
CCEE=Table[EEEE[[j,i,k,l]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
CCCC=Table[EEEE[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
EEEE=tt*Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)-(EECC.nn).Inverse[nn.CCCC.nn].(nn.CCEE)+(EEEE.nn).(Outer[Times,nn,nn]*1/(nn.(nn.EEEE.nn).nn)).(nn.EEEE)];

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δ[ϵ]].Flatten[σ];
δwext=δ[uvw].{fX,fY,fZ}+δ[ϕθψ].{mX,mY,mZ};

QUAD[TRI7,(δwext+δwint)*jac,{α,β}]
];



δW[DISP,{EMS,{{EE_,νν_},{tt_},{fX_,fY_,fZ_,mX_,mY_,Mz_}},Polygon[nodes_]},fun_]:=Module[{nl,NN,r,e1,e2,e3,nn,PP,FF,FFINV,jac,uvw,ϕθψ,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,EECC,CCEE,CCCC,δwint,δwext},

(*shape functions*)
nl=Length[node];
NN[3]={α,β,1-α-β};NN[4]={(1-α)(1-β),α(1-β),(1-α)β,α β};
INT[3]=TRI7;INT[4]=REC9;
MID[3]={α->1/3,β->1/3}; MID[4]={α->1/2,β->1/2};

r=NN[nl].fun[[node,1]];  
{e1,e2}={(∂_α)r,(∂_β)r} /.MID[nl];
 e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0&&h>0];

FF={e1, e2,nn};
FFINV =Simplify[Inverse[FF],L>0&&h>0];
jac=Simplify[Abs[Det[FF]],L>0&&h>0];
PP=LeviCivitaTensor[3]; 

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];
ϕθψ=NN.fun[[nl,3]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw}-(PP.nn)*(nn.ϕθψ);

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]],ee[[2,1]]] +
GM[[1,1]]*Outer[Times,ee[[2,1]],ee[[1,2]]] +GM[[2,2]]*Outer[Times,ee[[2,3]],ee[[3,2]]] +
GM[[2,2]]*Outer[Times,ee[[3,2]],ee[[2,3]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]],ee[[1,3]]]+
GM[[3,3]]*Outer[Times,ee[[1,3]],ee[[3,1]]]];
EECC=Table[EEEE[[i,j,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
CCEE=Table[EEEE[[j,i,k,l]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
CCCC=Table[EEEE[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
EEEE=tt*Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)-(EECC.nn).Inverse[nn.CCCC.nn].(nn.CCEE)+(EEEE.nn).(Outer[Times,nn,nn]*1/(nn.(nn.EEEE.nn).nn)).(nn.EEEE)];

(*non-symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δ[ϵ]].Flatten[σ];
δwext=δ[uvw].{fX,fY,fZ}+δ[ϕθψ].{mX,mY,mZ};

QUAD[TRI7,(δwext+δwint)*jac,{α,β}]
];



(*

δW[MODE_,{{PLANE,model_},{{EE_,νν_},{tt_},{ϵ0_,λλ_},{fX_,fY_}},Polygon[node_]}]:=Module[{ns,enode ,NN,α,β,X,Y,r,FF,FFINV,PP,jac,uv,ϵ,σ,ρ,δww,δWW,EEEE,IIII,II,IIII1,IIII2,δwint,δwext,δwlag},

(*shape functions*)
ns =Dimensions[node];
enode =Flatten[node];
NN[{2,2}]={(1-α)*(1-β),α*(1-β),(1-α)*β,α*β};

(*assuming a linear mapping*)
{X,Y}=r=NN[ns].fun[[enode,1,{1,2}]];  
FF={(∂_α)r,(∂_β)r}/.{α->1/2,β->1/2};
FFINV =Inverse[FF];
jac=Abs[Det[FF]];

(*approximations in structural system*) 
uv=NN[ns].fun[[enode,2,{1,2}]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uv,(∂_β)uv};

(*plane-stress or strain symmetric elasticity dyad*)
II={{1,0},{0,1}};
IIII1=Outer[Times,II,II];
IIII=Sum[Outer[Times,i,j,j,i],{i,II},{j,II}];
IIII2=Table[IIII[[i,j,k,l]]+IIII[[j,i,k,l]]+IIII[[i,j,l,k]]+IIII[[j,i,l,k]],{i,1,2},{j,1,2},{k,1,2},{l,1,2}]/4;
EEEE=tt[X,Y]*EE[X,Y]/(1+νν[X,Y])*(νν[X,Y]/(1-νν[X,Y])*IIII1+IIII2);
If[model===strain,
EEEE=tt[X,Y]*EE[X,Y]/(1+νν[X,Y])*(νν[X,Y]/(1-2*νν[X,Y])*IIII1+IIII2)];

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*(ϵ0[X,Y][[j,i]]+ϵ[[j,i]]),{i,1,2},{j,1,2}];
If[MODE==DISP,
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uv].{fX[X,Y],fY[X,Y]};
δwlag=δ[λλ[X,Y]].uv+λλ[X,Y].δ[uv];
δWW=QUAD[LIN3,QUAD[LIN3,(δwext+δwint+δwlag)*jac,{α}],{β}];
Return[δWW]];
If[MODE==POSTP,
δWW=QUAD[LIN3,QUAD[LIN3,σ*jac,{α}],{β}];
Return[δWW]];

(*stress at the centerpoint*)
If[MODE==STRESS,Return[σ /.{α->1/3,β->1/3}]]

]/; Dimensions[node]=={2,2};


*)

δW[MODE_,{PLANE,{{EE_,νν_},{tt_,ϵ0_,λλ_},{fX_,fY_}},Polygon[node_]}]:=Module[{ns,NN,α,β,X,Y,r,FF,FFINV,PP,jac,uv,ϵ,σ,s,ρ,δww,δWW,EEEE,IIII,II,IIII1,IIII2,δwint,δwext,δwlag},

(*shape functions*)
ns =Length[node];
NN[3]={α,β,1-α-β};
NN[6]={1+2 (β^2)-3 α+2 (α^2)+β (-3+4 α),α (-1+2 α),β (-1+2 β),-4 α (-1+β+α),4 β α,-4 β (-1+β+α)};

(*assuming a linear mapping*)
{X,Y}=r=NN[ns].fun[[node,1,{1,2}]];  
FF={(∂_α)r,(∂_β)r}/.{α->1/3,β->1/3};
FFINV =Inverse[FF];
jac=Abs[Det[FF]];

(*approximations in structural system*) 
uv=NN[ns].fun[[node,2,{1,2}]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uv,(∂_β)uv};

(*plane-stress or strain symmetric elasticity dyad*)
II={{1,0},{0,1}};
IIII1=Outer[Times,II,II];
IIII=Sum[Outer[Times,i,j,j,i],{i,II},{j,II}];
IIII2=Table[IIII[[i,j,k,l]]+IIII[[j,i,k,l]]+IIII[[i,j,l,k]]+IIII[[j,i,l,k]],{i,1,2},{j,1,2},{k,1,2},{l,1,2}]/4;
EEEE=tt[X,Y]*EE[X,Y]/(1+νν[X,Y])*(νν[X,Y]/(1-νν[X,Y])*IIII1+IIII2);
If[model===strain,
EEEE=tt[X,Y]*EE[X,Y]/(1+νν[X,Y])*(νν[X,Y]/(1-2*νν[X,Y])*IIII1+IIII2)];

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*(ϵ0[X,Y][[j,i]]+ϵ[[j,i]]),{i,1,2},{j,1,2}];

If[MODE==DISP,
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uv].{fX[X,Y],fY[X,Y]};
δwlag=δ[λλ[X,Y]].uv+λλ[X,Y].δ[uv];
δWW=QUAD[TRI7,(δwext+δwint+δwlag)*jac,{α,β}];
Return[δWW]];

If[MODE==POSTP,δWW=QUAD[TRI7,σ*jac,{α,β}];Return[δWW]];

(*stress at the centerpoint*)
If[MODE==STRESS,
s=σ /.{α->1/3,β->1/3};
Return[{s[[1,1]],s[[2,2]],(s[[1,2]]+s[[2,1]])/2}]]

]/; Dimensions[node]=={3} ||Dimensions[node]=={6} ;



δW[VIBR,{PLANE,{{EE_,νν_,ρρ_},{tt_},{fX_,fY_,fZ_}},Polygon[node_]},fun_]:=Module[{nl,NN,INT,MID,r,e1,e2,e3,nn,FF,FFINV,jac,uvw,uvw0,uvw2,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,δwint,δwext,δwine},

(*shape functions*)
nl=Length[node];
NN[3]={α,β,1-α-β}; NN[4]={(1-α)(1-β),α(1-β),(1-α)β,α β};
INT[3]=TRI7;INT[4]=REC9;
MID[3]={α->1/3,β->1/3}; MID[4]={α->1/2,β->1/2};

(*element plane*)
r=NN[nl].fun[[node,1]];  
{e1,e2}={(∂_α)r,(∂_β)r} /.MID[nl];
 e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0&&h>0];

FF={e1, e2,nn};
FFINV =Simplify[Inverse[FF],L>0&&h>0];
jac=Simplify[Abs[Det[FF]],L>0&&h>0];

(*approximations in structural system*) 
uvw=NN[nl].fun[[node,2]];
(*uvw =uvw-e3(e3.uvw);*)
uvw0=uvw/. DRULE[0];
uvw2=uvw/. DRULE[2];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw0,(∂_β)uvw0,(∂_γ)uvw0};

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];EEEE=Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)];  

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δ[ϵ]].Flatten[σ]*tt;
δwext=δ[uvw0].{fX,fY,fZ};
δwine=-δ[uvw0].uvw2*ρρ*tt;
Return[QUAD[INT[nl],(δwext+δwint+δwine)*jac,{α,β}]]
];



δW[NONL,{PLANE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Polygon[node_]},fun_]:=Module[{nl,NN,INT,MID,DOM,r,e1,e2,e3,nn,FF,FFINV,jac,uvw,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,δwint,δwext},

(*shape functions*)
nl=Length[node];
NN[3]={1-α-β,α,β};NN[4]={(1-α)(1-β),α(1-β),α β,(1-α)β};
INT[3]=TRI7;INT[4]=REC9;
MID[3]={α->1/3,β->1/3}; MID[4]={α->1/2,β->1/2};
DOM[4]={{0,0},{1,0},{1,1},{0,1}};
DOM[3]={{0,0},{1,0},{1,1}};

(*orthonomal basis defined by the mapping*)
r=NN[nl].fun[[node,1]];  
{e1,e2}={(∂_α)r,(∂_β)r} /.MID[nl];
e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0];
FF={e1, e2, nn};
FFINV =Simplify[Inverse[FF],L>0];
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN[nl].fun[[node,2]];

(*displacement gradient in the structural system*)
FG=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};
EG=(FG+Transpose[FG]+FG.Transpose[FG])/2;
δEG=(δ[FG]+Transpose[δ[FG]]+δ[FG].Transpose[FG]+FG.Transpose[δ[FG]])/2;

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];EEEE=Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)]; 
 
(*symmetric stress*)
SS=Sum[EEEE[[;;,;;,i,j]]*EG[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δEG].Flatten[SS] tt;
δwext=δ[uvw].{fX,fY,fZ};
If[nl==3,Return[QUAD[INT[nl],(δwext+δwint)*jac,{α,β}]]];
If[nl==4,Return[Integrate[(δwext+δwint)*jac,{α,β}∈Polygon[{{0,0},{1,0},{1,1},{0,1}}]]]]
];



δW[NONL,{PLANE,{{Ε_,ν_},{t_},{fx_,fy_,fz_}},Triangle[{n1_,n2_,n3_}]},fun_]:=Module[{pol,sha,nod,x,y,NN,u,v,Eσ,EE,δE,SS,δwint,δwext,δWW},

nod ={n1,n2,n3};
sha={1,x,y};
pol=fun[[nod,1,1;;2]];

(*shape functions*)
NN=sha .Inverse[Map[sha /. Thread[{x,y}->#]&,pol]];

(*approximations*) 
u=NN.fun[[nod,2,1]];
v=NN.fun[[nod,2,2]];

(*plane stress elasticity*)
Eσ=Ε/(1-ν^2)*{{1,ν,0},{ν,1,0},{0,0,(1-ν)/2}};

(*strain and stress*)
EE={(∂_x)u+(((∂_x)u)^2+((∂_x)v)^2)/2,
(∂_y)v+(((∂_y)u)^2+((∂_y)v)^2)/2,
((∂_x)v+(∂_y)u)+((∂_x)u)*((∂_y)u)+((∂_x)v)*((∂_y)v)};

δE={δ[(∂_x)u]+δ[(∂_x)u](∂_x)u+δ[(∂_x)v](∂_x)v,
δ[(∂_y)v]+δ[(∂_y)u](∂_y)u+δ[(∂_y)v](∂_y)v,
δ[(∂_x)v+(∂_y)u]+δ[(∂_x)u]*(∂_y)u+(∂_x)u*δ[(∂_y)u]+δ[(∂_x)v]*(∂_y)v+(∂_x)v*δ[(∂_y)v]};

SS=t  Eσ.EE ;

(*virtual work expression*)
δwint=-δE.SS;
δwext=δ[{u,v,0}].{fx,fy,fz};
δWW=Integrate[δwext+δwint,{x,y}∈Polygon[pol],Assumptions->L>0]];




δW[DISP,{PLANE,{{EE_,νν_,αα_,kk_},{tt_},{fX_,fY_,fZ_,ss_,ϑ0_}},Triangle[node_]},fun_]:=δW[DISP,{PLANE,{{EE,νν,αα,kk},{tt},{fX,fY,fZ,ss,ϑ0}},Polygon[node]},fun];

δW[DISP,{PLANE,{{EE_,νν_,αα_,kk_},{tt_},{fX_,fY_,fZ_,ss_,ϑ0_}},Polygon[node_]},fun_]:=Module[{nl,NN,INT,MID,r,e1,e2,e3,nn,FF,FFINV,jac,uvw,du,dϑ,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,δwint,δwext,δpint,δpext,ϑϑ},

(*shape functions*)
nl=Length[node];
NN[3]={1-ξ-η,ξ,η};NN[4]={(1-ξ)(1-η),ξ(1-η),ξ η,(1-ξ)η};
INT[3]=TRI7;INT[4]=REC9;
MID[3]={ξ->1/3,η->1/3}; MID[4]={ξ->1/2,η->1/2};

r=NN[nl].fun[[node,1]];  
{e1,e2}={(∂_ξ)r,(∂_η)r} /.MID[nl];
 e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0&&h>0];

FF={e1, e2,nn};
FFINV =Simplify[Inverse[FF],L>0&&h>0];
jac=Simplify[Abs[Det[FF]],L>0&&h>0];

(*approximations in structural system*) 
uvw=NN[nl].fun[[node,2]];
ϑϑ=NN[nl].fun[[node,4]];

(*displacement gradient in the structural system*)
du=FFINV.{(∂_ξ)uvw,(∂_η)uvw,(∂_ζ)uvw};
dϑ=FFINV.{(∂_ξ)ϑϑ,(∂_η)ϑϑ,(∂_ζ)ϑϑ};

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2 νν)/EE,0,0},{0,(2+2 νν)/EE,0},{0,0,(2+2 νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];EEEE=Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)]; 

(*symmetric stress*)
ϵ=du-IdentityMatrix[3]*αα*(ϑϑ-ϑ0);
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δδ[du]].Flatten[σ]*tt;
δwext=δδ[uvw].{fX,fY,fZ};
δpint=-δδ[dϑ].dϑ*kk*tt;
δpext= δδ[ϑϑ]*ss;
Return[QUAD[INT[nl],(δwext+δwint+δpint+δpext)*jac,{ξ,η}]]
];

δW[DISP,{PLANE,{{EE_,νν_},{tt_},{ϵxx_,ϵyy_,ϵxx_},{fX_,fY_}},Polygon[nodes_]},fun_]:=Module[{nl,NN,r,e1,e2,e3,nn,PP,FF,FFINV,jac,uvw,ϕθψ,ϵ,σ,δww,δWW,e,ee,EM,GM,EEEE,EECC,CCEE,CCCC,δwint,δwext},

(*shape functions*)
nl=Length[node];
NN[3]={α,β,1-α-β};NN[4]={(1-α)(1-β),α(1-β),(1-α)β,α β};
INT[3]=TRI7;INT[4]=REC9;
MID[3]={α->1/3,β->1/3}; MID[4]={α->1/2,β->1/2};

r=NN[nl].fun[[node,1]];  
{e1,e2}={(∂_α)r,(∂_β)r} /.MID[nl];
 e3=e1\[Cross]e2;
nn=Simplify[e3/Sqrt[e3.e3],L>0&&h>0];

FF={e1,e2,nn};
FFINV =Inverse[FF];
jac=Abs[Det[FF]];
PP=LeviCivitaTensor[3]; 

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];
ϕθψ=NN.fun[[nl,3]];

(*displacement gradient in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw}-(PP.nn) (nn.ϕθψ);

(*Plane stress elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GM=Inverse[{{(2+2*νν)/EE,0,0},{0,(2+2*νν)/EE,0},{0,0,(2+2*νν)/EE}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]],ee[[2,1]]] +
GM[[1,1]]*Outer[Times,ee[[2,1]],ee[[1,2]]] +GM[[2,2]]*Outer[Times,ee[[2,3]],ee[[3,2]]] +
GM[[2,2]]*Outer[Times,ee[[3,2]],ee[[2,3]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]],ee[[1,3]]]+
GM[[3,3]]*Outer[Times,ee[[1,3]],ee[[3,1]]]];
EECC=Table[EEEE[[i,j,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
CCEE=Table[EEEE[[j,i,k,l]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
CCCC=Table[EEEE[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
EEEE=tt*Simplify[EEEE-(EEEE.nn).Inverse[nn.EEEE.nn].(nn.EEEE)-(EECC.nn).Inverse[nn.CCCC.nn].(nn.CCEE)+(EEEE.nn).(Outer[Times,nn,nn]*1/(nn.(nn.EEEE.nn).nn)).(nn.EEEE)];


(*non-symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*(ϵ0[[j,i]]+ϵ[[j,i]]),{i,1,3},{j,1,3}];

If[MODE==DISP,
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uv].{fX[X,Y],fY[X,Y]};
δwlag=δ[λλ[X,Y]].uv+λλ[X,Y].δ[uv];
δWW=QUAD[TRI7,(δwext+δwint+δwlag)*jac,{α,β}];
Return[δWW]];

If[MODE==POSTP,δWW=QUAD[TRI7,σ*jac,{α,β}];Return[δWW]];

(*stress at the centerpoint*)
If[MODE==STRESS,
s=σ /.{α->1/3,β->1/3};
Return[{s[[1,1]],s[[2,2]],(s[[1,2]]+s[[2,1]])/2}]]

(*non-symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

δwint=-Flatten[δ[ϵ]].Flatten[σ];
δwext=δ[uvw].{fX,fY,fZ}+δ[ϕθψ].{mX,mY,mZ};

QUAD[TRI7,(δwext+δwint)*jac,{α,β}]
];

PLATE ELEMENT defs

δW[MODE_,{PLATE,{{EE_,GG_,νν_},{tt_},{fx_,fy_,fz_}},Polygon[{n1_Integer,n2_Integer,n3_Integer,n4_Integer}]},fun_]:=Module[{nl,α,β,
n,enode,NN,r0,r0α,r0β,eα,eβ,en,hx,hy,FF,jac,x,y,u,v,w,ϕ,θ,ψ,πϕ,πθ,πψx,πψy,Eσ,ϵϵ,κκ,γγ,M,Q,F,δwint,δwext},

nl={n1,n2,n3,n4};
NN={(1-α)(1-β),α(1-β),(1-α)β,α β};

(*mapping to orthonormal material system*)
r0=NN.fun[[nl,1]];
r0α=(∂_α)r0 /.{α->1/2,β->1/2};
r0β=(∂_β)r0 /.{α->1/2,β->1/2};
hx=Simplify[Sqrt[r0α.r0α],L>0 && h>0 ];
hy=Simplify[Sqrt[r0β.r0β],L>0 && h>0 ];
eα=Simplify[r0α/Sqrt[r0α.r0α],L>0 && h>0 ];
eβ=Simplify[r0β/Sqrt[r0β.r0β],L>0 && h>0 ];
en=eα\[Cross]eβ;
FF={r0α,r0β,en};
jac =Simplify[Det[FF],L>0 && h>0 ];

(*shape function in material coordinates*)
NN=NN /.{α->x/hx,β->y/hy};

(*functions in the material system*) 
u=NN.fun[[nl,2]].eα;
v=NN.fun[[nl,2]].eβ;
w=NN.fun[[nl,2]].en+NN[[1]]*NN[[2]]*NN[[3]]*NN[[4]]*a[nl]*0;
ϕ=NN.fun[[nl,3]].eα;
θ=NN.fun[[nl,3]].eβ;
ψ=NN.fun[[nl,3]].en;

(*taylor projections onto constants*)
πϕ=ϕ/.y->hy/2;
πθ=θ/.x->hx/2;
πψx=ψ/.y->hy/2;
πψy=ψ/.x->hx/2;

(*plane stress*)
Eσ=EE/(1-νν^2)*{{1,νν,0,0},{νν,1,0,0},{0,0,(1-νν)/2,0},{0,0,0,(1-νν)/2}};

(*plate strain and stress measures*)
ϵϵ={(∂_x)u,(∂_y)v,(∂_x)v-πψy,(∂_y)u+πψx};
κκ={-(∂_x)θ,(∂_y)ϕ,(∂_x)ϕ-(∂_y)θ,0};
γγ={(∂_y)w-πϕ,(∂_x)w+πθ};
F=tt*Eσ.ϵϵ;
M=tt^3/12*Eσ.κκ;
Q=tt*GG*γγ;

(*virtual work expression*)
δwint=(-δ[κκ].M-δ[γγ].Q -δ[ϵϵ].F) /.{x->α*hx,y->β*hy}; 
δwext=(δ[{u,v,w}].{fx,fy,fz})/.{x->α*hx,y->β*hy};
QUAD[REC9,(δwext+δwint)*jac,{α,β}]; 

δwint=(-δ[κκ].M-δ[γγ].Q -δ[ϵϵ].F);
δwext=(δ[{u,v,w}].{fx,fy,fz});
Integrate[Integrate[(δwext+δwint)*jac,{x,0,hx}],{y,0,hy}]
];


δW[MODE_,{PLATE,{{EE_,GG_,νν_},{tt_},{fx_,fy_,fz_}},Polygon[node_]},fun_]:=Module[{nl,α,β,
n,nα,nβ,NN,r0,r0α,r0β,eα,eβ,en,hx,hy,FF,jac,x,y,u,v,w,ϕ,θ,ψ,πϕ,πθ,πψx,πψy,Eσ,ϵϵ,κκ,γγ,M,Q,F,δwint,δwext},

(*nodes*)
{nα,nβ}=Dimensions[node];
nl=Flatten[node];
NN=Flatten[LAGRANGE[{{nα,α},{nβ,β}}]];

(*mapping to orthonormal material system*)
r0=NN.fun[[nl,1]];
r0α=(∂_α)r0 /.{α->1/2,β->1/2};
r0β=(∂_β)r0 /.{α->1/2,β->1/2};
hx=Simplify[Sqrt[r0α.r0α],L>0 && h>0 ];
hy=Simplify[Sqrt[r0β.r0β],L>0 && h>0 ];
eα=Simplify[r0α/Sqrt[r0α.r0α],L>0 && h>0 ];
eβ=Simplify[r0β/Sqrt[r0β.r0β],L>0 && h>0 ];
en=eα\[Cross]eβ;
FF={r0α,r0β,en};
jac =Simplify[Det[FF],L>0 && h>0 ];

(*shape function in material coordinates*)
NN=NN /.{α->x/hx,β->y/hy};

(*functions in the material system*) 
u=NN.fun[[nl,2]].eα;
v=NN.fun[[nl,2]].eβ;
w=NN.fun[[nl,2]].en;
ϕ=NN.fun[[nl,3]].eα;
θ=NN.fun[[nl,3]].eβ;
ψ=NN.fun[[nl,3]].en;

Print["here we go"];

(*taylor projections onto linears*)
πϕ=(ϕ/.y->hy/2)+((∂_y)ϕ/.y->hy/2)*(y-hy/2)+
+((∂_(y,y))ϕ/.y->hy/2)*(y-hy/2)^2/2*0;
πθ=(θ/.x->hx/2)+((∂_x)θ/.x->hx/2)*(x-hx/2)*(9/4)+
+((∂_(x,x))θ/.x->hx/2)*(x-hx/2)^2/2*0;
πψx=(ψ/.y->hy/2)+((∂_y)ψ/.y->hy/2)*(y-hy/2)*(9/4)+((∂_(y,y))ψ/.y->hy/2)*(y-hy/2)^2/2*0;
πψy=(ψ/.x->hx/2)+((∂_x)ψ/.x->hx/2)*(x-hx/2)*0+((∂_(x,x))ψ/.x->hx/2)*(x-hx/2)^2/2*0;

(*plane stress*)
Eσ=EE/(1-νν^2)*{{1,νν,0,0},{νν,1,0,0},{0,0,(1-νν)/2,0},{0,0,0,(1-νν)/2}};

(*plate strain and stress measures*)
ϵϵ={(∂_x)u,(∂_y)v,(∂_x)v-πψy,(∂_y)u+πψx};
κκ={-(∂_x)θ,(∂_y)ϕ,(∂_x)ϕ-(∂_y)θ,0};
γγ={(∂_y)w-πϕ,(∂_x)w+πθ};
F=tt*Eσ.ϵϵ;
M=tt^3/12*Eσ.κκ;
Q=tt*GG*γγ;

(*virtual work expression*)
δwint=(-δ[κκ].M-δ[γγ].Q -δ[ϵϵ].F) /.{x->α*hx,y->β*hy}; 
δwext=(δ[{u,v,w}].{fx,fy,fz})/.{x->α*hx,y->β*hy}; 
QUAD[LIN7,QUAD[LIN7,(δwint+δwext)*jac,{α}],{β}];

δwint=(-δ[κκ].M-δ[γγ].Q -δ[ϵϵ].F);
δwext=(δ[{u,v,w}].{fx,fy,fz});
Integrate[Integrate[(δwext+δwint)*jac,{x,0,hx}],{y,0,hy}]
];


δW[MODE_,{GENERICPLATE,{{EE_,νν_},{tt_},{fX_,fY_,fZ_}},Polygon[node_]},fun_]:=
δW[MODE,{GENERICPLATE,{{EE,νν},{tt,0,tt^3/12},{fX,fY,fZ,0,0,0}},Polygon[node]},fun];

δW[MODE_,{GENERICPLATE,{{EE_,νν_},{tt_,st_,it_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Polygon[node_]},fun_]:=Module[{enode,nα,nβ,α,β,n,NN,r0,rα0,rβ0,rn0,hα0,hβ0,hn0,iα0,iβ0,in0,jac,FF,FFINV,GG,PP,u0,θ0,u00,θ00,ω00,f00,m00,F,M,ϵ,κ,II0,III,IIII,IIII1,IIII2,EEEE,AE,BE,CE,δwint,δwext,δWW},

(*nodes*)
{nα,nβ}=Dimensions[node];
enode=Flatten[node];
NN=Flatten[LAGRANGE[{{nα,α},{nβ,β}}]];

(*generic basis vectors*)
r0=NN.fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/2,β->1/2};
rβ0=(∂_β)r0 /.{α->1/2,β->1/2};
rn0=rα0\[Cross]rβ0/.{α->1/2,β->1/2};
hn0=Simplify[Norm[rn0],L>0 && h>0 ];
in0=rn0/hn0;
jac =hn0;

(*metric dyad and permutation symbol of generic metrics*)
FF={rα0,rβ0,in0};
FFINV=Simplify[Inverse[FF],L>0 && h>0 ];
GG =FF.Transpose[FF]; 
PP=Table[Sum[FF[[a,i]]*FF[[b,j]]*FFINV[[k,c]]*LeviCivitaTensor[3][[i,j,k]],{i,1,3},{j,1,3},{k,1,3}],{a,1,3},{b,1,3},{c,1,3}];

(*displacement and rotation*)
u0=NN.fun[[enode,2]];
θ0=NN.fun[[enode,3]];

(*transform to material system*)
u00=u0.FFINV;
θ00=θ0.FFINV;
ω00=in0.(θ00.PP);
f00={fX,fY,fZ}.FFINV;
m00={mX,mY,mZ}.FFINV;

(*strain measures of plate model*)
ϵ=D[u00,{{α,β,n}}].Transpose[FFINV].FFINV+Outer[Times,in0,ω00];
κ=D[ω00,{{α,β,n}}].Transpose[FFINV].FFINV;

(*elasticity dyad of isotropic plate*)
II0=Sum[Outer[Times,FFINV[[i]],FFINV[[i]]],{i,1,2}];
IIII=Sum[Outer[Times,i,j,j,i],{i,FFINV},{j,FFINV}];
IIII1=Outer[Times,II0,II0];
IIII2=Table[IIII[[i,j,k,l]]+IIII[[j,i,k,l]]+IIII[[i,j,l,k]]+IIII[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]/4-Outer[Times,in0,in0,in0,in0];
EEEE=EE/(1+νν)*(νν/(1-νν)*IIII1+IIII2);

(*      *)
AE =tt*EEEE;
CE=st*EEEE;
BE =it*EEEE;

(*stress resultants*)
F=tt*Sum[EEEE[[;;,;;,k,l]]*GG[[l,m]]*GG[[k,n]]*ϵ[[m,n]],{k,1,3},{l,1,3},{m,1,3},{n,1,3}];
M=it*Sum[EEEE[[;;,;;,k,l]]*GG[[l,m]]*GG[[k,n]]*κ[[m,n]],{k,1,3},{l,1,3},{m,1,3},{n,1,3}];

(*virtual work densities*)
δwint=-Sum[M[[i,j]]*GG[[j,l]]*GG[[i,k]]*δ[κ[[k,l]]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]-Sum[F[[i,j]]*GG[[j,l]]*GG[[i,k]]*δ[ϵ[[k,l]]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
δwext=δ[u00].GG.f00;

δWW=QUAD[LIN7,QUAD[LIN7,(δwint+δwext)*jac,{α}],{β}]
];



δW[MODE_,{PLATE,{{EE_,νν_,ρρ_},{tt_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Polygon[enode_]}]:=Module[{δ,nne,α,β,n,NN,r0,rα0,rβ0,rn0,hα0,hβ0,hn0,iα0,iβ0,in0,jac,FF,FFINV,GG,PP,u0,θ0,u00,θ00,ω00,f00,F,M,ϵ,κ,II0,III,IIII,IIII1,IIII2,EEEE,δwint,δwext,δWW},

(*rule*)
δ[u_]:=u/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};

(*shape functions*)
nne=Dimensions[enode];
NN[{3}]={1-α-β,α,β};
NN[{10}]={1/2*α*(2-9*α+9*(α^2)),1/2* β*(2-9* β+9 *(β^2)),1/2*(2-9 (α^3)-11 β+18 (β^2)-9 (β^3)-9 *(α^2)*(-2+3*β)+α*(-11+36*β-27*(β^2))),9/2* α*(-1+3*α)*β,9/2* α*β*(-1+3*β),-9/2* β*(-1+α+β)*(-1+3*β),9/2* β*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),9/2*α*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),-9/2* α*(-1+3*α)*(-1+α+β),-27*α*β*(-1+α+β)};

(*generic basis vectors*)
r0=NN[nne].fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/3,β->1/3};
rβ0=(∂_β)r0 /.{α->1/3,β->1/3};
rn0=rα0\[Cross]rβ0/.{α->1/3,β->1/3};
hn0=Norm[rn0];
in0=rn0/hn0;
jac =hn0;

(*metric dyad and permutation symbol of generic metrics*)
FF={rα0,rβ0,in0};
FFINV=Inverse[FF];
GG =FF.Transpose[FF]; 
PP=Table[Sum[FF[[a,i]]*FF[[b,j]]*FFINV[[k,c]]*LeviCivitaTensor[3][[i,j,k]],{i,1,3},{j,1,3},{k,1,3}],{a,1,3},{b,1,3},{c,1,3}];

(*displacement and rotation*)
u0=NN[nne].fun[[enode,2]];
θ0=NN[nne].fun[[enode,3]];

(*transform to material system*)
u00=u0.FFINV;
θ00=θ0.FFINV;
ω00=in0.(θ00.PP);
f00={fX,fY,fZ}.FFINV;
m00={mX,mY,mZ}.FFINV;

(*strain measures of plate model*)
ϵ=D[u00,{{α,β,n}}].Transpose[FFINV].FFINV+Outer[Times,in0,ω00];
κ=D[ω00,{{α,β,n}}].Transpose[FFINV].FFINV;

(*elasticity dyad of isotropic plate*)
II0=Sum[Outer[Times,FFINV[[i]],FFINV[[i]]],{i,1,2}];
IIII=Sum[Outer[Times,i,j,j,i],{i,FFINV},{j,FFINV}];
IIII1=Outer[Times,II0,II0];
IIII2=Table[IIII[[i,j,k,l]]+IIII[[j,i,k,l]]+IIII[[i,j,l,k]]+IIII[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]/4-Outer[Times,in0,in0,in0,in0];
EEEE=EE/(1+νν)*(νν/(1-νν)*IIII1+IIII2);

(*stress resultants*)
F=tt*Sum[EEEE[[;;,;;,k,l]]*GG[[l,m]]*GG[[k,n]]*ϵ[[m,n]],{k,1,3},{l,1,3},{m,1,3},{n,1,3}];
M=tt^3/12*Sum[EEEE[[;;,;;,k,l]]*GG[[l,m]]*GG[[k,n]]*κ[[m,n]],{k,1,3},{l,1,3},{m,1,3},{n,1,3}];

(*virtual work density*)
δwint=-Sum[M[[i,j]]*GG[[j,l]]*GG[[i,k]]*δ[κ[[k,l]]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]-Sum[F[[i,j]]*GG[[j,l]]*GG[[i,k]]*δ[ϵ[[k,l]]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];
δwext=δ[u00].GG.f00;
δWW=QUAD[TRI28,(δwint+δwext)*jac,{α,β}]]/; Dimensions[enode]=={10};


(*
δW[MODE_,{PLATE,{{EE_,νν_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},Polygon[node_]}]:=Module[{nα,nβ,nne,enode,δ,α,β,n,NN,r0,rα0,rβ0,rn0,hα0,hβ0,hn0,iα0,iβ0,in0,jac,FF,FFINV,GG,PP,u0,θ0,u00,θ00,F,M,ϵ,κ,II0,III,IIII,IIII1,IIII2,EEEE,δwint,δwext,δWW},
(*rule*)
δ[u_]:= u/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};
(*nodes*)
{nα,nβ}=Dimensions[node];
enode=Flatten[node];

(*mapping*)
NN=Flatten[LAGRANGE[{{nα,α},{nβ,β}}]];
r0=NN.fun[[enode,1]];

(*generic basis vectors*)
rα0=(∂_α)r0 /.{α->1/2,β->1/2};
rβ0=(∂_β)r0 /.{α->1/2,β->1/2};
rn0=rα0\[Cross]rβ0/.{α->1/2,β->1/2};
hn0=Norm[rn0];
in0=rn0/hn0;
jac =hn0;

(*metric dyad and permutation symbol of generic metrics*)
αβn=FF={rα0,rβ0,in0};
Print[MatrixForm[αβn]];
ijk=FFINV=Inverse[FF];
GG =FF.Transpose[FF]; 
PP=Table[Sum[αβn[[a,i]]*αβn[[b,j]]*ijk[[k,c]]*LeviCivitaTensor[3][[i,j,k]],{i,1,3},{j,1,3},{k,1,3}],{a,1,3},{b,1,3},{c,1,3}];
(*Print[Simplify[PP,{Lx>0,Ly>0}]];
Print[Simplify[FF.(FF.LeviCivitaTensor[3]).FFINV,{Lx>0,Ly>0}]]*);

(*displacement and rotation test case*)
u0=NN.fun[[enode,2]];
θ0=NN.fun[[enode,3]];
(*displacement and rotation test case*)

(*
u0={ux*x+uy*y,vx*x+vy*y,wx*x+wy*y}/.Thread[{x,y,z}->r0];
θ0={ϕx*x+ϕy*y,θx*x+θy*y,ψx*x+ψy*y}/.Thread[{x,y,z}->r0]; 
*)

(*transform to material system*)
u00=u0.FFINV;
θ00=θ0.FFINV;
ω00=in0.(θ00.PP);
f00={fx,fy,fz}.FFINV;
(*
Print[Simplify[θ0\[Cross]{0,0,1} /.{α->1/2,β->1/2},{Lx>0,Ly>0}]];
Print[Simplify[ω00.FF /.{α->1/2,β->1/2},{Lx>0,Ly>0}]];
*)

(*strain measures of plate model*)
ϵ=D[u00,{{α,β,n}}].Transpose[ijk].ijk+Outer[Times,in0,ω00];
κ=D[ω00,{{α,β,n}}].Transpose[ijk].ijk;
(*Print[MatrixForm[Simplify[Transpose[FF].ϵ.FF/.{α->1/2,β->1/2},{Lx>0,Ly>0}]]];
Print[MatrixForm[Simplify[ϵ/.{α->1/2,β->1/2},{Lx>0,Ly>0}]]];*)
(*Print[MatrixForm[Simplify[Transpose[FF].κ.FF/.{α->1/2,β->1/2},{Lx>0,Ly>0}]]];
Print[MatrixForm[Simplify[κ/.{α->1/2,β->1/2},{Lx>0,Ly>0}]]];*)

(*elasticity dyad of isotropic plate*)
II0=Sum[Outer[Times,FFINV[[i]],FFINV[[i]]],{i,1,2}];
(*II=Sum[Outer[Times,FFINV[[i]],FFINV[[i]]],{i,1,3}];
Print[Simplify[{FF[[1]],II.GG.FF[[1]]},{Lx>0,Ly>0}]];*)
IIII=Sum[Outer[Times,i,j,j,i],{i,FFINV},{j,FFINV}];
IIII1=Outer[Times,II0,II0];
IIII2=Table[IIII[[i,j,k,l]]+IIII[[j,i,k,l]]+IIII[[i,j,l,k]]+IIII[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]/4-Outer[Times,in0,in0,in0,in0];
EEEE=EE/(1+νν)*(νν/(1-νν)*IIII1+IIII2);

(*stress resultants*)
F=tt*Sum[EEEE[[;;,;;,k,l]]*GG[[l,m]]*GG[[k,n]]*ϵ[[m,n]],{k,1,3},{l,1,3},{m,1,3},{n,1,3}];
M=tt^3/12*Sum[EEEE[[;;,;;,k,l]]*GG[[l,m]]*GG[[k,n]]*κ[[m,n]],{k,1,3},{l,1,3},{m,1,3},{n,1,3}];

Print[MatrixForm[Simplify[Transpose[FF].M.FF /.{α->1/2,β->1/2},{Lx>0,Ly>0}]]];

(*virtual work density*)
δwint=-Flatten[GG.F].δ[Flatten[Transpose[GG.ϵ]]]*0-Flatten[GG.M].δ[Flatten[Transpose[GG.κ]]];

δwint=-Sum[M[[i,j]]*GG[[j,l]]*GG[[i,k]]*δ[κ[[k,l]]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]-Sum[F[[i,j]]*GG[[j,l]]*GG[[i,k]]*δ[ϵ[[k,l]]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}];

δwext=δ[u00].GG.f00;

δWW=QUAD[LINE7,QUAD[LINE7,(δwint+δwext)*jac,{{α},{{0},{1}}}],{{β},{{0},{1}}}]
]/;(Dimensions[node]=={2,2} || Dimensions[node]=={3,3}|| Dimensions[node]=={4,4});


δW[MODE_,{PLATE,{{EE_,GG_,νν_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},Polygon[node_]}]:=Module[{δ,nne,enode,NN,jac,r0,rα0,rβ0,rn0,hα0,iα0,hβ0,iβ0,hn0,in0,α,β,n,nα,nβ,HH,FF,DD, Qx,Qy,δwint,δwext,δWW,u0,Θ0,ω0,fα,fβ,fn,F,M,ϵ,κ,
II0,II,IIII,IIII1,IIII2},
(*rule*)
δ[u_]:= u/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};
(*nodes*)
{nα,nβ}=Dimensions[node];
nne =nα*nβ;
enode=Flatten[node];

(*shape functions and orientation of the material axes*)
NN=Flatten[LAGRANGE[{{nα,α},{nβ,β}}]];
r0=NN.fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/2,β->1/2};
rβ0=(∂_β)r0 /.{α->1/2,β->1/2};
rn0=rα0\[Cross]rβ0;
hα0=Norm[rα0];
hβ0=Norm[rβ0];
hn0=Norm[rn0];
iα0=rα0/hα0;
iβ0=rβ0/hβ0;
in0=rn0/hn0;
jac =hn0;

(*in flat curvilinear geometry*)
HH={rα0,rβ0,in0};
FF={iα0,iβ0,in0};
DD=Inverse[HH.Transpose[FF]];

(*transform into the material system*)
u0=FF.(NN.fun[[enode,2]]);
Θ0=FF.(NN.fun[[enode,3]]);
{fα,fβ,fn}=FF.{fx,fy,fz};
ω0=Θ0\[Cross]in0;

(*strain measures*)
ϵ=DD.Transpose[D[u0,{{α,β,n}}]]+Outer[Times,in0,ω0];
κ=DD.Transpose[D[ω0,{{α,β,n}}]];

(*elasticity dyad of plate*)
II0=Outer[Times,iα0,iα0]+Outer[Times,iβ0,iβ0];
II=II0+Outer[Times,in0,in0];
IIII1=Outer[Times,II0,II0];
IIII=Sum[Outer[Times,i,j,j,i],{i,II},{j,II}];
IIII2=Table[IIII[[i,j,k,l]]+IIII[[j,i,k,l]]+IIII[[i,j,l,k]]+IIII[[j,i,l,k]],{i,1,3},{j,1,3},{k,1,3},{l,1,3}]/4-Outer[Times,in0,in0,in0,in0];
EEEE=EE/(1+νν)*(νν/(1-νν)*IIII1+IIII2);

(*stress resultants*)
F=tt*Sum[Sum[EEEE[[;;,;;,ii,jj]]*ϵϵ[[jj,ii]],{jj,1,3}],{ii,1,3}];
M=tt^3/12*Sum[Sum[EEEE[[;;,;;,ii,jj]]*κκ[[jj,ii]],{jj,1,3}],{ii,1,3}];

(*virtual work expression*)
δwint=-Flatten[δ[Transpose[ϵϵ]]].Flatten[F]-Flatten[Transpose[δ[κκ]]].Flatten[M];
δwext=δ[u0].{fα,fβ,fn};
δWW=QUAD[LINE7,QUAD[LINE7,(δwint+δwext)*jac,{{α},{{0},{1}}}],{{β},{{0},{1}}}]
]/;(Dimensions[node]=={2,2} || Dimensions[node]=={3,3}|| Dimensions[node]=={4,4});
*)




(*


δW[MODE_,{PLATEC,{{EE_,GG_,νν_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},Polygon[node_]}]:=Module[{δrule,nne,α,β,n,enode,NL,NN,r0,rα0,rβ0,jac,hα0,iα0,hβ0,iβ0,in0,HH,FF,DD},

(*rule*)
δrule={a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};

(*nodes*)
nne=Dimensions[node][[1]];
enode=Flatten[node];
 
(*shape functions*)
NL[3]={α,β,1-α-β};
NL[6]={α (-1+2 α),β (-1+2 β),1+2 (α^2)-3 β+2 (β^2)+α (-3+4 β),4 α β,-4 β (-1+α+β),-4 α (-1+α+β)};
NL[10]={1/2*α*(2-9*α+9*(α^2)),1/2* β*(2-9* β+9 *(β^2)),1/2*(2-9 (α^3)-11 β+18 (β^2)-9 (β^3)-9 *(α^2)*(-2+3*β)+α*(-11+36*β-27*(β^2))),9/2* α*(-1+3*α)*β,9/2* α*β*(-1+3*β),-9/2* β*(-1+α+β)*(-1+3*β),9/2* β*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),9/2*α*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),-9/2* α*(-1+3*α)*(-1+α+β),-27*α*β*(-1+α+β)};
NN=NL[nne];

(*mapping*)
r0=NN.fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/3.,β->1/3.};
rβ0=(∂_β)r0 /.{α->1/3.,β->1/3.};
(*for integration*)
jac=Norm[rα0\[Cross]rβ0];

hα0=Sqrt[rα0.rα0];
iα0=rα0/hα0;
rβ0=(rβ0-(rβ0.iα0)*iα0);
hβ0=Sqrt[rβ0.rβ0];
iβ0=rβ0/hβ0;
in0=iα0\[Cross]iβ0;
(*in flat curvilinear geometry*)
HH={rα0,rβ0,in0};
FF={iα0,iβ0,in0};
Print[MatrixForm[FF]];
DD=Inverse[HH.Transpose[FF]];

(*transform into the material αβn-system*)
{u,v,w}=FF.(NN.fun[[enode,2]]);
{ϕ,Θ,ψ}=FF.(NN.fun[[enode,3]]);

{δu,δv,δw}={u,v,w}/. δrule;
{fα,fβ,fn}=FF.{fx,fy,fz};

(*gradient components in the material system*)
{(Subscript[u, α]),(Subscript[u, β]),(Subscript[u, n])}=DD.{(∂_α)u,(∂_β)u,(∂_n)u};
{(Subscript[v, α]),(Subscript[v, β]),(Subscript[v, n])}=DD.{(∂_α)v,(∂_β)v,(∂_n)v};
{(Subscript[w, α]),(Subscript[w, β]),(Subscript[w, n])}=DD.{(∂_α)w,(∂_β)w,(∂_n)w};
{(Subscript[ϕ, α]),(Subscript[ϕ, β]),(Subscript[ϕ, n])}=DD.{(∂_α)ϕ,(∂_β)ϕ,(∂_n)ϕ};
{(Subscript[Θ, α]),(Subscript[Θ, β]),(Subscript[Θ, n])}=DD.{(∂_α)Θ,(∂_β)Θ,(∂_n)Θ};
{(Subscript[ψ, α]),(Subscript[ψ, β]),(Subscript[ψ, n])}=DD.{(∂_α)ψ,(∂_β)ψ,(∂_n)ψ};

(*strain measures*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(Subscript[u, α]),(Subscript[v, β]),(Subscript[v, α])-ψ,(Subscript[u, β])+ψ};
{δϵαα,δϵββ,δϵαβ,δϵβα}={ϵαα,ϵββ,ϵαβ,ϵβα} /. δrule;
{καα,κββ,καβ}={(Subscript[Θ, α]),-(Subscript[ϕ, β]),(Subscript[Θ, β])-(Subscript[ϕ, α])};
{δκαα,δκββ,δκαβ}={καα,κββ,καβ} /. δrule;
{ϵαn,ϵβn}={(Subscript[w, α])+Θ,(Subscript[w, β])-ϕ};
{δϵαn,δϵβn}={ϵαn,ϵβn}/. δrule;

(*stress resultants*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*EE/(1-νν^2)*(1-νν)*ϵαβ/2;
Nβα=tt*EE/(1-νν^2)*(1-νν)*ϵβα/2;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*EE/(1-νν^2)*(1-νν)*καβ/2;
Qα=GG*tt*ϵαn;
Qβ=GG*tt*ϵβn;

(* virtual work *)
δwint=-{δϵαα,δϵββ,δϵαβ,δϵβα}.{Nαα,Nββ,Nαβ,Nβα}-{δκαα,δκββ,δκαβ}.{Mαα,Mββ,Mαβ}-{δϵαn,δϵβn}.{Qα,Qβ} ;
δwext={δu,δv,δw}.{fα,fβ,fn};
δWW=QUAD[TRI28,(δwint+δwext)*jac,{α,β}];
Return[δWW]]/;(Dimensions[node]=={3} || Dimensions[node]=={6}|| Dimensions[node]=={10});

δW[MODE_,{PLATE,{{EE_,GG_,νν_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},Polygon[node_]}]:=Module[{δ,nα,nβ,nne,α,β,n,enode,NN,r0,rα0,rβ0,rn0,jac,hα0,iα0,hβ0,iβ0,hn0,in0,FF,u,v,w,ϕ,Θ,ψ,fα,fβ,fn,ϵαα,ϵββ,ϵαβ,ϵβα,καα,κββ,καβ,ϵαn,ϵβn,Nαα,Nββ,Nαβ,Nβα,Mαα,Mββ,Mαβ,Qα,Qβ,δwint,δwext},
(*rule*)
δ[u_]:= u/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};

(*nodes*)
{nα,nβ}=Dimensions[node];
nne =nα*nβ;
enode=Flatten[node];

(*shape functions*)
NN=LAGRANGE[{{nα,α},{nβ,β}}];

(*mapping to orthonormal material system*)
r0=NN.fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/2,β->1/2};
rβ0=(∂_β)r0 /.{α->1/2,β->1/2};
rn0=rα0\[Cross]rβ0 /.{α->1/2,β->1/2};
hα0=Norm[rα0];
iα0=rα0/hα0;
hβ0=Norm[rβ0];
iβ0=rβ0/hβ0;
hn0=Norm[rn0];
in0=rn0/hn0;
jac =hn0;

(*in flat geometry*)
FF={iα0,iβ0,in0};

(*transform into the material αβn-system*)
{u,v,w}=FF.(NN.fun[[enode,2]]);
{ϕ,Θ,ψ}=FF.(NN.fun[[enode,3]]);
{fα,fβ,fn}=FF.{fx,fy,fz};

(*strain measures with non-symmetric ϵ-part*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(∂_α)u/hα0,(∂_β)v/hβ0,(∂_α)v/hα0-ψ,(∂_β)u/hβ0+ψ};
{καα,κββ,καβ}={(∂_α)Θ/hα0,-(∂_β)ϕ/hβ0,(∂_β)Θ/hβ0-(∂_α)ϕ/hα0};
{ϵαn,ϵβn}={(∂_α)w/hα0+Θ,(∂_β)w/hβ0-ϕ};

(*stress resultants with nonsymmetric N-part*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*EE/(1-νν^2)*(1-νν)*ϵαβ/2;
Nβα=tt*EE/(1-νν^2)*(1-νν)*ϵβα/2;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*EE/(1-νν^2)*(1-νν)*καβ/2;
Qα=GG*tt*ϵαn;
Qβ=GG*tt*ϵβn;

(* virtual work *)
δwint=-δ[{ϵαα,ϵββ,ϵαβ,ϵβα}].{Nαα,Nββ,Nαβ,Nβα}-δ[{καα,κββ,καβ}].{Mαα,Mββ,Mαβ}-δ[{ϵαn,ϵβn}].{Qα,Qβ} ;
δwext=δ[{u,v,w}].{fα,fβ,fn};
δWW=QUAD[LINE7,QUAD[LINE7,(δwint+δwext)*jac,{{α},{{0},{1}}}],{{β},{{0},{1}}}]]/;(Dimensions[node]=={2,2} || Dimensions[node]=={3,3}|| Dimensions[node]=={4,4});
*)


(*
δW[MODE_,{PLATEC,{{EE_,GG_,νν_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},Polygon[node_]}]:=Module[{δ,nne,α,β,n,enode,NL,NN,r0,rα0,rβ0,jac,hα0,iα0,hβ0,iβ0,in0,HH,FF,DD},

(*rule*)
δ[u_]:=u/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};

(*nodes*)
nne=Dimensions[node][[1]];
enode=Flatten[node];
 
(*shape functions*)
NL[3]={α,β,1-α-β};
NL[6]={α (-1+2 α),β (-1+2 β),1+2 (α^2)-3 β+2 (β^2)+α (-3+4 β),4 α β,-4 β (-1+α+β),-4 α (-1+α+β)};
(*these are OK*)
NL[10]={1/2*α*(2-9*α+9*(α^2)),1/2* β*(2-9* β+9 *(β^2)),1/2*(2-9 (α^3)-11 β+18 (β^2)-9 (β^3)-9 *(α^2)*(-2+3*β)+α*(-11+36*β-27*(β^2))),9/2* α*(-1+3*α)*β,9/2* α*β*(-1+3*β),-9/2* β*(-1+α+β)*(-1+3*β),9/2* β*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),9/2*α*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),-9/2* α*(-1+3*α)*(-1+α+β),-27*α*β*(-1+α+β)};
NN=NL[nne];

(*mapping*)
r0=NN.fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/3.,β->1/3.};
rβ0=(∂_β)r0 /.{α->1/3.,β->1/3.};
rn0=rα0\[Cross]rβ0;
jac=Norm[rα0\[Cross]rβ0];
rn0=rn0/jac;
FF={rα0,rβ0,rn0};
Print[MatrixForm[FF]];
DD=Inverse[FF.Transpose[FF]];

(*transform into the material αβn-system*)
{u,v,w}=FF.(NN.fun[[enode,2]]);
{ϕ,Θ,ψ}=FF.(NN.fun[[enode,3]]);
{fα,fβ,fn}=FF.{fx,fy,fz};

(*gradient components in the material system*)
{(Subscript[u, α]),(Subscript[u, β]),(Subscript[u, n])}=DD.{(∂_α)u,(∂_β)u,(∂_n)u};
{(Subscript[v, α]),(Subscript[v, β]),(Subscript[v, n])}=DD.{(∂_α)v,(∂_β)v,(∂_n)v};
{(Subscript[w, α]),(Subscript[w, β]),(Subscript[w, n])}=DD.{(∂_α)w,(∂_β)w,(∂_n)w};
{(Subscript[ϕ, α]),(Subscript[ϕ, β]),(Subscript[ϕ, n])}=DD.{(∂_α)ϕ,(∂_β)ϕ,(∂_n)ϕ};
{(Subscript[Θ, α]),(Subscript[Θ, β]),(Subscript[Θ, n])}=DD.{(∂_α)Θ,(∂_β)Θ,(∂_n)Θ};
{(Subscript[ψ, α]),(Subscript[ψ, β]),(Subscript[ψ, n])}=DD.{(∂_α)ψ,(∂_β)ψ,(∂_n)ψ};

(*strain measures*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(Subscript[u, α]),(Subscript[v, β]),(Subscript[v, α])-ψ,(Subscript[u, β])+ψ};
{καα,κββ,καβ}={(Subscript[Θ, α]),-(Subscript[ϕ, β]),(Subscript[Θ, β])-(Subscript[ϕ, α])};
{ϵαn,ϵβn}={(Subscript[w, α])+Θ,(Subscript[w, β])-ϕ};

(*stress resultants*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*EE/(1-νν^2)*(1-νν)*ϵαβ/2;
Nβα=tt*EE/(1-νν^2)*(1-νν)*ϵβα/2;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*EE/(1-νν^2)*(1-νν)*καβ/2;
Qα=GG*tt*ϵαn;
Qβ=GG*tt*ϵβn;

(* virtual work *)
δwint=-δ[{ϵαα,ϵββ,ϵαβ,ϵβα}].{Nαα,Nββ,Nαβ,Nβα}-δ[{καα,κββ,καβ}].{Mαα,Mββ,Mαβ}-{δϵαn,δϵβn}.{Qα,Qβ} ;
δwext=δ[{u,v,w}].{fα,fβ,fn};
δWW=QUAD[TRI28,(δwint+δwext)*jac,{α,β}];
Return[δWW]]/;(Dimensions[node]=={3} || Dimensions[node]=={6}|| Dimensions[node]=={10});


*)



(*
δW[MODE_,{PLATE,{{EE_,GG_,νν_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},Polygon[node_]}]:=Module[{δrule,nne,α,β,n,enode,NL,NN,r0,rα0,rβ0,jac,hα0,iα0,hβ0,iβ0,in0},

(*rule*)
δrule={a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};

(*nodes*)
nne=Dimensions[node][[1]];
enode=Flatten[node];
 
(*shape functions*)
NL[3]={α,β,1-α-β};
NL[6]={α (-1+2 α),β*(-1+2 β),1+2 (α^2)-3 β+2 (β^2)+α (-3+4 β),4 α β,-4 β (-1+α+β),-4 α (-1+α+β)};
NL[10]={1/2*α*(2-9 α+9 (α^2)),1/2*β*(2-9 β+9 (β^2)),1/2*(2-9 (α^3)-11 β+18 (β^2)-9 (β^3)-9 (α^2) (-2+3 β)+α (-11+36 β-27 (β^2))),9/2* α (-1+3 α) β,9/2* α β (-1+3 β),-9/2* β (-1+α+β) (-1+3 β),9/2* β (2+3 (α^2)-5 β+3 (β^2)+α (-5+6 β)),9/2* α (2+3 (α^2)-5 β+3 (β^2)+α (-5+6 β)),-9/2* α (-1+3 α) (-1+α+β),-27 α β (-1+α+β)};
NN=NL[nne];

r0=NN.fun[[enode,1]];
rα0=(∂_α)r0 /.{α->1/3,β->1/3};
rβ0=(∂_β)r0 /.{α->1/3,β->1/3};
(*for integration*)
jac=Norm[rα0\[Cross]rβ0];

hα0=Sqrt[rα0.rα0];
iα0=rα0/hα0;
rβ0=(rβ0-(rβ0.iα0)*iα0);
hβ0=Sqrt[rβ0.rβ0];
iβ0=rβ0/hβ0;
in0=iα0\[Cross]iβ0;
(*in flat curvilinear geometry*)
HH={rα0,rβ0,in0};
FF={iα0,iβ0,in0};
DD=Inverse[HH.Transpose[FF]];

(*transform into the material system*)
{u,v,w}=NN.Map[FF.#&,fun[[enode,2]]];
{ϕ,Θ,ψ}=NN.Map[FF.#&,fun[[enode,3]]];
{δu,δv,δw}={u,v,w}/. δrule;
{fα,fβ,fn}=FF.{fx,fy,fz};

(*gradient components in the material system*)
{(Subscript[u, α]),(Subscript[u, β]),(Subscript[u, n])}=DD.{(∂_α)u,(∂_β)u,(∂_n)u};
{(Subscript[v, α]),(Subscript[v, β]),(Subscript[v, n])}=DD.{(∂_α)v,(∂_β)v,(∂_n)v};
{(Subscript[w, α]),(Subscript[w, β]),(Subscript[w, n])}=DD.{(∂_α)w,(∂_β)w,(∂_n)w};
{(Subscript[ϕ, α]),(Subscript[ϕ, β]),(Subscript[ϕ, n])}=DD.{(∂_α)ϕ,(∂_β)ϕ,(∂_n)ϕ};
{(Subscript[Θ, α]),(Subscript[Θ, β]),(Subscript[Θ, n])}=DD.{(∂_α)Θ,(∂_β)Θ,(∂_n)Θ};
{(Subscript[ψ, α]),(Subscript[ψ, β]),(Subscript[ψ, n])}=DD.{(∂_α)ψ,(∂_β)ψ,(∂_n)ψ};

(*strain measures*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(Subscript[u, α]),(Subscript[v, β]),(Subscript[v, α])-ψ,(Subscript[u, β])+ψ};
{δϵαα,δϵββ,δϵαβ,δϵβα}={ϵαα,ϵββ,ϵαβ,ϵβα} /. δrule;
{καα,κββ,καβ}={(Subscript[Θ, α]),-(Subscript[ϕ, β]),(Subscript[Θ, β])-(Subscript[ϕ, α])};
{δκαα,δκββ,δκαβ}={καα,κββ,καβ} /. δrule;
{ϵαn,ϵβn}={(Subscript[w, α])+Θ,(Subscript[w, β])-ϕ};
{δϵαn,δϵβn}={ϵαn,ϵβn}/. δrule;

(*stress resultants*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*EE/(1-νν^2)*(1-νν)*ϵαβ/2;
Nβα=tt*EE/(1-νν^2)*(1-νν)*ϵβα/2;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*EE/(1-νν^2)*(1-νν)*καβ/2;
Qα=GG*tt*ϵαn;
Qβ=GG*tt*ϵβn;

(* virtual work *)
δwint1=-{δϵαα,δϵββ,δϵαβ,δϵβα}.{Nαα,Nββ,Nαβ,Nβα}-{δκαα,δκββ,δκαβ}.{Mαα,Mββ,Mαβ}-{δϵαn,δϵβn}.{Qα,Qβ} *0;
δwint2=-{δϵαα,δϵββ,δϵαβ,δϵβα}.{Nαα,Nββ,Nαβ,Nβα}*0-{δκαα,δκββ,δκαβ}.{Mαα,Mββ,Mαβ}*0-{δϵαn,δϵβn}.{Qα,Qβ} ;
δwext={δu,δv,δw}.{fα,fβ,fn};
δWW=QUAD[TRI12,(δwint1+δwext)*jac,{α,β}]+QUAD[TRI7,(δwint2)*jac,{α,β}];
Return[δWW]]/;(Dimensions[node]=={3} || Dimensions[node]=={6}|| Dimensions[node]=={10});
*)

(* Orthotropic plate (R-M)
δW[MODE_,{PLATE,{{E1_,E2_,G12_,G13_,G23_,ν12_,ρρ_},{tt_},{fx_,fy_,fz_,mx_,my_,mz_}},node_}]:=Module[{δrule,rule,nξ,nη,nne,ver,NN,FFT,dNN,FFTI,Nx,Ny,dΩ,xx,yy,uu,uux,uuy,δuu,δuux,δuuy,vv,vvx,vvy,δvv,δvvx,δvvy,ww,wwx,wwy,δww,δwwx,δwwy,ϕϕ,ϕϕx,ϕϕy,δϕϕ,δϕϕx,δϕϕy,ΘΘ,ΘΘx,ΘΘy,δΘΘ,δΘΘx,δΘΘy,ψψ,ψψx,ψψy,δψψ,δψψx,δψψy,aa,δaa,ν21,DD,GGG,Nxx,Nyy,Nxy,Nyx,Mxx,Myy,Mxy,Qx,Qy,δwint,δwext,δwext2,x1,y1,x2,y2,ξ0,η0,ξ1,η1,δWW,AA,sigxx,sigyy,
sigxy,sigxz,sigyz},
δrule={a[any__] -> δa[any],b[any__] -> δb[any]};

(* number of nodes in element *)
{nη,nξ}=Dimensions[node];
nne =nξ*nη;

(* shape functions *)
NN=LAGRANGE[{{nξ,ξ},{nη,η}}];
rule=RULE2[NN,Flatten[node]];

(* tranformation to material coordinates *)
FFT =Simplify[({iξ*hξ,iη*hη,iζ*hζ} /.rule)[[1;;2,1;;2]]];
FFT=FFT/.{ξ->1/2,η->1/2};
dNN=Transpose[{D[NN,ξ],D[NN,η]}];
FFTI=Inverse[FFT];
{Nx,Ny}=Transpose[Map[FFTI.#&,dNN]];
dΩ=Det[FFT];

aa=Array[x,nne]/.rule; xx=NN . aa;
aa=Array[y,nne]/.rule; yy=NN . aa;
aa=Array[ux,nne]/.rule; δaa=aa/.δrule;
uu=NN . aa; δuu=NN . δaa;uux=Nx . aa; δuux=Nx . δaa;uuy=Ny . aa; δuuy=Ny . δaa;
aa=Array[uy,nne]/.rule; δaa=aa/.δrule;
vv=NN . aa; δvv=NN . δaa;vvx=Nx . aa; δvvx=Nx . δaa;vvy=Ny . aa; δvvy=Ny . δaa;
aa=Array[uz,nne]/.rule; δaa=aa/.δrule;
ww=NN . aa; δww=NN . δaa;wwx=Nx . aa; δwwx=Nx . δaa;wwy=Ny . aa; δwwy=Ny . δaa;
aa=Array[Θx,nne]/.rule; δaa=aa/.δrule;
ϕϕ=NN . aa; δϕϕ=NN . δaa;ϕϕx=Nx . aa; δϕϕx=Nx . δaa;ϕϕy=Ny . aa; δϕϕy=Ny . δaa;
aa=Array[Θy,nne]/.rule; δaa=aa/.δrule;
ΘΘ=NN . aa; δΘΘ=NN . δaa;ΘΘx=Nx . aa; δΘΘx=Nx . δaa;ΘΘy=Ny . aa; δΘΘy=Ny . δaa;
aa=Array[Θz,nne]/.rule; δaa=aa/.δrule;
ψψ=NN . aa; δψψ=NN . δaa;ψψx=Nx . aa; δψψx=Nx . δaa;ψψy=Ny . aa; δψψy=Ny . δaa;

(* stress resultants *)
ν21=E2/E1*ν12;
DD=(tt^3/12)/(1-ν12*ν21);
HH=tt/(1-ν12*ν21);
Nxx=HH*E1*(uux+ν21*vvy);
Nyy=HH*E2*(vvy+ν12*uux);
Nxy=G12*tt*(vvx-ψψ);
Nyx=G12*tt*(uuy+ψψ);
Mxx=DD*E1*(ΘΘx-ν21*ϕϕy);
Myy=DD*E2*(-ϕϕy+ν12*ΘΘx);
Mxy=G12*tt^3/12*(ΘΘy-ϕϕx);
Qx=G13*tt*(wwx+ΘΘ);
Qy=G23*tt*(wwy-ϕϕ);

If[MODE==POSTP,
(* post processing *)
AA=1/(1-ν12*ν21);
(* stresses *)
sigxx=E1*AA*((uux+ν21*vvy)+zz*(ΘΘx-ν21*ϕϕy));
sigyy=E2*AA*((vvy+ν12*uux)+zz*(-ϕϕy+ν12*ΘΘx));
sigxy=G12*((uuy+vvx)+zz*(ΘΘy-ϕϕx));
sigxz=G13*(wwx+ΘΘ);
sigyz=G23*(wwy-ϕϕ);
Return[{x->xx,y->yy,u->uu,v->vv,w->ww,NXX->Nxx,NXY->Nxy,NYX->Nyx,NYY->Nyy,MXX->Mxx,MXY->Mxy,MYY->Myy,QX->Qx,QY->Qy,SXX->sigxx,SYY->sigyy,SXY->sigxy,
SXZ->sigxz,SYZ->sigyz} ]];
If[MODE==DISP,
(* virtual work *)
δwint=-{δuux,δvvy,δvvx-δψψ,δuuy+δψψ}.{Nxx,Nyy,Nxy,Nyx};
δwint+=-{δΘΘx,-δϕϕy,δΘΘy-δϕϕx}.{Mxx,Myy,Mxy};
δwint+=-{δwwx+δΘΘ,δwwy-δϕϕ}.{Qx,Qy};
δwext={δuu,δvv}.({fx,fy}/.{x->xx,y->yy});
δwext+={δϕϕ,δΘΘ,δψψ}.({mx,my,mz}/.{x->xx,y->yy});
δWW=QUAD[LINE7,QUAD[LINE7,(δwint+δwext)*dΩ,{{ξ},{{0},{1}}}],{{η},{{0},{1}}}];
δwext2=δww*(fz[[1]]/.{x->xx,y->yy});
{x1,y1}=XY[node[[1,1]]];
{x2,y2}=XY[node[[-1,-1]]];
If[fz[[2,1,1]]≤x1,ξ0=0,ξ0=(fz[[2,1,1]]-x1)/(x2-x1)];
If[fz[[2,1,2]]≤y1,η0=0,η0=(fz[[2,1,2]]-y1)/(y2-y1)];
If[fz[[2,-1,1]]≥x2,ξ1=1,ξ1=(fz[[2,-1,1]]-x1)/(x2-x1)];
If[fz[[2,-1,2]]≥y2,η1=1,η1=(fz[[2,-1,2]]-y1)/(y2-y1)];
δWW+=QUAD[LINE7,QUAD[LINE7,δwext2*dΩ,{{ξ},{{ξ0},{ξ1}}}],{{η},{{η0},{η1}}}];
Return[δWW]]
] /;(MODE== DISP || MODE== POSTP );

*)

SHELL ELEMENT defs

δW[DISP,{SHELL,{{EE_,νν_},{tt_},{fx_,fy_,fz_}},ELEMENT[node_]},fun_]:=Module[{nα,nβ,α,β,NN,r,rα,rβ,rn,jac,hα,eα,hβ,eβ,en,FF,u,v,w,ϕ,Θ,ψ,fα,fβ,fn,ϵαα,ϵββ,ϵαβ,ϵβα,καα,κββ,καβ,γα,γβ,GG,Nαα,Nββ,Nαβ,Nβα,Mαα,Mββ,Mαβ,Qα,Qβ,δwint,δwext},

(*shape functions*)
NN={1/2*α*(2-9*α+9*(α^2)),1/2* β*(2-9* β+9 *(β^2)),1/2*(2-9 (α^3)-11 β+18 (β^2)-9 (β^3)-9 *(α^2)*(-2+3*β)+α*(-11+36*β-27*(β^2))),9/2* α*(-1+3*α)*β,9/2* α*β*(-1+3*β),-9/2* β*(-1+α+β)*(-1+3*β),9/2* β*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),9/2*α*(2+3*(α^2)-5*β+3*(β^2)+α*(-5+6*β)),-9/2* α*(-1+3*α)*(-1+α+β),-27*α*β*(-1+α+β)};

(*mapping to orthonormal material system*)
r=NN.fun[[node,1]];
rα=(∂_α)r /.{α->1/3,β->1/3};
hα=Norm[rα];eα=rα/hα;
rβ=(∂_β)r /.{α->1/3,β->1/3};
rβ=rβ-(rβ.eα)*eα;
hβ=Norm[rβ];eβ=rβ/hβ;
en=eα\[Cross]eβ;
jac =hα*hβ;

(*in flat geometry*)
FF={eα,eβ,en};

(*transform into the material αβn-system*)
{u,v,w}=FF.(NN.fun[[node,2]]);
{ϕ,Θ,ψ}=FF.(NN.fun[[node,3]]);
{fα,fβ,fn}=FF.{fx,fy,fz};

(*strain measures with non-symmetric ϵ-part*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(∂_α)u/hα,(∂_β)v/hβ,(∂_α)v/hα-ψ,(∂_β)u/hβ+ψ};
{καα,κββ,καβ}={(∂_α)Θ/hα,-(∂_β)ϕ/hβ,(∂_β)Θ/hβ-(∂_α)ϕ/hα};
{γα,γβ}={(∂_α)w/hα+Θ,(∂_β)w/hβ-ϕ};

GG=EE/(2+2*νν);
(*stress resultants with a nonsymmetric N-part*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*GG*ϵαβ;
Nβα=tt*GG*ϵβα;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*GG*καβ;
Qα=5/6*GG*tt*γα;
Qβ=5/6*GG*tt*γβ;

(* virtual work *)
δwint=-δ[{ϵαα,ϵββ,ϵαβ,ϵβα}].{Nαα,Nββ,Nαβ,Nβα}-δ[{καα,κββ,καβ}].{Mαα,Mββ,Mαβ}-δ[{γα,γβ}].{Qα,Qβ} ;
δwext=δ[{u,v,w}].{fα,fβ,fn};
QUAD[TRI28,(δwint+δwext)*jac,{α,β}]]/; Dimensions[node]=={10};


δW[DISP,{SHELL,{{EE_,νν_},{tt_},{fx_,fy_,fz_}},ELEMENT[node_]},fun_]:=Module[{nα,nβ,nne,α,β,n,enode,NN,r,rα,rβ,rn,jac,hα,eα,hβ,eβ,en,FF,u,v,w,ϕ,Θ,ψ,fα,fβ,fn,ϵαα,ϵββ,ϵαβ,ϵβα,καα,κββ,καβ,γα,γβ,GG,Nαα,Nββ,Nαβ,Nβα,Mαα,Mββ,Mαβ,Qα,Qβ,δwint,δwext},

(*nodes*)
{nα,nβ}=Dimensions[node];
nne =nα*nβ;
enode=Flatten[node];

(*shape functions*)
NN=LAGRANGE[{{nα,α},{nβ,β}}];

(*mapping to orthonormal material system*)
r=NN.fun[[enode,1]];
rα=(∂_α)r /.{α->1/2,β->1/2};
hα=Norm[rα];eα=rα/hα;
rβ=(∂_β)r /.{α->1/2,β->1/2};
rβ=rβ-(rβ.eα)*eα;
hβ=Norm[rβ];eβ=rβ/hβ;
en=eα\[Cross]eβ;
jac =hα*hβ;

(*in flat geometry*)
FF={eα,eβ,en};

(*transform into the material αβn-system*)
{u,v,w}=FF.(NN.fun[[enode,2]]);
{ϕ,Θ,ψ}=FF.(NN.fun[[enode,3]]);
{fα,fβ,fn}=FF.{fx,fy,fz};

(*strain measures with non-symmetric ϵ-part*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(∂_α)u/hα,(∂_β)v/hβ,(∂_α)v/hα-ψ,(∂_β)u/hβ+ψ};
{καα,κββ,καβ}={(∂_α)Θ/hα,-(∂_β)ϕ/hβ,(∂_β)Θ/hβ-(∂_α)ϕ/hα};
{γα,γβ}={(∂_α)w/hα+Θ,(∂_β)w/hβ-ϕ};

GG=EE/(2+2*νν);
(*stress resultants with a nonsymmetric N-part*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*GG*ϵαβ;
Nβα=tt*GG*ϵβα;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*GG*καβ;
Qα=5/6*GG*tt*γα;
Qβ=5/6*GG*tt*γβ;

(* virtual work *)
δwint=-δ[{ϵαα,ϵββ,ϵαβ,ϵβα}].{Nαα,Nββ,Nαβ,Nβα}-δ[{καα,κββ,καβ}].{Mαα,Mββ,Mαβ}-δ[{γα,γβ}].{Qα,Qβ} ;
δwext=δ[{u,v,w}].{fα,fβ,fn};
QUAD[LIN7,QUAD[LIN7,(δwint+δwext)*jac,α],β]]/; Dimensions[node]=={4,4};

SOLID ELEMENT defs

δW[{SOLID,{{EE_,νν_},{fX_,fY_,fZ_}},Tetrahedron[node_]}]:=δW[MODE,{SOLID,{{EE,νν},{fX,fY,fZ}},Tetrahedron[node]},fun];

δW[{SOLID,{{EE_,νν_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Tetrahedron[node_]}]:=δW[MODE,{SOLID,{{EE,νν},{fX,fY,fZ,mX,mY,mZ}},Tetrahedron[node]},fun];

δW[MODE_,{SOLID,{{EE_,νν_},{fX_,fY_,fZ_}},Tetrahedron[{I1_,I2_,I3_,I4_}]},fun_]:=Module[{ns,NN,r,FF,PP,uvw,ϕθψ,Duvw,σσ,σ,ρ,δww,δWW,EEEE,δwσ,δwint,δwext,e,ee,ϵ,EM,GM,GG,nl,jac,FFINV},

nl={I1,I2,I3,I4};
(*shape functions*)
NN={α,β,γ,1-α-β-γ};

(*assuming a linear mapping*)
r=NN.fun[[nl,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r};
FFINV=Simplify[Inverse[FF],L>0&&h>0];
jac=Simplify[Abs[Det[FF]],L>0&&h>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];

(*displacement gradient*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};

(*symmetric elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GG=EE/(2+2*νν);
GM=Inverse[{{1/GG,0,0},{0,1/GG,0},{0,0,1/GG}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];

(*nonsymmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwint=-Flatten[δ[ϵ]].Flatten[σ];
δwext=δ[uvw].{fX,fY,fZ};
QUAD[TET5,(δwext+δwint)*jac,{α,β,γ}]
];


δW[{SOLID,{{EE_,νν_},{fX_,fY_,fZ_}},Hexahedron[node_]}]:=δW[MODE,{SOLID,{{EE,νν},{fX,fY,fZ}},Hexahedron[node]},fun];

δW[MODE_,{SOLID,{{EE_,νν_},{fX_,fY_,fZ_}},Hexahedron[{I1_,I2_,I3_,I4_,I5_,I6_,I7_,I8_}]},fun_]:=Module[{ns,NN,r,FF,PP,uvw,ϕθψ,Duvw,σσ,σ,ρ,δww,δWW,EEEE,δwσ,e,ee,EM,GM,GG,nl,jac,FFINV,ϵ,δwext,δwint},

nl={I1,I2,I3,I4,I5,I6,I7,I8};
(*shape functions*)
NN={(1-α)(1-β)(1-γ),α(1-β)(1-γ),(1-α)β(1-γ),α β(1-γ),(1-α)(1-β)γ,α(1-β)γ,(1-α)β γ,α β γ};

(*assuming a linear mapping*)
r=NN.fun[[nl,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r} /. {α->1/2,β ->1/2,γ->1/2};
FFINV=Simplify[Inverse[FF],L>0];
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];

(*displacement gradient*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};

(*symmetric elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GG=EE/(2+2*νν);
GM=Inverse[{{1/GG,0,0},{0,1/GG,0},{0,0,1/GG}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];

(*nonsymmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uvw].{fX,fY,fZ};
QUAD[HEX27,(δwext+δwint)*jac,{α,β,γ}]
];


δW[MODE_,{SOLID,{{EE_,νν_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Tetrahedron[{I1_,I2_,I3_,I4_}]},fun_]:=Module[{ns,NN,r,FF,FFINV,jac,PP,uvw,ϕθψ,Duvw,σσ,σ,ρ,δww,δWW,EEEE,δwσ,e,ee,EM,GM,GG,nl,δwint,δwext,ϵ},

nl={I1,I2,I3,I4};
(*shape functions*)
NN={α,β,γ,1-α-β-γ};

r=NN.fun[[nl,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r};
FFINV=Inverse[FF];
PP=LeviCivitaTensor[3]; 
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];
ϕθψ=NN.fun[[nl,3]];

(*displacement gradient*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw}-PP.ϕθψ;

(*symmetric elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GG=EE/(2+2*νν);
GM=Inverse[{{1/GG,0,0},{0,1/GG,0},{0,0,1/GG}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]],ee[[2,1]]] +
GM[[1,1]]*Outer[Times,ee[[2,1]],ee[[1,2]]] +GM[[2,2]]*Outer[Times,ee[[2,3]],ee[[3,2]]] +
GM[[2,2]]*Outer[Times,ee[[3,2]],ee[[2,3]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]],ee[[1,3]]]+
GM[[3,3]]*Outer[Times,ee[[1,3]],ee[[3,1]]]];

(*nonsymmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwint=-Flatten[δ[ϵ]].Flatten[σ];
δwext=δ[uvw].{fX,fY,fZ}+δ[ϕθψ].{mX,mY,mZ};
QUAD[TET5,(δwext+δwint)*jac,{α,β,γ}]
];

(*

δW[MODE_,{SOLIDB,{{EE_,νν_},{fX_,fY_,fZ_,mX_,mY_,mZ_}},Tetrahedron[{I1_,I2_,I3_,I4_}]}]:=Module[{δ,ns,NN,r,FF,FFINV,PP,jac,uvw,ϕθψ,Duvw,δuvw,δDuvw,δλλ,σσ,σ,ρ,δww,δWW,e1,e2,e3,EEEE,IIII,II,IIII1,IIII2,δwσ},

(*shape functions*)
NN={α,β,γ,1-α-β-γ};

(*assuming a linear mapping*)
r=NN.fun[[node,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r}/.{α->1/3,β->1/3,γ->1/3};
FFINV =Inverse[FF];
PP=LeviCivitaTensor[3]; 
jac=Abs[Det[FF]];

(*approximations in structural system*) 
uvw=NN.fun[[node,2]];
ϕθψ=NN.fun[[node,3]];

(*nonsymmetric strain in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw}-PP.ϕθψ;

(*nonsymmetric elasticity dyad*)
II={{1,0,0},{0,1,0},{0,0,1}};
IIII1=Outer[Times,II,II];
IIII2=Sum[Outer[Times,i,j,j,i],{i,II},{j,II}];
EEEE=EE/(1+νν)*(νν/(1-2*νν)*IIII1+IIII2);

(*nonsymmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uvw].{fX,fY,fZ}+δ[ϕθψ].{mX,mY,mZ};
δWW=QUAD[TET5,(δwext+δwint)*jac,{α,β,γ}]
];



δW[MODE_,{SOLID,{{EE_,νν_},{fX_,fY_,fZ_}},ELEMENT[node_]}]:=Module[{δ,nα,nβ,nγ,enode,α,β,γ,NN,r,FF,FFINV,PP,jac,uvw,ϕθψ,ϵ,σ,EEEE,IIII,II,IIII1,IIII2,δwint,δwext},
δ[u_]:=u/.{a[any__] -> δa[any],b[any__] -> δb[any],c[any__] -> δc[any]};

(*nodes*)
{nγ,nβ,nα}=Dimensions[node];
enode=Flatten[node];
NN=Flatten[LAGRANGE[{{nα,α},{nβ,β},{nγ,γ}}]];

(*assuming a linear mapping*)
r=NN.fun[[enode,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r}/.{α->1/2,β->1/2,γ->1/2};
FFINV =Inverse[FF];
PP=LeviCivitaTensor[3]; 
jac=Abs[Det[FF]];

(*approximations in structural system*) 
uvw=NN.fun[[enode,2]];
ϕθψ=NN.fun[[enode,3]];

(*nonsymmetric strain in the structural system*)
ϵ=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw}-PP.ϕθψ;

(*nonsymmetric elasticity dyad*)
II={{1,0,0},{0,1,0},{0,0,1}};
IIII1=Outer[Times,II,II];
IIII2=Sum[Outer[Times,i,j,j,i],{i,II},{j,II}];
EEEE=EE/(1+νν)*(νν/(1-2*νν)*IIII1+IIII2);

(*nonsymmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uvw].{fX,fY,fZ};
QUAD[LIN7,QUAD[LIN7,QUAD[LIN7,(δwext+δwint)*jac,{α}],{β}],{γ}]
];

*)


δW[{SOLID,{{EE_,νν_,ρρ_},{fX_,fY_,fZ_}},Tetrahedron[node_]}]:=δW[VIBR,{SOLID,{{EE,νν,ρρ},{fX,fY,fZ}},Tetrahedron[node]},fun];

δW[VIBR,{SOLID,{{EE_,νν_,ρρ_},{fX_,fY_,fZ_}},Tetrahedron[{I1_,I2_,I3_,I4_}]},fun_]:=Module[{ns,NN,r,FF,PP,uvw,uvw0,uvw2,Duvw,ϵ,σ,δww,δWW,EEEE,δwσ,e,ee,EM,GM,GG,nl,jac,FFINV,δwext,δwint,δwine},

nl={I1,I2,I3,I4};
(*shape functions*)
NN={α,β,γ,1-α-β-γ};

(*assuming a linear mapping*)
r=NN.fun[[nl,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r};
FFINV=Simplify[Inverse[FF],L>0];
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];
uvw0= uvw/.{ anya_[any_] -> anya[any,0]};
uvw2= uvw /.{ anya_[any_] ->anya[any,2]};

(*displacement gradient*)
ϵ=FFINV.{(∂_α)uvw0,(∂_β)uvw0,(∂_γ)uvw0};

(*symmetric elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GG=EE/(2+2*νν);
GM=Inverse[{{1/GG,0,0},{0,1/GG,0},{0,0,1/GG}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];

(*symmetric stress*)
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwext=-Flatten[δ[ϵ]].Flatten[σ];
δwint=δ[uvw0].{fX,fY,fZ};
δwine=-δ[uvw0].(ρρ uvw2);
QUAD[TET5,(δwext+δwint+δwine)*jac,{α,β,γ}]
];


δW[NONL,{SOLID,{{EE_,νν_},{fX_,fY_,fZ_}},Tetrahedron[{I1_,I2_,I3_,I4_}]},fun_]:=Module[{nl,NN,r,FF,uvw,DG,GL,δGL,SS,δwext,δwint,EEEE,e,ee,EM,GM,GG,jac,FFINV},

nl={I1,I2,I3,I4};
(*shape functions*)
NN={α,β,γ,1-α-β-γ};

(*assuming a linear mapping*)
r=NN.fun[[nl,1]];  
FF={(∂_α)r,(∂_β)r,(∂_γ)r};
FFINV=Simplify[Inverse[FF],L>0];
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];

(*displacement gradient*)
DG=FFINV.{(∂_α)uvw,(∂_β)uvw,(∂_γ)uvw};
GL=(DG+Transpose[DG]+DG.Transpose[DG])/2;
δGL=(δ[DG]+Transpose[δ[DG]]+δ[DG].Transpose[DG]+DG.Transpose[δ[DG]])/2;

(*symmetric elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GG=EE/(2+2*νν);
GM=Inverse[{{1/GG,0,0},{0,1/GG,0},{0,0,1/GG}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];

(*PK2 stress*)
SS=Sum[EEEE[[;;,;;,i,j]]*GL[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwint=-Flatten[δGL].Flatten[SS];
δwext=δ[uvw].{fX,fY,fZ};
QUAD[TET5,(δwext+δwint)*jac,{α,β,γ}]
];


δW[DISP,{SOLID,{{EE_,νν_,αα_,kk_},{fX_,fY_,fZ_,ss_,ϑ0_}},Tetrahedron[{I1_,I2_,I3_,I4_}]},fun_]:=Module[{nl,NN,r,FF,uvw,ϑϑ,Duvw,Dϑϑ,σ,ρ,δww,δWW,EEEE,δwσ,ϵ,e,ee,EM,GM,GG,jac,FFINV,δwext,δwint,δpext,δpint},

nl={I1,I2,I3,I4};
(*shape functions*)
NN={ξ,η,ζ,1-ξ-η-ζ};

(*assuming a linear mapping*)
r=NN.fun[[nl,1]];  
FF={(∂_ξ)r,(∂_η)r,(∂_ζ)r};
FFINV=Simplify[Inverse[FF],L>0];
jac=Simplify[Abs[Det[FF]],L>0];

(*approximations in structural system*) 
uvw=NN.fun[[nl,2]];
ϑϑ=NN.fun[[nl,4]];

(*gradients*)
Duvw=FFINV.{(∂_ξ)uvw,(∂_η)uvw,(∂_ζ)uvw};
Dϑϑ=FFINV.{(∂_ξ)ϑϑ,(∂_η)ϑϑ,(∂_ζ)ϑϑ};

(*symmetric elasticity dyad*)
e={{1,0,0},{0,1,0},{0,0,1}}; 
ee=Table[Outer[Times,e1,e2],{e1,e},{e2,e}];
EM=Inverse[{
{1/EE,-νν/EE,-νν/EE},
{-νν/EE,1/EE,-νν/EE},
{-νν/EE,-νν/EE,1/EE}}];
GG=EE/(2+2*νν);
GM=Inverse[{{1/GG,0,0},{0,1/GG,0},{0,0,1/GG}}];
EEEE=Simplify[Sum[EM[[i,j]]*Outer[Times,ee[[i,i]],ee[[j,j]]],{i,1,3},{j,1,3}]+
GM[[1,1]]*Outer[Times,ee[[1,2]]+ee[[2,1]],ee[[1,2]]+ee[[2,1]]] +GM[[2,2]]*Outer[Times,ee[[2,3]]+ee[[3,2]],ee[[2,3]]+ee[[3,2]]] +
GM[[3,3]]*Outer[Times,ee[[3,1]]+ee[[1,3]],ee[[3,1]]+ee[[1,3]]]];

(*nonsymmetric stress*)
ϵ=Duvw-IdentityMatrix[3]*αα*(ϑϑ-ϑ0);
σ=Sum[EEEE[[;;,;;,i,j]]*ϵ[[j,i]],{i,1,3},{j,1,3}];

(*virtual work expression*)
δwext=-Flatten[δδ[Duvw]].Flatten[σ];
δwint=δδ[uvw].{fX,fY,fZ};
δpint=-δδ[Dϑϑ].Dϑϑ*kk;
δpext= δδ[ϑϑ]*ss;
QUAD[TET5,(δwext+δwint+δpext+δpint)*jac,{ξ,η,ζ}]
];

Element needs 1005

(*force element*)

δW[VIBR,{FORCE,{{ρ_},{lx_,ly_,lz_,ix_,iy_},{FX_,FY_,FZ_,MX_,MY_,MZ_}},Point[{I1_}]},fun_]:= Module[{m,J,ux,uy,uz,T},
m=ρ*lx*ly*lz;
J=m*{{lx^2+lz^2,0,0},{0,ly^2+lz^2,0},{0,0,lx^2+ly^2}}/12;
T={ix,iy,ix\[Cross]iy};
({FX,FY,FZ}-m * T. fun[[I1,2]]/.DRULE[2]). δ[T.fun[[I1,2]]/.DRULE[0]] +
({MX,MY,MZ}-J. T.fun[[I1,3]]/.DRULE[2]).δ[T.fun[[I1,3]]/.DRULE[0]]
];

δW[VIBR,{RIGID,{},Line[{I1_,I2_}]},fun_]:=
δ[(fun[[I2,2]]-fun[[I1,2]])/.DRULE[0]].({FX[{I2,I1}],FY[{I2,I1}],FZ[{I2,I1}]}/.DRULE[0])+
((fun[[I2,2]]-fun[[I1,2]])/.DRULE[0]).δ[{FX[{I2,I1}],FY[{I2,I1}],FZ[{I2,I1}]}/.DRULE[0]]+

δ[(fun[[I2,3]]-fun[[I1,3]])/.DRULE[0]].({MX[{I2,I1}],MY[{I2,I1}],MZ[{I2,I1}]}/.DRULE[0]) +
((fun[[I2,3]]-fun[[I1,3]])/.DRULE[0]).δ[{MX[{I2,I1}],MY[{I2,I1}],MZ[{I2,I1}]}/.DRULE[0]];

δW[VIBR,{FORCE,{{m_,J_},{FX_,FY_,FZ_,MX_,MY_,MZ_}},Point[{I1_}]},fun_]:=
({FX,FY,FZ}-m  fun[[I1,2]]/.DRULE[2]). δ[fun[[I1,2]]/.DRULE[0]] +
({MX,MY,MZ}-J.fun[[I1,3]]/.DRULE[2]).δ[fun[[I1,3]]/.DRULE[0]];

δW[DISP,{BEAM,{{EE_,GG_,κκ_},{{d_,t_},iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[DISP,{BEAM,{{EE,GG,κκ},{ d π t, d π t ((d^2)+(t^2))/8, d π t ((d^2)+(t^2))/8,iy0},{fx,fy,fz}},Line[{n1,n2}]},fun];

δW[DISP,{BEAM,{{EE_,GG_,κκ_},{d_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[DISP,{BEAM,{{EE,GG,κκ},{Pi*d^2/4,Pi*d^4/64,Pi*d^4/64,iy0},{fx,fy,fz}},Line[{n1,n2}]},fun];

δW[DISP,{BEAM,{{EE_,GG_,κκ_},{hy_,hz_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[DISP,{BEAM,{{EE,GG,κκ},{hy*hz,hz^3*hy/12,hy^3*hz/12,iy0},{fx,fy,fz}},Line[{n1,n2}]},fun];

δW[DISP,{BEAM,{{EE_,GG_,κκ_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,h,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=h=Simplify[Sqrt[r0.r0],L>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;
ux[1]=fun[[n1,2]].ix0; ux[2]=fun[[n2,2]].ix0;
uy[1]=fun[[n1,2]].iy0; uy[2]=fun[[n2,2]].iy0;
uz[1]=fun[[n1,2]].iz0; uz[2]=fun[[n2,2]].iz0;
θx[1]=fun[[n1,3]].ix0; θx[2]=fun[[n2,3]].ix0;
θy[1]=fun[[n1,3]].iy0; θy[2]=fun[[n2,3]].iy0;
θz[1]=fun[[n1,3]].iz0; θz[2]=fun[[n2,3]].iz0;
δux[1]=δ[fun[[n1,2]]].ix0; δux[2]=δ[fun[[n2,2]]].ix0;
δuy[1]=δ[fun[[n1,2]]].iy0; δuy[2]=δ[fun[[n2,2]]].iy0;
δuz[1]=δ[fun[[n1,2]]].iz0; δuz[2]=δ[fun[[n2,2]]].iz0;
δθx[1]=δ[fun[[n1,3]]].ix0; δθx[2]=δ[fun[[n2,3]]].ix0;
δθy[1]=δ[fun[[n1,3]]].iy0; δθy[2]=δ[fun[[n2,3]]].iy0;
δθz[1]=δ[fun[[n1,3]]].iz0; δθz[2]=δ[fun[[n2,3]]].iz0;

((AA^2) (GG^2) (h^4) ((κκ)^2) (6 fx (h^2) (δux[1]+δux[2])+6 fz (h^2) δuz[1]+6 fz (h^2) δuz[2]-fz (h^3) δθy[1]+fz (h^3) δθy[2]+fy (h^2) (6 δuy[1]+6 δuy[2]+h δθz[1]-h δθz[2])-12 GG Iyy δθx[1] θx[1]-12 GG Izz δθx[1] θx[1]+12 GG Iyy δθx[2] θx[1]+12 GG Izz δθx[2] θx[1]+12 GG Iyy δθx[1] θx[2]+12 GG Izz δθx[1] θx[2]-12 GG Iyy δθx[2] θx[2]-12 GG Izz δθx[2] θx[2])-1728 (EE^3) Iyy Izz (AA (ux[1]-ux[2]) (δux[1]-δux[2])+Izz (δθy[1]-δθy[2]) (θy[1]-θy[2])+Iyy (δθz[1]-δθz[2]) (θz[1]-θz[2]))+144 (EE^2) (-(AA^2) GG (h^2) (Iyy+Izz) κκ (ux[1]-ux[2]) (δux[1]-δux[2])+6 fx (h^2) Iyy Izz (δux[1]+δux[2])+Iyy Izz (fz (h^2) (6 δuz[1]+6 δuz[2]-h δθy[1]+h δθy[2])+fy (h^2) (6 δuy[1]+6 δuy[2]+h δθz[1]-h δθz[2])-12 GG (Iyy+Izz) (δθx[1]-δθx[2]) (θx[1]-θx[2]))-AA GG κκ ((h^2) (Izz^2) (δθy[1]-δθy[2]) (θy[1]-θy[2])+(h^2) (Iyy^2) (δθz[1]-δθz[2]) (θz[1]-θz[2])+2 Iyy Izz (6 uz[1] δuz[1]-6 uz[2] δuz[1]-6 uz[1] δuz[2]+6 uz[2] δuz[2]-3 h uz[1] δθy[1]+3 h uz[2] δθy[1]-3 h uz[1] δθy[2]+3 h uz[2] δθy[2]+3 uy[1] (2 δuy[1]-2 δuy[2]+h (δθz[1]+δθz[2]))-3 uy[2] (2 δuy[1]-2 δuy[2]+h (δθz[1]+δθz[2]))-3 h δuz[1] θy[1]+3 h δuz[2] θy[1]+2 (h^2) δθy[1] θy[1]+(h^2) δθy[2] θy[1]-3 h δuz[1] θy[2]+3 h δuz[2] θy[2]+(h^2) δθy[1] θy[2]+2 (h^2) δθy[2] θy[2]+3 h δuy[1] θz[1]-3 h δuy[2] θz[1]+2 (h^2) δθz[1] θz[1]+(h^2) δθz[2] θz[1]+3 h δuy[1] θz[2]-3 h δuy[2] θz[2]+(h^2) δθz[1] θz[2]+2 (h^2) δθz[2] θz[2])))-12 AA EE GG (h^2) κκ ((AA^2) GG (h^2) κκ (ux[1]-ux[2]) (δux[1]-δux[2])-6 fx (h^2) (Iyy+Izz) (δux[1]+δux[2])-(Iyy+Izz) (fz (h^2) (6 δuz[1]+6 δuz[2]-h δθy[1]+h δθy[2])+fy (h^2) (6 δuy[1]+6 δuy[2]+h δθz[1]-h δθz[2])-12 GG (Iyy+Izz) (δθx[1]-δθx[2]) (θx[1]-θx[2]))+2 AA GG κκ (Izz (-3 uz[1] (-2 δuz[1]+2 δuz[2]+h (δθy[1]+δθy[2]))+3 uz[2] (-2 δuz[1]+2 δuz[2]+h (δθy[1]+δθy[2]))+h (-3 δuz[1] (θy[1]+θy[2])+3 δuz[2] (θy[1]+θy[2])+h (δθy[1] (2 θy[1]+θy[2])+δθy[2] (θy[1]+2 θy[2]))))+Iyy (3 uy[1] (2 δuy[1]-2 δuy[2]+h (δθz[1]+δθz[2]))-3 uy[2] (2 δuy[1]-2 δuy[2]+h (δθz[1]+δθz[2]))+h (3 δuy[1] (θz[1]+θz[2])-3 δuy[2] (θz[1]+θz[2])+h (δθz[1] (2 θz[1]+θz[2])+δθz[2] (θz[1]+2 θz[2])))))))/(12 h (12 EE Iyy+AA GG (h^2) κκ) (12 EE Izz+AA GG (h^2) κκ))];

δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{d_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[VIBR,{BEAM,{{EE,GG,ρρ},{Pi*d^2/4,Pi*d^4/64,Pi*d^4/64,iy0},{fx,fy,fz,0,0,0}},Line[{n1,n2}]},fun];

δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{hy_,hz_,iy0_},{fx_,fy_,fz_}},Line[{n1_,n2_}]},fun_]:=δW[VIBR,{BEAM,{{EE,GG,ρρ},{hy*hz,hz^3*hy/12,hy^3*hz/12,iy0},{fx,fy,fz,0,0,0}},Line[{n1,n2}]},fun];

δW[VIBR,{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_,iy0_},{fx_,fy_,fz_,mx_,my_,mz_}},Line[{n1_,n2_}]},fun_]:=Module[{r0,h0,h,hα0,iα0,ix0,iz0,ux,uy ,uz ,θx ,θy ,θz ,δux ,δuy,δuz,δθx,δθy,δθz},

(*mapping*)
r0=fun[[n2,1]]-fun[[n1,1]];
h0=h=Simplify[Sqrt[r0.r0],L>0];
ix0=r0/h0;
iz0=ix0\[Cross]iy0;

{ux[1,0],uy[1,0],uz[1,0]}=({ix0,iy0,iz0}.fun[[n1,2]])/.DRULE[0];
{ux[1,2],uy[1,2],uz[1,2]}=({ix0,iy0,iz0}.fun[[n1,2]])/.DRULE[2];
{ux[2,0],uy[2,0],uz[2,0]}=({ix0,iy0,iz0}.fun[[n2,2]])/.DRULE[0];
{ux[2,2],uy[1,2],uz[2,2]}=({ix0,iy0,iz0}.fun[[n2,2]])/.DRULE[2];
{θx[1,0],θy[1,0],θz[1,0]}=({ix0,iy0,iz0}.fun[[n1,3]])/.DRULE[0];
{θx[1,2],θy[1,2],θz[1,2]}=({ix0,iy0,iz0}.fun[[n1,3]])/.DRULE[2];
{θx[2,0],θy[2,0],θz[2,0]}=({ix0,iy0,iz0}.fun[[n2,3]])/.DRULE[0];
{θx[2,2],θy[2,2],θz[2,2]}=({ix0,iy0,iz0}.fun[[n2,3]])/.DRULE[2];
{δux[1,0],δuy[1,0],δuz[1,0]}=δ[{ux[1,0],uy[1,0],uz[1,0]}];
{δux[2,0],δuy[2,0],δuz[2,0]}=δ[{ux[2,0],uy[2,0],uz[2,0]}];
{δθx[1,0],δθy[1,0],δθz[1,0]}=δ[{θx[1,0],θy[1,0],θz[1,0]}];
{δθx[2,0],δθy[2,0],δθz[2,0]}=δ[{θx[2,0],θy[2,0],θz[2,0]}];

-(1/(420 (h^3)))(-210 fx (h^4) (δux[1,0]+δux[2,0])+AA (h^2) (420 EE (ux[1,0]-ux[2,0]) (δux[1,0]-δux[2,0])+(h^2) ρρ (70 ux[1,2] (2 δux[1,0]+δux[2,0])+70 ux[2,2] (δux[1,0]+2 δux[2,0])+156 uy[1,2] δuy[1,0]+54 uy[2,2] δuy[1,0]+54 uy[1,2] δuy[2,0]+156 uy[2,2] δuy[2,0]+156 uz[1,2] δuz[1,0]+54 uz[2,2] δuz[1,0]+54 uz[1,2] δuz[2,0]+156 uz[2,2] δuz[2,0]-22 h uz[1,2] δθy[1,0]-13 h uz[2,2] δθy[1,0]+13 h uz[1,2] δθy[2,0]+22 h uz[2,2] δθy[2,0]+22 h uy[1,2] δθz[1,0]+13 h uy[2,2] δθz[1,0]-13 h uy[1,2] δθz[2,0]-22 h uy[2,2] δθz[2,0]-22 h δuz[1,0] θy[1,2]-13 h δuz[2,0] θy[1,2]+4 (h^2) δθy[1,0] θy[1,2]-3 (h^2) δθy[2,0] θy[1,2]+13 h δuz[1,0] θy[2,2]+22 h δuz[2,0] θy[2,2]-3 (h^2) δθy[1,0] θy[2,2]+4 (h^2) δθy[2,0] θy[2,2]+22 h δuy[1,0] θz[1,2]+13 h δuy[2,0] θz[1,2]+4 (h^2) δθz[1,0] θz[1,2]-3 (h^2) δθz[2,0] θz[1,2]-13 h δuy[1,0] θz[2,2]-22 h δuy[2,0] θz[2,2]-3 (h^2) δθz[1,0] θz[2,2]+4 (h^2) δθz[2,0] θz[2,2]))+7 (720 EE (Izz (uy[1,0]-uy[2,0]) (δuy[1,0]-δuy[2,0])+Iyy (uz[1,0]-uz[2,0]) (δuz[1,0]-δuz[2,0]))+5 fz (h^5) (δθy[1,0]-δθy[2,0])-5 fy (h^4) (6 δuy[1,0]+6 δuy[2,0]+h (δθz[1,0]-δθz[2,0]))-360 EE h (Iyy (uz[1,0] (δθy[1,0]+δθy[2,0])-uz[2,0] (δθy[1,0]+δθy[2,0])+(δuz[1,0]-δuz[2,0]) (θy[1,0]+θy[2,0]))+Izz (-uy[1,0] (δθz[1,0]+δθz[2,0])+uy[2,0] (δθz[1,0]+δθz[2,0])-(δuy[1,0]-δuy[2,0]) (θz[1,0]+θz[2,0])))+12 (h^2) (Iyy (6 ρρ (uz[1,2]-uz[2,2]) (δuz[1,0]-δuz[2,0])+5 (GG (δθx[1,0]-δθx[2,0]) (θx[1,0]-θx[2,0])+2 EE (δθy[1,0] (2 θy[1,0]+θy[2,0])+δθy[2,0] (θy[1,0]+2 θy[2,0]))))+Izz (6 ρρ (uy[1,2]-uy[2,2]) (δuy[1,0]-δuy[2,0])+5 (GG (δθx[1,0]-δθx[2,0]) (θx[1,0]-θx[2,0])+2 EE (δθz[1,0] (2 θz[1,0]+θz[2,0])+δθz[2,0] (θz[1,0]+2 θz[2,0])))))-2 (h^4) (15 fz (δuz[1,0]+δuz[2,0])+15 mx (δθx[1,0]+δθx[2,0])-ρρ (Iyy (5 δθx[1,0] (2 θx[1,2]+θx[2,2])+5 δθx[2,0] (θx[1,2]+2 θx[2,2])+4 δθy[1,0] θy[1,2]-δθy[2,0] θy[1,2]-δθy[1,0] θy[2,2]+4 δθy[2,0] θy[2,2])+Izz (5 δθx[1,0] (2 θx[1,2]+θx[2,2])+5 δθx[2,0] (θx[1,2]+2 θx[2,2])+4 δθz[1,0] θz[1,2]-δθz[2,0] θz[1,2]-δθz[1,0] θz[2,2]+4 δθz[2,0] θz[2,2])))+6 (h^3) (10 mz (δuy[1,0]-δuy[2,0])-10 my (δuz[1,0]-δuz[2,0])+ρρ (Iyy (-uz[1,2] (δθy[1,0]+δθy[2,0])+uz[2,2] (δθy[1,0]+δθy[2,0])-(δuz[1,0]-δuz[2,0]) (θy[1,2]+θy[2,2]))+Izz (uy[1,2] (δθz[1,0]+δθz[2,0])-uy[2,2] (δθz[1,0]+δθz[2,0])+(δuy[1,0]-δuy[2,0]) (θz[1,2]+θz[2,2]))))))];


δW[VIBR,{SHELL,{{EE_,νν_,ρρ_},{tt_},{fx_,fy_,fz_}},ELEMENT[node_]},fun_]:=Module[{nα,nβ,nne,α,β,n,enode,NN,r,rα,rβ,rn,jac,hα,eα,hβ,eβ,en,FF,u,v,w,ϕ,θ,ψ,u0,v0,w0,ϕ0,θ0,ψ0,u2,v2,w2,ϕ2,θ2,ψ2,fα,fβ,fn,ϵαα,ϵββ,ϵαβ,ϵβα,καα,κββ,καβ,γα,γβ,GG,Nαα,Nββ,Nαβ,Nβα,Mαα,Mββ,Mαβ,Qα,Qβ,δwint,δwext,δwine},

(*nodes*)
{nα,nβ}=Dimensions[node];
nne =nα*nβ;
enode=Flatten[node];

(*shape functions*)
NN=LAGRANGE[{{nα,α},{nβ,β}}];

(*mapping to orthonormal material system*)
r=NN.fun[[enode,1]];
rα=(∂_α)r /.{α->1/2,β->1/2};
hα=Norm[rα];eα=rα/hα;
rβ=(∂_β)r /.{α->1/2,β->1/2};
rβ=rβ-(rβ.eα)*eα;
hβ=Norm[rβ];eβ=rβ/hβ;
en=eα\[Cross]eβ;
jac =hα*hβ;

(*in flat geometry*)
FF={eα,eβ,en};

(*transform into the material αβn-system*)
{u,v,w}=FF.(NN.fun[[enode,2]]);
{ϕ,θ,ψ}=FF.(NN.fun[[enode,3]]);
{u0,v0,w0}={u,v,w} /.DRULE[0];
{ϕ0,θ0,ψ0}={ϕ,θ,ψ} /.DRULE[0];
{u2,v2,w2}={u,v,w}/.DRULE[2];
{ϕ2,θ2,ψ2}={ϕ,θ,ψ} /.DRULE[2];
{fα,fβ,fn}=FF.{fx,fy,fz};

(*strain measures with non-symmetric ϵ-part*)
{ϵαα,ϵββ,ϵαβ,ϵβα}={(∂_α)u0/hα,(∂_β)v0/hβ,(∂_α)v0/hα-ψ0,(∂_β)u0/hβ+ψ0};
{καα,κββ,καβ}={(∂_α)θ0/hα,-(∂_β)ϕ0/hβ,(∂_β)θ0/hβ-(∂_α)ϕ0/hα};
{γα,γβ}={(∂_α)w0/hα+θ0,(∂_β)w0/hβ-ϕ0};

GG=EE/(2+2*νν);
(*stress resultants with a nonsymmetric N-part*)
Nαα=tt*EE/(1-νν^2)*(ϵαα+νν*ϵββ);
Nββ=tt*EE/(1-νν^2)*(ϵββ+νν*ϵαα);
Nαβ=tt*GG*ϵαβ;
Nβα=tt*GG*ϵβα;
Mαα=(tt^3/12)*EE/(1-νν^2)*(καα+νν*κββ);
Mββ=(tt^3/12)*EE/(1-νν^2)*(κββ+νν*καα);
Mαβ=(tt^3/12)*GG*καβ;
Qα=5/6*GG*tt*γα;
Qβ=5/6*GG*tt*γβ;

(* virtual work *)
δwint=-δ[{ϵαα,ϵββ,ϵαβ,ϵβα}].{Nαα,Nββ,Nαβ,Nβα}-δ[{καα,κββ,καβ}].{Mαα,Mββ,Mαβ}-δ[{γα,γβ}].{Qα,Qβ} ;
δwext=δ[{u0,v0,w0}].{fα,fβ,fn};
δwine=-δ[{u0,v0,w0}].(ρρ*tt*{u2,v2,w2})-
δ[{ϕ0,θ0,ψ0}].(ρρ*tt^3/12*{ϕ2,θ2,ψ2});
QUAD[LIN7,QUAD[LIN7,(δwint+δwext+δwine)*jac,α],β]];

SOLVER

SOLVER defs

Clear[SOLVE];

SOLVE[{ele_,fun_}]:=SOLVE[{DISP},{ele,fun}];

SOLVE[{DISP},{ele_,fun_}]:=Module[{dof,δdof,equ,sol,δWT},
δWT=ParallelMap[δW[DISP,#,fun]&,ele];
dof=DOFS[δWT];δdof=δDOFS[δWT];
equ=Apply[Plus,D[δWT,{δdof}]];
sol=Solve[Thread[equ==0],dof];
Return[First[sol]]]; 

SOLVE[{CLASSIC},{ele_,fun_}]:=Module[{dof ,δdof,sol,δWe,DOF,δDOF,MAP,δMAP,ABL,nequ,ndof,A,B,dofe,δdofe,eque,Le,LA,LB,tt},
tt=TimeUsed[];
(*                                   *)
(* element contributions in parallel *)
(*                                   *)
ABL=Map[(δWe = δW[DISP,#];
dofe =Union[Cases[δWe,a[__]|b[__],Infinity]];
δdofe =Union[Cases[δWe,δa[__]|δb[__],Infinity]];
eque=D[δWe,{δdofe}];
Join[CoefficientArrays[eque,dofe],{dofe,δdofe}])&,
ele];
Print["elements(",TimeUsed[]-tt,"): nele = ",Length[ele]];
tt=TimeUsed[];
(*             *)
(* dof mapping *)
(*             *)
DOF=Union[Flatten[ABL[[All,3]]]];
δDOF=Union[Flatten[ABL[[All,4]]]];
ndof=Length[DOF];
nequ=Length[δDOF];
MAP= Dispatch[Thread[DOF->Array[#&,ndof]]];
δMAP= Dispatch[Thread[δDOF->Array[#&,nequ]]];
ABL =Map[{#[[1]],#[[2]],#[[3]]/. MAP,#[[4]]/. δMAP}&,ABL];
A =SparseArray[{{1,1}->0},{nequ,ndof}];
B =SparseArray[{{1}->0},{nequ}];
Print["analysis(",TimeUsed[]-tt,"): {nequ,ndof} = ",{nequ,ndof}];
(*                *)
(* parallel build *)
(*                *)
tt=TimeUsed[];
Do[
LA = Flatten[Outer[List,ec[[4]],ec[[3]]],1];
LB = Map[{#}&,ec[[4]]];
A+=SparseArray[Thread[LA->Flatten[ec[[2]]]],{nequ,ndof}];
B+=SparseArray[Thread[LB->Flatten[ec[[1]]]],{nequ}],
{ec,ABL}];
Print["build(",TimeUsed[]-tt,"): nele = ",Length[ele]]; 
(*                           *)
(* solve with default method *)
(*                           *)
tt=TimeUsed[];
sol=Thread[DOF->LinearSolve[A,-B]];
Print["solve(",TimeUsed[]-tt,")"];
Return[sol]];

SOLVE[{CLASSICP},{ele_,fun_}]:=Module[{dof ,δdof,sol,δWe,DOF,δDOF,MAP,δMAP,ABL,nequ,ndof,A,B,dofe,δdofe,eque,Le,LA,LB,tt,ec},
(*tt=TimeUsed[];*)
(*                                   *)
(* element contributions in parallel *)
(*                                   *)
ABL=Map[(δWe = δW[DISP,#];
dofe =Union[Cases[δWe,a[__]|b[__]|c[__],Infinity]];
δdofe =Union[Cases[δWe,δa[__]|δb[__]|δc[__],Infinity]];
(*for load elements*)
dofe=If[dofe=={},(δdofe/.{δa->a,δb->b,δc->c}),dofe];
eque=D[δWe,{δdofe}];
coff=CoefficientArrays[eque,dofe];
coff=If[Length[coff]==1,Append[coff,SparseArray[{},{Length[δdofe],Length[δdofe]}]],coff];
Join[coff,{dofe,δdofe}])&,
ele];
(*Print["elements(",TimeUsed[]-tt,"): nele = ",Length[ele]];*)
(*tt=TimeUsed[];*)
(*             *)
(* dof mapping *)
(*             *)
DOF=Union[Flatten[ABL[[All,3]]]];
δDOF=Union[Flatten[ABL[[All,4]]]];
ndof=Length[DOF];
nequ=Length[δDOF];
MAP= Dispatch[Thread[DOF->Array[#&,ndof]]];
δMAP= Dispatch[Thread[δDOF->Array[#&,nequ]]];
ABL =Map[{#[[1]],#[[2]],#[[3]]/. MAP,#[[4]]/. δMAP}&,ABL];
A =SparseArray[{{1,1}->0},{nequ,ndof}];
B =SparseArray[{{1}->0},{nequ}];
(* Print["analysis(",TimeUsed[]-tt,"): {nequ,ndof} = ",{nequ,ndof}];*)
(*                *)
(* parallel build *)
(*                *)
(* tt=TimeUsed[];*)
A=ParallelSum[
LA = Flatten[Outer[List,ec[[4]],ec[[3]]],1];
SparseArray[Thread[LA->Flatten[ec[[2]]]],{nequ,ndof}],
{ec,ABL}];
B=ParallelSum[
LB = Map[{#}&,ec[[4]]];
SparseArray[Thread[LB->Flatten[ec[[1]]]],{nequ}],
{ec,ABL}];
(*Print["build(",TimeUsed[]-tt,"): nele = ",Length[ele]]; *)
(*                           *)
(* solve with default method *)
(*                           *)
(*tt=TimeUsed[]; *)
sol=Thread[DOF->LinearSolve[A,-B]];
(* Print["solve(",TimeUsed[]-tt,")"];*)
Return[sol]];

SOLVE[{NONL,ALL},{ele_,fun_}]:=Module[{dof,δdof,equ,sol,δWT},
δWT=ParallelMap[δW[NONL,#,fun]&,ele];
dof=DOFS[δWT];δdof=δDOFS[δWT];
equ=Apply[Plus,D[δWT,{δdof}]];
sol=Solve[Thread[equ==0],dof];
Return[sol]]; 

SOLVE[{NONL,rule_},{ele_,fun_}]:=Module[{dof,δdof,dof0,equ,sol,δWT},
δWT=ParallelMap[δW[NONL,#,fun]&,ele];
dof=DOFS[δWT];δdof=δDOFS[δWT];
dof0=Transpose[{dof,dof /.rule}];
equ=Apply[Plus,D[δWT,{δdof}]];
sol=FindRoot[Thread[equ==0],dof0,DampingFactor->4,AccuracyGoal->2,PrecisionGoal->2];
Return[sol]]; 

SOLVE[{NONL},{ele_,fun_}]:=Module[{dof,δdof,equ,sol,δWT},
δWT=ParallelMap[δW[NONL,#,fun]&,ele];
dof=DOFS[δWT];δdof=δDOFS[δWT];
equ=Apply[Plus,D[δWT,{δdof}]];
sol=NSolve[Thread[equ==0],dof,Reals];
Return[MinimalBy[sol,Norm[dof /. #]&][[1]]]]; 

SOLVE[δWW_]:=Module[{equ,sol},
equ=D[δWW,{δDOFS[δWW]}];
sol=Solve[Thread[equ==0],DOFS[δWW]];
Return[First[sol]]];

SOLVE[{VIBR},{ele_,fun_}]:=Module[{dof,δdof,dofall,dof0 ,dof2 ,equ,sol,δWW,KK,MM,nn,val,vec},
δWW=Simplify[Apply[Plus,Map[δW[VIBR,#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
dofall=Union[dof /. anya_[anyb_,0|2]->anya[anyb]];
dof0 =dofall/. DRULE[0];
dof2 =dofall/.DRULE[2];
KK =D[equ,{dof0}];
MM =D[equ,{dof2}];
(*{val,vec}=Eigensystem[Inverse[MM].KK];*)
{val,vec}=Eigensystem[{KK,MM}];
Table[  { ω[ii]->Sqrt[val[[ii]]],Thread[dofall->vec[[ii,;;]]]},{ii,1,Length[dofall]}]];

SOLVE[{VIBR},δWW_]:=Module[{dof,δdof,dofall,dof0 ,dof2 ,equ,sol,KK,MM,nn,val,vec},
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
dofall=Union[dof /. anya_[anyb_,0|2]->anya[anyb]];
dof0 =dofall/. DRULE[0];
dof2 =dofall/.DRULE[2];
KK =D[equ,{dof0}];
MM =D[equ,{dof2}];
{val,vec}=Eigensystem[{KK,MM}];
Table[  { ω[ii]->Sqrt[val[[ii]]],Thread[dofall->vec[[ii,;;]]]},{ii,1,Length[dofall]}]];

MATRIXFUNCTION[f_,M_]:=Module[{val,vec},
{val,vec}=Eigensystem[M];
Transpose[vec].DiagonalMatrix[Map[f,val]].Inverse[Transpose[vec]]];

SOLVE[{VIBR,rule_},{ele_,fun_}]:=Module[{dof,dof0,dof1,dof2,δdof,dofall,equ,δWW,KK,MM,Ω},
δWW=Simplify[Apply[Plus,Map[δW[VIBR,#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
dofall=Union[dof /. anya_[anyb_,0|2]->anya[anyb]];
dof0 =dofall/. DRULE[0];
dof1 =dofall/. DRULE[1];
dof2 =dofall/. DRULE[2];
KK =D[equ,{dof0}];
MM =D[equ,{dof2}];
Ω=MATRIXFUNCTION[Sqrt[#]&,Inverse[MM].KK];
Thread[dofall->
Simplify[MATRIXFUNCTION[Cos[#*t]&,Ω].(dof0/.rule)+MATRIXFUNCTION[Sin[#*t]&,Ω].Inverse[Ω].(dof1/.rule)]]
];

SOLVE[{VIBR,rule_},δWW_]:=Module[{dof,dof0,dof1,dof2,δdof,dofall,equ,KK,MM,Ω},
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
dofall=Union[dof /. anya_[anyb_,0|2]->anya[anyb]];
dof0 =dofall/. DRULE[0];
dof1 =dofall/. DRULE[1];
dof2 =dofall/. DRULE[2];
KK =D[equ,{dof0}];
MM =D[equ,{dof2}];
Ω=MATRIXFUNCTION[Sqrt[#]&,Inverse[MM].KK];
Thread[dofall->
Simplify[MATRIXFUNCTION[Cos[#*t]&,Ω].(dof0/.rule)+MATRIXFUNCTION[Sin[#*t]&,Ω].Inverse[Ω].(dof1/.rule)]]
];

SOLVE[{STAB,p_},{ele_,fun_}]:=Module[{δWW,dof,δdof,equ,sol,KK,KK0,KK1,val,vec,modes,prule,list},

(*first ignoring the coupling*)
prule={};
δWW=Simplify[Apply[Plus,Map[δW[{STAB,prule},#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
prule=Solve[Thread[equ==0],dof][[1]];

(*then considering the coupling*)
δWW=Simplify[Apply[Plus,Map[δW[{STAB,prule},#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
KK =D[equ,{dof}];
KK0= KK /. p->0;
KK1 =D[KK ,p];
{val,vec}=Simplify[Eigensystem[Inverse[KK0].KK1]];
list=Select[Transpose[{val,vec}],Not[#[[1]]===0]&];
MapIndexed[{p[#2[[1]]]->-1/#1[[1]],Thread[dof->#1[[2]]]}&,list] ];

PRE-POST

LINK RULE defs

LINK[{I1_,I2_}]:=
DeleteCases[Flatten[{Thread[fun[[I2,3]]->fun[[I1,3]]],
Thread[fun[[I2,2]]->(fun[[I1,2]]+fun[[I1,3]]\[Cross](fun[[I2,1]]-fun[[I1,1]]))]}],0->0];

TOOL defs

EX[M_,K_,alist_,rule_,time_]:=Module[{t0,A,fun,dfun,out,alist0,alist1,a0,a1},
alist0 =(alist /.{ a[b_] -> a[b,0]});
alist1 =(alist /.{ a[b_] -> a[b,1]});
a0 =(alist0 /. rule);
a1 =(alist1 /. rule);
t0 = First[time];
A = Inverse[M].K;
fun=Simplify[MATRIXFUN[A,Cos[Sqrt[#]*(t-t0)]&].a0+MATRIXFUN[A,Sin[Sqrt[#]*(t-t0)]/Sqrt[#]&].a1];
dfun = D[fun,t];
out = Map[(Join[fun,dfun] /. t->#)&,time];
alist0 =(alist /.{ a[b_] -> a[b,0]});
alist1 =(alist /.{ a[b_] -> a[b,1]});
Map[MAKERULE[Join[alist0,alist1],#]& ,out]]; 

CR[M_,K_,alist_,rule_,time_]:=Module[{nn,Δt,A,II,AA,out,alist0,alist1,a0,a1},
alist0 =(alist /.{ a[b_] -> a[b,0]});
alist1 =(alist /.{ a[b_] -> a[b,1]});
a0 =(alist0 /. rule);
a1 =(alist1 /. rule);
nn =Length[time]-1;
Δt=(Last[time]-First[time])/nn;
A = Inverse[M].K;
II = IdentityMatrix[Length[a0]];
AA = Inverse[ArrayFlatten[{{II,-II/2*Δt},{A*Δt^2/2,II*Δt}}]].ArrayFlatten[{{II,II/2*Δt},{-A*Δt^2/2,II*Δt}}];
out =NestList[AA.#&,Flatten[{a0,a1}],nn];
Map[MAKERULE[Join[alist0,alist1],#]& ,out]]; 

DG[M_,K_,alist_,rule_,time_]:=Module[{nn,Δt,A,II ,AA ,out,alist0,alist1,a0,a1},
alist0 =(alist /.{ a[b_] -> a[b,0]});
alist1 =(alist /.{ a[b_] -> a[b,1]});
a0 =(alist0 /. rule);
a1 =(alist1 /. rule);
nn =Length[time]-1;
Δt=(Last[time]-First[time])/nn;
A = Inverse[M].K;
II = IdentityMatrix[Length[a0]];
AA = Inverse[ArrayFlatten[{{A*Δt^2,(II-A*Δt^2/2)*Δt},{-II-A*Δt^2/2,(A*Δt^2/3)*Δt}}]].ArrayFlatten[{{0*II,II*Δt},{-II,-II*Δt}}];
out =NestList[AA.#&,Flatten[{a0,a1}],nn];
Map[MAKERULE[Join[alist0,alist1],#]& ,out]]; 

NEWTON[equ_,var_,rule_,{ε_,m_}]:=Module[{Dequ,sol,dsol,K,F,ii=m},
Dequ=Transpose[D[equ,{var}]];
sol =var /. rule;
While[ii>0,
K=Dequ /.Thread[var->sol];
F=equ /.Thread[var->sol];
dsol=-LinearSolve[K,F];
Print[dsol];
sol=sol+dsol;
If[Norm[dsol]<ε*Norm[sol],Break[]];
ii=ii-1];
Thread[var->sol]];

REFINE defs

left :={{a1_,a2_,a3_}->{a1, (3 a1+6 a2-a3)/8,a2},{a1_,a2_}->{a1,(a1+a2)/2},a1_->a1};

right :={{a1_,a2_,a3_}->{a2, (-a1+6 a2+3 a3)/8,a3},{a1_,a2_}->{(a1+a2)/2,a2},a1_->a1};

REF[{RIGID,mat_,Line[{n1_,n2_}]}]:={{RIGID,mat,Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{RIGID,mat,Line[{n3,n2}]}};

REF[{FORCE,mat_,Point[{a1_}]}]:={{FORCE,mat,Point[{a1}]}};

REF[{FORCE,{fX_,fY_,fZ_},Line[{n1_,n2_}]}]:={{FORCE,{fX /.left,fY/.left,fZ/.left},Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{FORCE,{fX /.right,fY/.right,fZ/.right},Line[{n3,n2}]}};

REF[{BAR,{{EE_},{AA_},{ff_}},Line[{n1_,n2_}]}]:={{BAR,{{EE /.left},{AA/.left},{ff/.left}},Line[{n1,n3=NEWNODE[BAR,Sort[{n1,n2}]]}]},
{BAR,{{EE /.right},{AA/.right},{ff/.right}},Line[{n3,n2}]}};

REF[{BAR,{{EE_,ρρ_},{AA_},{ff_}},Line[{n1_,n2_}]}]:={{BAR,{{EE /.left,ρρ/.left},{AA/.left},{ff/.left}},Line[{n1,n3=NEWNODE[BAR,Sort[{n1,n2}]]}]},
{BAR,{{EE /.right,ρρ/.right},{AA/.right},{ff/.right}},Line[{n3,n2}]}};

REF[{BAR,{{EE_},{AA_,iy_},{fx_,fy_,fz_}},Line[{n1_,n2_}]}]:={{BAR,{{EE /.left},{AA/.left,iy },{fx/.left,fy/.left,fz/.left}},Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{BAR,{{EE /.right},{AA/.right,iy},{fx/.right,fy/.right,fz/.right}},Line[{n3,n2}]}};

REF[{BAR,{{EE_,αα_,kk_},{AA_},{fx_,ss_,ϑϑ_}},Line[{n1_,n2_}]}]:={{BAR,{{EE /.left,αα/.left,kk/.left },{AA/.left},{fx/.left,ss/.left,ϑϑ/.left}},Line[{n1,n3=NEWNODET[BAR,Sort[{n1,n2}]]}]},
{BAR,{{EE /.right,αα/.right,kk/.right },{AA/.right},{fx/.right,ss/.right,ϑϑ/.right}},Line[{n3,n2}]}};

REF[{{BEAM,κ0_},{{EE_},{Ln_,Lb_}},Line[{n1_,n2_}]}]:={{{BEAM,κ0},{{EE},{Ln ,Lb}},Line[{n1,n3=NEWNODE[{BEAM,κ0},{n1,n2}]}]},
{{BEAM,κ0},{{EE},{Ln,Lb}},Line[{n3,n2}]}};

REF[{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]}]:={{BEAM,{{EE /.left,GG /.left},{AA /.left,Iyy /.left,Izz /.left},{fx /.left,fy /.left,fz /.left}},Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{BEAM,{{EE /.right,GG /.right},{AA /.right,Iyy /.right,Izz /.right},{fx /.right,fy /.right,fz /.right}},Line[{n3,n2}]}};

REF[{BEAM,{{EE_,GG_},{AA_,Iyy_,Izz_,Ip_},{fx_,fy_,fz_}},Line[{n1_,n2_}]}]:={{BEAM,{{EE /.left,GG /.left},{AA /.left,Iyy /.left,Izz /.left,Ip},{fx /.left,fy /.left,fz /.left}},Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{BEAM,{{EE /.right,GG /.right},{AA /.right,Iyy /.right,Izz /.right,Ip},{fx /.right,fy /.right,fz /.right}},Line[{n3,n2}]}};

REF[{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_},{fx_,fy_,fz_}},Line[{n1_,n2_}]}]:={{BEAM,{{EE /.left,GG /.left,ρρ},{AA /.left,Iyy /.left,Izz /.left},{fx /.left,fy /.left,fz /.left}},Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{BEAM,{{EE /.right,GG /.right,ρρ},{AA /.right,Iyy /.right,Izz /.right},{fx /.right,fy /.right,fz /.right}},Line[{n3,n2}]}};

REF[{BEAM,{{EE_,GG_,ρρ_},{AA_,Iyy_,Izz_,Ip_},{fx_,fy_,fz_}},Line[{n1_,n2_}]}]:={{BEAM,{{EE /.left,GG /.left,ρρ},{AA /.left,Iyy /.left,Izz /.left,Ip},{fx /.left,fy /.left,fz /.left}},Line[{n1,n3=NEWNODE[Sort[{n1,n2}]]}]},
{BEAM,{{EE /.right,GG /.right,ρρ},{AA /.right,Iyy /.right,Izz /.right,Ip},{fx /.right,fy /.right,fz /.right}},Line[{n3,n2}]}};

REF[{TWODIM,mat_,Triangle[{n1_,n2_,n3_}]}]:={
{TWODIM,mat,Triangle[{n1,n4=NEWNODE[Sort[{n1,n2}]],n6=NEWNODE[Sort[{n3,n1}]]}]},
{TWODIM,mat,Triangle[{n4,n2,n5=NEWNODE[Sort[{n2,n3}]]}]},
{TWODIM,mat,Triangle[{n6,n5,n3}]},
{TWODIM,mat,Triangle[{n4,n5,n6}]}};

REF[{PLANE,mat_,Triangle[{n1_,n2_,n3_}]}]:={
{PLANE,mat,Triangle[{n1,n4=NEWNODE[Sort[{n1,n2}]],n6=NEWNODE[Sort[{n3,n1}]]}]},
{PLANE,mat,Triangle[{n4,n2,n5=NEWNODE[Sort[{n2,n3}]]}]},
{PLANE,mat,Triangle[{n6,n5,n3}]},
{PLANE,mat,Triangle[{n4,n5,n6}]}};

REF[{PLANE,mat_,Polygon[{n1_,n2_,n3_}]}]:={
{PLANE,mat,Polygon[{n1,n4=NEWNODE[Sort[{n1,n2}]],n6=NEWNODE[Sort[{n3,n1}]]}]},
{PLANE,mat,Polygon[{n4,n2,n5=NEWNODE[Sort[{n2,n3}]]}]},
{PLANE,mat,Polygon[{n6,n5,n3}]},
{PLANE,mat,Polygon[{n4,n5,n6}]}};

REF[{PLANE,mat_,Polygon[{n1_,n2_,n3_,n4_}]}]:={
{PLANE,mat,Polygon[{n1,n5=NEWNODE[Sort[{n1,n2}]],n8=NEWNODE[Sort[{n1,n3}]],n9=NEWNODE[Sort[{n1,n2,n3,n4}]]}]},
{PLANE,mat,Polygon[{n5,n2,n9,n6=NEWNODE[Sort[{n2,n4}]]}]},
{PLANE,mat,Polygon[{n8,n9,n3,n7=NEWNODE[Sort[{n3,n4}]]}]},
{PLANE,mat,Polygon[{n9,n6,n7,n4}]}};

REF[{EMS,mat_,Polygon[{n1_,n2_,n3_,n4_}]}]:={
{EMS,mat,Polygon[{n1,n5=NEWNODE[Sort[{n1,n2}]],n8=NEWNODE[Sort[{n1,n3}]],n9=NEWNODE[Sort[{n1,n2,n3,n4}]]}]},
{EMS,mat,Polygon[{n5,n2,n9,n6=NEWNODE[Sort[{n2,n4}]]}]},
{EMS,mat,Polygon[{n8,n9,n3,n7=NEWNODE[Sort[{n3,n4}]]}]},
{EMS,mat,Polygon[{n9,n6,n7,n4}]}};

REF[{PLATE,mat_,Triangle[{n1_,n2_,n3_}]}]:={
{PLATE,mat,Triangle[{n1,n4=NEWNODE[Sort[{n1,n2}]],n6=NEWNODE[Sort[{n3,n1}]]}]},
{PLATE,mat,Triangle[{n4,n2,n5=NEWNODE[Sort[{n2,n3}]]}]},
{PLATE,mat,Triangle[{n6,n5,n3}]},
{PLATE,mat,Triangle[{n4,n5,n6}]}};

REF[{PLATE,mat_,Polygon[{n1_,n2_,n3_,n4_}]}]:={
{PLATE,mat,Polygon[{n1,n5=NEWNODE[Sort[{n1,n2}]],n8=NEWNODE[Sort[{n1,n3}]],n9=NEWNODE[Sort[{n1,n2,n3,n4}]]}]},
{PLATE,mat,Polygon[{n5,n2,n9,n6=NEWNODE[Sort[{n2,n4}]]}]},
{PLATE,mat,Polygon[{n8,n9,n3,n7=NEWNODE[Sort[{n3,n4}]]}]},
{PLATE,mat,Polygon[{n9,n6,n7,n4}]}};

REF[{PLATE,mat_,Polygon[{{n1_,n2_},{n3_,n4_}}]}]:={
{PLATE,mat,Polygon[{{n1,n5=NEWNODE[Sort[{n1,n2}]]},{n8=NEWNODE[Sort[{n1,n3}]],n9=NEWNODE[Sort[{n1,n2,n3,n4}]]}}]},
{PLATE,mat,Polygon[{{n5,n2},{n9,n6=NEWNODE[Sort[{n2,n4}]]}}]},
{PLATE,mat,Polygon[{{n8,n9},{n3,n7=NEWNODE[Sort[{n3,n4}]]}}]},
{PLATE,mat,Polygon[{{n9,n6},{n7,n4}}]}};

REF[{SOLID,mat_,Tetrahedron[{n1_,n2_,n3_,n4_}]}]:={
{SOLID,mat,Tetrahedron[{n5=NEWNODE[Sort[{n1,n2}]],n8=NEWNODE[Sort[{n1,n4}]],
n7=NEWNODE[Sort[{n1,n3}]],n1}]},
{SOLID,mat,Tetrahedron[{n5,n6=NEWNODE[Sort[{n2,n3}]],
n9=NEWNODE[Sort[{n2,n4}]],n2}]},
{SOLID,mat,Tetrahedron[{n8,n9,n10=NEWNODE[Sort[{n3,n4}]],n4}]},
{SOLID,mat,Tetrahedron[{n7,n10,n6,n3}]},
{SOLID,mat,Tetrahedron[{n5,n8,n9,n10}]}
 };


REFINE[{ele_,fun_}]:=Module[{funout=fun,eleout=ele,ii,rule,a1,a2,a3,a4,a5,a6,left,right},

(*refinement inherits conditions and has memory*)
ii =Length[funout]+1;
Clear[NEWNODE,NEWNODET];

NEWNODET[{a1_,a2_}]:=NEWNODET[{a1,a2}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]])/2,
{If[AllTrue[funout[[{a1,a2},2,1]],NumberQ],Mean[funout[[{a1,a2},2,1]]],uX[ii]],If[AllTrue[funout[[{a1,a2},2,2]],NumberQ],Mean[funout[[{a1,a2},2,2]]],uY[ii]],If[AllTrue[funout[[{a1,a2},2,3]],NumberQ],Mean[funout[[{a1,a2},2,3]]],uZ[ii]]},
{If[AllTrue[funout[[{a1,a2},3,1]],NumberQ],Mean[funout[[{a1,a2},3,1]]],θX[ii]],If[AllTrue[funout[[{a1,a2},3,2]],NumberQ],Mean[funout[[{a1,a2},3,2]]],θY[ii]],If[AllTrue[funout[[{a1,a2},3,3]],NumberQ],Mean[funout[[{a1,a2},3,3]]],θZ[ii]]},
  If[AllTrue[funout[[{a1,a2},4]],NumberQ],Mean[funout[[{a1,a2},3,3]]],ϑ[ii]]}}];ii++];

NEWNODE[{a1_,a2_}]:=NEWNODE[{a1,a2}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]])/2,
{If[AllTrue[funout[[{a1,a2},2,1]],NumberQ],Mean[funout[[{a1,a2},2,1]]],uX[ii]],If[AllTrue[funout[[{a1,a2},2,2]],NumberQ],Mean[funout[[{a1,a2},2,2]]],uY[ii]],If[AllTrue[funout[[{a1,a2},2,3]],NumberQ],Mean[funout[[{a1,a2},2,3]]],uZ[ii]]},
{If[AllTrue[funout[[{a1,a2},3,1]],NumberQ],Mean[funout[[{a1,a2},3,1]]],θX[ii]],If[AllTrue[funout[[{a1,a2},3,2]],NumberQ],Mean[funout[[{a1,a2},3,2]]],θY[ii]],If[AllTrue[funout[[{a1,a2},3,3]],NumberQ],Mean[funout[[{a1,a2},3,3]]],θZ[ii]]}}}];ii++];

offset[κ_,n1_,n2_]:=Module[{r12,L},
If[κ==0,{0,0,0},
r12=funout[[n2,1]]-funout[[n1,1]];
L=Sqrt[r12.r12];
-{0,0,1}\[Cross]r12/L*(1./κ-Sqrt[1./κ^2-L^2/4])]];

NEWNODE[{BEAM,κ_},{n1_,n2_}]:=NEWNODE[{BEAM,κ},{n1,n2}]=CompoundExpression[
funout=Join[funout,{
{(funout[[n1,1]]+funout[[n2,1]])/2+offset[κ,n1,n2],
{If[AllTrue[funout[[{n1,n2},2,1]],NumberQ],Mean[funout[[{n1,n2},2,1]]],uX[ii,0]],
If[AllTrue[funout[[{n1,n2},2,2]],NumberQ],Mean[funout[[{n1,n2},2,2]]],uY[ii,0]],
If[AllTrue[funout[[{n1,n2},2,3]],NumberQ],Mean[funout[[{n1,n2},2,3]]],uZ[ii,0]]},
{If[AllTrue[funout[[{n1,n2},3,1]],NumberQ],Mean[funout[[{n1,n2},3,1]]],uX[ii,1]],
If[AllTrue[funout[[{n1,n2},3,2]],NumberQ],Mean[funout[[{n1,n2},3,2]]],uY[ii,1]],
If[AllTrue[funout[[{n1,n2},3,3]],NumberQ],Mean[funout[[{n1,n2},3,3]]],uZ[ii,1]]} }}];ii++];

NEWNODE[{a1_,a2_,a3_,a4_}]:=NEWNODE[{a1,a2,a3,a4}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]]+funout[[a3,1]]+funout[[a4,1]])/4,
{If[AllTrue[funout[[{a1,a2,a3,a4},2,1]],NumberQ],Mean[funout[[{a1,a2,a3,a4},2,1]]],uX[ii]],If[AllTrue[funout[[{a1,a2,a3,a4},2,2]],NumberQ],Mean[funout[[{a1,a2,a3,a4},2,2]]],uY[ii]],If[AllTrue[funout[[{a1,a2,a3,a4},2,3]],NumberQ],Mean[funout[[{a1,a2,a3,a4},2,3]]],uZ[ii]]},
{If[AllTrue[funout[[{a1,a2,a3,a4},3,1]],NumberQ],Mean[funout[[{a1,a2,a3,a4},3,1]]],θX[ii]],If[AllTrue[funout[[{a1,a2,a3,a4},3,2]],NumberQ],Mean[funout[[{a1,a2,a3,a4},3,2]]],θY[ii]],If[AllTrue[funout[[{a1,a2,a3,a4},3,3]],NumberQ],Mean[funout[[{a1,a2,a3,a4},3,3]]],θZ[ii]]}  }}];ii++];

NEWNODE[BAR,{a1_,a2_}]:=NEWNODE[{a2,a1}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]])/2,
ux[ii]*Simplify[(funout[[a2,1]]-funout[[a1,1]])/
Sqrt[(funout[[a2,1]]-funout[[a1,1]]).(funout[[a2,1]]-funout[[a1,1]])],L>0],
{0,0,0}}}];ii++];

NEWNODET[BAR,{a1_,a2_}]:=NEWNODET[BAR,{a2,a1}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]])/2,
ux[ii]*Simplify[(funout[[a2,1]]-funout[[a1,1]])/
Sqrt[(funout[[a2,1]]-funout[[a1,1]]).(funout[[a2,1]]-funout[[a1,1]])],L>0],
{0,0,0},  If[AllTrue[funout[[{a1,a2},4]],NumberQ],Mean[funout[[{a1,a2},3,3]]],ϑ[ii]]}}];ii++];

(*DO IT*)
eleout=Flatten[Map[REF[#]&,eleout],1];

Return[{eleout,funout}]];


REFINE[{ele_,fun_,lnk_}]:=Module[{funout=fun,eleout=ele,lnkout=lnk,ii,rule,a1,a2,a3,a4,a5,a6,left,right},

(*refinement inherits conditions and has memory*)
ii =Length[funout]+1;
Clear[NEWNODE];

NEWNODE[{a1_,a2_}]:=NEWNODE[{a1,a2}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]])/2,
{If[AllTrue[funout[[{a1,a2},2,1]],NumberQ],Mean[funout[[{a1,a2},2,1]]],uX[ii]],If[AllTrue[funout[[{a1,a2},2,2]],NumberQ],Mean[funout[[{a1,a2},2,2]]],uY[ii]],If[AllTrue[funout[[{a1,a2},2,3]],NumberQ],Mean[funout[[{a1,a2},2,3]]],uZ[ii]]},
{If[AllTrue[funout[[{a1,a2},3,1]],NumberQ],Mean[funout[[{a1,a2},3,1]]],θX[ii]],If[AllTrue[funout[[{a1,a2},3,2]],NumberQ],Mean[funout[[{a1,a2},3,2]]],θY[ii]],If[AllTrue[funout[[{a1,a2},3,3]],NumberQ],Mean[funout[[{a1,a2},3,3]]],θZ[ii]]}}}];ii++];

NEWNODE[BAR,{a1_,a2_}]:=NEWNODE[{a2,a1}]=CompoundExpression[funout=Join[funout,{
{(funout[[a1,1]]+funout[[a2,1]])/2,
ux[ii]*Simplify[(funout[[a2,1]]-funout[[a1,1]])/
Sqrt[(funout[[a2,1]]-funout[[a1,1]]).(funout[[a2,1]]-funout[[a1,1]])],L>0],
{0,0,0}}}];ii++];

(*driven by this*)

rule:={
{PLANE,mat_,Triangle[{n1_,n2_,n3_}]}:>{
{PLANE,mat,Triangle[{n1,n4=NEWNODE[Sort[{n1,n2}]],n6=NEWNODE[Sort[{n3,n1}]]}]},
{PLANE,mat,Triangle[{n4,n2,n5=NEWNODE[Sort[{n2,n3}]]}]},
{PLANE,mat,Triangle[{n6,n5,n3}]},
{PLANE,mat,Triangle[{n4,n5,n6}]}}
};

eleout=Flatten[(eleout /. rule),1];

Return[{eleout,funout}]];

FORMAT defs

STANDARDFORM[δW_]:=STANDARDFORM[{DISP},δW];

STANDARDFORM[{DISP},δW_]:= Print["δW = -",((MatrixForm[δDOFS[δW]])^T),"(",MatrixForm[Simplify[-D[D[δW,{δDOFS[δW]}],{DOFS[δW]}]]],
"",MatrixForm[DOFS[δW]],"-",MatrixForm[Simplify[D[δW,{δDOFS[δW]}] /.Thread[DOFS[δW]->0]]],")"];

STANDARDFORM[{ele_,fun_}]:=STANDARDFORM[{DISP},{ele,fun}];

STANDARDFORM[{DISP},{ele_,fun_}]:= Module[{δWW,dof,δdof,equ},
δWW=Simplify[Apply[Plus,Map[δW[DISP,#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
Print["δW = -",((MatrixForm[δdof])^T),"(",MatrixForm[Simplify[-D[D[δWW,{δdof}],{dof}]]],
"",MatrixForm[dof],"-",MatrixForm[Simplify[D[δWW,{δdof}] /.Thread[dof->0]]],")"]];

STANDARDFORM[{STAB},{ele_,fun_}]:= Module[{δWW,dof,δdof,equ},
δWW=Simplify[Apply[Plus,Map[δW[{STAB,Null},#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ=Simplify[D[δWW,{δdof}]];
Print["δW = -",((MatrixForm[δdof])^T),MatrixForm[Simplify[equ]]  ]];

STANDARDFORM[{NONL},{ele_,fun_}]:= Module[{δWW,dof,δdof,equ},
δWW=Simplify[Apply[Plus,Map[δW[NONL,#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ=Simplify[D[δWW,{δdof}]];
Print["δW = -",((MatrixForm[δdof])^T),MatrixForm[Simplify[-equ]]  ]];

STANDARDFORM[{VIBR},δW_]:= Module[{dof,δdof,equ,dofall,dof0,dof2,KK,MM},
dof=DOFS[δW];δdof=δDOFS[δW];
equ =D[δW,{δdof}];
dofall=Union[dof /. anya_[anyb__,0|2]->anya[anyb]];
dof0 =dofall /.DRULE[0];
dof2 =dofall/. DRULE[2];
KK =D[equ,{dof0}];
MM =D[equ,{dof2}];
Print["δW = -",((MatrixForm[δdof])^T),"(",MatrixForm[Simplify[-KK]],
"",MatrixForm[dof0],"+",MatrixForm[Simplify[-MM]],
"",MatrixForm[dof2],"-",MatrixForm[equ /.Thread[dof->0]],")"]];

STANDARDFORM[{VIBR},{ele_,fun_}]:= Module[{δWW,dof,δdof,equ,dofall,dof0,dof2,KK,MM},
δWW=Simplify[Apply[Plus,Map[δW[VIBR,#,fun]&,ele]]];
dof=DOFS[δWW];δdof=δDOFS[δWW];
equ =D[δWW,{δdof}];
dofall=Union[dof /. anya_[anyb_,0|2]->anya[anyb]];
dof0 =dofall /. DRULE[0];
dof2 =dofall/. DRULE[2];
KK =D[equ,{dof0}];
MM =D[equ,{dof2}];
Print["δW = -",((MatrixForm[δdof])^T),"(",MatrixForm[Simplify[-KK]],
"",MatrixForm[dof0],"+",MatrixForm[Simplify[-MM]],
"",MatrixForm[dof2],"-",MatrixForm[equ /.Thread[dof->0]],")"]];

FORMATTED[{ele_,fun_}]:=Grid[{{TableForm[ele,TableDepth->2,TableHeadings->{Array[#&,Length[ele]],{"type","properties","geometry"}}]},
{},
{TableForm[fun,TableDepth->2,TableHeadings->{Array[#&,Length[fun]],{"{X,Y,Z}","{(Subscript[u, X]),(Subscript[u, Y]),(Subscript[u, Z])}","{(Subscript[θ, X]),(Subscript[θ, Y]),(Subscript[θ, Z])}","ϑ"}}]}},Alignment->Left];


SHAPERULES:={Polygon[{n1_,n2_,n3_,n4_}]:>{Triangle[{n1,n2,n3}],Triangle[{n3,n2,n4}]}};

MESH[{ele_,fun_}]:=Module[{pick,labs,crds,ℛ},
pick=Map[Not[AllTrue[#,PossibleZeroQ]]&,Transpose[fun[[;;,1]]]];
crds=Pick[{1,2,3},pick];
labs=Pick[{"X","Y","Z"},pick];
ℛ=MeshRegion[fun[[;;,1,crds]] ,Map[Last[#]&,ele] /.SHAPERULES];
Show[HighlightMesh[ℛ,Style[1,Thin]],HighlightMesh[ℛ,0],AxesLabel->labs,Axes->True,SphericalRegion->True]];

STYLE[a_]:=None;
STYLE[BEAM]:=Red;
STYLE[BAR]:=Green;
STYLE[RIGID]:=Black;
STYLE[FORCE]:=Black;
STYLE[SOLID]:=Gray;

DISP[{ele_,fun_}]:=Module[{pick,labs,crds,ℛ},
pick=Map[Not[AllTrue[#,PossibleZeroQ]]&,Transpose[fun[[;;,1]]]];
crds=Pick[{1,2,3},pick];
labs=Pick[{"X","Y","Z"},pick];
ℛ=MeshRegion[fun[[;;,1,crds]]+fun[[;;,2,crds]] ,Map[Style[Last[#],STYLE[First[#]]]&,ele] /.SHAPERULES];
Show[HighlightMesh[ℛ,Style[1,Thin]],HighlightMesh[ℛ,0],AxesLabel->labs,Axes->True,Boxed->True,PlotRange->All,SphericalRegion->True]];

STRESS[{ele_,fun_}]:=Map[If[#[[1]]===PLANE,δW[STRES,#,fun],None]&,ele];

COLORFUNCTION[min_,max_]:=If[#<0,Blend[{Blue,LightGray},(#-min)/(0-min)],Blend[{LightGray,Red},(#-0)/(max-0)]]&;

(*stress calculations*)
DISP[{ele_,fun_},elements_]:=Module[{pick,labs,crds,stress,min,max,rule},
pick=Map[Not[AllTrue[#,PossibleZeroQ]]&,Transpose[fun[[;;,1]]]];
crds=Pick[{1,2,3},pick];
labs=Pick[{"X","Y","Z"},pick];
stress =Map[δW[STRES,#,fun]&,ele];
min=Table[Min[stress[[;;,el[[1]],el[[2]] ]] ],{el,elements}];
max=Table[Max[stress[[;;,el[[1]],el[[2]] ]] ],{el,elements}];
rule :={Triangle[{n1_,n2_,n3_}]:> Triangle[(fun[[{n1,n2,n3},1,1;;2]]+fun[[{n1,n2,n3},2,1;;2]])],
Polygon[{n1_,n2_,n3_}]:> Polygon[(fun[[{n1,n2,n3},1,1;;2]]+fun[[{n1,n2,n3},2,1;;2]])]};
Table[Show[Graphics[Table[{COLORFUNCTION[ min[[i]],max[[i]]][stress[[e,elements[[i,1]],elements[[i,2]] ]]  ],ele[[e,3]]/.rule},{e,1,Length[ele]}]],Frame->True,FrameLabel->labs],{i,1,Length[elements]}]  
];

POST defs

Clear[SHOW,GRAPH];

box ={{-1,1},{-1,1},{-1,1}}*1.5;
jointsize =0.02;
scale =1.;
aspectratio=1/4;

PRINT[label_,{ele_,fun_}] := Print[label," ",MatrixForm[ele,TableDepth->2]," ",MatrixForm[fun,TableDepth->2]];

PRINT[label_,{tab_}] := Print[label," ",MatrixForm[tab,TableDepth->2]];

SHOW[var_,rule_,time_]:=Module[{nn,ne,sol},
nn=Length[time];
ne =Length[var];
Table[
sol=Table[{time[[ii]],(var[[jj]] /. rule[[ii]])},{ii,1,nn}];
ListPlot[sol,Joined->True,Frame-> True,PlotRange-> All,AspectRatio->aspectratio],{jj,1,ne}]];


SHOW[{MODE,step_,time_},{ele_,funin_}]:=Map[(fun = funin /. t -> #; SHOW[{DISP},{ele,fun}])&,time];

SHOW[{STAB,rule_},{ele_,funin_}]:=Map[(fun = funin /. #; SHOW[{DISP},{ele,fun}])&,rule];

SHOW[{DG,rule_,time_},{ele_,funin_}]:=Module[{localrule},
localrule =rule /.{a[b_,0]-> a[b]};
Table[fun = (funin /.localrule[[ii]]); SHOW[{DISP},{ele,fun}],{ii,1,Length[rule]}]];

SHOW[{DISP},{ele_,fun_}]:=Show[Graphics3D[GRAPHICS[{ele,fun}],Axes-> True,Boxed->True,SphericalRegion -> True,Lighting->Automatic,AxesLabel->{"X","Y","Z"}],PlotRange->box];

SHOW[{DISP,rule_},{ele_,fun_}]:=Show[Graphics3D[GRAPHICS[{ele,fun /.rule}],Axes-> True,Boxed->True,SphericalRegion -> True,Lighting->None,AxesLabel->{"X","Y","Z"}],PlotRange->box];

GRAPHICS[{ele_,fun_}]:=Flatten[Join[Map[GRAPH[#]&,ele]]];


GRAPH[{FORCE,{FX_,FY_,FZ_,MX_,MY_,MZ_},{I1_}}]:={};

GRAPH[{GLUE,{{kx_,ky_}},{I1_,I2_}}]:={};

GRAPH[{GLUE,{{kx_,ky_,kz_},{z1_,z2_,iy_}},{I1_,I2_,I3_,I4_}}]:={};

GRAPH[{GLUE,{{kx_,ky_,kz_},{z1_,z2_,ty_,iy_}},{I1_,I2_,I3_,I4_,I5_,I6_}}]:={};

GRAPH[{GLUET,{{kx_,ky_,kz_},{z1_,z2_,ty_,iy_}},{I1_,I2_,I3_,I4_,I5_,I6_}}]:={};

GRAPH[{RIGID,{{mm_,Ixx_,Iyy_,Izz_,ix_,iy_},{Fx_,Fy_,Fz_,Mx_,My_,Mz_}},{I1_}}]:={};

GRAPH[{BAR,{{EE_,ρρ_},{AA_},{fx_}},{I1_,I2_}}]:={Thickness[0.005],Black,Line[{XYZ[I1]+UVW[I1]*scale,XYZ[I2]+UVW[I2]*scale }],Blue,PointSize[jointsize],Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale]};

GRAPH[{BAR,list_,{I1_,I2_}}]:={Thickness[0.005],Black,Line[{XYZ[I1]+UVW[I1]*scale,XYZ[I2]+UVW[I2]*scale }],Blue,PointSize[jointsize],Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale]};


GRAPH[{BEAM,{{EE_,GG_,ρρ_},{AA_,Irr_,Iyy_,Izz_,iy_},{fx_,fy_,fz_}},{I1_,I2_}}]:=Module[{ix,hx,iz,ty,tz,Ω,NL,NC,XX,YY,ZZ,uu,vv,ww,ϕϕ,ΘΘ,ψψ,XYZN},
{ix,hx}=UNIT[XYZ[I2]-XYZ[I1]];
iz=CROSS[ix,iy];
ty =Sqrt[12*Iyy/AA]/2; 
tz =Sqrt[12*Izz/AA]/2;
Ω ={{0},{hx}};
NL= SHAPES1[ {1,x},Ω];
NC= SHAPES11[ {1,x,x^2,x^3},Ω];
XX= NL.{X[I1],X[I2]};
YY= NL.{Y[I1],Y[I2]};
ZZ= NL.{Z[I1],Z[I2]};
uu= NL.{ix.UVW[I1],ix.UVW[I2]}*scale;
vv= NC.{iy.UVW[I1],iz.ϕΘψ[I1],iy.UVW[I2],iz.ϕΘψ[I2]}*scale;
ww= NC.{iz.UVW[I1],-iy.ϕΘψ[I1],iz.UVW[I2],-iy.ϕΘψ[I2]}*scale;
ϕϕ= NL.{ix.ϕΘψ[I1],ix.ϕΘψ[I2]}*scale;
ΘΘ=-(∂_x)ww;
ψψ= (∂_x)vv;
XYZN[y_,z_]={XX,YY,ZZ}+ix*uu+iy*(y+vv)+iz*(z+ww)+CROSS[ix*ϕϕ+iy*ΘΘ+iz*ψψ,iy*y+iz*z] ;
Join[ Table[
{FaceForm[Gray],Polygon[{XYZN[ty,tz],XYZN[-ty,tz],XYZN[-ty,-tz],XYZN[ty,-tz]} ]/.x->xr},   {xr,0,hx,hx/20}] ,{Gray},{Line[Table[XYZN[0,0]/.x->xr,{xr,0,hx,hx/50}] ]} ,
{Blue,Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale]}   ]];

GRAPH[{BEAM,{{EE_,GG_,ρρ_},{AA_,Irr_,Iyy_,Izz_,iy_},{fx_,fy_,fz_}},{I1_,I2_,I3_}}]:=Module[{ix,hx,iz,ty,tz,Ω,NL,NC,XX,YY,ZZ,uu,vv,ww,ϕϕ,ΘΘ,ψψ,XYZN},
{ix,hx}=UNIT[XYZ[I3]-XYZ[I1]];
iz=CROSS[ix,iy];
ty =Sqrt[12*Iyy/AA]/2; 
tz =Sqrt[12*Izz/AA]/2;
Ω ={{0},{hx}};
NL= SHAPES1[ {1,x},Ω];
NQ= SHAPES1[ {1,x,x^2},{{0},{hx}/2,{hx}}];
NC= SHAPES11[ {1,x,x^2,x^3},Ω];
XX= NL.{X[I1],X[I3]};
YY= NL.{Y[I1],Y[I3]};
ZZ= NL.{Z[I1],Z[I3]};
uu= NQ.{ix.UVW[I1],ix.UVW[I2],ix.UVW[I3]}*scale;
vv= NC.{iy.UVW[I1],iz.ϕΘψ[I1],iy.UVW[I3],iz.ϕΘψ[I3]}*scale;
ww= NC.{iz.UVW[I1],-iy.ϕΘψ[I1],iz.UVW[I3],-iy.ϕΘψ[I3]}*scale;
ϕϕ= NL.{ix.ϕΘψ[I1],ix.ϕΘψ[I3]}*scale;
ΘΘ=-(∂_x)ww;
ψψ= (∂_x)vv;
XYZN[y_,z_]={XX,YY,ZZ}+ix*uu+iy*(y+vv)+iz*(z+ww)+CROSS[ix*ϕϕ+iy*ΘΘ+iz*ψψ,iy*y+iz*z] ;
Join[ Table[
{FaceForm[Gray],Polygon[{XYZN[ty,tz],XYZN[-ty,tz],XYZN[-ty,-tz],XYZN[ty,-tz]} ]/.x->xr},   {xr,0,hx,hx/20}] ,{Gray},{Line[Table[XYZN[0,0]/.x->xr,{xr,0,hx,hx/50}] ]} ,
{Blue,Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale]}   ]];


GRAPH[{BEAMT,{{EE_,GG_,ρρ_},{AA_,Irr_,Iyy_,Izz_,iy_},{fx_,fy_,fz_}},{I1_,I2_,I3_}}]:=Module[{ix,hx,iz,ty,tz,Ω,NL,NC,XX,YY,ZZ,uu,vv,ww,ϕϕ,ΘΘ,ψψ,XYZN},
{ix,hx}=UNIT[XYZ[I3]-XYZ[I1]];
iz=CROSS[ix,iy];
ty =Sqrt[12*Iyy/AA]/2; 
tz =Sqrt[12*Izz/AA]/2;
Ω ={{0},{hx}};
NQ= SHAPES1[ {1,x,x^2},{{0},{hx}/2,{hx}}];
XX= NQ.{X[I1],X[I2],X[I3]};
YY= NQ.{Y[I1],Y[I2],Y[I3]};
ZZ= NQ.{Z[I1],Z[I2],Z[I3]};
uu= NQ.{ix.UVW[I1],ix.UVW[I2],ix.UVW[I3]}*scale;
vv= NQ.{iy.UVW[I1],iy.UVW[I2],iy.UVW[I3]}*scale;
ww= NQ.{iz.UVW[I1],iz.UVW[I2],iz.UVW[I3]}*scale;
ϕϕ= NQ.{ix.ϕΘψ[I1],ix.ϕΘψ[I2],ix.ϕΘψ[I3]}*scale;
ΘΘ= NQ.{iy.ϕΘψ[I1],iy.ϕΘψ[I2],iy.ϕΘψ[I3]}*scale;;
ψψ=  NQ.{iz.ϕΘψ[I1],iz.ϕΘψ[I2],iz.ϕΘψ[I3]}*scale;;
XYZN[y_,z_]={XX,YY,ZZ}+ix*uu+iy*(y+vv)+iz*(z+ww)+CROSS[ix*ϕϕ+iy*ΘΘ+iz*ψψ,iy*y+iz*z] ;
Join[ Table[
{FaceForm[Gray],Polygon[{XYZN[ty,tz],XYZN[-ty,tz],XYZN[-ty,-tz],XYZN[ty,-tz]} ]/.x->xr},   {xr,0,hx,hx/20}] ,{Gray},{Line[Table[XYZN[0,0]/.x->xr,{xr,0,hx,hx/50}] ]} ,
{Blue,Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale]}   ]];


GRAPH[{PLANE,{{EE_,νν_,ρρ_},{tt_},{fx_,fy_}},{I1_,I2_,I3_}}]:=
{Gray,Polygon[ XYZ[{I1,I2,I3,I1}]+ UVW[{I1,I2,I3,I1}]*scale],Blue,Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale],Point[XYZ[I3]+UVW[I3]*scale]};

GRAPH[{PLANE,{{EE_,νν_,ρρ_},{tt_},{fx_,fy_}},{I1_,I2_,I3_,I4_}}]:=
{Gray,Polygon[ XYZ[{I1,I2,I4,I3,I1}]+ UVW[{I1,I2,I4,I3,I1}]*scale],Blue,Point[XYZ[I1]+UVW[I1]*scale],Point[XYZ[I2]+UVW[I2]*scale],Point[XYZ[I3]+UVW[I3]*scale],Point[XYZ[I4]+UVW[I4]*scale]};

Pre needs 1005

(*enrich Line[{a__}]-objects*)
Clear[ENRICH,EXTRUDE];

ENRICH[{nod_,crd_}]:=Module[{FN,ii,rule,nodout,crdout},
crdout =crd;nodout=nod;
ii=Length[crdout]+1;
FN[{a_,b_}]:=FN[{b,a}]=CompoundExpression[crdout=Join[crdout,{(2crdout[[a]]+crdout[[b]])/3,(crdout[[a]]+2crdout[[b]])/3}];{ii++,ii++}];
rule:=Line[{a_,b_}]:>Line[Flatten[{a,FN[{a,b}],b}]];
nodout=(nodout/. rule);
Return[{nodout,crdout}]];

(*extrude a cross-section in z-direction*)
EXTRUDE[{nod_,crd_},{ns_,np_},L_]:=Module[{nodout,crdout,offset,nnod},
crdout=Table[ Map[Append[#,L*ii/(np*ns)]&,crd],{ii,0,np*ns}];
nnod=Max[Flatten[nod /. Line[a_]->a]];
offset =Partition[Table[ii,{ii,1, (np+1)*ns-(ns-1)}],np+1,np];
nodout=Flatten[Table[nod /.Line[a_]->ELEMENT[Table[a+(ii-1)*nnod,{ii,off}]],{off,offset}],1] ;
Return[{nodout,crdout}]];

(*extrude a cross-section in z-direction*)
EXTRUDE[{nod_,crd_},np_,z_List]:=Module[{nodout,crdout,offset,nnod,ns},
ns=Length[z]-1;
crdout=Flatten[Table[Table[ Map[Append[#,z[[is]]+(z[[is+1]]-z[[is]])*ii/np]&,crd],{ii,If[is==1,0,1],np}],{is,1,ns}],1];
nnod=Max[Flatten[nod /. Line[a_]->a]];
offset =Partition[Table[ii,{ii,1, (np+1)*ns-(ns-1)}],np+1,np];
nodout=Flatten[Table[nod /.Line[a_]->ELEMENT[Table[a+(ii-1)*nnod,{ii,off}]],{off,offset}],1] ;
Return[{nodout,crdout}]];

LINK[lnk_,fun_]:=Module[ {funout,n1,n2},
funout =fun;
Do[
{n1,n2}=lnk[[i]];
funout[[n1]]={fun[[n1,1]],fun[[n2,2]]+fun[[n2,3]]\[Cross](fun[[n1,1]]-fun[[n2,1]]),fun[[n2,3]]},{i,1,Length[lnk]}];
Return[funout]];

(*one node tie with any element*)
(*could be generalized*)
TIE[n0_,nodes_,fun_]:=Module[ {funout,nξ,nη,ξ,η,NN,x,y,z,u,v,w,ϕ,Θ,ψ},
funout =fun;
{nξ,nη}=Dimensions[nodes];
NN=LAGRANGE[{{nξ,ξ},{nη,η}}];
{x,y,z}=NN.fun[[Flatten[nodes],1]];
{ξ,η}=MinimalBy[Flatten[Table[{ξ,η, Norm[fun[[n0,1]]-{x,y,z}]},{ξ,0,1,1/20},{η,0,1,1/20}],1],Last][[1,1;;2]];
{u,v,w}=NN.fun[[Flatten[nodes],2]];
{ϕ,Θ,ψ}=NN.fun[[Flatten[nodes],3]];
funout[[n0]]={fun[[n0,1]],{u,v,w},{ϕ,Θ,ψ}};
Return[funout]];

(*one node tie with any element
(*could be generalized*)
TIE[n0_,nodes_,fun_]:=Module[ {funout,nξ,nη,ξ,η,NN,x,y,z,u,v,w,ϕ,Θ,ψ},
funout =fun;
{nξ,nη}=Dimensions[nodes];
NN=LAGRANGE[{{nξ,ξ},{nη,η}}];
{x,y,z}=NN.fun[[Flatten[nodes],1]];
{ξ,η}=MinimalBy[Flatten[Table[{ξ,η, Norm[fun[[n0,1]]-{x,y,z}]},{ξ,0,1,1/20},{η,0,1,1/20}],1],Last][[1,1;;2]];
{u,v,w}=NN.fun[[Flatten[nodes],2]];
{ϕ,Θ,ψ}=NN.fun[[Flatten[nodes],3]];
funout[[n0]]={fun[[n0,1]],{u,v,w},{ϕ,Θ,ψ}};
Return[funout]];*)

GRAPHICS defs

(*beam graphics*)

GRAPHICS[MESH,{BEAM,pro_,Line[{n1_,n2_}]},fun_]:={Gray,Cylinder[{fun[[n1,1]],fun[[n2,1]]},0.003],Blue,PointSize[Medium],Point[{fun[[n1,1]],fun[[n2,1]]}]};

GRAPHICS[{DISP,scale_},{BEAM,{mat_,{{d_,t_},iy_},for_},Line[{n1_,n2_}]},fun_]:= Module[{ρ,h,NL,NQ,ix,iz,T},
ρ=fun[[n2,1]]-fun[[n1,1]];
h=Simplify[Sqrt[ρ.ρ],{h>0,L>0}];
NL={1-ξ,ξ};
NQ={(((1-ξ))^2) (1+2 ξ),h(((1-ξ))^2) ξ,(3-2 ξ) (ξ^2),h (ξ^2) (ξ-1)};
ix=ρ/h;
iz=ix\[Cross]iy;
T={ix,iy,iz};
ux1=fun[[n1,2]].ix; ux2=fun[[n2,2]].ix;
uy1=fun[[n1,2]].iy; uy2=fun[[n2,2]].iy;
uz1=fun[[n1,2]].iz; uz2=fun[[n2,2]].iz;
θx1=fun[[n1,3]].ix; θx2=fun[[n2,3]].ix;
θy1=fun[[n1,3]].iy; θy2=fun[[n2,3]].iy;
θz1=fun[[n1,3]].iz; θz2=fun[[n2,3]].iz;
u=NL.{ux1,ux2}*scale;
v=NQ.{uy1,-θz1,uy2,-θz2}*scale;
w=NQ.{uz1,-θy1,uz2,-θy2}*scale;
pp=Partition[Table[fun[[n1,1]]+ix*h*ξ+{u,v,w}.T,{ξ,0,1,1/10}],2,1];
pp=Table[fun[[n1,1]]+ix*h*ξ+{u,v,w}.T,{ξ,0,1,1/10}];{Gray,CapForm["Butt"],Tube[pp,d/2 ],Blue,PointSize[Medium],Point[fun[[n1,1]]+fun[[n1,2]]*scale],
Point[fun[[n2,1]]+fun[[n2,2]]*scale]} ];

GRAPHICS[{DISP,scale_},{BEAM,{mat_,{ly_,lz_,iy_},for_},Line[{n1_,n2_}]},fun_]:= Module[{ρ,h,x,y,z,NL,NQ,ix,iz,T,u,v,w,ϕ,θ,ψ},
ρ=fun[[n2,1]]-fun[[n1,1]];
h=Simplify[Sqrt[ρ.ρ],{h>0,L>0}];
ix=ρ/h;
iz=ix\[Cross]iy;
ρ=x ix+y iy+z iz;
T={ix,iy,iz};
NL={1-x/h,x/h};
NQ={(((1-x/h))^2) (1+2 x/h),h(((1-x/h))^2) x/h,(3-2 x/h) (((x/h))^2),h (((x/h))^2) (x/h-1)};
ux1=fun[[n1,2]].ix; ux2=fun[[n2,2]].ix;
uy1=fun[[n1,2]].iy; uy2=fun[[n2,2]].iy;
uz1=fun[[n1,2]].iz; uz2=fun[[n2,2]].iz;
θx1=fun[[n1,3]].ix; θx2=fun[[n2,3]].ix;
θy1=fun[[n1,3]].iy; θy2=fun[[n2,3]].iy;
θz1=fun[[n1,3]].iz; θz2=fun[[n2,3]].iz;
u=NL.{ux1,ux2};
v=NQ.{uy1,-θz1,uy2,-θz2};
w=NQ.{uz1,-θy1,uz2,-θy2};
ϕ=NL.{θx1,θx2};
θ=-(∂_x)w;
ψ=(∂_x)v;
ux=(u+θ z-ψ y)*scale;
uy=(v-ϕ z)*scale;
uz=(w+ϕ y)*scale;
pp=Table[(fun[[n1,1]]+ρ+{ux,uy,uz}.T)/.Thread[{y,z}->yz],{x,0,h,h/10},{yz,{{ly,lz},{-ly,lz},{-ly,-lz},{ly,-lz}}/2}];
Join[{Gray,EdgeForm[]},Table[{
Polygon[{pp[[ii,1]],pp[[ii,2]],pp[[ii+1,2]],pp[[ii+1,1]]}],
Polygon[{pp[[ii,2]],pp[[ii,3]],pp[[ii+1,3]],pp[[ii+1,2]]}],
Polygon[{pp[[ii,4]],pp[[ii,3]],pp[[ii+1,3]],pp[[ii+1,4]]}],
Polygon[{pp[[ii,1]],pp[[ii,4]],pp[[ii+1,4]],pp[[ii+1,1]]}]},{ii,1,Length[pp]-1}],{Blue,PointSize[Medium],Point[fun[[n1,1]]+fun[[n1,2]]*scale],
Point[fun[[n2,1]]+fun[[n2,2]]*scale]}  ]];

GRAPHICS[MESH,{RIGID,pro_,Line[{n1_,n2_}]},fun_]:={Black,Line[{fun[[n1,1]],fun[[n2,1]]}],Blue,PointSize[Medium],Point[{fun[[n1,1]],fun[[n2,1]]}]};

GRAPHICS[{DISP,scale_},{RIGID,pro_,Line[{n1_,n2_}]},fun_]:=Module[{crd1,crd2},
crd1=fun[[n1,1]]+fun[[n1,2]]*scale;
crd2=fun[[n2,1]]+fun[[n2,2]]*scale;{Black,Line[{crd1,crd2}],Blue,PointSize[Medium],Point[{crd1,crd2}]}];

GRAPHICS[{DISP,scale_},{RIGID,{d_,b_,iy_},Line[{n1_,n2_}]},fun_]:=Module[{crd1,crd2},
crd1=fun[[n1,1]]-iy*b/2;
crd2=fun[[n2,1]]+iy*b/2;{Black,Cylinder[{crd1,crd2},d/2],Blue,PointSize[Medium],Point[{crd1,crd2}]}];

GRAPHICS[{DISP,scale_},{FORCE,{{ρ_},{lx_,ly_,lz_,ix_,iy_},{FX_,FY_,FZ_,MX_,MY_,MZ_}},Point[{n1_}]},fun_]:=Module[{r,T},
pnt={{-lx,-ly,-lz},{lx,-ly,-lz},{lx,ly,-lz},{-lx,ly,-lz},
{-lx,-ly,lz},{lx,-ly,lz},{lx,ly,lz},{-lx,ly,lz}}/2;
crd=Map[{ix,iy,ix\[Cross]iy}.#&,pnt];
r=Map[fun[[n1,1]]+#+scale*fun[[n1,2]]+scale*fun[[n1,3]]\[Cross](#-fun[[n1,1]])&,crd];
{Gray,Opacity[0.5],
Polygon[{r[[4]],r[[3]],r[[2]],r[[1]]}],Polygon[{r[[5]],r[[6]],r[[7]],r[[8]]}],Polygon[{r[[1]],r[[2]],r[[6]],r[[5]]}],Polygon[{r[[3]],r[[4]],r[[8]],r[[7]]}],Polygon[{r[[1]],r[[5]],r[[8]],r[[4]]}],Polygon[{r[[2]],r[[3]],r[[7]],r[[6]]}],
Blue,PointSize[Medium],Point[fun[[n1,1]]+scale*fun[[n1,2]]]}];


GRAPHICS[{DISP,scale_},{SHELL,{mat_,{t_},for_},ELEMENT[nodes_]},fun_]:= Module[{node,nα,nβ,α,β,γ,ρ,rα,rβ,rn,r0,n,NN,en,u,v,w,ϕ,θ,ψ,pp,face1,face2,face3,face4,face5,face6},
{nα,nβ}=Dimensions[nodes];
NN=LAGRANGE[{{nα,α},{nβ,β}}];
node=Flatten[nodes];
r0=NN.fun[[node,1]];
{u,v,w}=NN.fun[[node,2]];
{ϕ,θ,ψ}=NN.fun[[node,3]];
rα=(∂_α)r0 /.{α->1/2,β->1/2};
rβ=(∂_β)r0 /.{α->1/2,β->1/2};
rn=rα\[Cross]rβ;
en=rn/Norm[rn];
ρ=en*γ;
n=5;
pp=Table[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /. γ->t/2,{β,0,1,1/n},{α,0,1,1/n}];
face1=Flatten[Table[{pp[[i,j]],pp[[i+1,j]],pp[[i+1,j+1]],pp[[i,j+1]]},{j,1,n},{i,1,n}],1];
pp=Table[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /. γ->-t/2 ,{β,0,1,1/n},{α,0,1,1/n}];
face2=Flatten[Table[Reverse[{pp[[i,j]],pp[[i+1,j]],pp[[i+1,j+1]],pp[[i,j+1]]}],{j,1,n},{i,1,n}],1];
pp=Table[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /. β->1,{γ,-t/2,t/2,t/n},{α,0,1,1/n}];
n=1;
face3=Flatten[Table[{pp[[i,j]],pp[[i+1,j]],pp[[i+1,j+1]],pp[[i,j+1]]},{j,1,n},{i,1,n}],1];
pp=Table[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /. β->0,{γ,-t/2,t/2,t/n},{α,0,1,1/n}];
face4=Flatten[Table[Reverse[{pp[[i,j]],pp[[i+1,j]],pp[[i+1,j+1]],pp[[i,j+1]]}],{j,1,n},{i,1,n}],1];
pp=Table[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /. α->1,{γ,-t/2,t/2,t/n},{β,0,1,1/n}];
face5=Flatten[Table[{pp[[i,j]],pp[[i+1,j]],pp[[i+1,j+1]],pp[[i,j+1]]},{j,1,n},{i,1,n}],1];
pp=Table[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /. α->0,{γ,-t/2,t/2,t/n},{β,0,1,1/n}];
face6=Flatten[Table[Reverse[{pp[[i,j]],pp[[i+1,j]],pp[[i+1,j+1]],pp[[i,j+1]]}],{j,1,n},{i,1,n}],1];
{Gray,Opacity[0.5],EdgeForm[],Polygon[face1],Polygon[face2],Polygon[face3],Polygon[face4],Polygon[face5],Polygon[face6],Blue,PointSize[Tiny],Point[fun[[node,1]]+fun[[node,2]]*scale]} ];

GRAPHICS[{DISP,scale_},{BEAM,{mat_,{d_,iy_},for_},Line[{n1_,n2_}]},fun_]:= Module[{ρ,h,NL,NQ,ix,iz,T},
ρ=fun[[n2,1]]-fun[[n1,1]];
h=Simplify[Sqrt[ρ.ρ],{h>0,L>0}];
NL={1-ξ,ξ};
NQ={(((1-ξ))^2) (1+2 ξ),h(((1-ξ))^2) ξ,(3-2 ξ) (ξ^2),h (ξ^2) (ξ-1)};
ix=ρ/h;
iz=ix\[Cross]iy;
T={ix,iy,iz};
ux1=fun[[n1,2]].ix; ux2=fun[[n2,2]].ix;
uy1=fun[[n1,2]].iy; uy2=fun[[n2,2]].iy;
uz1=fun[[n1,2]].iz; uz2=fun[[n2,2]].iz;
θx1=fun[[n1,3]].ix; θx2=fun[[n2,3]].ix;
θy1=fun[[n1,3]].iy; θy2=fun[[n2,3]].iy;
θz1=fun[[n1,3]].iz; θz2=fun[[n2,3]].iz;
u=NL.{ux1,ux2}*scale;
v=NQ.{uy1,-θz1,uy2,-θz2}*scale;
w=NQ.{uz1,-θy1,uz2,-θy2}*scale;
pp=Partition[Table[fun[[n1,1]]+ix*h*ξ+{u,v,w}.T,{ξ,0,1,1/10}],2,1];
pp=Table[fun[[n1,1]]+ix*h*ξ+{u,v,w}.T,{ξ,0,1,1/10}];{Gray,Tube[pp,d/2 ],Blue,PointSize[Medium],Point[fun[[n1,1]]+fun[[n1,2]]*scale],
Point[fun[[n2,1]]+fun[[n2,2]]]*scale} ];

GRAPHICS[{DISP,scale_},{FORCE,{FX_,FY_,FZ_},Point[{n1_}]},fun_]:=Module[{L,r0},L=Max[Map[#[[2]]-#[[1]]&,Table[MinMax[fun[[;;,1,i]]],{i,1,3}]]];
r0=fun[[n1,1]]+scale*fun[[n1,2]];
{Black,Thick,Arrowheads[Medium],Arrow[{r0,r0+L/10*{FX,FY,FZ}/Max[Norm[{FX,FY,FZ}],1/100]}]}];

MESH3D[{ele_,fun_}]:=SHOW3D[MESH,{ele,fun}];

SHOW3D[MESH,{ele_,fun_}]:=Module[{},
Show[Graphics3D[ Flatten[Map[GRAPHICS[MESH,#,fun ]&,ele],1]],
AxesLabel->{"X","Y","Z"},Axes->True,SphericalRegion->True,Lighting->"Neutral"]];

SHOW3D[{DISP,scale_},{ele_,fun_}]:=Module[{},
Show[Graphics3D[ Flatten[Map[GRAPHICS[{DISP,scale},#,fun ]&,ele],1]],
AxesLabel->{"X","Y","Z"},Axes->True,SphericalRegion->True,Lighting->"Neutral"]];

(*ad hoc geometry*)

GRAPHICS[{DISP,scale_},{RIGID,{},Point[{n1_,n2_}]},fun_]:={};

δW[DISP,{CORNERE,dat_,nod_},fun_]:=0;

GRAPHICS[{DISP,scale_},{CORNERE,{{d_,l_},i1_,i2_},Point[{n1_}]},fun_]:=Module[{i3,r0,dr1,dr2,dr3},
i3=i1\[Cross]i2/Norm[i1\[Cross]i2];
r0=fun[[n1,1]]+scale*fun[[n1,2]];
dr1=i1*l+scale*fun[[n1,3]]\[Cross]i1*l;
dr2=i2*l+scale*fun[[n1,3]]\[Cross]i2*l;
dr3=i3*l+scale*fun[[n1,3]]\[Cross]i3*l;
{Red,Sphere[r0,d/2],Cylinder[{r0,r0+dr1},d/2],Cylinder[{r0,r0+dr2},d/2],Cylinder[{r0,r0+dr3},d/2]}];

δW[DISP,{PIVOTA,dat_,Point[{n1_,n2_}]},fun_]:=0;

GRAPHICS[{DISP,scale_},{PIVOTA,{{d_,l_},i1_,i2_},Point[{n1_,n2_}]},fun_]:=
Module[{i3,r0,dr1,dr2,dr3},
i3=i1\[Cross]i2/Norm[i1\[Cross]i2];
r0=fun[[n1,1]]+scale*fun[[n1,2]];
dr1=i1*l+scale*fun[[n2,3]]\[Cross]i1*l;
dr2=i2*l+scale*fun[[n1,3]]\[Cross]i2*l;
dr3=i3*d/4+scale*fun[[n1,3]]\[Cross]i3*d/4;
{Blue,Cylinder[{r0,r0+dr1},d/2],Cylinder[{r0-dr2,r0+dr2},d/2],Cylinder[{r0-dr3,r0+dr3},d]}];

δW[DISP,{SLEEVEA,dat_},fun_]:=0;

GRAPHICS[{DISP,scale_},{SLEEVEA,{{d_,l_},i1_,i2_},Point[{n1_}]},fun_]:=Module[{i3,r0,r1,dr1,dr2,dr3},
i3=i1\[Cross]i2/Norm[i1\[Cross]i2];
r0=fun[[n1,1]]+scale*fun[[n1,2]];
r1=r0+i2*d/2+fun[[n1,3]]\[Cross]i2*d/2*scale;
dr1=i1*l/2+scale*fun[[n1,3]]\[Cross]i1*l/2;
dr3=i3*d/8+scale*fun[[n1,3]]\[Cross]i3*d/8;
{Blue,Cylinder[{r0-dr1,r0+dr1},d/2],Cylinder[{r1-dr3,r1+dr3},d]}];

(*one node tie with any element*)
(*could be generalized*)
TIE[n0_,nodes_,fun_]:=Module[ {funout,nξ,nη,ξ,η,NN,x,y,z,u,v,w,ϕ,Θ,ψ},
funout =fun;
{nξ,nη}=Dimensions[nodes];
NN=LAGRANGE[{{nξ,ξ},{nη,η}}];
{x,y,z}=NN.fun[[Flatten[nodes],1]];
{ξ,η}=MinimalBy[Flatten[Table[{ξ,η, Norm[fun[[n0,1]]-{x,y,z}]},{ξ,0,1,1/20},{η,0,1,1/20}],1],Last][[1,1;;2]];
{u,v,w}=NN.fun[[Flatten[nodes],2]];
{ϕ,Θ,ψ}=NN.fun[[Flatten[nodes],3]];
funout[[n0]]={fun[[n0,1]],{u,v,w},{ϕ,Θ,ψ}};
Return[funout]];

GRAPHICS[{DISP,scale_},{BEAM,{mat_,{d_Real,iy_},for_},Line[{n1_,n2_}]},fun_]:= Module[{ρ,h,NL,NQ,ix,iz,T},
ρ=fun[[n2,1]]-fun[[n1,1]];
h=Simplify[Sqrt[ρ.ρ],{h>0,L>0}];
NL={1-ξ,ξ};
NQ={(((1-ξ))^2) (1+2 ξ),h(((1-ξ))^2) ξ,(3-2 ξ) (ξ^2),h (ξ^2) (ξ-1)};
ix=ρ/h;
iz=ix\[Cross]iy;
T={ix,iy,iz};
ux1=fun[[n1,2]].ix; ux2=fun[[n2,2]].ix;
uy1=fun[[n1,2]].iy; uy2=fun[[n2,2]].iy;
uz1=fun[[n1,2]].iz; uz2=fun[[n2,2]].iz;
θx1=fun[[n1,3]].ix; θx2=fun[[n2,3]].ix;
θy1=fun[[n1,3]].iy; θy2=fun[[n2,3]].iy;
θz1=fun[[n1,3]].iz; θz2=fun[[n2,3]].iz;
u=NL.{ux1,ux2}*scale;
v=NQ.{uy1,-θz1,uy2,-θz2}*scale;
w=NQ.{uz1,-θy1,uz2,-θy2}*scale;
pp=Partition[Table[fun[[n1,1]]+ix*h*ξ+{u,v,w}.T,{ξ,0,1,1/10}],2,1];
pp=Table[fun[[n1,1]]+ix*h*ξ+{u,v,w}.T,{ξ,0,1,1/10}];{Gray,Tube[pp,d/2 ],Blue,PointSize[Medium],Point[fun[[n1,1]]+fun[[n1,2]]*scale],
Point[fun[[n2,1]]+fun[[n2,2]]*scale]} ];

GRAPHICS[{DISP,scale_},{BEAM,{mat_,{ly_,lz_,iy_},for_},Line[{n1_,n2_}]},fun_]:= Module[{ρ,h,x,y,z,NL,NQ,ix,iz,T,u,v,w,ϕ,θ,ψ},
ρ=fun[[n2,1]]-fun[[n1,1]];
h=Simplify[Sqrt[ρ.ρ],{h>0,L>0}];
ix=ρ/h;
iz=ix\[Cross]iy;
ρ=x ix+y iy+z iz;
T={ix,iy,iz};
NL={1-x/h,x/h};
NQ={(((1-x/h))^2) (1+2 x/h),h(((1-x/h))^2) x/h,(3-2 x/h) (((x/h))^2),h (((x/h))^2) (x/h-1)};
ux1=fun[[n1,2]].ix; ux2=fun[[n2,2]].ix;
uy1=fun[[n1,2]].iy; uy2=fun[[n2,2]].iy;
uz1=fun[[n1,2]].iz; uz2=fun[[n2,2]].iz;
θx1=fun[[n1,3]].ix; θx2=fun[[n2,3]].ix;
θy1=fun[[n1,3]].iy; θy2=fun[[n2,3]].iy;
θz1=fun[[n1,3]].iz; θz2=fun[[n2,3]].iz;
u=NL.{ux1,ux2};
v=NQ.{uy1,-θz1,uy2,-θz2};
w=NQ.{uz1,-θy1,uz2,-θy2};
ϕ=NL.{θx1,θx2};
θ=-(∂_x)w;
ψ=(∂_x)v;
ux=(u+θ z-ψ y)*scale;
uy=(v-ϕ z)*scale;
uz=(w+ϕ y)*scale;
pp=Table[(fun[[n1,1]]+ρ+{ux,uy,uz}.T)/.Thread[{y,z}->yz],{x,0,h,h/10},{yz,{{ly,lz},{-ly,lz},{-ly,-lz},{ly,-lz}}/2}];
Join[{Gray,EdgeForm[]},Table[{
Polygon[{pp[[ii,1]],pp[[ii,2]],pp[[ii+1,2]],pp[[ii+1,1]]}],
Polygon[{pp[[ii,2]],pp[[ii,3]],pp[[ii+1,3]],pp[[ii+1,2]]}],
Polygon[{pp[[ii,4]],pp[[ii,3]],pp[[ii+1,3]],pp[[ii+1,4]]}],
Polygon[{pp[[ii,1]],pp[[ii,4]],pp[[ii+1,4]],pp[[ii+1,1]]}]},{ii,1,Length[pp]-1}],{Blue,PointSize[Medium],Point[fun[[n1,1]]+fun[[n1,2]]*scale],
Point[fun[[n2,1]]+fun[[n2,2]]*scale]}  ]];

GRAPHICS[MESH,{RIGID,pro_,Line[{n1_,n2_}]},fun_]:={Black,Line[{fun[[n1,1]],fun[[n2,1]]}],Blue,PointSize[Medium],Point[{fun[[n1,1]],fun[[n2,1]]}]};

GRAPHICS[{DISP,scale_},{RIGID,pro_,Line[{n1_,n2_}]},fun_]:=Module[{crd1,crd2},
crd1=fun[[n1,1]]+fun[[n1,2]]*scale;
crd2=fun[[n2,1]]+fun[[n2,2]]*scale;{Black,Line[{crd1,crd2}],Blue,PointSize[Medium],Point[{crd1,crd2}]}];

(*force element*)

δW[VIBR,{FORCE,{{ρ_},{lx_,ly_,lz_,ix_,iy_},{FX_,FY_,FZ_,MX_,MY_,MZ_}},Point[{I1_}]},fun_]:= Module[{m,J,ux,uy,uz,T},
m=ρ*lx*ly*lz;
J=m*{{lx^2+lz^2,0,0},{0,ly^2+lz^2,0},{0,0,lx^2+ly^2}}/12;
T={ix,iy,ix\[Cross]iy};
({FX,FY,FZ}-m * T. fun[[I1,2]]/.DRULE[2]). δ[T.fun[[I1,2]]/.DRULE[0]] +
({MX,MY,MZ}-J. T.fun[[I1,3]]/.DRULE[2]).δ[T.fun[[I1,3]]/.DRULE[0]]
];

GRAPHICS[{DISP,scale_},{FORCE,{{ρ_},{lx_,ly_,lz_,ix_,iy_},{FX_,FY_,FZ_,MX_,MY_,MZ_}},Point[{n1_}]},fun_]:=Module[{r,T},
pnt={{-lx,-ly,-lz},{lx,-ly,-lz},{lx,ly,-lz},{-lx,ly,-lz},
{-lx,-ly,lz},{lx,-ly,lz},{lx,ly,lz},{-lx,ly,lz}}/2;
crd=Map[{ix,iy,ix\[Cross]iy}.#&,pnt];
r=Map[fun[[n1,1]]+#+scale*fun[[n1,2]]+scale*fun[[n1,3]]\[Cross](#-fun[[n1,1]])&,crd];
{Gray,Opacity[0.5],
Polygon[{r[[4]],r[[3]],r[[2]],r[[1]]}],Polygon[{r[[5]],r[[6]],r[[7]],r[[8]]}],Polygon[{r[[1]],r[[2]],r[[6]],r[[5]]}],Polygon[{r[[3]],r[[4]],r[[8]],r[[7]]}],Polygon[{r[[1]],r[[5]],r[[8]],r[[4]]}],Polygon[{r[[2]],r[[3]],r[[7]],r[[6]]}],
Blue,PointSize[Medium],Point[fun[[n1,1]]+scale*fun[[n1,2]]]}];

GRAPHICS[{DISP,scale_},{PLATE,{mat_,{t_},for_},Polygon[{n1_,n2_,n3_,n4_}]},fun_]:= Module[{node,nα,nβ,α,β,γ,ρ,rα,rβ,rn,r0,n,NN,en,u,v,w,ϕ,θ,ψ,pp},
NN=LAGRANGE[{{2,α},{2,β}}];
r0=NN.fun[[{n1,n2,n3,n4},1]];
{u,v,w}=NN.fun[[{n1,n2,n3,n4},2]];
{ϕ,θ,ψ}=NN.fun[[{n1,n2,n3,n4},3]];
rα=(∂_α)r0 /.{α->1/2,β->1/2};
rβ=(∂_β)r0 /.{α->1/2,β->1/2};
rn=rα\[Cross]rβ;
en=rn/Norm[rn];
ρ=-t/2+en*γ*t;
pp=Map[(r0+ρ+{u,v,w}*scale+{ϕ,θ,ψ}\[Cross]ρ*scale) /.Thread[{α,β,γ}->#]&,{{0,0,0},{1,0,0},{1,1,0},{0,1,0},{0,0,1},{1,0,1},{1,1,1},{0,1,1}}];
{Gray,Opacity[0.5],EdgeForm[],Hexahedron[pp],Blue,PointSize[Tiny],Point[pp]} ];

Stability analysis (week 4)

Example 3.1 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,θY[1],0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}}};

FORMATTED[{ele,fun}]  

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Example 3.2 (truss)

ele={  
{BAR,{{Ε},{(Sqrt[8])A},{0}},Line[{1,3}]},
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{2,3}]},
{BAR,{{Ε},{(Sqrt[8])A},{0}},Line[{4,2}]},
{FORCE,{0,0,F},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{0,0,uZ[2]},{0,θY[2],0}},
{{L,0,L},{0,0,uZ[3]},{0,-θY[2],0}},
{{0,0,L},{0,0,0},{0,0,0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,F},{ele,fun}],Alignment->Left]

Example 3.3 (plate )

(*this element type and approximation combination is not in the element library of the code. Lets start with the building blocks*)

w=a[0] (x/L) (1-(x/L))(y/L)(1-(y/L));

Eσ=(Ε/(1-(ν^2))){{1,ν,0},{ν,1,0},{0,0,((1-ν)/2)}};
δwint:=-δ[{(∂_(x,x))w,(∂_(y,y))w,2 (∂_(x,y))w}].(((t^3)/12) Eσ).{(∂_(x,x))w,(∂_(y,y))w,2 (∂_(x,y))w};
δwsta:=-δ[{(∂_x)w,(∂_y)w}].{{-p,0},{0,0}}.{(∂_x)w,(∂_y)w};

Ω=Rectangle[{0,0},{L,L}];
δWW=Simplify[Integrate[δwint+δwsta,{x,y}∈Ω],L>0];

STANDARDFORM[δWW]

Example 3.4 (truss)

(*NOTICE: the outcome of the hand calculation (analytical solution) and the one by the code (numerical solution) differ due to discretization error.
The solution by FEM converges to the analytical solution when the mesh is refined*)

(*Force downwards: beam 1 buckling *)

ele={  
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{BAR,{{Ε},{(Sqrt[8])A},{0}},Line[{3,2}]},
{FORCE,{0,0,F},Point[{2}]}};

fun ={
{{0,0,L},{0,0,0},{0,θY[1],0}},
{{L,0,L},{uX[2],0,uZ[2]},{0,θY[2],0}},
{{0,0,0},{0,0,0},{0,θY[3],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,F},{ele,fun}],Alignment->Left]

(*Force upwards: beam 2 buckling*)

ele={  
{BAR,{{Ε},{A},{0}},Line[{1,2}]},
{BEAM,{{Ε,G},{(Sqrt[8])A,Ι,Ι},{0,0,0}},Line[{3,2}]},
{FORCE,{0,0,-F},Point[{2}]}};

fun ={
{{0,0,L},{0,0,0},{0,θY[1],0}},
{{L,0,L},{uX[2],0,uZ[2]},{0,θY[2],0}},
{{0,0,0},{0,0,0},{0,θY[3],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,F},{ele,fun}],Alignment->Left]

Problem 1 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,uZ[2]},{0,0,0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Problem 2 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Problem 3 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,uZ[2]},{0,θY[2],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Problem 4 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,θY[1],0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Problem 5 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{2,3}]},
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{3}]},
{FORCE,{p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}},
{{2L,0,0},{uX[3],0,0},{0,θY[3],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Problem 6 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{2,3}]},
{FORCE,{-p,0,0},Point[{3}]}};

fun ={
{{0,0,0},{0,0,0},{0,θY[1],0}},
{{L/2,0,0},{uX[2],0,uZ[2]},{0,0,0}},
{{L,0,0},{uX[3],0,0},{0,-θY[1],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Problem 7 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{-ρ A g,0,0}},Line[{1,2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,uZ[2]},{0,θY[2],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,ρ},{ele,fun}],Alignment->Left]

Problem 8 (truss)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{7,6}]},
{RIGID,{},Line[{3,4}]},
{RIGID,{},Line[{4,5}]},
{FORCE,{-F,0,0},Point[{4}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,uZ[2]},{0,θY[2],0}},
{{L,0,0},{uX[2],0,uZ[2]},{0,0,0}},
{{L,0,(1-α)L},{uX[2],0,uZ[2]},{0,0,0}},
{{L,0,L},{uX[2],0,uZ[2]},{0,0,0}},
{{L,0,L},{uX[2],0,uZ[2]},{0,θY[6],0}},
{{0,0,L},{0,0,0},{0,0,0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,F},{ele,fun}] ,Alignment->Left]

Problem 9 (truss)

(*NOTICE: the outcome of the hand calculation (analytical solution) and the one by the code (numerical solution) differ due to discretization error.
The solution by FEM converges to the analytical solution when the mesh is refined*)

ele={ 
{BEAM,{{Ε,G},{2A,Ι,Ι},{0,0,0}},Line[{1,6}]},
{BEAM,{{Ε,G},{(Sqrt[8]) A,Ι,Ι},{0,0,0}},Line[{2,3}]},
{BEAM,{{Ε,G},{(Sqrt[8])A,Ι,Ι},{0,0,0}},Line[{4,5}]},
{FORCE,{0,0,-F,0,0,0},Point[{3}]},
{FORCE,{-F,0,0,0,0,0},Point[{5}]}};

fun ={
{{-L,0,0},{0,0,0},{0,θY[1],0}},
{{-L,0,0},{0,0,0},{0,θY[2],0}},
{{0,0,L},{uX[3],0,uZ[3]},{0,θY[3],0}},
{{0,0,L},{uX[3],0,uZ[3]},{0,θY[4],0}},
{{L,0,0},{uX[5],0,0},{0,θY[5],0}},
{{L,0,0},{uX[5],0,0},{0,θY[6],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,F},{ele,fun}],Alignment->Left]

Problem 10 (plate)

(*this element type and approximation combination is not in the element library of the code. Lets start with the building blocks*)

w=a[0]Sin[Pi (x/L) ]Sin[Pi (y/L) ];

Eσ=(Ε/(1-(ν^2))){{1,ν,0},{ν,1,0},{0,0,((1-ν)/2)}};
δwint:=-δ[{(∂_(x,x))w,(∂_(y,y))w,2 (∂_(x,y))w}].(((t^3)/12) Eσ).{(∂_(x,x))w,(∂_(y,y))w,2 (∂_(x,y))w};
δwsta:=-δ[{(∂_x)w,(∂_y)w}].{{-p,0},{0,0}}.{(∂_x)w,(∂_y)w};

Ω=Rectangle[{0,0},{L,L}];
δWW=Simplify[Integrate[δwint+δwsta,{x,y}∈Ω],L>0];

STANDARDFORM[δWW]

Home assignment 1 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,uZ[2]},{0,0,0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Home assignment 2 (beam truss)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{2,3}]},
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}},
{{2L,0,0},{uX[3],0,0},{0,θY[3],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Home assignment 3 (plate)

w=a[0](1- (x/L) ) (x/L) ;

Eσ=(Ε/(1-(ν^2))){{1,ν,0},{ν,1,0},{0,0,((1-ν)/2)}};
δwint:=-δ[{(∂_(x,x))w,(∂_(y,y))w,2 (∂_(x,y))w}].(((t^3)/12) Eσ).{(∂_(x,x))w,(∂_(y,y))w,2 (∂_(x,y))w};
δwsta:=-δ[{(∂_x)w,(∂_y)w}].{{-p,0},{0,0}}.{(∂_x)w,(∂_y)w};

Ω=Rectangle[{0,0},{L,L}];
δWW=Simplify[Integrate[δwint+δwsta,{x,y}∈Ω],L>0];

STANDARDFORM[δWW]

Lecture assignment 1 (beam)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,0,0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

Lecture assignment 2 (beam)

(*NOTICE: the outcome of the hand calculation (analytical solution) and the one by the code (numerical solution) differ due to discretization error.
The solution by FEM converges to the analytical solution when the mesh is refined*)

ele={ 
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{1,2}]},
{BEAM,{{Ε,G},{A,Ι,Ι},{0,0,0}},Line[{3,4}]},
{FORCE,{-p,0,0},Point[{2}]}};

fun ={
{{0,0,0},{0,0,0},{0,θY[1],0}},
{{L,0,0},{uX[2],0,0},{0,θY[2],0}},
{{L,0,0},{uX[2],0,0},{0,θY[3],0}},
{{2L,0,0},{0,0,0},{0,θY[4],0}}};

FORMATTED[{ele,fun}]

STANDARDFORM[{STAB},{ele,fun}]

Grid[SOLVE[{STAB,p},{ele,fun}],Alignment->Left]

((120 Ε Ι)/((Sqrt[7]) (L^2)))//N