Meccanica delle Strutture

1 - Albero di trasmissione

Un albero con una ruota conica in estremità (punto A) ed un'utenza dall'altra estremità (punto D) è tenuto con due cuscinetti e sottoposto a un carico distribuito, come raffigurato in figura. Assumendo dei dati verosimili si esegua il dimensionamento statico e la verifica a vita infinita dell'albero e calcolare l'abbassamento dei punti A e C. Successivamente verificare il dimensionamento statico anche per via numerica.

Dimensionamento analitico

⊳ Dati

rpm=mm=Ν=W=MPa=1;

a=150 mm;   b=250 mm;   c=100mm;    L=a+b+c;    p=4 Ν/mm;
dr=250  mm;    (* diametro primitivo della ruota conica *)
α=20°;             (* angolo di spinta della ruota conica *) 
β=30°;             (* angolo di semiapertura della ruota conica *)
Pw=50000  W;  (* potenza da trasmettere *)
n0= 500 rpm; (* regime di rotazione *)             n=((n0 2 π)/60); (* (rad/(sec )) *)

⊳ Calcolo delle forze trasmesse dalla ruota conica e delle reazioni vincolari trasmesse dai cuscinetti

- Calcolo del momento torcente (costante su tutta la lunghezza della trave)

Mt=((1000 Pw)/n);     Print["Mt: ",Mt//N ," N mm \n"]

- Calcolo della componente tangenziale della forza applicata dalla ruota conica

Ft=(Mt/((dr/2)));     Print["Ft: ",Ft//N," N \n"]

- Calcolo della componente radiale Fr ed assiale Fa dovute alla ruota conica

Fr=Ft Tan[α];     Print["Fr: ",Fr//N," N"]
Fa=Ft Tan[β];     Print["Fa: ",Fa//N," N \n"]

- Calcolo del Momento concentrato Ma  nel punto A, dovuto alla presenza della Forza Fa disassata

Ma=Fa (dr/2);     Print["Ma: ",Ma//N," N mm \n"]

Ora considero due travi distine ottenute proiettando l'albero, e le relative forze, prima nel piano XY poi in quello XZ.

Piano XY

- Calcolo delle reazioni vincolari mediante equazioni di equilibrio alla traslazione verticale ed orizzontale e di equilibrio alla rotazione rispetto A

HB=.;VB=.;VD=.;
s1=Solve[{   Fa==HB, 
		Fr-VB+p b-VD==0, 
		Ma-VB a - VD(a+b+c)+p b (a+(b/2))==0},{HB, VB, VD}] ;
HB=s1[[1,1,2]] ; Print["HB: ",HB//N," N"]
VB=s1[[1,2,2]]  ; Print["VB: ",VB//N," N"]
VD=s1[[1,3,2]]  ; Print["VD: ",VD//N," N \n"]

- Grafici

(* Sforzo Normale [N] *)               N1[x_]=If[x<a,-HB,0];
(* Momento Flettente [Nmm] *)   Mf1[x_]=(Piecewise[{{Ma-Fr x, x<a}, {Ma-Fr x -(p/2)(((x-a))^2)+VB (x-a), x≤a+b}, {Ma-Fr x +VB(x-a)-p b (x-a-(b/2)), x≤L}}]);
(* Taglio [N] *)                                  T1[x_]=(∂_x)Mf1[x];

Plot[N1[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","SN1 (N)"},Filling->Axis,GridLines->{{a,b+a,L},Automatic},PlotLabel->Style[Framed["Piano XY"]]]
Plot[Mf1[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","Mf1 (Nmm)"},Filling->Axis,GridLines->{{a,b+a,L},Automatic},Ticks->{{{0,"A"},{a,"B"},{a+b,"C"},{L,"D"}}}]
Plot[T1[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","T1 (N)"},Filling->Axis,GridLines->{{a,b+a,L},Automatic}]

Piano XZ

- Calcolo delle reazioni vincolari mediante equazioni di equilibrio alla traslazione verticale ed alla rotazione rispetto B

VB2=.;VD2=.;
s2=Solve[{   Ft-VB2-VD2==0,
		Ft a + VD2(b+c)==0
},{VB2,VD2}] ;
VB2=s2[[1,1,2]] ;    Print["VB2: ",VB2//N," N"]
VD2=s2[[1,2,2]] ;    Print["VD2: ",VB2//N," N \n"]

- Grafici

(* Taglio [N] *)                                  T2[x_]=If[x<a,-Ft,-Ft+VB2];
(* Momento Flettente [Nmm] *)   Mf2[x_]=If[x<a,-Ft x,-Ft x+VB2 (x-a)];

Plot[T2[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","T2 (N)"},Filling->Axis,GridLines->{{a,L},Automatic},PlotLabel->Style[Framed["Piano XZ"]]]
Plot[Mf2[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","Mf2 (Nmm)"},Filling->Axis,GridLines->{{a,L},Automatic},Ticks->{{{0,"A"},{a,"B"},{L,"D"}}}]

⊳ Dimensionamento del diametro

Poichè non c'è una sezione che appare evidentemente più sollecitata, considero separatamente le 3 sezioni A, B, C. Considerando che lo sforzo dovuto alla torsione è uguale su tutte e trascurando il taglio perchè oltre ad essere di entità modesta rispetto agli altri sforzi genera tensioni di picco dove gli altri sforzi generano tensioni nulle e viceversa.

(* SEZIONE A *)
(* Sforzo Normale *)          NA=N1[0]  ;                                     Print["NA= ",NA//N," N"]
(* Momento Flettente *)   MfA=(Sqrt[((Mf1[0])^2)+((Mf2[0])^2)]) ;    Print["MfA= ",MfA//N," N mm \n"]

(* SEZIONE B *) 
(* Sforzo Normale *)         NB=N1[a-0.001]  ;                    Print["NB= ",NB//N," N"]
(* Momento Flettente *)  MfB=(Sqrt[((Mf1[a])^2)+((Mf2[a])^2)]);     Print["MfB= ",MfB//N," N mm \n"]

(* SEZIONE C *)
(* Momento Flettente *)  MfC=(Sqrt[((Mf1[a+b])^2)+((Mf2[a+b])^2)]);   Print["MfC= ",MfC//N," N mm \n"]

E' evidente che la sezione più sollecitata è la B. 
Calcolo quindi il diametro che dovrà avere l'albero per reggere le sollecitazioni, usando il criterio di Von Mises ed utilizzando un acciaio C40 bonificato con coefficiente di sicurezza statico FS pari a 3.

Sy=420  MPa;   Su=640 MPa;   FS=3;   Ε=200000  MPa ;

(Subscript[σ, Mf])[d_]= -(32/(π (d^3)))MfB;     (Subscript[σ, Ν])[d_]=(4/(π (d^2)))NB;      (Subscript[τ, t])[d_]=(16/(π (d^3)))Mt;

FindRoot[ (Sqrt[((((Subscript[σ, Mf])[d]+(Subscript[σ, Ν])[d]))^2)+3(((Subscript[τ, t])[d])^2)])==(Sy/FS),{d,1}];
d=Round[⌈%[[1,2]]⌉,5];   Print[" d = ",d," mm \n"]

Inizialmente si era scelto di mettere una cerniera nel punto B e non un carrello per ridurre la lunghezza di inflessione, in modo che una eventuale verifica a carico di punta (secondo Eulero) fosse soddisfatta. Infatti il carico critico Pcr (secondo Eulero) è molto superiore allo sforzo normale che agisce sul tratto di albero interessato.

Pcr=(((π^2) Ε (((π (d^4))/64)))/(a^2));    Print["Pcr = ",Pcr//N," N \n"]

Si sceglie quindi un diametro minimo dell'albero di 48 mm, per il tratto B-D. Per quanto riguarda il tratto A-B, la scelta viene fatta da catalogo SKF dei cuscinetti.
Scegliendo un cuscinetto obliqo ad una corona di sfere, ponendo che deve raggiungere (10^7)cicli di lavoro, si calcola il carico radiale (P) che grava sul cuscinetto e conseguentemente il coeficiente di carico statico del cuscinetto (C0).

P= (Sqrt[(VB^2)+(VB2^2)]);    L10=10 (* milioni di cicli di lavoro *);    q=3 (* perchè cuscinetto a sfera *); 
C0=(L10^(1/q))P;     Print[" C0= ",C0//N," N \n"]

Il primo cuscinetto da catalogo che soddisfa le imposizioni sul diametro e su C0 è il SKF Explorer 7210 BECBP, che richiede un diametro di spallamento minimo di 57 mm ed un raggio di raccordo di 1 mm.

(Subscript[d, BD])=50 mm;    (Subscript[d, AB])=57 mm;

⊳ Verifica a fatica nella sezione B

(Subscript[σ, n])= (NB/((π ((Subscript[d, BD])^2))/4));     (Subscript[σ, f])=(MfB/((π ((Subscript[d, BD])^3))/32));     σt[t_]=(Subscript[σ, n])+(Subscript[σ, f]) Sin[t];

Plot[σt[t],{t,0,4π},PlotStyle->Thick,AxesLabel->{"tempo","σ (MPa)"},PlotLabel->Style["Andamento nel tempo della tensione nella sezione B"],Filling->Axis,Ticks->{{π/2,π,3π/2,2π,5π/2,3π,7π/2,4π}},GridLines->{{π/2,π,3π/2,2π,3π,4π},{σt[π/2],σt[3π/2],(Subscript[σ, n])}},ImageSize->400]

(* Tensione media *) σm=(Subscript[σ, n]);
(* Tensione alternata *) σA = (Subscript[σ, f]);
(* COEFFICIENTI di CORREZIONE *)
K1=1.58 (Su^(-0.085)) (* Superficie rettificata *);
K2 = 0.9;
q=0.75;
Kt=2.25;
Kf = 1+q (Kt-1);
Se=0.5 Su ((K1 K2)/Kf);    Print["Tens. al limite di fatica \t Se = ",Se, " MPa"]
FSf=(1/((((σA)/Se)+((σm)/Su))));      Print["Coefficiente di sicurezza \t FSf = ",FSf," ; \n l' albero è verificato. \n"]

Calcolo della linea elastica e degli spostamenti dei punti A e C

Piano XY

(Subscript[J, AB])=((π ((Subscript[d, AB])^4))/64);   (Subscript[J, BD])=((π ((Subscript[d, BD])^4))/64);    (Subscript[J, AD])=If[x≤a,(Subscript[J, AB]),(Subscript[J, BD])];
Re[DSolve[{Ε*(Subscript[J, AD])*f''[x]==Mf1[x], f[a]==0,f[L]==0},{f[x]},x][[1,1,2]]]//N;
(Subscript[F, xy])[x_]=%;

Plot[(Subscript[F, xy])[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","f (mm)"},PlotLabel->Style[Framed["Freccia nel piano XY"]],Filling->Axis,GridLines->Automatic,ImageSize->500, AxesOrigin->{0,0}]
Print["Abbassamento del punto A: ",(Subscript[F, xy])[0]//N," mm"]
Print["Abbassamento del punto C: ",(Subscript[F, xy])[a+b]//N," mm \n"]

Piano XZ

(Subscript[F, xz])[x_]=DSolve[{Ε (Subscript[J, AD]) f''[x]==Mf2[x], f[a]==0,f[L]==0},{f[x]},x][[1,1,2]];

Plot[(Subscript[F, xz])[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","f (mm)"},PlotLabel->Style[Framed["Freccia nel piano XZ"]],Filling->Axis,GridLines->Automatic,ImageSize->500, AxesOrigin->{0,0}]
Print["Abbassamento del punto A: ",(Subscript[F, xz])[0]//N," mm"]
Print["Abbassamento del punto C: ",(Subscript[F, xz])[a+b]//N," mm \n"]

⊳ Calcolo dell'energia di deformazione

(* Energia di deformazione esatta *)   (Subscript[U, es])=(1/2)(∫_0^L)((((Mf1[x]))^2)/(Ε (Subscript[J, AD])))\[DifferentialD]x+(1/2)(∫_0^L)((((Mf2[x]))^2)/(Ε (Subscript[J, AD])))\[DifferentialD]x;

Print["L'energia di deformazione esatta è di ",(Subscript[U, es])=Re[(Subscript[U, es])]//N," J \n\n"]

Risoluzione numerica

Clear[VB,VD,Ε]

⊳ Matrice di rigidezza
 Calcolo della matrice di rigidezza totale dall'assemblaggio delle matrici di rigidezza dei singoli elementi ssociati ai tratti (OverBar[AB]), (OverBar[BC]), (OverBar[CD]) .
Si procede utilizzando un algoritmo automatico che mediante le matrici H trasforma le matrici di rigidezza associate ai gradi di liberta del singolo elemento in matrici degli stessi associate ai gradi di libertà della matrice totale. 
Si è fatto in modo che l'unico valore da fissare nell'algoritmo sia il numero di elementi el , il resto viene calcolato in funzione di questo:

el=3;
x_⊗y_:=Transpose[x].y.x;

nodi=(el+1);   (Subscript[n, loc])=4;   (Subscript[n, glob])=2nodi;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{
For[j=1,j≤4,j++,H[[i,j,j +(i-1) 2]]=1],
Print[H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=H[[i]]⊗(Subscript[K, i,loc])]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

(Subscript[K, loc])[J_,l_]=((Ε J)/(l^3))(({{12, 6 l, -12, 6 l}, {6 l, 4 (l^2), -6 l, 2 (l^2)}, {-12, -6 l, 12, -6 l}, {6 l, 2 (l^2), -6 l, 4 (l^2)}}));     
For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc])[(Subscript[J, i]),(Subscript[l, i])][[jc,jr]]]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

(Subscript[J, 1])=(Subscript[J, AB]);   (Subscript[J, 2])=(Subscript[J, 3])=(Subscript[J, BD]);   (Subscript[l, 1])=a;   (Subscript[l, 2])=b;   (Subscript[l, 3])=c;   Ε=200000;
Print["(Subscript[K, tot])= ",(Subscript[K, tot])//MatrixForm//N,"\n"]

Piano XY

⊳ Vettore dei carichi e degli spostamenti

Fxy=(({{-Fr}, {-Ma}, {-((p b)/2)+VB}, {-((p (b^2))/12)}, {-((p b)/2)}, {((p (b^2))/12)}, {VD}, {0}}));     (Subscript[Δ, xy])=(({{(Subscript[v, A])}, {(Subscript[ϕ, A])}, {0}, {(Subscript[ϕ, B])}, {(Subscript[v, C])}, {(Subscript[ϕ, C])}, {0}, {(Subscript[ϕ, D])}}));

S=Solve[{Fxy==(Subscript[K, tot]).(Subscript[Δ, xy])},{VB,VD,(Subscript[v, A]),(Subscript[ϕ, A]),(Subscript[ϕ, B]),(Subscript[v, C]),(Subscript[ϕ, C]),(Subscript[ϕ, D])}]//N

Fxy=Fxy/.S[[1]]; (Subscript[Δ, xy])=(Subscript[Δ, xy])/.S[[1]];      Print[" (Subscript[F, xy]) = ",Fxy//N//MatrixForm,"\t (Subscript[Δ, xy]) = ",(Subscript[Δ, xy])//MatrixForm,"\n"]

Tracciamo l'andamento della deformata su XY per confrontarlo con l'andamento calcolato analiticamente

(* FUNZIONI di FORMA *)
ξ=(2/∠)(x-R);   R=((r1+r2)/2);   ∠=r2-r1;    Ν=Transpose[(({{(1/4)(2-3ξ+(ξ^3))}, {(∠/8)(1-ξ-(ξ^2)+(ξ^3))}, {(1/4)(2+3ξ-(ξ^3))}, {(∠/8)(-1-ξ+(ξ^2)+(ξ^3))}}))];
Nab[x_]=Ν/.{r1->0,r2->a};
Nbc[x_]=Ν/.{r1->a,r2->a+b};
Ncd[x_]=Ν/.{r1->a+b,r2->L};

(Subscript[Δ, AB])=Take[(Subscript[Δ, xy]),4];   (Subscript[Δ, BC])=Take[(Subscript[Δ, xy]),{3,6}];   (Subscript[Δ, CD])=Take[(Subscript[Δ, xy]),-4];

(Subscript[Fxy, num])[x_]=(Piecewise[{{Nab[x].(Subscript[Δ, AB]), x<a}, {Nbc[x].(Subscript[Δ, BC]), x<a+b}, {Ncd[x].(Subscript[Δ, CD]), x≤L}}]);

Plot[{(Subscript[Fxy, num])[x]},{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","f (mm)"},PlotLabel->Style[Framed["Freccia nel piano XY per via numerica"]],GridLines->Automatic,ImageSize->500, AxesOrigin->{0,0}]

Errore[x_]=100×((Subscript[Fxy, num])[x]-(Subscript[F, xy])[x])/(Subscript[F, xy])[x];
Plot[Errore[x],{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","errore (%)"},Filling->Axis,PlotLabel->Style["Errore percentuale della freccia tra il metodo numerico e quello analitico"],GridLines->Automatic,ImageSize->500, AxesOrigin->{0,0}]

Come ci si aspettava gli spostamenti del punto A e del punto C coincidono nel valore con quelli calcolati nella parte analitica, così come i valori delle reazioni vincolari in B e in D. Inoltre l'andamento della freccia tra i due metodi è lo stesso, tranne nel tratto soggetto a carico distribuito, in cui comunque è molto contenuto (come ci si aspettava).

Piano XZ

(La matrice di rigidezza non cambia)

Clear[VB2,VD2]
Fxz=(({{-Ft}, {0}, {VB2}, {0}, {0}, {0}, {VD2}, {0}})); (Subscript[Δ, xz])=(({{(Subscript[v, A2])}, {(Subscript[ϕ, A2])}, {0}, {(Subscript[ϕ, B2])}, {(Subscript[v, C2])}, {(Subscript[ϕ, C2])}, {0}, {(Subscript[ϕ, D2])}}));
S2=Solve[{Fxz==(Subscript[K, tot]).(Subscript[Δ, xz])},{VB2,VD2,(Subscript[v, A2]),(Subscript[ϕ, A2]),(Subscript[ϕ, B2]),(Subscript[v, C2]),(Subscript[ϕ, C2]),(Subscript[ϕ, D2])}]//N

(Subscript[Δ, xz])=(Subscript[Δ, xz])/.S2[[1]];   Fxz=Fxz/.S2[[1]];
(Subscript[Δ, AB2])=Take[(Subscript[Δ, xz]),4];   (Subscript[Δ, BC2])=Take[(Subscript[Δ, xz]),{3,6}];   (Subscript[Δ, CD2])=Take[(Subscript[Δ, xz]),-4];

(Subscript[Fxz, num])[x_]=(Piecewise[{{Nab[x].(Subscript[Δ, AB2]), x≤a}, {Nbc[x].(Subscript[Δ, BC2]), x≤a+b}, {Ncd[x].(Subscript[Δ, CD2]), x≤L}}]);

Plot[{(Subscript[Fxz, num])[x]},{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","f (mm)"},PlotLabel->Style[Framed["Freccia nel piano XZ per via numerica"]],GridLines->Automatic,ImageSize->500, AxesOrigin->{0,0}]

Errorexz[x_]=100((Subscript[Fxz, num])[x]-(Subscript[F, xz])[x])/(Subscript[F, xz])[x];
Plot[{Errorexz[x]},{x,0,L},PlotStyle->Thick,AxesLabel->{"x (mm)","errore (%)"},PlotLabel->Style["Errore sulla freccia"],GridLines->Automatic,ImageSize->500, AxesOrigin->{0,0},PlotRange->All]

Anche nel Piano XZ i valori degli spostamenti in A e in D, così come i valori delle reazioni vincolari in B e in D coincidono tra il caso numerico e quello analitico. Si nota inoltre che l'errore percentuale sulla deformazione è praticamente nullo in tutta la trave (è dell'ordine di (10^(-8)), dovuto agli arrotondamenti di calcolo), risultato che ci si attendeva in quanto sul piano XZ  i carichi sono tutti concentrati.

⊳ Calcolo dell'energia di deformazione

(* Energia di deformazione *)                (Subscript[U, app])=-(1/2)  Transpose[Fxy].(Subscript[Δ, xy])+ (1/2) Transpose[Fxz].(Subscript[Δ, xz]);

Print[" (Subscript[U, es])= ",(Subscript[U, es]),"\n (Subscript[U, approssimata])= ",(Subscript[U, app])[[1,1]]," J \n"]

Come previsto l'energia di deformazione calcolata col metodo numerico è più bassa del caso esatto per via dell'approssimazione dovuta al carico distribuito.

Quit[]

2 - MFLE di una trave con intaglio

Data una trave sollecitata da una forza P eccentrica, si trova le condizioni di collasso plastico e propagazione della cricca, il numero di cicli vita, la discretizzazione con elementi parabolici.

Condizioni di collasso plastico

Si calcola il valore del carico critico che porta a collasso, secondo la MFLE (clivaggio), in funzione della dimensione a della cricca e quindi calcoleremo la sua dimensione critica per cui il collasso è controllatto invece dallo snervamento.

⊳ Dati

mm=MPa=1;

w=100 mm;     e=10mm;     β=a/w;
(Subscript[S, y])=350 MPa;     R=600 MPa;     (Subscript[K, IC])=1700 MPa(Sqrt[mm]);

⊳ Calcolo critico

Per calcolare il coefficiente di intensità delle sollecitazioni (Subscript[K, I])=Y σ (Sqrt[π a])  useremo delle formule del coefficiente Y (funzione della geometria, del carico e del tipo di cricca) per cui esiste un campo di validità: {({{h/w>1}, {b≥2.5((((Subscript[K, IC])/(Subscript[S, y])))^2)}})   per la prima assumeremo h=200 mm ; utilizziamo la seconda, che deve essere rispettata per le condizioni stato piano di deformazione, per calcolarci un valore di b ammissibile:

2.5((((Subscript[K, IC])/(Subscript[S, y])))^2)

b=60 mm;

Per la MFLE:
	- Flessione				- Sforzo Normale

(Subscript[σ, f])=((6 P e)/(b (w^2)));                                   (Subscript[σ, sn])=(P/(b w));
(Subscript[Y, f])=((1-β/2+0.32(β^2))/(Sqrt[1-β]));           (Subscript[Y, sn])=0.265(((1-β))^4)+((0.857+0.265 β)/(((1-β))^(3/2))); 

eq=(Subscript[Y, f])(Subscript[σ, f])(Sqrt[π a])+(Subscript[Y, sn])(Subscript[σ, sn])(Sqrt[π a]);
(Subscript[P, MFLE])[a_]=Solve[ eq==(Subscript[K, IC]), P][[1,1,2]];

Per la rottura a snervamento:

(Subscript[σ, tot])=((P/A)+((P e )/J)(((w-a)/2)));     A=b(w-a);     J=((b(((w-a))^3))/12);

(Subscript[P, YELD])[a_]=Solve[ (Subscript[σ, tot])==(Subscript[S, y]), P][[1,1,2]];

Confrontiamo i due carichi critici e quindi calcoliamo la dimensione critica della cricca:

Plot[{(Subscript[P, MFLE])[a],(Subscript[P, YELD])[a]},{a,0,w},PlotStyle->Thick,AxesLabel->{"a (mm)","P (N)"},AxesStyle->Arrowheads[{0.03}]]

(Subscript[𝕒, cr])=FindRoot [(Subscript[P, MFLE])[a]==(Subscript[P, YELD])[a],{a,5}][[1,2]];     Pcr=(Subscript[P, MFLE])[(Subscript[𝕒, cr])];

Print["Transiz. YELD/MFLE:  (Subscript[a, cr])= ",(Subscript[𝕒, cr])," mm \n\t\t\t\t\t (Subscript[P, cr])= ",Pcr/(10^3)," KN"]

(Subscript[P, cr])[a_]=(Piecewise[{{(Subscript[P, MFLE])[a], a>(Subscript[𝕒, cr])}, {(Subscript[P, YELD])[a], a≤(Subscript[𝕒, cr])}}]);
Plot[(Subscript[P, cr])[a],{a,0,w},PlotStyle->Thick,PlotStyle->Thick,AxesLabel->{"a (mm)","P (N)"},GridLines->{{{(Subscript[𝕒, cr]),{Black,Dashed}},20,40,60,80,100},Automatic},ImageSize->500]

Cicli a fatica

Ricaviamo il numero di cicli ΔN che il pezzo può sopportare prima che la cricca con dimensione iniziale  (Subscript[a, i]) < (Subscript[a, cr]) raggiunga la dimensione critica (Subscript[a, cr])  che divide la zona di accrescimento stabile definita dalla legge di Paris  ((da)/(dN))=A(((ΔK))^n)  , da quella di accrescimento instabile.	

Calcoliamo il numero di cicli per un valore del carico che puo assumere un valore tra il 20% e il 100% del carico critico, per un ciclo all'origine ed assumiamo per i fattori Y un valore medio costante (variano molto poco):

(Subscript[𝕒, i])=1 mm;     n=3;     A=6.9×(10^(-12)) ;
ΔP=Pcr*δ;      (Subscript[Δσ, f])=(Subscript[σ, f])/.P->ΔP;     (Subscript[Δσ, sn])=(Subscript[σ, sn])/.P->ΔP;
(Subscript[(OverBar[Y]), f])=((((Subscript[Y, f])/.a->(Subscript[𝕒, i]))+(Subscript[Y, f])/.a->(Subscript[𝕒, cr]))/2);     (Subscript[(OverBar[Y]), sn])=((((Subscript[Y, sn])/.a->(Subscript[𝕒, i]))+((Subscript[Y, sn])/.a->(Subscript[𝕒, cr])))/2);

Integrando per parti la legge di Paris:

ΔN =(∫_(Subscript[𝕒, i])^(Subscript[𝕒, cr]))(1/(A ((ΔK)^n)))da		quindi essendo: 

ΔK=(Subscript[Y, f]) (Subscript[Δσ, f])(Sqrt[π a])+(Subscript[Y, sn]) (Subscript[Δσ, sn])(Sqrt[π a])

ΔN[δ_]=(2/((2-n)A ((((Subscript[(OverBar[Y]), f])(Subscript[Δσ, f])+(Subscript[(OverBar[Y]), sn])(Subscript[Δσ, sn])))^n)(π^(n/2))))(((Subscript[𝕒, cr])^((2-n)/2))-((Subscript[𝕒, i])^((2-n)/2)));

Plot[ΔN[δ],{δ,0.2,1},AxesOrigin->{0,0},PlotRange->All,PlotStyle->Thick,Ticks->{{{0.2,"20"},{0.4,"40"},{0.6,"60"},{0.8,"80"},{1,"100"}}},GridLines->Automatic,AxesLabel->{"%(Subscript[P, cr])","n° cicli"},ImageSize->500]

3 - Piattaforma di sollevamento

Data una piattaforma di carico si conduce un'analisi statica per dimensionare le aste e i perni.

Dimensionamento delle aste e dei perni in condizioni statiche

⊳ Dati:

Kg=MPa=Ν=mm=1;

m=1000 Kg;
F=m*9.807 Ν;
q=F/l;
α=π/3;
l=200 mm;
h=360 mm;

⊳ Calcolo degli sforzi assiali nelle aste e delle reazioni vincolari mediante l'equilibrio alla traslazione nei nodi :

Solve[{       (*A_y*)  (Subscript[N, 1])Sin[α]==(F/2),
		(*A_x*)  (Subscript[N, 1]) Cos[α]==(Subscript[N, 3]),
		(*B_y*)  (Subscript[N, 2]) Sin[α]==(F/2)-(Subscript[N, 4]),
		(*B_x*)  (Subscript[N, 2])Cos[α]==-(Subscript[N, 3]),
		(*C_n*)  (Subscript[R, C])==(Subscript[N, 1]),
		(*D_n*)  (Subscript[R, D])==(Subscript[N, 2]),
		(*V_y*)  (Subscript[N, 4])==(Subscript[R, V])
},{(Subscript[N, 1]),(Subscript[N, 2]),(Subscript[N, 3]),(Subscript[N, 4]),(Subscript[R, C]),(Subscript[R, D]),(Subscript[R, V])}]

(Subscript[Ν, 1])=%[[1,1,2]]; (Subscript[Ν, 2])=%[[1,2,2]]; (Subscript[Ν, 3])=%[[1,3,2]]; (Subscript[Ν, 4])=%[[1,4,2]]; 
(Subscript[R, C])=%%[[1,5,2]]; (Subscript[R, D])=%%[[1,6,2]]; (Subscript[R, V])=%%[[1,7,2]];

L'asta (2) è in trazione essendo negativo il valore della soluzione.

Il momento flettente massimo nell' asta (3) vale:

(Subscript[M, f])=q ((l^2)/8);     Print[" (Subscript[M, f])= ",(Subscript[M, f])," N·mm"]

⊳ Grafici:

⊳ Dimensionamento asta:
Per la scelta del diametro con cui realizzare le aste il calcolo verrà eseguito sull'asta (4), poichè è quella soggetta a sforzo normale maggiore e sull'asta (3), dove lo sforzo normale è minore ma è presente un momento flettente (mentre il taglio potremo tranquillamente trascurarlo).
SI sceglie come materiale un  Fe 430 .

Sy=275 MPa;   Ε=200000 MPa;   FS=3;

(*4*)
(Subscript[σ, N4])=((Subscript[Ν, 4])/(π ((Subscript[d, 4])^2)/4));
d4=FindRoot[(Subscript[σ, N4])==(Sy/FS),{(Subscript[d, 4]),1}]

(*1*)
(Subscript[σ, N3])=((Subscript[Ν, 3])/(π ((Subscript[d, 3])^2)/4));   (Subscript[σ, f])=((Subscript[M, f])/(π ((Subscript[d, 3])^3)/32));
d3=FindRoot[(Subscript[σ, N3])+(Subscript[σ, f])==(Sy/FS),{(Subscript[d, 3]),1}]

Assumiamo uguale per tutte le aste il diametro maggiore approssimato all'intero sueperiore pari:

d=Round[Max[⌈d4[[1,2]]⌉,⌈d3[[1,2]]⌉],2]

Quindi si fa anche una verifica a carico di punta per l'asta piu sollecitata assialmente:

J=π ((d^4)/64);   A=π ((d^2)/4);   i=(Sqrt[(J/A)]);   λ=((Subscript[L, 0])/i);   (Subscript[L, 0])=h;
(Subscript[P, cr])=(((π^2) Ε)/λ);   P=((Subscript[Ν, 4])/A);     Print[P//N," < ",(Subscript[P, cr])//N]
P<(Subscript[P, cr])

⊳ Dimensionamento perno:
ci riferiremo al perno più sollecitato, ovvero quello dell' asta (4).  Utilizzeremo un C60 Bonificato e mediante la verifica al taglio determiniamo il diametro ϕ minimo e fissato il rapporto con la lunghezza a  (vedi Fig.) uguale a 1 si farà una verifica a rifollamento , essendo: n il numero di superfici di taglio, τ il taglio massimo dovuto allo sforzo normale.

(Subscript[σ, y])=510 MPa;   (Subscript[σ, amm])=((Subscript[σ, y])/FS);   S=π ((ϕ^2)/4);   n=2;
(Subscript[τ, max])=(4/3)((Subscript[Ν, 4])/(n S));   (Subscript[τ, amm])=((Subscript[σ, amm])/(Sqrt[3]));
FindRoot[(Subscript[τ, max])==(Subscript[τ, amm]),{ϕ,1}]
Print["ϕ= ",ϕ=⌈%[[1,2]]⌉," mm"]

Se a è minore di 1,5 volte il diametro del perno si può trascurare la flessione, quindi per sempèlicità porremo a = 1.4 ϕ

(Subscript[p, amm])=1.35 (Subscript[σ, amm]);   a=1.4 ϕ;   ((Subscript[Ν, 4])/(ϕ a))<(Subscript[p, amm])

Risoluzione numerica

Chiamiamo i nodi con la seguente numerazione:	A = 1 ,  B = 2 ,  C = 3 ,  D = 4 ,  V = 5
in modo da poter usare una "mappatura" dei nodi da associare ad ogni elemento:

el=4;   nodi=5;
(Subscript[el, 1])=(({{3}, {1}}));  (Subscript[el, 2])=(({{4}, {2}}));  (Subscript[el, 3])=(({{1}, {2}}));  (Subscript[el, 4])=(({{2}, {5}}));

quindi definiamo i g.d.l. della matrice globale dell'elemento  (Subscript[n, glob]) e del sistema intero  (Subscript[n, tot])  e le matrici di trasformazione associate ad ogni elemento per passare dalla matrice del singolo elemento a quella con (Subscript[n, tot]) g.d.l. da poter poi sommare per ottenere quella globale totale:

(Subscript[n, glob])=4;   (Subscript[n, tot])=2nodi;
H=ConstantArray[0,{el,(Subscript[n, glob]),(Subscript[n, tot])}];
For[i=1,i≤el,i++,{For[j=1,j≤2,j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,glob])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, glob]),(Subscript[n, glob])}]]
For[i=1,i≤el,i++,(Subscript[K, i,tot])=Transpose[H[[i]]].(Subscript[K, i,glob]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,tot]);
%//MatrixForm

Adesso sostituiamo la morfologia delle matrici di rigidezza globali e i valori dell'angolo β e la lunghezza L di ogni elemento:

c=Cos[β]; s=Sin[β];
(Subscript[K, glob])[β_,L_]=((Ε A)/L)(({{(c^2), c s, -(c^2), -c s}, {c s, (s^2), -c s, -(s^2)}, {-(c^2), -c s, (c^2), c s}, {-c s, -(s^2), c s, (s^2)}}));

(*1*)  (Subscript[β, 1])=α;       (Subscript[L, 1])=h/Sin[α];
(*2*)  (Subscript[β, 2])=α;       (Subscript[L, 2])=h/Sin[α];
(*3*)  (Subscript[β, 3])=0;       (Subscript[L, 3])=l;
(*4*)  (Subscript[β, 4])=π/2; (Subscript[L, 4])=h;

For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, glob]),jr++,For[jc=1,jc≤(Subscript[n, glob]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, glob])[(Subscript[β, i]),(Subscript[L, i])][[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm//N

Quindi definiamo il vettore dei carichi e degli spostamenti e risolviamo il sistema:

Fe=(({{0}, {-F/2}, {0}, {-F/2}, {(Subscript[R, 3,x])}, {(Subscript[R, 3,y])}, {(Subscript[R, 4,x])}, {(Subscript[R, 4,y])}, {(Subscript[R, 5,x])}, {(Subscript[R, 5,y])}}));     Δ=(({{(Subscript[u, 1])}, {(Subscript[v, 1])}, {(Subscript[u, 2])}, {(Subscript[v, 2])}, {0}, {0}, {0}, {0}, {0}, {0}}));
sol=Solve[Fe==(Subscript[K, tot]).Δ,{(Subscript[u, 1]),(Subscript[v, 1]),(Subscript[u, 2]),(Subscript[v, 2]),(Subscript[R, 3,x]),(Subscript[R, 3,y]),(Subscript[R, 4,x]),(Subscript[R, 4,y]),(Subscript[R, 5,x]),(Subscript[R, 5,y])}]

(({{(Subscript[u, 1])}, {(Subscript[v, 1])}, {(Subscript[u, 2])}, {(Subscript[v, 2])}, {(Subscript[R, 3,x])}, {(Subscript[R, 3,y])}, {(Subscript[R, 4,x])}, {(Subscript[R, 4,y])}, {(Subscript[R, 5,x])}, {(Subscript[R, 5,y])}}))=(({{sol[[1,1,2]]}, {sol[[1,2,2]]}, {sol[[1,3,2]]}, {sol[[1,4,2]]}, {sol[[1,5,2]]}, {sol[[1,6,2]]}, {sol[[1,7,2]]}, {sol[[1,8,2]]}, {sol[[1,9,2]]}, {sol[[1,10,2]]}}));

(Subscript[R, 3])=(Sqrt[((Subscript[R, 3,x])^2)+((Subscript[R, 3,y])^2)])
(Subscript[R, 4])=(Sqrt[((Subscript[R, 4,x])^2)+((Subscript[R, 4,y])^2)])

⊳ Calcolo dell' energie di deformazione

(Subscript[U, num])=(1/2) Transpose[Fe].Δ;
(Subscript[U, es])=(1/2)(∑_(i=1)^4)(∫_0^(Subscript[L, i]))(((Subscript[Ν, i])^2)/(Ε A))\[DifferentialD]x;

Print[" Energia di deform. esatta \t (Subscript[U, es])= ",(Subscript[U, es]), " J \n Energia di def. numerica \t  (Subscript[U, num])= ",(Subscript[U, num])[[1,1]], " J"]

Le due energie di deformazione coincidono. Si è trascurata l'energia di deformazione dovuta al Momento Flettente (che è comunque consistente) in quanto nel caso numerico il carico distribuito è stato schematizzato con due forze concentrate nei nodi A e B, e perciò non avrebbe avuto senso fare un confronto considerando anche quella. Per questo motivo l'errore è nullo, in quanto la struttura è caricata solo da forze concentrate nei nodi.

Quit[]

4 - Tubo serrato da due fondi piatti tramite bulloni

Si dimensiona un recipiente in pressione serrato alle estremità da due fondi piatti collegati mediante bulloni

Dimensionamento analitico

Si fa un dimensionamento del tubo ipotizzando che sia nota la capienza dello stesso e che quindi sia fissato il raggio interno e l'altezza

⊳ Dati

mm=MPa=1;   <<PlotLegends`

H=1000mm; h=50mm; a=200mm; p=5MPa;    l=2h+H;   Ε=200000 MPa;   ν=0.3;
 
(*mantello*)
(Subscript[A, m])=π((b^2)-(a^2));   (Subscript[S, y])=390MPa;   (Subscript[S, u])=700MPa;   (Subscript[k, m])=((Ε (Subscript[A, m]))/H);
(Subscript[F, e])=p π (a^2);

(*vite M 20 Classe 10.9*)
(Subscript[A, res])=245 (mm^2);   (Subscript[f, y])=900 MPa;   (Subscript[f, t])=1000 MPa;   (Subscript[k, b])=((Ε (Subscript[A, res]))/l);   (Subscript[d, B])=20 mm;

Per determinare il numero delle viti n si usa una formula empirica, e per determinare la forza di serraggio (Subscript[F, 0]) delle viti si suppone che il totale della forza esercitata dal serragio delle viti sia superiore di un quinto a quella della forza dovuta alla pressione interna che agisce sul coperchio (Subscript[F, e]).

n=⌈(a/40)+4⌉;     (Subscript[F, 0])=1.2 ((Subscript[F, e])/n);        Print[" n= ",n,"\n (Subscript[F, 0])= ",Round[(Subscript[F, 0]) (10^(-3)),1],"\t, (Subscript[F, 0, tot])= ",Round[n (Subscript[F, 0]) (10^(-3)),1] kN,"\n"]

Quindi si determina il fattore di sicurezza statico del bullone in cui agirà anche una componente dovuta al momento di serraggio, a sua volta divisibile in altre 2 componenti, una dovuta all'attrito tra la testa del dado e la superficie della flangia, una dovuta all'attrito tra filetti di vite e madrevite: 
(Subscript[M, s])=(Subscript[M, s])' + (Subscript[M, s])''

(Subscript[σ, amm])=((Subscript[f, y])/FS);     (Subscript[M, S])=(0.17+0.20)(Subscript[F, 0]) (Subscript[d, B]);
(Subscript[σ, B])=(Sqrt[(((((Subscript[F, 0])/(Subscript[A, res]))))^2)+3(((((Subscript[M, S])/((π ((Subscript[d, B])^3))/16))))^2)]);     (Subscript[FS, B])=((Subscript[f, y])/(Subscript[σ, B]));
Print[" (Subscript[M, S])= ",(Subscript[M, S]),"\t, (Subscript[σ, B])= ",(Subscript[σ, B]),"\n FS statico dei bulloni: ",(Subscript[FS, B]),"\n"]

⊳ Calcolo delle tensioni

Si calcola le forze che si scaricano sui bulloni e sul mantello (Subscript[F, b]) e (Subscript[F, m]) ,considerando che agiscono come due resistenze in parallelo.  Le due forze producono una tensione lungo l'asse z e sono funzione del raggio esterno b del mantello ancora incognito.

(Subscript[F, b])=(Subscript[F, 0])+((Subscript[k, b])/((Subscript[k, b])+(Subscript[k, m])))((Subscript[F, e])/n);      (Subscript[F, m])=n (Subscript[F, 0])-((Subscript[k, m])/((Subscript[k, b])+(Subscript[k, m])))(Subscript[F, e]);      

(Subscript[σ, z,b])=((Subscript[F, b])/(Subscript[A, res]));     (Subscript[σ, z,m])=-((Subscript[F, m])/(Subscript[A, m]));

Quindi si calcola lo stato tensionale del mantello mediante le equazioni di equilibrio del tubo di grosso spessore e le condizioni al contorno:

(Subscript[σ, R])[r_]=A-(B/(r^2));   (Subscript[σ, θ])[r_]=A+(B/(r^2));

s=Solve[{               (Subscript[σ, R])[a]==-p,
			(Subscript[σ, R])[b]==0
},{A,B}];

(Subscript[σ, R,m])[r_]=(Subscript[σ, R])[r]/.{A->s[[1,1,2]],B->s[[1,2,2]]} ;
(Subscript[σ, θ,m])[r_]=(Subscript[σ, θ])[r]/.{A->s[[1,1,2]],B->s[[1,2,2]]};

Print[" (Subscript[σ, R])= ",(Subscript[σ, R,m])[r],"\t (Subscript[σ, θ])= ",(Subscript[σ, θ,m])[r],"\n"]

Adesso si calcola la tensione equivalente secondo Von Mises (calcolata nel punto pià critico, ovvero la superficie interna di raggio a ) ed uguagliandola alla tensione ammissibile si ricava b

(Subscript[σ, VM])=(1/(Sqrt[2]))(Sqrt[((((Subscript[σ, z,m])-(Subscript[σ, θ,m])[a]))^2)+((((Subscript[σ, θ,m])[a]-(Subscript[σ, R,m])[a]))^2)+((((Subscript[σ, R,m])[a]-(Subscript[σ, z,m])))^2)]); 
(* tensione ammissibile per recipienti in pressione secondo il codice italiano VSR *)    (Subscript[σ, amm])=Min[((Subscript[S, y])/1.5),((Subscript[S, u])/2.4)];

Solve[{(Subscript[σ, VM])==(Subscript[σ, amm])},{b}];

Print[" b= ",b=⌈%[[4,1,2]]⌉," mm \n"]

⊳ Grafici

Plot[{(Subscript[σ, R,m])[r],(Subscript[σ, θ,m])[r],(Subscript[σ, z])[r]=(Subscript[σ, z,m])},{r,a,b},PlotLegend->{"(Subscript[σ, R, m])","(Subscript[σ, θ, m])","(Subscript[σ, z, m])"},LegendShadow->None,LegendPosition->{1.2,-0.5}, AxesLabel -> {"r (mm)", "MPa"},GridLines -> Automatic,PlotStyle -> Thick,ImageSize->700]

(* Grafico in funzione dell'inverso del quadrato del raggio *)
(({{R[r2_]}, {T[r2_]}, {Z[r2_]}}))=(({{(Subscript[σ, R,m])[1/(Sqrt[r2])]}, {(Subscript[σ, θ,m])[1/(Sqrt[r2])]}, {(Subscript[σ, z,m])}}));
Plot[{R[r2],T[r2],Z[r2]},{r2,0,(a^(-2))},AxesOrigin->{0,0},PlotStyle->Thick, AxesLabel -> {"(1/(r^2))", "MPa"},GridLines->{{{(a^(-2)),Dashed},{(b^(-2)),Dashed}},{s[[1,1,2]]}},Ticks->{{{0,"0"},{(a^(-2)),"(1/(a^2))"},{(b^(-2)),"(1/(b^2))"}},{{s[[1,1,2]],"A"},{50,"50"},{150,"150"},{200,"200"}}}]

Verifica a fatica

⊳ Mantello
Assumendo che la pressione vada da 0 a un massimo, pari al valore di progetto, ciclicamente si procede con la verifica mediante il criterio di Sines

Plot[{(p/2)(Sin[2π t]+1)},{t,0,2},PlotStyle->Thick,AxesLabel->{"tempo","p (MPa)"},Filling->Axis,GridLines->Automatic]

Su un punto interno del mantello la tensione varia quindi con il valore della pressione, in modo che la tensioni radiale e tangenziale vanno da 0 al valore massimo, mentre la tensione assiale varia da un massimo pari allo sforzo imposto dai precarichi dei bulloni, mentre cala quando la pressione cresce in quanto la forza dovuta alla pressione è opposta a quella dei precarichi.

(Subscript[σ, R,min])=0;   (Subscript[σ, R,max])=(Subscript[σ, R,m])[a]  ; 
(Subscript[σ, θ,min])=0;   (Subscript[σ, θ,max])=(Subscript[σ, θ,m])[a];
(Subscript[σ, z,min])=((Subscript[F, 0])/(π((b^2)-(a^2))));  (Subscript[σ, z,max])=((Subscript[F, m])/(π((b^2)-(a^2))));   

Print[" (Subscript[σ, R, min])= ",(Subscript[σ, R,min])," MPa \t (Subscript[σ, R, max])= ",(Subscript[σ, R,max])," MPa \n (Subscript[σ, θ, min])= ",(Subscript[σ, θ,min])," MPa \t (Subscript[σ, θ, max])= ",Round[(Subscript[σ, θ,max]),0.1]," MPa \n (Subscript[σ, z, min])= ",Round[(Subscript[σ, z,min]),0.1]," MPa    (Subscript[σ, z, max])= ",Round[(Subscript[σ, z,max]),0.1]," MPa \n"]

quindi utilizzando il termine ottaedrico per la componente alternata e il termine idrostatico per la tensione media

(Subscript[σ, Rm])= (((Subscript[σ, R,max])+(Subscript[σ, R,min]))/2);     (Subscript[σ, RA])=(((Subscript[σ, R,min])-(Subscript[σ, R,max]))/2);
(Subscript[σ, θm])=(((Subscript[σ, θ,max])+(Subscript[σ, θ,min]))/2);      (Subscript[σ, θA])=(((Subscript[σ, θ,max])-(Subscript[σ, θ,min]))/2);
(Subscript[σ, zm])=(((Subscript[σ, z,max])+(Subscript[σ, z,min]))/2) ;     (Subscript[σ, zA])=(((Subscript[σ, z,max])-(Subscript[σ, z,min]))/2);

(Subscript[σ, eqa])=(Sqrt[((Subscript[σ, RA])^2)+((Subscript[σ, θA])^2)+((Subscript[σ, zA])^2)-((Subscript[σ, RA]) (Subscript[σ, θA]) + (Subscript[σ, θA]) (Subscript[σ, zA]) + (Subscript[σ, zA]) (Subscript[σ, RA]))]);

(Subscript[σ, eqm])=(((Subscript[σ, Rm])+(Subscript[σ, θm])+(Subscript[σ, zm]))/3);      (Subscript[S, ea])=0.4(Subscript[S, u]);

FSm=((Subscript[S, ea])/(Subscript[σ, eqa]))(1- ((Subscript[σ, eqm])/(Subscript[S, u])));    

Print[" (Subscript[σ, eqa])= ",Round[(Subscript[σ, eqa]),0.1]," , (Subscript[σ, eqm])= ",Round[(Subscript[σ, eqm]),0.1]," MPa \n"," FS dinamico del mantello: ",FSm,"\n"]

⊳ Bulloni

Ogni bullone è invece sottoposto a un ciclo affaticante che ha un minimo quando la pressione è nulla, pari alla tensione dovuta all'effetto combinato del precarico e del momento di serraggio. Il massimo è invece dovuto agli stessi carichi a cui si aggiunge il carico dovuto alla pressione interna al tubo. E' presente anche una tensione tangenziale dovuta al momento di serraggio, che però è costante e non ciclica. 
Del momento di serraggio il contributo di attrito tra testa e flangia non lo considereremo, perchè nel tempo si annulla, quello tra filetti e madrevite si:

(Subscript[σ, B,min])=((Subscript[F, 0])/(Subscript[A, res]));     (Subscript[σ, B,max])=((Subscript[F, 0])/(Subscript[A, res]))+((p π (a^2))/(n (Subscript[A, res])));     
 (Subscript[M, Sf])=0.20(Subscript[F, 0]) (Subscript[d, B]);     (Subscript[τ, B])=((Subscript[M, Sf])/((π ((Subscript[d, B])^3))/16));
Print[" (Subscript[σ, B, min])= ",(Subscript[σ, B,min])," MPa \n (Subscript[σ, B, max])= ",(Subscript[σ, B,max])," MPa \n (Subscript[τ, B])= ",(Subscript[τ, B])," MPa \n"]

Si utilizza il criterio di Gough-Pollard nel caso di tensione media non nulla. Non essendo costante la tensione media si procede calcolando le resistenze limite a fatica mendiante Wohler: calcoliamo la retta di lavoro, quindi intersecandola con la retta limite nel diagramma di wholer otterremo la tensione limite a fatica;  mentre quella tangenziale, essendo nulla la componente alternata, sarà uguale alla resistenza tangenziale statica che secondo Soderberg sarà uguale alla tensione di snervamento tangenziale (Subscript[f, ys]) .

(Subscript[S, e])=((Subscript[f, t])/2);     (Subscript[f, ys])=((Subscript[f, y])/(Sqrt[3]));
(Subscript[σ, Bm])=(((Subscript[σ, B,max])+(Subscript[σ, B,min]))/2);   (Subscript[σ, Ba])=(((Subscript[σ, B,max])-(Subscript[σ, B,min]))/2);   
(Subscript[τ, Bm])=(Subscript[τ, B,max])=(Subscript[τ, B]);   (Subscript[τ, Ba])=0;

rdl[x_]=((Subscript[σ, Ba])/(Subscript[σ, Bm]))x;     Wohler[x_]=(Subscript[S, e])(1-(x/(Subscript[f, t])));
(Subscript[σ, B,lim])=Wohler[Solve[Wohler[x]==rdl[x],x][[1,1,2]]]; 

Print[" (Subscript[σ, B, lim])= ",Round[(Subscript[σ, B,lim]),1]," MPa"]
Plot[{(Subscript[S, e])(1-(x/(Subscript[f, t]))),rdl[x],(Subscript[σ, B,lim])},{x,0,(Subscript[f, t])},PlotStyle->{Thick,Dashed,Dashed},AxesLabel -> {"(Subscript[f, t])", "(Subscript[S, e])"}]

ℋ=((Subscript[σ, B,lim])/(Subscript[f, ys]))  (* secondo Soderberg *);     (Subscript[σ, eq])=(Sqrt[((Subscript[σ, Ba])^2)+(ℋ^2) ((Subscript[τ, B])^2)]);     FSb=((Subscript[σ, B,lim])/(Subscript[σ, eq]));     Print[" FS dinamico dei bulloni: ",FSb]

Calcolo spostamento esatto

(Subscript[σ, θ])[r_]=.;(Subscript[σ, R])[r_]=.;
(Subscript[D, m])=(Ε/((1+ν)(1-2ν)))(({{1-ν, ν, ν}, {ν, 1-ν, ν}, {ν, ν, 1-ν}}));

(({{(Subscript[ϵ, R])}, {(Subscript[ϵ, θ])}, {(Subscript[ϵ, z0])}}))=(({{(∂_r)u[r]}, {u[r]/r}, {((Subscript[σ, z,m])-ν((Subscript[σ, R,m])[r]+(Subscript[σ, θ,m])[r]))÷Ε}}));
(({{(Subscript[σ, R])[r_]}, {(Subscript[σ, θ])[r_]}, {(Subscript[σ, z])[r_]}}))=(Subscript[D, m]).(({{(Subscript[ϵ, R])}, {(Subscript[ϵ, θ])}, {(Subscript[ϵ, z0])}}));

Equilibrio=(∂_r)(Subscript[σ, R])[r]-(((Subscript[σ, θ])[r]-(Subscript[σ, R])[r])/r)==0;

DSolve[{Equilibrio,
	(Subscript[σ, R])[a]==-p,
	(Subscript[σ, R])[b]==0
},{u[r]},r]//Rationalize//N
u[r_]=%[[1,1,2]];

Plot[u[r],{r,a,b},PlotStyle->Thick,AxesLabel->{"R (mm)","u (mm)"}]

Calcolo numerico

⊳ Spostamento

	- Calcolo della rigidezza:

(Subscript[N, 1])[ξ_]=((1-ξ)/2); (Subscript[N, 2])[ξ_]=((1+ξ)/2); L=b-a; r[ξ_]=(((b+a))/2)+(L/2)ξ;
B=(({{(2/L)(∂_ξ)(Subscript[N, 1])[ξ], (2/L)(∂_ξ)(Subscript[N, 2])[ξ], 0}, {(Subscript[N, 1])[ξ]/r[ξ], (Subscript[N, 2])[ξ]/r[ξ], 0}, {0, 0, 1/H}}));
K=(∫_(-1)^1)(L/2)Transpose[B].(Subscript[D, m]).B r[ξ]\[DifferentialD]ξ;     Print[" K= ",K//MatrixForm,"\n"]

- Vettore dello spostamento e della forza (per unità di radiante e di altezza):

Δ=(({{(Subscript[u, 1])}, {(Subscript[u, 2])}, {w}}));     F=(({{p a}, {0}, {-(Subscript[F, m])/(2 π H)}}));

- Calcolo dello spostamento:

Solve[K.Δ==F,{(Subscript[u, 1]),(Subscript[u, 2]),w}]
(Subscript[u, 1])=%[[1,1,2]];
(Subscript[u, 2])=%%[[1,2,2]];
w=%%%[[1,3,2]];

(Subscript[u, app])[r_]=(Subscript[u, 1]) (Subscript[N, 1])[ξ]+(Subscript[u, 2]) (Subscript[N, 2])[ξ]/.ξ->(2/L)(r-((a+b)/2));

Plot[{(Subscript[u, app])[r],u[r]},{r,a,b},AxesOrigin->Automatic,PlotStyle->{{Thick},{Dashed,Black}},AxesLabel->{r,"u (mm)"},ImageSize->700,PlotLegend->{"(Subscript[u, app])","(Subscript[u, es])"},LegendShadow->None,LegendPosition->{1.2,-0.5}]

- Calcolo delle tensioni:

(({{(Subscript[σ, R,app])[r_]}, {(Subscript[σ, θ,app])[r_]}, {(Subscript[σ, z,app])[r_]}}))=(Subscript[D, m]).B.(({{(Subscript[u, 1])}, {(Subscript[u, 2])}, {w}}))/.ξ->(2/L)(r-((a+b)/2));

Plot[{(Subscript[σ, R,app])[r],(Subscript[σ, θ,app])[r],(Subscript[σ, z,app])[r]},{r,a,b},PlotLegend->{"(Subscript[σ, R, app])","(Subscript[σ, θ, app])","(Subscript[σ, z, app])"},LegendShadow->None,ImageSize->700,LegendPosition->{1.2,-0.5},PlotMarkers->Automatic,AxesLabel->{"MPa","r (mm)"}]

- Confronto tra tensioni approssimate e esatte mediante il grafico con il quadrato dell' inverso del raggio

(({{(Subscript[R, a])[r2_]}, {(Subscript[Θ, a])[r2_]}, {(Subscript[Z, a])[r2_]}}))=(({{(Subscript[σ, R,app])[1/(Sqrt[r2])]}, {(Subscript[σ, θ,app])[1/(Sqrt[r2])]}, {(Subscript[σ, z,app])[1/(Sqrt[r2])]}}));
Show[Plot[{(Subscript[R, a])[r2],(Subscript[Θ, a])[r2],(Subscript[Z, a])[r2]},{r2,0,(a^(-2))},PlotStyle->Thick],Plot[{R[r2],T[r2],Z[r2]},{r2,0,(a^(-2))},PlotStyle->Thin],AxesOrigin->{0,0},AxesLabel -> {"(1/(r^2))", "MPa"},GridLines->{{{(a^(-2)),Dashed},{(b^(-2)),Dashed}},{s[[1,1,2]]}},Ticks->{{{0,"0"},{(a^(-2)),"(a^(-2))"},{(b^(-2)),"(b^(-2))"}},{{s[[1,1,2]],"A"},{50,"50"},{150,"150"},{200,"200"}}}]

Quit[]

5 - Cerchiatura di un tubo

Dato un tubo sottoposto a pressione interna p di diametro interno a e diametro esterno b, si supponga di cinturarlo con un altro tubo dello stesso materiale avente diametro interno b e diametro esterno c.

Calcolo analitico

(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν}, {ν, 1}}));     (* Matrice di rigidezza in stato piano di tensione*)

(({{(Subscript[ϵ, r])}, {(Subscript[ϵ, θ])}}))=(({{(∂_r)u[r]}, {u[r]/r}}));     (* Equazione di compatibilità *)

(({{(Subscript[σ, R])[r_]}, {(Subscript[σ, θ])[r_]}}))=(Subscript[D, SPT]).(({{(Subscript[ϵ, r])}, {(Subscript[ϵ, θ])}}));     (* Equazione costitutiva *)

(∂_r)(Subscript[σ, R])[r]+(((Subscript[σ, R])[r]-(Subscript[σ, θ])[r])/r)==0;     (* Equazione di equilibrio *)

Equilibrio=Collect[%/.(Ε/(1-(ν^2)))->1 (*cost*),Derivative[_][u][_],Together]

⊳ Dati

Ε=200000  MPa;   ν=0.3;   α=(10^(-5)) ((°C )^(-1)); 
a=100 mm;   b=150 mm;   c=200 mm;   p=20 MPa;
MPa=mm=°C=1;Needs["PlotLegends`"]

⊳ Calcolo con sola pressione interna

DSolve[{       Equilibrio,
		(Subscript[σ, R])[a]==-p,
		(Subscript[σ, R])[c]==0

},{u[r]},r]//Rationalize
u[r_]=%[[1,1,2]];

Plot[{(Subscript[σ, R])[r],(Subscript[σ, θ])[r]},{r,a,c},PlotLegend->{"(Subscript[σ, R])","(Subscript[σ, θ])"},LegendShadow->None,LegendPosition->{0.3,0.2},PlotStyle->Thick,AxesLabel->{"r (mm)","MPa"},PlotLabel->Style["\n Andamento tensioni radiale e tangenziale per sola pressione interna \n"],GridLines->Automatic,ImageSize->500,LegendSize->1/4]

⊳ Calcolo con sola interferenza
  Si ipotizza che l'interferenza δ  sia dovuta a un ΔT  imposto:

ΔT=10 °C;     δ=ΔT α b mm;     Print[" δ= ",δ//N," mm"]

(* pressione di forzamento *)
(OverBar[p])=((Ε δ)/b)((((c^2)-(b^2))((b^2)-(a^2)))/(2 (b^2)((c^2)-(a^2))));    

(* Tensioni tubo interno *)
(Subscript[σ, R1])[r_]=-(((OverBar[p]) (b^2))/((b^2)-(a^2)))(1-((a^2)/(r^2))); 
(Subscript[σ, θ1])[r_]=-(((OverBar[p]) (b^2))/((b^2)-(a^2)))(1+((a^2)/(r^2)));      

(* Tensioni tubo esterno *)
(Subscript[σ, R2])[r_]=(((OverBar[p]) (b^2))/((c^2)-(b^2)))(1-((c^2)/(r^2))); 
(Subscript[σ, θ2])[r_]=(((OverBar[p]) (b^2))/((c^2)-(b^2)))(1+((c^2)/(r^2)));


(Subscript[σ, Rf])[r_]=(Piecewise[{{Null, r<a}, {(Subscript[σ, R1])[r], r<b}, {(Subscript[σ, R2])[r], r>b}}]);     (Subscript[σ, θf])[r_]=(Piecewise[{{Null, r<a}, {(Subscript[σ, θ1])[r], r<b}, {(Subscript[σ, θ2])[r], r>b}}]);

Plot[{(Subscript[σ, Rf])[r],(Subscript[σ, θf])[r]},{r,a,c},PlotLegend->{"(Subscript[σ, R])","(Subscript[σ, θ])"},LegendShadow->None,LegendPosition->{0.3,-0.6},PlotStyle->Thick,AxesLabel->{"r (mm)","MPa"},PlotLabel->Style["\n Andamento tensioni radiale e tangenziale per solo forzamento \n"],GridLines->Automatic,ImageSize->500,ExclusionsStyle->{{Dotted}},LegendSize->1/4]

⊳ Sovrapposizione degli effetti

(Subscript[σ, R,es])[r_]=(Subscript[σ, R])[r]+(Subscript[σ, Rf])[r];
(Subscript[σ, θ,es])[r_]=(Subscript[σ, θ])[r]+(Subscript[σ, θf])[r];

Plot[{(Subscript[σ, R,es])[r],(Subscript[σ, θ,es])[r],(Subscript[σ, R])[r],(Subscript[σ, θ])[r]},{r,a,c},PlotStyle->{Thick,Thick,Dashed,Dashed},AxesLabel->{"r (mm)","σ (MPa)"},PlotLabel->Style["\n Sovrapposizione degli effetti di pressione interna e forzamento \n"],GridLines->Automatic,ImageSize->550,ExclusionsStyle->{Dotted},PlotLegend->{"(Subscript[σ, R]) ((OverBar[p])+p)","(Subscript[σ, θ]) ((OverBar[p])+p)","(Subscript[σ, R]) (p)","(Subscript[σ, θ]) (p)"},LegendShadow->None,LegendPosition->{0.7,-0.1},LegendSize->0.5]

⊳ Confronto tra tubo semplice e tubo forzato
   Vediamo adesso cosa accade ad un tubo semplice (con raggio interno a e raggio esterno b) soggetto a pressione interna, quando gli viene forzato esternamente un tubo

(* Tubo semplice *)
u[r_]=.;
DSolve[{       Equilibrio,
		(Subscript[σ, R])[a]==-p,
		(Subscript[σ, R])[b]==0

},{u[r]},r];
u[r_]=%[[1,1,2]];

(* Grafico in funzione dell'inverso del quadrato del raggio *)
(({{R1[r2_]}, {Θ1[r2_]}}))=(({{(Subscript[σ, R])[1/(Sqrt[r2])]}, {(Subscript[σ, θ])[1/(Sqrt[r2])]}}));
(({{R[r2_]}, {Θ[r2_]}}))=(({{(Subscript[σ, R,es])[1/(Sqrt[r2])]}, {(Subscript[σ, θ,es])[1/(Sqrt[r2])]}}));

Plot[{R[r2],Θ[r2],R1[r2],Θ1[r2]},{r2,0,(a^(-2))},AxesOrigin->{0,0},PlotStyle->{Thick,Thick,Dashed,Dashed}, AxesLabel -> {"(1/(r^2))", "MPa"},GridLines->{{(a^(-2)),(b^(-2)),(c^(-2))},Automatic},ExclusionsStyle->{Dotted},ImageSize->500,PlotLegend->{"(Subscript[σ, R]) (f)","(Subscript[σ, θ]) (f)","(Subscript[σ, R])","(Subscript[σ, θ])"},LegendShadow->None,LegendPosition->{1,0},LegendSize->0.5,Ticks->{{{0,"0"},{(a^(-2)),"(a^(-2))"},{(b^(-2)),"(b^(-2))"},{(c^(-2)),"(c^(-2))"}}}]

Come si può osservare la pressione di forzamento (OverBar[p])  produce una tensione radiale sul raggio esterno b pari a -(OverBar[p]) , ma contemporaneamente riduce in maniera notevole la tensione tangenziale e quindi in definitiva la sollecitazione complessiva a cui è soggetto il tubo.

Calcolo numerico

L' insieme dei due tubi viene schematizzato con due elementi EM1, posti radialmente ed aventi i nodi estremi in corrispondenza dei raggi a , c e il nodo in comune in corrispondenza del raggio b.

⊳ Matrice di rigidezza

(Subscript[R, 1])=((a+b)/2);   L=b-a;   r1=(Subscript[R, 1])+(L/2)ξ;   (Subscript[B, 1])=(({{-1/L, 1/L}, {((1-ξ)/(2 r1)), ((1+ξ)/(2r1))}}));
K1=(L/2)(∫_(-1)^1)Transpose[(Subscript[B, 1])].(Subscript[D, SPT]).(Subscript[B, 1])r1\[DifferentialD]ξ;     Print[" K1= ",K1//MatrixForm,"\n"]

(Subscript[R, 2])=((b+c)/2)  ;   L=c-b;   r2=(Subscript[R, 2])+(L/2)ξ;   (Subscript[B, 2])=(({{-1/L, 1/L}, {((1-ξ)/(2 r2)), ((1+ξ)/(2r2))}}));
K2=(L/2)(∫_(-1)^1)Transpose[(Subscript[B, 2])].(Subscript[D, SPT]).(Subscript[B, 2]) r2\[DifferentialD]ξ;     Print[" K2= ",K2//MatrixForm,"\n"]

(Subscript[K, tot])=(({{K1[[1,1]], K1[[1,2]], 0}, {K1[[2,1]], K1[[2,2]]+K2[[1,1]], K2[[1,2]]}, {0, K2[[2,1]], K2[[2,2]]}}));     Print[" (Subscript[K, tot])= ",(Subscript[K, tot])//MatrixForm,"\n"]

⊳ Vettore delle forze e degli spostamenti

 Il forzamento viene simulato con un vettore di carichi termici agenti sul tubo interno, in stato di tensione piana:

(* Vettore dei carichi dovuto al forzamento *)
(Subscript[F, t])=((Ε α L ΔT)/(2(1-ν)))(({{1-2 (Subscript[R, 1])/L}, {1+2 (Subscript[R, 1])/L}, {0}}));

(* Vettore dei carichi dovuto alla pressione *)
(Subscript[F, p])=(({{p a}, {0}, {0}}));

(* Vettore dei carichi totale *)
(Subscript[F, tot])=(Subscript[F, t])+(Subscript[F, p]);

(* Vettore degli spostamenti radiali *)
Δ=(({{(Subscript[u, 1])}, {(Subscript[u, 2])}, {(Subscript[u, 3])}}))=Inverse[(Subscript[K, tot])].(Subscript[F, tot]);     (Subscript[Δ, 1])=(({{(Subscript[u, 1])}, {(Subscript[u, 2])}}));     (Subscript[Δ, 2])=(({{(Subscript[u, 2])}, {(Subscript[u, 3])}}));
Print[" (Subscript[Δ, 1])= ",(Subscript[Δ, 1])//MatrixForm,"\t (Subscript[Δ, 2])= ",(Subscript[Δ, 2])//MatrixForm,"\n"]

⊳ Calcolo delle tensioni

(Subscript[σ, n1])=(Subscript[D, SPT]).(Subscript[B, 1]).(Subscript[Δ, 1])-((Ε α ΔT)/(1-ν))(({{1}, {1}})) /.ξ->2((r-(Subscript[R, 1]))/L);
(Subscript[σ, n2])=(Subscript[D, SPT]).(Subscript[B, 2]).(Subscript[Δ, 2]) /.ξ->2((r-(Subscript[R, 2]))/L);

(Subscript[σ, Rn])[r_]=(Piecewise[{{(Subscript[σ, n1])[[1]], r<b}, {(Subscript[σ, n2])[[1]], r>b}}]);     (Subscript[σ, θn])[r_]=(Piecewise[{{(Subscript[σ, n1])[[2]], r<b}, {(Subscript[σ, n2])[[2]], r>b}}]);

Plot[{(Subscript[σ, Rn])[r],(Subscript[σ, R,es])[r]},{r,a,c},PlotStyle->{{Thick},{Thick,Dashed}},AxesLabel->{"r (mm)","(Subscript[σ, R]) (MPa)"},PlotLabel->Style["\n Tensioni radiali \n",Larger],GridLines->Automatic,ImageSize->550,ExclusionsStyle->{Dotted},PlotLegend->{"numerico","analitico"},LegendShadow->None,LegendPosition->{0.3,-0.6},LegendSize->0.3]

Plot[{(Subscript[σ, θn])[r],(Subscript[σ, θ,es])[r]},{r,a,c},PlotStyle->{{Thick},{Thick,Dashed}},AxesLabel->{"r (mm)","(Subscript[σ, θ]) (MPa)"},PlotLabel->Style["\n Tensioni tangenziali \n",Larger],GridLines->Automatic,ImageSize->550,ExclusionsStyle->{Dotted},PlotLegend->{"numerico","analitico"},LegendShadow->None,LegendPosition->{0.3,0.2},LegendSize->0.3]

Calcolo nel caso di accoppiamento albero - mozzo per interferenza

p=.;   Ε=.;   ν=.;

⊳ Albero
  è in uno stato idrostatico

(Subscript[σ, R,a])=(Subscript[σ, θ,a])=-(Subscript[p, f]);
(Subscript[ϵ, θ,a])=(1/Ε)((Subscript[σ, θ,a])-ν (Subscript[σ, R,a]));     (Subscript[u, a])=-(Subscript[ϵ, θ,a])(Subscript[R, s]);     Print["(Subscript[u, a])= ",(Subscript[u, a])//Simplify]

⊳ Mozzo

(Subscript[σ, R,m])[r_]=A+(B/(r^2));     (Subscript[σ, θ,m])[r_]=A-(B/(r^2));

Solve[{       (Subscript[σ, R,m])[(Subscript[R, s])]==-(Subscript[p, f]),
		(Subscript[σ, R,m])[(Subscript[R, m])]==0
},{A,B}]
A=%[[1,1,2]];B=%[[1,2,2]];

(Subscript[ϵ, θ,m])=(1/Ε)((Subscript[σ, θ,m])[(Subscript[R, s])]-ν (Subscript[σ, R,m])[(Subscript[R, s])]);     (Subscript[u, m])=(Subscript[ϵ, θ,m])(Subscript[R, m]);     Print["(Subscript[u, a])= ",(Subscript[u, m])//FullSimplify]

Adesso calcolati gli spostamenti di albero e mozzo dovuti alla pressione di forzamento, poniamo che la loro soma sia uguale all' interferenza nota e ricaviamo la pressione di forzamento incognita:

(Subscript[R, s])=b;     (Subscript[R, m])=c;     Ε=200000;   ν=0.3;

Solve[  (Subscript[u, a])+(Subscript[u, m])==δ , (Subscript[p, f])]
(Subscript[p, f])=%[[1,1,2]];

(Subscript[σ, R,am])[r_]=(Piecewise[{{(Subscript[σ, R,a]), r<(Subscript[R, s])}, {(Subscript[σ, R,m])[r], r>(Subscript[R, s])}}]);
(Subscript[σ, θ,am])[r_]=(Piecewise[{{(Subscript[σ, θ,a]), r<(Subscript[R, s])}, {(Subscript[σ, θ,m])[r], r>(Subscript[R, s])}}]);

Plot[{(Subscript[σ, R,am])[r],(Subscript[σ, Rf])[r]},{r,0,(Subscript[R, m])},PlotStyle->{Thick,Dashed},AxesLabel->{"r (mm)","(Subscript[σ, R]) (MPa)"},PlotLabel->Style["\n Tensione radiale \n"],GridLines->Automatic,ImageSize->520,AxesOrigin->{0,0},PlotLegend->{"Albero","Tubo"},LegendShadow->None,LegendPosition->{0.7,-0.7},LegendSize->0.5]
Plot[{(Subscript[σ, θ,am])[r],(Subscript[σ, θf])[r]},{r,0,(Subscript[R, m])},PlotStyle->{Thick,Dashed},AxesLabel->{"r (mm)","(Subscript[σ, θ]) (MPa)"},PlotLabel->Style["\n Tensione circonferenziale \n"],GridLines->Automatic,ImageSize->400,AxesOrigin->{0,0},ExclusionsStyle->{Dotted}]

Quit[]

6 - Turbina De Laval

Dimensionamento e calcolo dello spostamento radiale della corona per via analitica e numerica.

Dimensionamento generale

Utilizzando un programma scritto con Matlab per la progettazione di una turbina si esegue il calcolo di tutti i parametri che saranno necessari alla soluzione del problema:
.................................................................................................
DATI di PROGETTO 

 Pressione in ingresso:    	p0= 10.00 bar 
 Pressione in uscita:      	p1= 1.00 bar 
 Potenza:                  		P = 30.00 kW 
 Vapore surriscaldato:     	T_surr= 250°C 
 Materiale:  			16 Ni Cr 4
   Tensione di rottura:		R=  830 MPa 
   Densità:			ρ=7.8×(10^(-6)) kg/(mm^3)
 Numero di giri:		n= 21000 rpm 
 ............................................................................

(Subscript[σ, R])=830 MPa;   n=21000 rpm;   ρ=7.8*(10^(-6)) kg/(mm^3);   ω=n*π/30;    ν=0.3;   Ε=200000 MPa;
kg=mm=MPa=rpm=1;Print["\t ω= ",Round[ω]," rad/s"]

Il programma quindi procede con il calolo delle entalpie, delle velocità e i loro rispettivi angoli, dei rendimenti, delle perdite e della portata.  Per il nostro problema mostreremo solo i calcoli dei dati necessari ovvero la velocità periferica e il diametro. 
  La velocità periferica delle pale mobili u deve essere inferiore ai 400 m/s, valore da intendersi come estremo superiore poiché superando tale limite si  sviluppano tensioni eccessivamente alte nel disco della girante, dovute  alle forze centrifughe.  Vediamo quindi come si può calcolare il valore di  in funzione della tensione ammissibile del materiale.
  Consideriamo una pala, avente sezione perpendicolare alla direzione radiale, di area costante, dalla radice alla sommità e sollecitata a trazione centrata dalle forze centrifughe.  La forza alla radice della pala vale:
  
  F = ρ (Subscript[A, p]) (ω^2) (∫_(  (Subscript[r, p]))^( (Subscript[r, p])+(Subscript[h, p])))rdr  = (1/2) ρ (Subscript[A, p]) (ω^2) [ ( (Subscript[r, p]) + (Subscript[h, p]) )^2 - ((Subscript[r, p])^2)]
  
((Subscript[A, p]): area della sezione, (Subscript[h, p]): altezza della pala).  La tensione normale che si ha alla radice è, posto k = (Subscript[h, p])/(Subscript[r, p]) = cost :
  
  (Subscript[σ, r]) = (F/(Subscript[A, p]))= (1/2) ρ (ω^2) ((Subscript[r, p])^2) [k(2+k)] = ρ (u^2) k'
  
Normalmente si ha  k = 0,1÷0,2  e quindi  k' ⩽ 0,4.  Per la tensione ammissibile si può assumere un valore uguale alla metà della tensione di rottura del materiale che non è influenzata significativamente dalla temperatura fino a 300 °C.  Assumendo quindi il valori limiti  k' = 0.4  e  (Subscript[σ, r]) = (Subscript[σ, amm]) , dalla equazione della tensione radiale si può calcolare la velocità periferica massima ammissibile e quindi il raggio medio del disco:

(Subscript[σ, amm])=((Subscript[σ, R])/2);     (Subscript[u, amm])=(Sqrt[((Subscript[σ, amm])/(0.4 ρ))*(10^(-3))]);     (Subscript[r, m])=((Subscript[u, amm])/ω)*(10^3);

Print[" (Subscript[u, amm])= ",N[(Subscript[u, amm]),1]," m/s \n\n (Subscript[r, m])= ",Round[(Subscript[r, m]),0.1]," mm \n"]

Infine il programma calcola la geometria dell'ugello e in particolare delle pale che ci servirà per calcolare il loro volume e quindi il peso.

............................................................................................
GEOMETRIA delle PALE MOBILI 

 Altezza palare in ingresso:	h_pale= 12.1 mm 
 Corda assiale:			l_a= 12.1 mm 
 Angolo geometrico:		b1g= 30.49° 
 Raggio di intradosso:		R1= 7.0 mm 
 Raggio di estradosso:		R2= 4.2 mm 
 Passo palare:			p_l= 5.5 mm 
 Larghezza condotto:		b_pale= 2.8 mm 
 p_l comprensivo sp:		p_p= 5.8 mm 

 Altezza della pala in uscita:	h_p= 13.7 mm
 
		 		dOF= 2.0 mm 
		 		dCF= 3.8 mm 
 Angoli: 
	 tra OP e asseX: 	 a1p= 59.51° 
	 apertura palare:	 teta= 119.03° 

 Numero delle pale:		 N_pale= 180
 ......................................................................

z=180;   (Subscript[l, a])=12.1;   (Subscript[h, p])=13.7;   (Subscript[R, 1])=7;   (Subscript[R, 2])=4.2;   (Subscript[p, l])=5.5;   b=2.8;   
(Subscript[α, 1])=59.51°;   (Subscript[β, 1])=30.49°;   (OverBar[ OF])=2;   (OverBar[CF])=3.8;   (Subscript[l, t])=(Subscript[p, l]) Sin[(Subscript[α, 1])];     
(*raggio alla base della pala*)(Subscript[r, b])=(Subscript[r, m])-(Subscript[h, p])/2;

"volume e massa della pala"
V=(((Subscript[R, 2])^2) (Subscript[α, 1])+(1/2)(Subscript[l, a]) (Subscript[R, 1]) Sin[(Subscript[β, 1])]+(OverBar[OF])  (Subscript[l, a])+(1/2) (OverBar[CF]) (Subscript[l, a])-((Subscript[l, t]) b+((Subscript[R, 1])^2) (Subscript[α, 1])))(Subscript[h, p]) ;  
(Subscript[m, p])=ρ*V;          
Print["\t V= ",Round[V]," (mm^3) \t (Subscript[m, p])= ",Round[(Subscript[m, p])*(10^3),0.1]," gr \n\n"]

Calcolo analitico

⊳ Dimensionamento del disco e della corona
Si procede avendo fissato arbitrariamente lo spessore della corona in senso radiale.
Calcoliamo quindi il profilo del disco imponendo che le tensioni radiali e ciconferenziali siano costanti e uguali  (Subscript[σ, r])=(Subscript[σ, θ])=(OverBar[σ])  che fissiamo uguale alla tensione ammissibile divisa unfattore di sicurezza FS=1.5 e fissando il valore dell'altezza della corona 2·(Subscript[h, c])  leggermente maggiore della larghezza assiale della pala (Subscript[l, a]) per ottenere un buon proporzionamento della turbina:

s=20;   (Subscript[r, e])=(Subscript[r, b])-s;   (Subscript[h, c])=(3/4)(Subscript[l, a]);   (Subscript[r, c])=(Subscript[r, b])-s/2;   (OverBar[σ])=((Subscript[σ, amm])/1.5);    Print["\t (Subscript[h, c])= ",(Subscript[h, c])=Round[(Subscript[h, c]),1]," mm"]

Quindi determiniamo l'altezza del disco al raggio esterno (Subscript[h, e]) in funzione del dimensionamento della corona mediante le equazioni di continuità tra disco e corona, per poi determinare il profilo del disco.

Introduciamo le equazioni di continuità con il disco, funzioni delle tensioni della corona  (Subscript[σ, r]) e (Subscript[σ, θ]): 
  
	- Congruenza degli spostamenti	(Subscript[u, disco])((Subscript[r, e])) = (Subscript[u, corona])((Subscript[r, e]))
	  
	 			 essendo	(Subscript[ϵ, t])=(u/r)=(1/E)((Subscript[σ, t])-ν (Subscript[σ, r]))  ,  (Subscript[σ, r,c]) ≃ 0  ,  (Subscript[σ, r,d]) = (Subscript[σ, θ,d]) = (OverBar[σ]) .
	 			 			 
	- Equilibrio radiale			(OverBar[σ]) (Subscript[h, e]) = (Subscript[σ, r]) (Subscript[h, c])

(Subscript[σ, θ])=(OverBar[σ])(1-ν);           Print["\t (Subscript[σ, θ])= ",(Subscript[σ, θ])," MPa"] 
  
	(Subscript[σ, r])=-(OverBar[σ]) ((Subscript[h, e])/(Subscript[h, c]));

Essendo  (s/(Subscript[r, c]))≪ 1  possiamo assimilare la corona ad un anello di piccolo spessore.  La tensione circonferenziale sarà:

eq=(Subscript[σ, θ])==(((Subscript[p, t]) (Subscript[r, c]))/s)+ρ (v^2)(10^3);     

v=ω (Subscript[r, c]) (10^(-3))(*m/s*);   

(Subscript[p, t])=(Subscript[p, c])-(Subscript[p, d]);

dove (Subscript[p, t]) è la pressione totale a cui e soggetta la corona per effetto del disco e delle palette:
	- (Subscript[p, c])  pressione dovuta alla forza centrifuga delle palette
	 che per ipotesi riterremo uniformemente distribuita sulla superficie esterna della corona
	 - (Subscript[p, d])  pressione esercitata radialmente dal disco sulla superficie interna corona

(Subscript[p, c])=((Subscript[F, c])/(2 π (Subscript[r, c]) (Subscript[h, c])));   (Subscript[F, c])=z((Subscript[m, p]) (ω^2) (Subscript[r, b]))(10^(-3)); 

(Subscript[p, d])=-(Subscript[σ, r]);

(Subscript[h, e])=Solve[eq,(Subscript[h, e])][[1,1,2]];     
Print["\t (Subscript[h, e])= ",(Subscript[h, e])," mm","\n\t (Subscript[σ, r])= ",(Subscript[σ, r])," MPa \n"]

Adesso noto  (Subscript[h, e]) è possibile ricavare l'equazione del profilo del disco e il valore dell'altezza al centro:

h[R_]=(Subscript[h, 0]) Exp[-((ρ (ω^2))/(2 (OverBar[σ])*(10^3)))(R^2)];

(Subscript[h, 0])=Solve[(Subscript[h, e])==h[(Subscript[r, e])],(Subscript[h, 0])][[1,1,2]];          Print["\t (Subscript[h, 0])= ",Round[(Subscript[h, 0]),0.1]," mm"]

Plot[h[R],{R,0,(Subscript[r, e])},PlotStyle->Thick,Filling->Axis,AxesLabel->{"r (mm)","h (mm)"},AxesOrigin->{0,0},AspectRatio->Automatic]

Ed infine disegnare l'intero  profilo della girante:

(Subscript[h, dc])=(Piecewise[{{h[R], R<(Subscript[r, e])}, {(Subscript[h, c]), R⩾(Subscript[r, e])}}]);

Plot[(Subscript[h, dc]),{R,0,(Subscript[r, b])},AxesOrigin->{0,0},PlotStyle->Thick,AspectRatio->Automatic,Filling->Axis,AxesLabel->{R,"(Subscript[h, dc])"},ImageSize->480,Ticks->{Automatic,{5,10,15}}]

⊳ Calcolo dello spostamento

(Subscript[u, b])=((Subscript[r, b])/Ε)(Subscript[σ, θ]);          Print["\t (Subscript[u, b])= ",(Subscript[u, b])," mm \n\n"]

Calcolo numerico

⊳ Calcolo della matrice di rigidezza.
Nel calcolo dell'integrale della matrice di rigidezza siccome l'integrale non converge nei pto (-1) utilizzeremo  -δ :

l=(Subscript[r, b]) ;    Rm=((Subscript[r, b])/2) ;   R=Rm+(l/2)ξ ;    (Subscript[N, 1])=((1-ξ)/2);   (Subscript[N, 2])=((1+ξ)/2);   δ=(1-(10^(-10)))//N;

(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν}, {ν, 1}}));          B=(({{-(1/l), (1/l)}, {((Subscript[N, 1])/R), ((Subscript[N, 2])/R)}}));

K=(l/2)(∫_(-δ)^(+1)) Transpose[B].(Subscript[D, SPT]).B R (Subscript[h, dc])\[DifferentialD]ξ

In questo caso il calcolo esatto però non riesce comunque a trovare una soluzione quindi per risolvere l'integrale e avere una miglior precisione si fa un calcolo numerico che si ferma solo in prossimità del pto -1 ma svolge comunque il calcolo fino dove la precisione di macchina permette ed è più rapido:

k[ξ_]=Transpose[B].(Subscript[D, SPT]).B R (Subscript[h, dc]);
K=(l/2)NIntegrate[k[ξ],{ξ,-1,+1}];        Print["\t K=",K//MatrixForm]

⊳ Calcolo del vettore della forza
Sarà la somma di tre contributi: 
	- la pressione dovuta alla corona uguale all'opposto della tensione radiale
	- la forza centrifuga della girante stessa che si scompone in due forze equivalenti nei due nodi che per verifica, 
	sommate dovrebbero essere uguali al carico complessivo
	- la reazione incognita X dovuta allo spostamento nullo nel centro della turbina

(Subscript[F, p])=(({{0}, {(Subscript[p, c]) (Subscript[r, b])}}));

	(Subscript[F, c])=(l/2)(∫_(-1)^(+1))(10^(-3))ρ R (ω^2) (({{(Subscript[N, 1])}, {(Subscript[N, 2])}}))R (Subscript[h, dc])\[DifferentialD]ξ;

	(Subscript[F, t])=(Subscript[F, c])+(Subscript[F, p])+(({{X}, {0}}));

Print["\n (Subscript[F, p])= ",(Subscript[F, p])//MatrixForm,"\t, (Subscript[F, c])= ",(Subscript[F, c])//MatrixForm,"\t, (Subscript[F, t])=",(Subscript[F, t])//MatrixForm,".\n"]

Clear[R]
(Subscript[F, app])=(Subscript[F, c])[[1,1]]+(Subscript[F, c])[[2,1]];   
(Subscript[F, es])=(∫_0^(Subscript[r, b]))(10^(-3))ρ (ω^2) (R^2) (Subscript[h, dc])\[DifferentialD]R;
R=Rm+(l/2)ξ;
Print[" (Subscript[F, appross])= ",(Subscript[F, app]),"\n (Subscript[F, esatta])= ",(Subscript[F, es]),"\n" ]

⊳ Calcolo degli spostamenti
Dall'equazione di equilibrio ricaviamo quindi lo spostamento all'estremo del disco e la reazione al centro:

Δ=(({{0}, {(Subscript[u, 2])}}));    eqm=K.Δ==(Subscript[F, t]);
Solve[{eqm},{X,(Subscript[u, 2])}]
u2=%[[1,2,2]];

Print[" Spostamento esatto:  \t (Subscript[u, b])= ",(Subscript[u, b]),"\n Spostamento approssimato: (Subscript[u, 2])= ",u2,"\n Errore percentuale=   \t",Round[100((Subscript[u, b])-u2)/(Subscript[u, b]),1]," % \n"]

⊳ Integrazione con Gauss
Lo spostamento calcolato numericamente  è minore per via della matrice di rigidezza che è sopravalutata. Vediamo se il risultato migliora calcolandola con 2 pti di Gauss, che approsimando di più il risultato dovrebbe far sì che la matrice di rigidezza risulti meno sopravalutata e quindi il risultato sullo spostamento risulti più preciso:

pG=2;

ord=2 pG-1;   pol=ConstantArray[0,ord+1];   poly=ConstantArray[0,{pG,ord+1}];
For[i=0,i≤ord, i++,pol[[i+1]]=(ξ^i)(Subscript[c, i])]; 
For[j=1,j≤pG,j++,For[i=0,i≤ord,i++,poly[[j,i+1]]=((Subscript[ξ, j])^i)(Subscript[c, i])]]
(Subscript[I, e])=(∫_(-1)^(+1))pol\[DifferentialD]ξ;     (OverTilde[I]) = (∑_(j=1)^pG)(Subscript[H, j])poly[[j]];
x=ConstantArray [0,pG]; h=ConstantArray [0,pG];
For[j=1,j≤pG,j++,{x[[j]]=(Subscript[ξ, j]),h[[j]]=(Subscript[H, j])}];
pp=Join[x,h];     sol=Solve[(Subscript[I, e]) == (OverTilde[I]), pp];
For[i=1,i≤pG,i++,{(Subscript[H, i])=sol[[1,pG+1-i,2]],(Subscript[ξ, i])=sol[[1,i+pG,2]],Print[i,") Pto: ",(Subscript[ξ, i]),"\t Peso: ",(Subscript[H, i])]}]

Kg=(l/2)(∑_(i=1)^pG)(Subscript[H, i])*k[(Subscript[ξ, i])];    Print[" (Subscript[K, Gauss2P])= ",Kg//MatrixForm]

eqm=Kg.Δ==(Subscript[F, t]);     Solve[{eqm},{X,(Subscript[u, 2])}]
(Subscript[u, G])=%[[1,2,2]];

Print[" Spostamento esatto:  \t (Subscript[u, b])= ",(Subscript[u, b]),"\n Spostamento 2 pti Gauss:  (Subscript[u, G])= ",(Subscript[u, G]),"\n Errore percentuale=   \t",Round[100((Subscript[u, b])-(Subscript[u, G]))/(Subscript[u, b]),1]," %"]

Il risultato come si può vedere è notevolmente migliorato.

7 - Anello di piccolo spessore

Calcolo mediante linea elastica e Castigliano di un anello sottoposto a trazione da due forze uguali diametralmente opposte.

Risoluzione con la linea elastica

Per risolvere il problema, il sistema può essere semplificato per simmetria a 1/4 dell'anello.
Oss: si sceglie di studiare la struttura permettendo lo spostamento ai due estremi dell' arco di circonferenza nella direzione di v in modo che, come vedremo, questo ci permetterà di fare un diagramma polare di come si deforma esattamente la struttura in quella direzione. In questo modo la forza incognita sarà M che sostituisce il vincolo di rotazione.

Calcoliamo il momento m applicato in un generico punto dell' arco di coordinate polari  ( R , θ )  quindi calcoliamo lo spostamento u(θ) con le condizioni al contorno e v(θ) che sarà la sua derivata rispetto a θ

m[θ_]=(P/2) R Cos[θ]-M;

v[θ_]=(∂_θ)u[θ];

DSolve[{       	( (∂_(θ,θ))v[θ] + v[θ])/(R^2) == ((m[θ])/(Ε J)),
			u[0]==0,
			u[(π/2)]==0,
			v'[0]==0
},u[θ],θ];
u[θ_]=Collect[%[[1,1,2]]//Simplify,R];

Print["\n u[θ]= ",u[θ],"\n\n v[θ]= ",Collect[v[θ]//Simplify,R],"\n"]

Ora possiamo calcolare il momento incognito M imponendo la condizione di congruenza di rotazione nulla per  θ=90°

Solve[ v'[(π/2)]==0,M]
M=%[[1,1,2]];

Si procede quindi con i grafici degli spostamenti e delle forze, sostituendo dei valori dat ai parametri

dat={Ε->200000,R->100,J->100,P->2000,A->30};

Needs["PlotLegends`"]
Plot[{v[θ]/.dat,u[θ]/.dat},{θ,0,π/2},PlotStyle->Thick,AxesLabel->{"θ","u,v (mm)"},PlotLabel->Style[Framed[" Grafici degli spostamenti u,v "]],Ticks->{{{π/4,"π/4"},{π/2,"π/2"}}},GridLines->{{π/8,π/4,3π/8,π/2},Automatic},ImageSize->600,PlotLegend->{"v","u"},LegendShadow->None,LegendPosition->{-0.8,0.3},LegendSize->0.2]
PolarPlot[{R/.dat,R+v[θ]/.dat},{θ,0,(π/2)},ImageSize->300,AxesLabel->{"θ=0","θ=(π/2)"},PlotStyle->{{Dashed,Thick},Thick},PlotLabel->Style[" \n - Grafico polare di v "]]PolarPlot[{R/.dat,R-u[θ]/.dat},{θ,0,π/2},ImageSize->300,AxesLabel->{"θ=0","θ=(π/2)"},PlotStyle->{{Dashed,Thick},Thick},PlotLabel->Style[" \n - Grafico polare di u \n"]]

n[θ_]=(P/2)Cos[θ];

Plot[((m[θ])/(P R)),{θ,0,π},PlotStyle->Thick,AxesLabel->{"θ","\!\(\*FractionBox[\(m[θ]\), \(P\\ R\)]\)"},PlotLabel->Style[Framed[" Grafico del momento e dello sforzo normale" ]],Ticks->{{{π/4,"π/4"},{π/2,"π/2"},{3π/4,"3π/4"},{π,"π"}}},GridLines->{{π/4,π/2,3π/4,π},Automatic},ImageSize->500]
Plot[((n[θ])/(P/2))/.dat,{θ,0,π},PlotStyle->Thick,AxesLabel->{"θ","((n[θ])/(P/2))"},PlotLabel->Style["\n"],Ticks->{{{π/4,"π/4"},{π/2,"π/2"},{3π/4,"3π/4"},{π,"π/2"}}},GridLines->{{π/4,π/2,3π/4,π},Automatic},ImageSize->500]

- Infine passiamo dagli spostamenti locali delll'elemento a quelli globali   ξ, η

ξ[θ_]=v[θ]Cos[θ]+u[θ]Sin[θ];
η[θ_]=v[θ]Sin[θ]-u[θ]Cos[θ];

Plot[{ξ[θ]/.dat,η[θ]/.dat},{θ,0,π/2},PlotStyle->Thick,AxesLabel->{"θ","ξ,η (mm)"},PlotLabel->Style[Framed[" Grafici degli spostamenti ξ,η "]],Ticks->{{{π/4,"π/4"},{π/2,"π/2"}}},GridLines->{{π/8,π/4,3π/8,π/2},Automatic},ImageSize->600,PlotLegend->{"ξ","η"},LegendShadow->None,LegendPosition->{-0.8,0.3},LegendSize->0.2]

Risoluzione con Castigliano

Per il calcolo con Castigliano si è aggiunta una forza incognita fittizia nella direzione di ξ in modo da poter calcolare con il teorema di Castigliano lo spostamento in entrambe le direzioni.
Scriviamo la formula del momento di un punto generico (R , θ ), quindi calcolimao l'energia di deformazione

Clear[M]

m[θ_]=(P/2) R Cos[θ]-M-Ν R(1-Sin[θ]);
U[P_,Ν_,M_]=(1/2)(∫_0^(π/2))((((m[θ])^2)/(Ε J)))R\[DifferentialD]θ ;  
Print["\n U= ",%,"\n"]

Calcoliamo adesso la derivata dell'energia rispetto a M  ponendo N=0; uguagliando il tutto a zero si può ricavare il momento incognito M

eq=(∂_M)U[P,Ν,M]==0/.Ν->0

Solve[eq,M]
M=%[[1,1,2]];

Quindi sostituendo M e calcolando la derivata del momento rispetto P e Ν sempre imponendo che sia N=0 si calcolano gli spostamenti lungo ξ e η

(Subscript[ξ, C])[θ_]=(∂_Ν)U[P,Ν,M]/.Ν->0;
(Subscript[η, C])[θ_]=(∂_P)U[P,Ν,M]/.Ν->0;

Print[" (Subscript[ξ, C])= ",(Subscript[ξ, C])[θ],"\n (Subscript[η, C])= ",(Subscript[η, C])[θ],"\n"]

verifichiamo l'uguaglianza dei risultati:

Print["\n\t\t Castigliano \t Linea Elast. \n\n ξ(0) \t",(Subscript[ξ, C])[0]//Simplify,"\t",ξ[0]//Simplify,"\n η(0) \t",(Subscript[η, C])[π/2]//Simplify,"\t",η[π/2]//Simplify,"\n"]

- Grafico del momento con Castigliano

Plot[((m[θ])/(P R))/.Ν->0,{θ,0,π},PlotStyle->Thick,AxesLabel->{"θ","\!\(\*FractionBox[\(m[θ]\), \(P\\ R\)]\)"},Ticks->{{{π/4,"π/4"},{π/2,"π/2"},{3π/4,"3π/4"},{π,"π"}}},GridLines->{{π/4,π/2,3π/4,π},Automatic},ImageSize->500]

Quit[]

8 - Frequenze proprie flessionali

Calcolo delle velocità critiche di un albero con due volani

⊳ Ipotesi:
	- Albero flessibile, di massa trascurabile
	- Cuscinetti perfettamente rigidi
	- Dischi rigidi di piccolo spessore assiale ⇒ effetto disco trascurabile (inerzia del disco + effetto giroscopico)
	- Deformata dovuta al peso trascurabile

Teoria dei sistemi continui

Si procede calcolando l'equazione di equilibrio alla traslazione lungo z

eq=ρ S dx (∂_(t,t))v[x,t]-T[x]+(T[x]+(∂_x)T[x] dx);

applicando le approssimazioni e definizioni di Eulero-Bernoulli:

M[x_]=(∂_(x,x))v[x,t]Ε J;   T[x_]=(∂_x)M[x];
eq=eq/dx//Simplify

Posto come come Integrale generale una funzione separata nelle due variabili:

v[x_,t_]=ϕ[x]Sin[ω t];
Print[eq//Simplify,"==0"]

Posto β=(((ω^2)((ρ S)/(Ε J)))^(1/4)) risolviamo l'equazione in x per i due tratti di una metà simmetrica con rispettive funzioni (Subscript[φ, 1])[x] e (Subscript[φ, 2])[x]

DSolve[{      (∂_(x,x,x,x))(Subscript[φ, 1])[x]-(β^4)(Subscript[φ, 1])[x]==0,
		(∂_(x,x,x,x))(Subscript[φ, 2])[x]-(β^4)(Subscript[φ, 2])[x]==0

},{(Subscript[φ, 1])[x],(Subscript[φ, 2])[x]},x];

Print[" (Subscript[φ, 1])[x]= ",(Subscript[φ, 1])[x_]=%[[1,1,2]],"\n (Subscript[φ, 2])[x]= ",(Subscript[φ, 2])[x_]=%[[1,2,2]]]

Condizioni al contorno

cc1=(Subscript[φ, 1])[0]==0;
cc2=(Subscript[φ, 1])''[0]==0;
cc3=(Subscript[φ, 1])[l]==(Subscript[φ, 2])[l];
cc4=(Subscript[φ, 1])'[l]==(Subscript[φ, 2])'[l];
cc5=(Subscript[φ, 1])''[l]==(Subscript[φ, 2])''[l];
cc6=(Subscript[φ, 1])''[l] Ε J==-(Subscript[φ, 1])[l] m (ω^2)l;
cc7=(Subscript[φ, 2])'[l 3/2]==0;
cc8=(Subscript[φ, 2])'''[l 3/2 ]Ε J==0;

per verificare che esista soluzione raccogliamo tutti i coefficienti in una matrice e calcoliamone il determinante

CoefficientArrays[{cc1,cc2,cc3,cc4,cc5,cc6,cc7,cc8},{C[1],C[2],C[3],C[4],C[5],C[6],C[7],C[8]}]
CA=%[[2]]//Normal;   Print[CA//MatrixForm]

dat={ρ->8000 (*kg/(m^3)*), Ε->2*(10^11)(*Pa*), l->1(*m*), m->10(*kg*), d->0.04(*m*),    J->π ((0.04^4)/64),    S->π ((0.04^2)/4)};β=(((ω^2)((ρ S)/(Ε J)))^(1/4));
detCA=Det[CA]/.dat;

Vediamo il grafico del determinante dove si annulla e quindi troviamo le radici che saranno le velocità critiche:

Plot[detCA,{ω,0,55},PlotStyle->Thick]

Plot[detCA ,{ω,0,5000},PlotStyle->Thick,PlotRange->{-1,1}]

FindRoot[detCA==0,{ω,50}]
ω[1,1]=%[[1,2]];

Calcolo analitico matriciale

Scrivendo l'equazione delle freccie (Subscript[f, i]) dovute ai singoli dischi di peso (Subscript[m, i]), con (Subscript[μ, ij]) coefficienti d'influenza (freccia in i dovuta ad una forza unitaria applicata in j ), si ottiene il sistema:
	{({{(Subscript[v, 1])=-(Subscript[m, 1])(Subscript[(Overscript[v, ¨]), 1])(Subscript[μ, 11])-(Subscript[m, 2])(Subscript[(Overscript[v, ¨]), 2])(Subscript[μ, 12])}, {(Subscript[v, 2])=-(Subscript[m, 2])(Subscript[(Overscript[v, ¨]), 1])(Subscript[μ, 21])-(Subscript[m, 1])(Subscript[(Overscript[v, ¨]), 2])(Subscript[μ, 22])}})
che sostituendo la vibrazione armonica:      v = V Sin[ω t]	  diventa semplificando:

𝒱=(({{(Subscript[V, 1])}, {(Subscript[V, 2])}}));   𝒟=(({{(Subscript[μ, 11]), (Subscript[μ, 12])}, {(Subscript[μ, 21]), (Subscript[μ, 22])}}));   ℳ=(({{m, 0}, {0, m}}));

𝒱=𝒟.ℳ.𝒱 (ω^2);                      Print[𝒱//MatrixForm]

Raccogiendo diventa il sistema omogeneo:	(Id-𝒟.ℳ (ω^2)).𝒱==0	
Per aver soluzione non ovvia si deve annullare il determinante della matrice dei coefficienti; tale condizione permetterà di ricavare le velocità critiche. Posto:

(Subscript[μ, 11])=b x (((a^2)+2a b-(x^2))/(6L Ε J))/.{a->l,b->2l,L->3l,x->l};     
(Subscript[μ, 12])=((-(a^3)L+x a((a^2)+2(L^2))-3 a L (x^2)+a (x^3))/(6L Ε J))/.{a->l,b->2l,L->3l,x->2l};
Print["(Subscript[μ, 11])=",(Subscript[μ, 11]),",\t (Subscript[μ, 12])=",(Subscript[μ, 12])]

(Subscript[μ, 22])=(Subscript[μ, 11]);   (Subscript[μ, 21])=(Subscript[μ, 12]);   Id=(({{1, 0}, {0, 1}}));

EqCar=Det[Id-𝒟.ℳ (ω^2)]==0
sol=Solve[EqCar/.dat,ω][[{3,4}]]

Metodo degli Elementi Finiti

el=3;
nodi=(el+1);   (Subscript[n, loc])=4;   (Subscript[n, glob])=2nodi;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,For[j=1,j≤4,j++,H[[i,j,j +(i-1) 2]]=1]]
For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, loc])=((Ε J)/(l^3))(({{12, 6 l, -12, 6 l}, {6 l, 4 (l^2), -6 l, 2 (l^2)}, {-12, -6 l, 12, -6 l}, {6 l, 2 (l^2), -6 l, 4 (l^2)}}));
For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc])[[jc,jr]]]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);     Print["(Subscript[K, tot])= \!\(\*FractionBox[\(J\\ Ε\), SuperscriptBox[\(l\), \(3\)]]\)",(Subscript[K, tot])((l^3)/(J Ε))//MatrixForm]

Si eliminano la prima e la settima colonna/riga associate agli spostamenti nulli sugli appoggi

M=(({{0, 0, 0, 0, 0, 0}, {0, m, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, m, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}}));    (Subscript[K, t])=((J Ε)/(l^3))(({{4 (l^2), -6 l, 2 (l^2), 0, 0, 0}, {-6 l, 24, 0, -12, 6 l, 0}, {2 (l^2), 0, 8 (l^2), -6 l, 2 (l^2), 0}, {0, -12, -6 l, 24, 0, 6 l}, {0, 6 l, 2 (l^2), 0, 8 (l^2), 2 (l^2)}, {0, 0, 0, 6 l, 2 (l^2), 4 (l^2)}}));

Quindi risolviamo

Solve[Det[(Subscript[K, t])-(ω^2)M]==0,ω][[{2,4}]]//N
%/.dat

Metodo di Rayleigh

g=9.81 (* m/(s^2) *);   R=m g  (* Newton *);

Mf[x_]=(Piecewise[{{R x, x<l}, {R l, l≤x<2l}, {R(3l-x), x≥2l}}])/.dat;
Plot[Mf[x]/.dat,{x,0,3l/.dat}]

f[x_]=DSolve[{       Ε J y''[x]==-Mf[x],
			y[0]==0,
			y[3l]==0                          }/.dat,{y[x]},x][[1,1,2]];

Plot[f[x],{x,0,3 l/.dat}]

l=l/.dat;   v=f[l]=f[2l];
Print["(Subscript[ω, cr])= ",(Sqrt[((g )/v)])]

9 - Albero soggetto a carico di punta

Per simmetria consideriamo solo metà dell'albero, imponendo nelle CC che in 1 ci sia un abbassamento f e che in 3 l'abbassamento sia nullo.

⊳ Dati

Ε=206000 (* MPa *); 
(Subscript[d, 1])=60 (* mm *);     (Subscript[d, 2])=40 (* mm *); 
(Subscript[L, 1])=600 (* mm *);     (Subscript[L, 2])=400 (* mm *);
(Subscript[J, 1])=((π ((Subscript[d, 1])^4))/64);     (Subscript[J, 2])=((π ((Subscript[d, 2])^4))/64);

Soluzione analitica

Equazioni di equilibrio sui due tratti e calcolo degli spostamenti (Subscript[w, 1]) e (Subscript[w, 2]) degli stessi, mediante le 4 condizioni al contorno, in funzione di P  ed f

eq1=Ε (Subscript[J, 1])(Subscript[v, 1])''[x]+P (Subscript[v, 1])[x]==0;
eq2=Ε (Subscript[J, 2])(Subscript[v, 2])''[x]+P (Subscript[v, 2])[x]==0;

c1=(Subscript[v, 1])[0]==f;
c2=(Subscript[v, 1])'[0]==0;
c3=(Subscript[v, 2])[(Subscript[L, 1])+(Subscript[L, 2])]==0;
c4=(Subscript[v, 1])[(Subscript[L, 1])]==(Subscript[v, 2])[(Subscript[L, 1])];

Sol=DSolve[{eq1,eq2,c1,c2,c3,c4},{(Subscript[v, 1])[x],(Subscript[v, 2])[x]},x];
(Subscript[v, 1])[x_]=Sol[[1,1,2]];     
(Subscript[v, 2])[x_]=Sol[[1,2,2]];

Calcoliamo le rotazioni nella sezione di passaggio (x=(Subscript[L, 1])) per le due equazioni dello spostamento.  Uguagliandole imponiamo la continuità della derivata prima dello spostamento, e ricaviamo il valore critico del carico (Subscript[P, cr]) per il primo modo:

(Subscript[ϕ, 1])=(∂_x)(Subscript[v, 1])[x]/.x->(Subscript[L, 1]);
(Subscript[ϕ, 2])=(∂_x)(Subscript[v, 2])[x]/.x->(Subscript[L, 1]);

Pcr=FindRoot[((Subscript[ϕ, 1])-(Subscript[ϕ, 2]))/f==0,{P,1}][[1,2]];     Print["Pcr = ",Pcr,"  N"]

Tale valore è compreso tra quelli calcolati con la formula di Eulero per un albero di sezione uniforme uguale al primo o al secondo diametro:

Pcreulero1=(((π^2)Ε (Subscript[J, 1]))/(4 ((((Subscript[L, 1])+(Subscript[L, 2])))^2)));     Pcreulero2=(((π^2)Ε (Subscript[J, 2]))/(4 ((((Subscript[L, 1])+(Subscript[L, 2])))^2)));
Print["PcrEulero1 = ",Pcreulero1//N,"  N\nPcrEulero2 = ",Pcreulero2//N,"  N \n"]

Soluzione numerica

Utilizzo due elementi trave in serie. Procedo con il calcolo automatico della matrice globale:

el=2;   nodi=(el+1);   (Subscript[n, loc])=4;   (Subscript[n, glob])=2nodi;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{
For[j=1,j≤4,j++,H[[i,j,j +(i-1) 2]]=1]}];
For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

⊳ Calcolo della matrice di rigidezza

(Subscript[K, rigid])[J_,l_]=((Ε J)/(l^3))(({{12, 6 l, -12, 6 l}, {6 l, 4 (l^2), -6 l, 2 (l^2)}, {-12, -6 l, 12, -6 l}, {6 l, 2 (l^2), -6 l, 4 (l^2)}}));
For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, rigid])[(Subscript[J, i]),(Subscript[L, i])][[jc,jr]]]]]
(Subscript[K, RIG])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm//N

⊳ Matrice di rigidezza geometrica

(Subscript[K, geom])[L_]=(1/(30 L))(({{36, 3L, -36, 3L}, {3L, 4(L^2), -3L, -(L^2)}, {-36, -3L, 36, -3L}, {3L, -(L^2), -3L, 4(L^2)}}));
For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, geom])[(Subscript[L, i])][[jc,jr]]]]]
(Subscript[K, GEO])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm//N

(* eliminazione dei gradi di liberta associati al nodo 1 che è incastrato *)
HH=(({{0, 0, 0, 0}, {0, 0, 0, 0}, {1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}));   (Subscript[K, rig])=Transpose[HH].(Subscript[K, RIG]).HH;   (Subscript[K, geo])=Transpose[HH].(Subscript[K, GEO]).HH;
Print["(Subscript[K, RIG])=",(Subscript[K, rig])//MatrixForm,"\t (Subscript[K, GEO])=",(Subscript[K, geo])//MatrixForm//N,"\n"]

⊳ Calcolo del carico critico mediante la condizione di stazionarietà
Si ricava la radice P minore che corrisponde al valore del carico critico.

Solve[{Det[(Subscript[K, rig])-P (Subscript[K, geo])]==0},{P}];
Chop[%//N,(10^(-8))][[1]]

Si nota che il valore calcolato è molto simile a quello trovato con la risoluzione analitica solo leggermente maggiore per via della maggiore rigidezza degli elementi finiti.

10 - Lastra circolare incastrata

Lastra circolare piena incastrata lungo il bordo e soggetta a carico distribuito su una circonferenza di raggio a: calcolo analitico e numerico con elementi ad anello ed elementi QL1 assialsimmetrici

Soluzione analitica

⊳ Calcolo delle equazioni di equilibrio

(Subscript[t, 1])[r_]=((p r)/(2 ));   (Subscript[t, 2])[r_]=((p (a^2))/(2 r));

For[i=1,i≤2,i++,
	{ (({{(Subscript[cr, i])}, {(Subscript[cθ, i])}}))=(({{-(∂_(r,r))(Subscript[w, i])[r]}, {-(1/r)(∂_r)(Subscript[w, i])[r]}})),                     (*Congruenza*)
	(({{(Subscript[mr, i])[r_]}, {(Subscript[mθ, i])[r_]}}))=Bf(({{1, ν}, {ν, 1}})).(({{(Subscript[cr, i])}, {(Subscript[cθ, i])}})),      (*Relazione costitutiva*)
	 (Subscript[eq, i])=r(∂_r)(Subscript[mr, i])[r]+(Subscript[mr, i])[r]-(Subscript[mθ, i])[r]==-(Subscript[t, i])[r] r,     Print["eq",i,"="(Subscript[eq, i])//Simplify//TraditionalForm]}]

⊳ Dati

s=10 mm;   a=10 mm;   b=100 mm;
p=5 MPa;  Ε=206000 MPa;   ν=0.3;   Bf=((Ε (s^3))/(12(1-(ν^2))));

⊳ Calcolo dello spostamento e dei momenti

DSolve[{(Subscript[eq, 1]),(Subscript[eq, 2]),
			(Subscript[w, 1])'[0]==0,
			(Subscript[w, 1])[a]==(Subscript[w, 2])[a],
			(Subscript[w, 1])'[a]==(Subscript[w, 2])'[a],
			(Subscript[mr, 1])[a]==(Subscript[mr, 2])[a],
			(Subscript[w, 2])[b]==0,
			(Subscript[w, 2])'[b]==0},
{(Subscript[w, 1])[r],(Subscript[w, 2])[r]},r];

(Subscript[w, 1])[r_]=%[[1,1,2]]; (Subscript[w, 2])[r_]=%[[1,2,2]];
w[r_]=\[Piecewise]({{(Subscript[w, 1])[r], r≤a}, {(Subscript[w, 2])[r], r>a}});

MR[r_]=If[r<a,(Subscript[mr, 1])[r],(Subscript[mr, 2])[r]];
Mθ[r_]=If[r<a,(Subscript[mθ, 1])[r],(Subscript[mθ, 2])[r]];

Plot[-w[r],{r,0,b},PlotStyle->Thick,AxesOrigin->{0,0},PlotLabel->Style[Framed["Spostamento"]],GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->450,AxesLabel -> {"", "v(mm)"}]Plot[{MR[r],Mθ[r]},{r,0,b},PlotStyle->Thick,PlotLegend->{"(Subscript[M, r])","(Subscript[M, θ])"},LegendShadow->None,LegendPosition->{0.5,0},LegendSize->0.3,PlotLabel->Style[Framed["Momenti"]],GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->450,AxesLabel -> {"", "MPa"}]

Soluzione numerica

⊳ Calcolo delle rifidezze

l=(Subscript[r, 2])-(Subscript[r, 1]);     R=(((Subscript[r, 2])+(Subscript[r, 1]))/2);     r[ξ_]=R+(l/2)ξ;     ξr=ξ->(2/l)(r-R);
B=(({{-((6 ξ)/(l^2)), ((1-3ξ)/l), ((6ξ)/(l^2)), -((1+3ξ)/l)}, {((3(1-(ξ^2)))/(2 r[ξ] l)), ((1+2ξ-3(ξ^2))/(4r[ξ])), ((3(-1+(ξ^2)))/(2 r[ξ] l)), ((1-2ξ-3(ξ^2))/(4r[ξ]))}}));     Df=Bf(({{1, ν}, {ν, 1}}));   

(Subscript[el, 1])={(Subscript[r, 1])->0,(Subscript[r, 2])->a};   (Subscript[el, 2])={(Subscript[r, 1])->a,(Subscript[r, 2])->b};

F1[ξ_]=(l/2)Transpose[B].Df.B r[ξ]/.(Subscript[el, 1]) ;
F2[ξ_]=(l/2)Transpose[B].Df.B r[ξ] /.(Subscript[el, 2]);

(Subscript[K, 1,loc])=NIntegrate[F1[ξ],{ξ,-1,+1}] ;
(Subscript[K, 2,loc])=NIntegrate[F2[ξ],{ξ,-1,+1}] ;

l'integrazione non riesce nel punto centrale, che rappresenta una singolarità, ma comunque viene svolta fino al limite della precisione macchina vicino ad esso.
Calcoliamo quindi la matrice globale di rigidezza :

elem=2;
nodi=(elem+1);   (Subscript[n, loc])=4;   (Subscript[n, glob])=2nodi;
HH=ConstantArray[0,{elem,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤elem,i++,{For[j=1,j≤4,j++,HH[[i,j,j +(i-1) 2]]=1]}]
For[i=1,i≤elem,i++,(Subscript[K, i,glob])=Transpose[HH[[i]]].(Subscript[K, i,loc]).HH[[i]]]
(Subscript[K, tot])=(∑_(i=1)^elem)(Subscript[K, i,glob]);
Print["(Subscript[K, tot])= ",(Subscript[K, tot])//MatrixForm]

⊳ Calcolo delle matrici delle forze e degli spostamenti

N1[ξ_]=(1/4)(2-3 ξ+(ξ^3));   N2[ξ_]=(l/8)(1-ξ-(ξ^2)+(ξ^3));   N3[ξ_]=(1/4)(2+3 ξ-(ξ^3));   N4[ξ_]=(l/8)(-1-ξ+(ξ^2)+(ξ^3)); 
(UnderBar[N])=(({{N1[ξ], N2[ξ], N3[ξ], N4[ξ]}}));     (*Matrice delle funzioni di forma*)

(Subscript[F, p])= (l/2)(∫_(-1)^1)p Transpose[(UnderBar[N])]r[ξ]\[DifferentialD]ξ/.(Subscript[el, 1]);     (*matrice di distribuzione della forza p sui nodi del primo elemento*)
P=Join[(Subscript[F, p]),(({{0}, {0}}))]+(({{0}, {(Subscript[M, 1])}, {0}, {0}, {(Subscript[F, 3])}, {(Subscript[M, 3])}}));       Δ=(({{(Subscript[u, 1])}, {(Subscript[ϕ, 1])}, {(Subscript[u, 2])}, {(Subscript[ϕ, 2])}, {(Subscript[u, 3])}, {(Subscript[ϕ, 3])}}))/.{(Subscript[ϕ, 1])->0,(Subscript[u, 3])->0,(Subscript[ϕ, 3])->0};

⊳ Calcolo delle funzioni dello spostamento e dei momenti
	- Spostamento

sol=Solve[{P==(Subscript[K, tot]).Δ},{(Subscript[u, 1]),(Subscript[M, 1]),(Subscript[u, 2]),(Subscript[ϕ, 2]),(Subscript[F, 3]),(Subscript[M, 3])}]
(Subscript[u, 1])=sol[[1,1,2]];  (Subscript[u, 2])=sol[[1,3,2]];  (Subscript[ϕ, 2])=sol[[1,4,2]];

(Subscript[δ, 1])=Take[Δ,4];  (Subscript[δ, 2])=Take[Δ,-4];
Print["Δ= ",Δ//MatrixForm,"\t (Subscript[Δ, 1])= ",(Subscript[δ, 1])//MatrixForm,"\t (Subscript[Δ, 2])= ",(Subscript[δ, 2])//MatrixForm]

Nr=(UnderBar[N])/.ξr;
w1n[r_]=Nr.(Subscript[δ, 1])/.(Subscript[el, 1]);
w2n[r_]=Nr.(Subscript[δ, 2])/.(Subscript[el, 2]) ;
(Subscript[w, num])[r_]=If[r<a,w1n[r],w2n[r]];
Plot[{-w[r],-(Subscript[w, num])[r]},{r,0,b},PlotStyle->Thick,AxesOrigin->{0,0},GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->500,AxesLabel -> {"", "mm"},PlotLegend->{"w","(Subscript[w, num])"},LegendShadow->None,LegendPosition->{0.5,-0.3},LegendSize->0.3]

- Momenti

For[i=1,i≤2,i++,{(Subscript[m, i])=Df.B.(Subscript[δ, i])/.ξr,
					(Subscript[mrn, i])[r_]=(Subscript[m, i])[[1,1]]/.(Subscript[el, i]),
					(Subscript[mθn, i])[r_]=(Subscript[m, i])[[2,1]]/.(Subscript[el, i])}]

MRn[r_]=\[Piecewise]({{(Subscript[mrn, 1])[r], r<a}, {(Subscript[mrn, 2])[r], r>a}}) ;     Mθn[r_]=\[Piecewise]({{(Subscript[mθn, 1])[r], r<a}, {(Subscript[mθn, 2])[r], r>a}}) ;

Plot[{MR[r],MRn[r]},{r,0,b},PlotStyle->Thick,PlotLegend->{"(Subscript[M, r])","(Subscript[M, r, num])"},LegendShadow->None,LegendPosition->{0.5,0},LegendSize->0.3,PlotLabel->Style[Framed["Momenti"]],GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->450,AxesLabel -> {"", "MPa"},ExclusionsStyle->{{Dashed}}]Plot[{Mθ[r],Mθn[r]},{r,0,b},PlotStyle->Thick,PlotLegend->{"(Subscript[M, θ])","(Subscript[M, θ, num])"},LegendShadow->None,LegendPosition->{0.5,0},LegendSize->0.3,PlotLabel->Style[Framed["Momenti"]],GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->450,AxesLabel -> {"", "MPa"},ExclusionsStyle->{{Dashed}}]

Confronto con Gauss

Vediamo la differenza calcolando la matrice di rigidezza con un numaro differente di punti di Gauss mediante il loro calcolo automatico

pG=1;

ord=2 pG-1;   
pol=ConstantArray[0,ord+1];
For[i=0,i≤ord, i++,pol[[i+1]]=(ξ^i)(Subscript[c, i])]; 
poly=ConstantArray[0,{pG,ord+1}];
For[j=1,j≤pG,j++,For[i=0,i≤ord,i++,poly[[j,i+1]]=((Subscript[ξ, j])^i)(Subscript[c, i])]]
(Subscript[I, e])=(∫_(-1)^(+1))pol\[DifferentialD]ξ;     (OverTilde[I]) = (∑_(j=1)^pG)(Subscript[H, j])poly[[j]];
x=ConstantArray[0,pG]; h=ConstantArray[0,pG];
For[j=1,j≤pG,j++,{x[[j]]=(Subscript[ξ, j]),h[[j]]=(Subscript[H, j])}];
pp=Join[x,h];
sol=Solve[(Subscript[I, e]) == (OverTilde[I]), pp];
For[i=1,i≤pG,i++,{(Subscript[H, i])=sol[[1,pG+1-i,2]],(Subscript[ξ, i])=sol[[1,i+pG,2]],Print[i,") Pto: ",(Subscript[ξ, i]),"\t Peso: ",(Subscript[H, i])]}]

(Subscript[Kg, 1,1])=(∑_(i=1)^pG)(Subscript[H, i])*F1[(Subscript[ξ, i])];     (Subscript[Kg, 1,2])=(∑_(i=1)^pG)(Subscript[H, i])*F2[(Subscript[ξ, i])];
For[i=1,i≤pG,i++,{(Subscript[H, i])=.,(Subscript[ξ, i])=.}]

pG=2;

ord=2 pG-1;   
pol=ConstantArray[0,ord+1];
For[i=0,i≤ord, i++,pol[[i+1]]=(ξ^i)(Subscript[c, i])]; 
poly=ConstantArray[0,{pG,ord+1}];
For[j=1,j≤pG,j++,For[i=0,i≤ord,i++,poly[[j,i+1]]=((Subscript[ξ, j])^i)(Subscript[c, i])]]
(Subscript[I, e])=(∫_(-1)^(+1))pol\[DifferentialD]ξ;     (OverTilde[I]) = (∑_(j=1)^pG)(Subscript[H, j])poly[[j]];
x=ConstantArray[0,pG]; h=ConstantArray[0,pG];
For[j=1,j≤pG,j++,{x[[j]]=(Subscript[ξ, j]),h[[j]]=(Subscript[H, j])}];
pp=Join[x,h];
sol=Solve[(Subscript[I, e]) == (OverTilde[I]), pp];
For[i=1,i≤pG,i++,{(Subscript[H, i])=sol[[1,pG+1-i,2]],(Subscript[ξ, i])=sol[[1,i+pG,2]],Print[i,") Pto: ",(Subscript[ξ, i]),"\t Peso: ",(Subscript[H, i])]}]

(Subscript[Kg, 2,1])=(∑_(i=1)^pG)(Subscript[H, i])*F1[(Subscript[ξ, i])];     (Subscript[Kg, 2,2])=(∑_(i=1)^pG)(Subscript[H, i])*F2[(Subscript[ξ, i])];
For[i=1,i≤pG,i++,{(Subscript[H, i])=.,(Subscript[ξ, i])=.}]

pG=3;

ord=2 pG-1;   
pol=ConstantArray[0,ord+1];
For[i=0,i≤ord, i++,pol[[i+1]]=(ξ^i)(Subscript[c, i])]; 
poly=ConstantArray[0,{pG,ord+1}];
For[j=1,j≤pG,j++,For[i=0,i≤ord,i++,poly[[j,i+1]]=((Subscript[ξ, j])^i)(Subscript[c, i])]]
(Subscript[I, e])=(∫_(-1)^(+1))pol\[DifferentialD]ξ;     (OverTilde[I]) = (∑_(j=1)^pG)(Subscript[H, j])poly[[j]];
x=ConstantArray[0,pG]; h=ConstantArray[0,pG];
For[j=1,j≤pG,j++,{x[[j]]=(Subscript[ξ, j]),h[[j]]=(Subscript[H, j])}];
pp=Join[x,h];
sol=Solve[(Subscript[I, e]) == (OverTilde[I]), pp];
For[i=1,i≤pG,i++,{(Subscript[H, i])=sol[[1,pG+1-i,2]],(Subscript[ξ, i])=sol[[1,i+pG,2]],Print[i,") Pto: ",(Subscript[ξ, i]),"\t Peso: ",(Subscript[H, i])]}]

(Subscript[Kg, 3,1])=(∑_(i=1)^pG)(Subscript[H, i])*F1[(Subscript[ξ, i])];     (Subscript[Kg, 3,2])=(∑_(i=1)^pG)(Subscript[H, i])*F2[(Subscript[ξ, i])];

For[j=1,j≤pG,j++,{For[i=1,i≤elem,i++,(Subscript[Kg, j,i,glob])=Transpose[HH[[i]]].(Subscript[Kg, j,i]).HH[[i]]],(Subscript[Kg, j,tot])=(∑_(ι=1)^elem)(Subscript[Kg, j,ι,glob]),Print[j,"pG: (Subscript[K, tot])= ",(Subscript[Kg, j,tot])//MatrixForm]}]

For[j=1,j≤3,j++,{{(Subscript[u, 1]),(Subscript[u, 2]),(Subscript[ϕ, 2])}=.,solg=Solve[{P==(Subscript[Kg, j,tot]).Δ},{(Subscript[u, 1]),(Subscript[M, 1]),(Subscript[u, 2]),(Subscript[ϕ, 2]),(Subscript[F, 3]),(Subscript[M, 3])}],For[i=1,i≤2,i++,{(Subscript[u, i])=solg[[1,2i-1,2]],(Subscript[ϕ, 2])=solg[[1,4,2]]}],(Subscript[Δ1, j])=Take[Δ,4],(Subscript[Δ2, j])=Take[Δ,-4],Print[j,"pG: Δ= ",Δ//MatrixForm],(Subscript[wg1, j])[r_]=Nr.(Subscript[Δ1, j])/.(Subscript[el, 1]),(Subscript[wg2, j])[r_]=Nr.(Subscript[Δ2, j])/.(Subscript[el, 2]) }]

(Subscript[wG, 1])[r_]=If[r<a,(Subscript[wg1, 1])[r],(Subscript[wg2, 1])[r]];(Subscript[wG, 2])[r_]=If[r<a,(Subscript[wg1, 2])[r],(Subscript[wg2, 2])[r]];(Subscript[wG, 3])[r_]=If[r<a,(Subscript[wg1, 3])[r],(Subscript[wg2, 3])[r]];
Plot[{-w[r],-(Subscript[wG, 1])[r],-(Subscript[wG, 2])[r],-(Subscript[wG, 3])[r]},{r,0,b},PlotStyle->Thick,AxesOrigin->{0,0},GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->600,AxesLabel -> {"", "mm"},PlotLegend->{"w","(Subscript[w, G1])","(Subscript[w, G2])","(Subscript[w, G3])"},LegendShadow->None,LegendPosition->{0.5,-0.3},LegendSize->0.3]

Le soluzioni piu vicine sono per 2 e 3 pti di gauss. si osserva nel grafico differenziale che più il calcolo della matrice è preciso più e sovrastimata e quindi maggiore è l'errore sullo spostamento, quindi risulta meglio 2 pti di gauss

Plot[{w[r]-(Subscript[w, num])[r],w[r]-(Subscript[wG, 2])[r],w[r]-(Subscript[wG, 3])[r]},{r,0,b-1},PlotLabel->Style[Framed["Differenza con la soluzione analitica"]],PlotStyle->Thick,AxesOrigin->{0,0},GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->600,AxesLabel -> {"", "mm"},PlotLegend->{"(Subscript[w, num])","(Subscript[w, G2])","(Subscript[w, G3])"},LegendShadow->None,LegendPosition->{0.5,0},LegendSize->0.3]

11- Piastra tubiera

Calcolo dell' irrigidimento di una lastra dovuto a una fila di tubi lungo una circonferenza mediante metodo numerico e metodo di Ritz

MEF

⊳ Dati

a=200mm; b=400mm;  
Ε=200000MPa;  p=0.4MPa;  ν=0.3; 

el=3;   nodi=4;
(Subscript[el, 1])=(({{1}, {2}}));  (Subscript[el, 2])=(({{2}, {3}}));  (Subscript[el, 3])=(({{2}, {4}}));

⊳ Calcolo automatico della matrice di rigidezza
	
	- Matrice globale

(Subscript[n, loc])=4;   (Subscript[n, glob])=2nodi;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤2,j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}]}]
For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
Grid[Join[Transpose[({{Null, (Subscript[w, 1]), (Subscript[θ, 1]), (Subscript[w, 2]), (Subscript[θ, 2]), (Subscript[w, 3]), (Subscript[θ, 3]), (Subscript[w, 4]), (Subscript[θ, 4])}})],Join[(({{(Subscript[w, 1]), (Subscript[θ, 1]), (Subscript[w, 2]), (Subscript[θ, 2]), (Subscript[w, 3]), (Subscript[θ, 3]), (Subscript[w, 4]), (Subscript[θ, 4])}})),%],2],Dividers->{{None,{Center}},{None,{Center}}}]

- Matrici di rigidezza degli elementi lastra calcolate con Gauss

s=10;   Bf=((Ε (s^3))/(12(1-(ν^2))));   Df=Bf(({{1, ν}, {ν, 1}}));   l=(Subscript[r, 2])-(Subscript[r, 1]);   R=(((Subscript[r, 2])+(Subscript[r, 1]))/2);   r[ξ_]=R+(l/2)ξ;   
el1={(Subscript[r, 1])->0,(Subscript[r, 2])->a};   el2={(Subscript[r, 1])->a,(Subscript[r, 2])->b};
 
B=(({{-((6 ξ)/(l^2)), ((1-3ξ)/l), ((6ξ)/(l^2)), -((1+3ξ)/l)}, {((3(1-(ξ^2)))/(2 r[ξ] l)), ((1+2ξ-3(ξ^2))/(4r[ξ])), ((3(-1+(ξ^2)))/(2 r[ξ] l)), ((1-2ξ-3(ξ^2))/(4r[ξ]))}}));
F[ξ_]=(l/2)Transpose[B].Df.B r[ξ];

pG=2;

ord=2 pG-1;   
pol=ConstantArray[0,ord+1];
For[i=0,i≤ord, i++,pol[[i+1]]=(ξ^i)(Subscript[c, i])]; 
poly=ConstantArray[0,{pG,ord+1}];
For[j=1,j≤pG,j++,For[i=0,i≤ord,i++,poly[[j,i+1]]=((Subscript[ξ, j])^i)(Subscript[c, i])]]
(Subscript[I, e])=(∫_(-1)^(+1))pol\[DifferentialD]ξ;     (OverTilde[I]) = (∑_(j=1)^pG)(Subscript[H, j])poly[[j]];
x=ConstantArray[0,pG]; h=ConstantArray[0,pG];
For[j=1,j≤pG,j++,{x[[j]]=(Subscript[ξ, j]),h[[j]]=(Subscript[H, j])}];
pp=Join[x,h];
sol=Solve[(Subscript[I, e]) == (OverTilde[I]), pp];
For[i=1,i≤pG,i++,{(Subscript[H, i])=sol[[1,pG+1-i,2]],(Subscript[ξ, i])=sol[[1,i+pG,2]],Print[i,") Pto: ",(Subscript[ξ, i]),"\t Peso: ",(Subscript[H, i])]}]

(Subscript[K, L])=(∑_(i=1)^pG)(Subscript[H, i])*F[(Subscript[ξ, i])];
(Subscript[K, L1])=(Subscript[K, L])/.el1;
(Subscript[K, L2])=(Subscript[K, L])/.el2;

Print["(Subscript[K, L1])= ",(Subscript[K, L1])//MatrixForm,"\n (Subscript[K, L2]) =",(Subscript[K, L2])//MatrixForm,"\n"]

- Matrici di rigidezza dell'elemento trave: lasciamo incognita la lunghezza c  per vedere come si comporta l'irrigidemento della lastra al suo variare

(Subscript[d, e])=40;  (Subscript[d, i])=30;   J=((π (((Subscript[d, e])^4)-((Subscript[d, i])^4)))/64);  A=((π (((Subscript[d, e])^2)-((Subscript[d, i])^2)))/4);  γ=((Ε A)/c);  β=((Ε J)/(c^3)) ;

(Subscript[K, T3])=(({{γ, 0, -γ, 0}, {0, 4(c^2)β, 0, 2(c^2)β}, {-γ, 0, γ, 0}, {0, 2(c^2)β, 0, 4(c^2)β}}));      (*rotazione ϕ=(π/2)*)     Print["(Subscript[K, T3])= ",(Subscript[K, T3])//MatrixForm//N,"\n"]

- Sostituzione nella matrice globale e calcolodella stessa per tre valori di c

For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[1]=(Subscript[K, L1])[[jc,jr]]]]
For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[2]=(Subscript[K, L2])[[jc,jr]]]]
For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[3]=(Subscript[K, T3])[[jc,jr]]]];

(Subscript[K, t,0])=(Subscript[K, tot])/.c->100;     (Subscript[K, t,1])=(Subscript[K, tot])/.c->1000;     (Subscript[K, t,2])=(Subscript[K, tot])/.c->(10^10);

⊳ Calcolo delle matrici degli spostamenti e delle forze

N1[ξ_]=(1/4)(2-3 ξ+(ξ^3));   N2[ξ_]=(l/8)(1-ξ-(ξ^2)+(ξ^3));   N3[ξ_]=(1/4)(2+3 ξ-(ξ^3));   N4[ξ_]=(l/8)(-1-ξ+(ξ^2)+(ξ^3));
(UnderBar[N])=(({{N1[ξ], N2[ξ], N3[ξ], N4[ξ]}}));

(Subscript[F, p1])= (l/2)(∫_(-1)^1)p Transpose[(UnderBar[N])]r[ξ]\[DifferentialD]ξ/.el1;     (Subscript[F, p2])= (l/2)(∫_(-1)^1)p Transpose[(UnderBar[N])]r[ξ]\[DifferentialD]ξ/.el2;
P=Join[(Subscript[F, p1]),(({{0}, {0}, {0}, {0}}))]+Join[(({{0}, {0}})),(Subscript[F, p2]),(({{0}, {0}}))]+Transpose[(({{0, M1, 0, 0, F3, M3, 0, M4}}))]; Print["P=",P//MatrixForm]

Δ=(({{w1}, {θ1}, {w2}, {θ2}, {w3}, {θ3}, {w4}, {θ4}}))/.{θ1->0,w3->0,θ3->0,θ4->0};

Risolviamo l'equazione di equilibrio e calcoliamo il vettore degli spostamenti nei tre casi

ξr=ξ->2/l (r-R);     Nr=(UnderBar[N])/.ξr;    (*passaggio alle cordinate polari*)

For[i=0,i≤2,i++,{
(Subscript[sol, i])=Solve[(P==(Subscript[K, t,i]).Δ),{w1,M1,w2,θ2,F3,M3,w4,M4}],
w1=(Subscript[sol, i])[[1,1,2]],w2=(Subscript[sol, i])[[1,3,2]],θ2=(Subscript[sol, i])[[1,4,2]],w4=(Subscript[sol, i])[[1,7,2]],
Print[i,") ",Δ//MatrixForm],
(Subscript[δ1, i])=Take[Δ,{1,4}],
(Subscript[δ2, i])=Take[Δ,{3,6}],
(Subscript[w, L1,i])[r_]=Nr.(Subscript[δ1, i])/.el1,
(Subscript[w, L2,i])[r_]=Nr.(Subscript[δ2, i])/.el2,
Clear[w1,w2,θ2,w4]}]

(Subscript[w, num,0])[r_]=If[r<a,(Subscript[w, L1,0])[r],(Subscript[w, L2,0])[r]];
(Subscript[w, num,1])[r_]=If[r<a,(Subscript[w, L1,1])[r],(Subscript[w, L2,1])[r]];
(Subscript[w, num,2])[r_]=If[r<a,(Subscript[w, L1,2])[r],(Subscript[w, L2,2])[r]];

Plot[{-(Subscript[w, num,0])[r],-(Subscript[w, num,1])[r],-(Subscript[w, num,2])[r]},{r,0,b},PlotStyle->Thick,AxesOrigin->{0,0},GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->600,AxesLabel -> {"", "mm"},PlotLegend->{"(Subscript[w, num, 0])","(Subscript[w, num, 1])","(Subscript[w, num, 2])"},LegendShadow->None,LegendPosition->{0.5,-0.3},LegendSize->0.3]

Metodo di Ritz

Clear[R,Ε,ν,J,p,s]

⊳ Lastra
Esprimiamo lo spostamento in funzione di un polinomio cubico interpolante che soddisfi le condizioni essenziali per la lastra

(Piecewise[{{r=0, ,, w'=0}, {r=a, ,, w=0}, { , ,, w'=0}}])

w[r_]=(Subscript[C, 3]) (r^3)+(Subscript[C, 2]) (r^2) +(Subscript[C, 1]) r +(Subscript[C, 0]);

Solve[{w'[0]==0,w[R]==0,w'[R]==0},{(Subscript[C, 3]),(Subscript[C, 2]),(Subscript[C, 1])}]
(Subscript[C, 3])=%[[1,1,2]];(Subscript[C, 2])=%[[1,2,2]];(Subscript[C, 1])=%[[1,3,2]];
Print["w[r]= ",Collect[w[r],(Subscript[C, 0])]]

Per calcolare (Subscript[C, 0]) imponiamo la congruenza della rotazione in r=a  della piastra e del tubo.  Imponiamo quindi che questa rotazione sia pari ad (Subscript[θ, 0]) e calcolaimo le equazioni dello spostamento della piastra e del tubo.  Per la lastra abbiamo:

Solve[w'[Ri]==(Subscript[θ, 0]),(Subscript[C, 0])]
(Subscript[C, 0])=%[[1,1,2]];
Print["w[r]= ",Collect[w[r],{((Subscript[θ, 0])/((R-Ri)Ri))}],"\n"]

⊳ Tubo
Per il tubo abbiamo le condizioni essenziali (L=c):

(Piecewise[{{z=0, ->, u=0, ,, u'=(Subscript[θ, 0])}, {z=L, ->, u=0, ,, u'=0}}])

u[z_]=(Subscript[C, 7])(z^3)+(Subscript[C, 6])(z^2)+(Subscript[C, 5])z+(Subscript[C, 4]);

Solve[{u[0]==0,u[L]==0,u'[0]==(Subscript[θ, 0]),u'[L]==0},{(Subscript[C, 7]),(Subscript[C, 6]),(Subscript[C, 5]),(Subscript[C, 4])}]
(Subscript[C, 7])=%[[1,1,2]]; (Subscript[C, 6])=%[[1,2,2]]; (Subscript[C, 5])=%[[1,3,2]]; (Subscript[C, 4])=%[[1,4,2]];
Print["u[z]= ",Collect[u[z],{(Subscript[θ, 0])}],"\n"]

⊳ Calcolo della rotazione in r=a
Calcoliamo l'energia potenziale della trave e della lastra ,che sommate all'energia del lavoro delle forze, danno l'energia totale. Quindi imponiamo la stazionarietà di Π per calcolare (Subscript[θ, 0])

B=((Ε (s^3))/(12(1-(ν^2))));   c=(({{(∂_(r,r))w[r]}, {(∂_r)w[r]/r}}));   m=B(({{1, ν}, {ν, 1}})).c;

(Subscript[U, Las])=(1/2)(∫_0^(2π))(∫_0^R)(Transpose[m].c) r\[DifferentialD]r\[DifferentialD]α;     Print["(Subscript[U, lastra])= ",(Subscript[U, Las])[[1,1]],"\n"]

(Subscript[U, Tra])=(1/2)(∫_0^L)Ε J((((∂_(z,z))u[z]))^2)\[DifferentialD]z;     Print["(Subscript[U, trave])= ",(Subscript[U, Tra]),"\n"]

W=(∫_0^(2π))(∫_0^R)p w[r]r\[DifferentialD]r\[DifferentialD]α;     Print["(Subscript[W, p])= ",W,"\n"]

Π=(Subscript[U, Las])+(Subscript[U, Tra])-W;

Solve[(∂_(Subscript[θ, 0]))Π==0,(Subscript[θ, 0])];
Print["(Subscript[θ, 0])= ",(Subscript[θ, 0])=%[[1,1,2]]//FullSimplify,"\n"]

⊳ Confronto con gli altri risultati

wR[r_]=w[r]/.{Ε->200000,p->0.4,s->10,ν->0.3,J->π((40^4)-(30^4))/64,R->b,Ri->a};

Plot[{-wR[r]/.L->100,-wR[r]/.L->1000,-wR[r]/.L->10^10,-(Subscript[w, num,0])[r],-(Subscript[w, num,1])[r],-(Subscript[w, num,2])[r]},{r,0,b},PlotStyle->{{RGBColor[0.5,0.1,0.1],Thick},{RGBColor[0.1,0.5,0.1],Thick},{RGBColor[0.1,0.1,0.5],Thick},{RGBColor[0.5,0.1,0.1],Dashed},{RGBColor[0.1,0.5,0.1],Dashed},{RGBColor[0.1,0.1,0.5],Dashed}},AxesOrigin->{0,0},GridLines->{{a,b},Automatic},Ticks->{{{a,"a"},{b,"b"}},Automatic},ImageSize->500,AxesLabel -> {"", "mm"},PlotLegend->{"(Subscript[w, R]) (c=(10^2))","(Subscript[w, R]) (c=(10^3))","(Subscript[w, R]) (c=(10^10))","(Subscript[w, num, 0])","(Subscript[w, num, 1])","(Subscript[w, num, 2])"},LegendShadow->None,LegendPosition->{0.4,-0.6},LegendSize->{0.4,0.7}]

Come si può osservare si ottengono risultati molto diversi a secondo della lunghezza del tubo

12 - Serbatoio in pressione con lastra incastrata in mezzo

Calcolo della sollecitazione di un cilindro di spessore sottile diviso in due sezioni a differente pressioni da una lastra unita al mantello mediante incastro.

Calcolo numerico

⊳ Cilindro

Spezziamo il cilindro in due parti all'altezza della lastra.  Nel caso di un cilindro di lunghezza infinita, gli integrali generali (somma degli effetti locali  (Subscript[A, i]) Exp[-β z] Sin[β z+(Subscript[ψ, i])]  e degli effetti globali  (Subscript[Z, i]) ), per i due cilindri saranno:

w1[z_]=(Subscript[A, 1]) Exp[-β z] Sin[β z+(Subscript[ψ, 1])]+(Subscript[Z, 1]);
w2[z_]=(Subscript[A, 2]) Exp[-β z] Sin[β z+(Subscript[ψ, 2])]+(Subscript[Z, 2]);

β=(((3(1-(ν^2)))^(1/4))/(Sqrt[R s]));     (Subscript[Z, 2])=(((Subscript[p, 2]) (R^2))/(Ε s));     (Subscript[Z, 1])=(((Subscript[p, 1]) (R^2))/(Ε s));

Chiamata  ϕ  la rotazione dovuta al momento trasmesso tr cilindro e lastra avremo:

Solve[{          w1[0]==0,
		w1'[0]==-ϕ
},{(Subscript[A, 1]),(Subscript[ψ, 1])}];
(Subscript[w, 1])[z_]=w1[z]/.{(Subscript[A, 1])->%[[1,1,2]],(Subscript[ψ, 1])->%[[1,2,2]]};

Solve[{ w2[0]==0,
	w2'[0]==ϕ
},{(Subscript[A, 2]),(Subscript[ψ, 2])}];
(Subscript[w, 2])[z_]=w2[z]/.{(Subscript[A, 2])->%[[1,1,2]],(Subscript[ψ, 2])->%[[1,2,2]]};

I momenti sul piano z,r :

(Subscript[mz, 1])[z_]=B(∂_(z,z))(Subscript[w, 1])[z];
(Subscript[mz, 2])[z_]=B(∂_(z,z))(Subscript[w, 2])[z];

⊳ Lastra

(Subscript[t, L])[r_]=((Δp r)/(2 ));     B=((Ε (s^3))/(12(1-(ν^2))));   
(({{(Subscript[mr, L])[r_]}, {(Subscript[mθ, L])[r_]}}))=B(({{1, ν}, {ν, 1}})).(({{-(∂_(r,r))(Subscript[u, L])[r]}, {-(1/r)(∂_r)(Subscript[u, L])[r]}}));
eqL=r(∂_r)(Subscript[mr, L])[r]+(Subscript[mr, L])[r]-(Subscript[mθ, L])[r]==-(Subscript[t, L])[r] r;
DSolve[{eqL,
			(Subscript[u, L])[R]==0,
			(Subscript[u, L])'[0]==0,
			(Subscript[u, L])'[R]==-ϕ},
(Subscript[u, L])[r],r];
(Subscript[u, L])[r_]=%[[1,1,2]];

⊳ Calcolo della rotazione
Per calcolare la rotazione ϕ nel punto di contatto tra cilindro e lastra, imponiamo che in tale punto il momento totale del cilindro sia uguale a quello della lastra :

eq=  (Subscript[mr, L])[R]==(Subscript[mz, 1])[0]+(Subscript[mz, 2])[0];

Solve[eq,ϕ]//FullSimplify
ϕ=%[[1,1,2]];

⊳ Dati

Ε=200000;  R=100;  ν=0.3;  s=5;  (Subscript[p, 1])=6;  (Subscript[p, 2])=3;  Δp=(Subscript[p, 1])-(Subscript[p, 2]);

Print["ϕ= ",ϕ];     Print["Lunghezza d'onda: λ=((2π)/β)= ",λ=((2π)/β)," mm"]

⊳ Grafici

- Spostamento radiale del cilindro

(Subscript[w, C])[z_]=(Piecewise[{{(Subscript[w, 1])[z], z≥0}, {(Subscript[w, 2])[-z], z<0}}]);    
Print["il massimo di w si ha per  z=",(FindRoot[(∂_z)(Subscript[w, 1])[z]==0,{z,1}][[1,2]]//Chop)/λ," λ"]
Plot[(Subscript[w, C])[z],{z,-2λ,2λ},PlotRange->Full,PlotStyle->Thick,Ticks->{{{-λ/8,"-λ/8"},{λ/8,"λ/8"},{-λ,"-λ"},{-λ/2,"-λ/2"},{λ/2,"λ/2"},{λ,"λ"}}},GridLines->{{-λ/8,λ/8},{}},ImageSize->600,AxesLabel->{"z (mm)","(Subscript[w, C]) (mm)"}]

Come si può osservare il massimo ed il minimo si trovano una distanza pari a circa  λ/8 dal punto dell'azione locale, e per un valore superiore a λ l'effetto locale è trascurabile.

- Spostamento assiale della lastra

Plot[-(Subscript[u, L])[r],{r,0,R},PlotRange->Full,PlotStyle->Thick,ImageSize->400,AxesLabel->{"u (mm)","r (mm)"}]

- Trasformiamo l'equazione dello spostamento u(r) della lastra in funzione di z in modo da poterla plottare insieme a quella del cilindro

equ=z==(Subscript[u, L])[r];     Solve[equ,r];
r1[z_]=%[[1,1,2]];r2[z_]=%[[2,1,2]];r3[z_]=%[[3,1,2]];r4[z_]=%[[4,1,2]];
Plot[{r1[z],r2[z],r3[z],r4[z]},{z,-(Subscript[u, L])[0],(Subscript[u, L])[0]}]

r[z_]=If[z≥0,Null,r2[-z]-R];     Plot[r[z],{z,-(Subscript[u, L])[0],0}]

Grafico con deformazione aumentata di 5 volte e grafico del cilindro con la lastra deformati in scala 1:1

Rotate[Show[Plot[{(Subscript[w, C])[z],r[z]},{z,-λ,λ},PlotRange->Full,AspectRatio->Automatic,ImageSize->700,AxesStyle->Gray,PlotStyle->{{Blue,Thickness[(1/(2λ))s]},{Purple,Thickness[(1/(2λ))s]}}],ListLinePlot[{{λ,-R},{-λ,-R}},PlotStyle->DotDashed]],π/2]Rotate[Show[Plot[{5(Subscript[w, C])[z],r[0.2z]},{z,-λ,λ},PlotRange->Full,PlotStyle->Thick,AspectRatio->Automatic,Ticks->None,AxesStyle->Gray,ImageSize->700],ListLinePlot[{{λ,-R},{-λ,-R}},PlotStyle->DotDashed]],π/2]

13 - Trave a grande curvatura

Determinazione delle tensioni in una trave a grande curvatura soggetta a carico concentrato mediante la teoria: di Eulero-Bernulli, delle travi a grande curvatura e la teoria dell'elasticità.
Oss: analizzeremo solo il caso di curvatura semplice, cioè il caso in cui la deformata non esce fuori dal piano

Soluzione con la teoria di Eulero-Bernoulli

In questo caso si ipotizza che la curvatura non influenzi l'andamento della tensione nella sezione, e che quindi questa abbia un andamento lineare

M[θ_]=P R Cos[θ];

DSolve[{       	(1/(R^2))( (∂_(θ,θ))w[θ] + w[θ]) == ((M[θ])/(Ε J)),
			w[0]==0,
			w'[0]==0
},w[θ],θ]//Simplify
w[θ_]=%[[1,1,2]];

u[θ_]=∫w[θ] \[DifferentialD]θ       (*u[0]=0 => Cost=0*)

⊳ Dati

J=((h^3)/12)s;   h=(R/2);   s=1;  (* spessore unitario *)
dat={Ε->200000,R->100,P->10000};

Passaggio alle cordinate assolute:

ξ[θ_]=w[θ]Cos[θ]+u[θ]Sin[θ];
η[θ_]=u[θ]Cos[θ]-w[θ]Sin[θ];

Plot[{w[θ]/.dat,u[θ]/.dat},{θ,0,π/2},ImageSize->300,PlotStyle->Thick, 
 AxesLabel->{"θ","mm"},Ticks->{{{π/4,"π/4"},{π/2,"π/2"}}},GridLines->{{π/4,π/2},Automatic},PlotLegend->{"w (θ)","u (θ)"},LegendShadow->None,LegendPosition->{-0.8,0.1},LegendSize->0.4]Plot[{ξ[θ]/.dat,η[θ]/.dat},{θ,0,π/2},ImageSize->300,PlotStyle->Thick, 
 AxesLabel->{"θ","mm"},Ticks->{{{π/4,"π/4"},{π/2,"π/2"}}},GridLines->{{π/4,π/2},Automatic},PlotLegend->{"ξ (θ)","η (θ)"},LegendShadow->None,LegendPosition->{-0.7,-0.5},LegendSize->0.4]

Rappresentazione dal vero della deformazione della trave mediante grafico polare:

Rotate[Show[PolarPlot[R/.dat,{θ,0,(π/2)},PlotStyle->{Blue,Thick,Dashed},ImageSize->350],PolarPlot[R-w[θ]/.dat,{θ,0,(π/2)+((u[π/2])/100)/.dat},PlotStyle->{Red,Thick}]],-π/2]

⊳ Momento, taglio e sforzo normale

T[θ_]=P Sin[θ];      Ν[θ_]=P Cos[θ]; 

Plot[((M[θ])/(P R)),{θ,0,π/2},ImageSize->300,PlotStyle->Thick, 
 AxesLabel->{"θ","\!\(\*FractionBox[\(M \((θ)\)\), \(P\\ R\)]\)"},Ticks->{{{π/4,"π/4"},{π/2,"π/2"}}},GridLines->{{π/4,π/2},Automatic}]Plot[{((T[θ])/P)/.dat,((Ν[θ])/P)/.dat},{θ,0,π/2},ImageSize->300,PlotStyle->Thick, 
 AxesLabel->{"θ"},Ticks->{{{π/4,"π/4"},{π/2,"π/2"}}},GridLines->{{π/4,π/2},Automatic},PlotLegend->{"T(θ)/P","N(θ)/P"},LegendShadow->None,LegendPosition->{0.5,0},LegendSize->0.4]

⊳ Tensione flessionale nella sezione più sollecitata
la sezione più sollecitata è quella all'incastro dove è massimo il momento e lo sforzo normale, cioè per θ=0.  La coordinata y è la distanza dall'asse che dista R ed è positiva verso il centro.

(Subscript[m, max])=M[0];   (Subscript[n, max])=Ν[0];

(Subscript[σ, f])[y_]=-((Subscript[m, max])/J)y/.dat;     (Subscript[σ, n])=-((Subscript[n, max])/(h s))/.dat;     (Subscript[σ, eb])[y_]=(Subscript[σ, f])[y]+(Subscript[σ, n]);
(OverBar[h])=h/.dat;

Plot[(Subscript[σ, eb])[y],{y,-((OverBar[h])/2),((OverBar[h])/2)},AxesOrigin->{0,0},PlotStyle->Thick,Filling->Axis, AxesLabel->{"y","(Subscript[σ, eb]) (MPa)"},ImageSize->400,Ticks->{{{-(OverBar[h])/2,"re"},{(OverBar[h])/2,"ri"}}},GridLines->{{-(OverBar[h])/2,(OverBar[h])/2},{}}](* vista ruotata di 90° in senso orario della tensione all'incastro *)

Soluzione con la teoria della trave a grande curvatura

Nel caso, come questo ((R/h)=2), in cui la curvatura ha lo stesso ordine di grandezza dell'altezza della trave, non si può più supporre che l'andamento della tensione nella sezione sia indipendente dalla curvatura; infatti come vedre con l'analisi delle travi di grande curvatura avrà un'andamento iperbolico.
Si è indicata, in figura, con r la cordinata radiale e con y  la distanza dall'asse neutro.  In questo caso abbiamo che il raggio baricentrico (Subscript[r, g]) coincide con il raggio R.  
Calcoliamo il raggio neutro (Subscript[r, n])

A=s h;    ri=R-(h/2);    re=R+(h/2);   (* dA=s \[DifferentialD]r *)
(Subscript[r, n])=(A/((∫_ri^re)(s/r)\[DifferentialD]r));     Print["(Subscript[r, n])= ",(Subscript[r, n]),"= ",(Subscript[r, n])=(Subscript[r, n])/.dat//N," mm"]

Il momento flettente e lo sforzo normale sono gli stessi del caso della trave di Eulero Bernulli

δ=R-(Subscript[r, n])/.dat;    (* Eccentricità *) 
ye=-((OverBar[h])/2)-δ;    yi=((OverBar[h])/2)-δ;     (* distanza inferiore e superiore dal raggio neutro*)

(* Andamento delle tensioni nella sezione *) 

(Subscript[σ, gc])[y_]=-((Subscript[n, max])/A)-((Subscript[m, max])/(A δ))((y/((Subscript[r, n])-y)));         (Subscript[σ, gc])[y_]=(Subscript[σ, gc])[y]/.dat;

Plot[(Subscript[σ, gc])[y],{y,ye,yi},AxesOrigin->{0,0},PlotStyle->Thick,Filling->Axis,PlotLabel->{{"(Subscript[σ, gc])=",(Subscript[σ, gc])[y],"(MPa)"}},ImageSize->400,Ticks->{{{ye,"ye"},{yi,"yi"}}},GridLines->{{ye,yi},{}}]
(* vista ruotata di 90° in senso orario della tensione all'incastro *)

Plot[{(Subscript[σ, eb])[y],(Subscript[σ, gc])[y-δ],(10^10)y-δ (10^10)},{y,-((OverBar[h])/2),((OverBar[h])/2)},AxesOrigin->{0,0},PlotStyle->{{Thick},{Thick},{Gray,Dashed}},ImageSize->400,Ticks->{{{-(OverBar[h])/2,"-h/2"},{(OverBar[h])/2,"h/2"}}},GridLines->{{-(OverBar[h])/2,(OverBar[h])/2},{}},PlotRange->{All,{-3100,2200}},PlotLegend->{"(Subscript[σ, eb])","(Subscript[σ, gc])","n-n"},LegendShadow->None,LegendPosition->{-0.7,-0.5},LegendSize->0.3]     (* (Subscript[σ, gc])[y-δ] traslazione per confrponto con (Subscript[σ, eb]) *)

Soluzione con la teoria dell' elasticità (Airy)

In quetso caso si procede senza le semplificazione della teoria della scienza delle costruzioni (Eulero-Bernoulli), come nel caso della teoria delle travi a grande curvatura, però assumendo una soluzione per la deformata Φ = f(r) Cos(θ) .  Procediamo dall'equazione di equilibrio biarmonica (∇^2)Φ  in cordinate polari:

Airy=(∂_(r,r))((∂_(r,r))Φ[r,θ]+(1/r)(∂_r)Φ[r,θ]+(1/(r^2))(∂_(θ,θ))Φ[r,θ])+(1/r)(∂_r)((∂_(r,r))Φ[r,θ]+(1/r)(∂_r)Φ[r,θ]+(1/(r^2))(∂_(θ,θ))Φ[r,θ])+(1/(r^2))(∂_(θ,θ))((∂_(r,r))Φ[r,θ]+(1/r)(∂_r)Φ[r,θ]+(1/(r^2))(∂_(θ,θ))Φ[r,θ])==0;
Collect[%,r]//TraditionalForm

Φ[r_,θ_]=f[r] Cos[θ];
Airy//Simplify//TraditionalForm

Risolviamo l'equazione differenziale e introduciamo le condizioni al contorno per ricavare le costanti

DSolve[Airy,f[r],r]
f[r_]=%[[1,1,2]];

(({{σr[r_,θ_]}, {σθ[r_,θ_]}, {(Subscript[τ, rθ])[r_,θ_]}}))=(({{ (1/r)(∂_r)Φ[r,θ]+(1/(r^2))(∂_(θ,θ))Φ[r,θ]}, {(∂_(r,r))Φ[r,θ]}, {-(∂_r)((1/r)(∂_θ)Φ[r,θ])}}));     ST=(({{σr[r,θ]}, {σθ[r,θ]}, {(Subscript[τ, rθ])[r,θ]}}));

Solve[{         σr[ri,θ]==0,
		σr[re,θ]==0,
		P==-(∫_ri^re)(Subscript[τ, rθ])[r,(π/2)]s\[DifferentialD]r
},{C[1],C[3],C[4]}]//N
CC={C[1]->%[[1,1,2]],C[3]->%[[1,2,2]],C[4]->%[[1,3,2]]}/.dat;

ST=ST/.CC;
%//Simplify//MatrixForm

(({{σr[r_]}, {σθ[r_]}, {(Subscript[τ, rθ])[r_]}}))=Collect[ST/.θ->0,r];
Print["Tensioni all'incastro (θ=0) \n\n (Subscript[σ, r])(r)= ",σr[r]//Chop,"\n (Subscript[σ, θ])(r)= ",σθ[r],"\n (Subscript[τ, rθ])= ",(Subscript[τ, rθ])[r]]

(OverBar[ri])=ri/.dat;  (OverBar[re])=re/.dat;
Plot[{σr[r],σθ[r]},{r,(OverBar[ri]),(OverBar[re])},AxesOrigin->{(OverBar[ri]),0},PlotStyle->Thick,ImageSize->400,Ticks->{{{100,"R"},{(OverBar[re]),"re"}}},GridLines->{{100,(OverBar[re])},{}},PlotLegend->{"(Subscript[σ, r])","(Subscript[σ, θ])"},LegendShadow->None,LegendPosition->{0.5,-0.5},LegendSize->0.3]
(* vista ruotata di 90° in senso antiorario della tensione all'incastro *)

(Subscript[σ, te])[y_]=σθ[r]/.r->R-y /.dat;     (* cambio di coordinate *)

Plot[{(Subscript[σ, eb])[y],(Subscript[σ, gc])[y-δ],(Subscript[σ, te])[y],(10^10)y-δ (10^10)},{y,-((OverBar[h])/2),((OverBar[h])/2)},AxesOrigin->{0,0},PlotStyle->{{Thick},{Thick},{Thick},{Gray,Dashed}},ImageSize->400,Ticks->{{{-(OverBar[h])/2,"re"},{(OverBar[h])/2,"ri"}}},GridLines->{{-(OverBar[h])/2,(OverBar[h])/2},{}},PlotRange->{All,{-3100,2200}},PlotLegend->{"(Subscript[σ, eb])","(Subscript[σ, gc])","(Subscript[σ, te])","n-n"},LegendShadow->None,LegendPosition->{-0.7,-0.5},LegendSize->0.3]

Le soluzioni della GC  e della TE  sono praticamente sovrapposte.  Facendone la differenza, si può osservare che il massimo discostamento rispetto il valore massimo della tensione vale poco più dell' 1%

Plot[(Subscript[σ, te])[y]-(Subscript[σ, gc])[y-δ],{y,-((OverBar[h])/2),((OverBar[h])/2)},Filling->Axis,PlotStyle->Thick,Ticks->{{{-(OverBar[h])/2,"re"},{(OverBar[h])/2,"ri"}}},GridLines->{{-(OverBar[h])/2,(OverBar[h])/2},{}}]

(Subscript[17, 1]) - Mensola di sezione triangolare soggetta a carico concentrato

⊳ Dati

Ε=200000MPa;   (Subscript[l, 0])=300mm;   (Subscript[H, 0])=100mm;   s=4;   P=2000 Ν;
h[x_]=(Subscript[H, 0])(1-(x/(Subscript[l, 0])));     J[x_]=s(((h[x])^3)/12);     M[x_]=P((Subscript[l, 0])- x);

Soluzione con trave di Eulero-Bernoulli

Calcolo dello spostamento v(x) mediante equazione di equilibrio e le CC

DSolve[{     v''[x]Ε J[x]==M[x],
		v[0]==0,
		v'[0]==0
},v[x],x];
(Subscript[v, EB])[x_]=%[[1,1,2]];

Soluzione con trave di Timoshenko

Nella trave di Bernoulli si è trascurato l'effetto del taglio nella rotazione.	Chiamando w  lo spostamento calcolato secondo Timoshenko, si avrà:

((∂w)/(∂x))=ϕ+γ	ove  ϕ  è il contributo alla rotazione del momento flettente, calcolato con E-B , e  γ quello del taglio.

χ=6/5;     G=(Ε/(2(1+ν)));     ν=0.3;     S=s h[x];
ϕ[x_]=(∂_x)(Subscript[v, EB])[x];     γ=(∂_x)w[x]-ϕ[x];     T[x_]= ((G S)/χ)γ;

Dall'equazione di equilibrio Ε J ϕ''(x) = T

DSolve[{               T[x]==P,
			w[0]==0
},w[x],x]
w[x_]=%[[1,1,2]];

Plot[{-(Subscript[v, EB])[x],-w[x]},{x,0,(Subscript[l, 0])},PlotStyle->Thick,ImageSize->500,PlotLegend->{"(Subscript[v, EB])","(Subscript[v, Ti])"},LegendShadow->None,LegendPosition->{-0.6,-0.6},LegendSize->0.25,PlotRange->{{0,300},Automatic},GridLines->Automatic]

⊳ Confronto energetico tra E.B. e Timoshenko:

(Subscript[U, EB])=(1/2)(∫_0^((Subscript[l, 0])-1))(((M[x])^2)/(Ε J[x]))\[DifferentialD]x ;     
(Subscript[U, Ti])=(Subscript[U, m])+(Subscript[U, t]);
(Subscript[U, m])=(Subscript[U, EB]);     (Subscript[U, t])=(1/2)(∫_0^((Subscript[l, 0])-1))(((T[x])^2)/( G S/χ))\[DifferentialD]x ;

Print["(Subscript[U, EB])= ",(Subscript[U, EB])//N//Chop," J\n(Subscript[U, Ti])= ",(Subscript[U, m])//N//Chop," + ",(Subscript[U, t])//N//Chop," = ",(Subscript[U, Ti])//N//Chop]

Come si può osservare dal calcolo dell'energia (calcolato fino (Subscript[l, 0])-1 perchè in punta lo spostamento è infinito) il contributo del taglio è trascurabile

Soluzione con TL2

⊳ Matrice di rigidezza

Procediamo con il calcolo automatico della matrice di rigidezza dell'elemento TL2 con gli assi e i nodi come in figura.
Lasciamo per ora incognite le coordinate che inseriremo sola alla fine del calcolo generico della matrice di trasformazione B.

(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     ν=0.3;     (Subscript[n, fdf])=6;

CooNod=(({{x1, x2, x3, x4, x5, x6}, {y1, y2, y3, y4, y5, y6}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{     (Subscript[x, i])=CooNod[[1,i]],
														(Subscript[y, i])=CooNod[[2,i]]}]
(Subscript[L, 1])=1-ξ-η;   
(Subscript[L, 2])=ξ;   
(Subscript[L, 3])=η;
(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}, {(Subscript[n, 5])[ξ_,η_]}, {(Subscript[n, 6])[ξ_,η_]}}))=(({{(Subscript[L, 1])(2(Subscript[L, 1])-1)}, {(Subscript[L, 2])(2(Subscript[L, 2])-1)}, {(Subscript[L, 3])(2(Subscript[L, 3])-1)}, {4(Subscript[L, 1])(Subscript[L, 2])}, {4(Subscript[L, 2])(Subscript[L, 3])}, {4(Subscript[L, 1])(Subscript[L, 3])}})); 

X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=(1/2)Det[J]; 

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

j=.;     (Subscript[b, s])=(({{(Overscript[(Subscript[n, j]), x]), 0}, {0, (Overscript[(Subscript[n, j]), y])}, {(Overscript[(Subscript[n, j]), y]), (Overscript[(Subscript[n, j]), x])}}));     For[j=1,j≤(Subscript[n, fdf]),j++,If[j==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]

Sostituiamo le coordinate e quindi calcoliamo la matrice di rigidezza

CN={     x1->0,    x2->(Subscript[l, 0]),x3->0,x4->(Subscript[l, 0])/2,    x5->(Subscript[l, 0])/2,x6->0,
	y1->-(Subscript[H, 0]),y2->0, y3->0, y4->-(Subscript[H, 0])/2, y5->0,        y6->-(Subscript[H, 0])/2};

For[i=1,i≤(Subscript[n, fdf]),i++,{      (Subscript[x, i])=CooNod[[1,i]]/.CN,
						(Subscript[y, i])=CooNod[[2,i]]/.CN}]
A=A/.CN;
B=B/.CN;     Print["B=",B//Simplify//MatrixForm,"\n"]

(Subscript[K, TL2])=2A s(∫_0^1)((∫_0^(1-ξ))(Transpose[B].(Subscript[D, SPT]).B)\[DifferentialD]η)\[DifferentialD]ξ;     Print["(Subscript[K, TL2])=",Chop[(Subscript[K, TL2])//MatrixForm//N,(10^(-8))],"\n"]

⊳ Calcolo degli spostamenti
Definiamo i vettori di spostamenti e forze e quindi risolviamo l'equazione di equilibrio :

Δ=(({{0}, {0}, {u2}, {v2}, {0}, {0}, {u4}, {v4}, {u5}, {v5}, {0}, {0}}));      F=(({{X1}, {Y1}, {0}, {-P}, {X3}, {Y3}, {0}, {0}, {0}, {0}, {X6}, {Y6}})); 
sol=Solve[{F==(Subscript[K, TL2]).Δ},{X1,Y1,u2,v2,X3,Y3,u4,v4,u5,v5,X6,Y6}]

(({{(Subscript[u, 1]), (Subscript[u, 2]), (Subscript[u, 3]), (Subscript[u, 4]), (Subscript[u, 5]), (Subscript[u, 6])}, {(Subscript[v, 1]), (Subscript[v, 2]), (Subscript[v, 3]), (Subscript[v, 4]), (Subscript[v, 5]), (Subscript[v, 6])}}))=(({{0, sol[[1,3,2]], 0, sol[[1,7,2]], sol[[1,9,2]], 0}, {0, sol[[1,4,2]], 0, sol[[1,8,2]], sol[[1,10,2]], 0}}));

Calcoliamo lo spostamento sull'asse neutro (coincidente con la mediana)

(Subscript[u, TL2])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[u, i]))/.η->(1/2)(1-ξ)/.ξ->(x/(Subscript[l, 0]));     (*η->(1/2)(1-ξ) asse neutro*)
(Subscript[v, TL2])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[v, i]))/.η->(1/2)(1-ξ)/.ξ->(x/(Subscript[l, 0]));

Plot[{-(Subscript[v, EB])[x],-w[x],(Subscript[v, TL2])[x]},{x,0,(Subscript[l, 0])},ImageSize->450,PlotStyle->{Thin,Thin,Thick}, 
 AxesLabel->{"mm","v (mm)"},GridLines->Automatic,PlotLegend->{"(Subscript[v, EB])","(Subscript[v, Ti])","(Subscript[v, TL2])"},LegendShadow->None,LegendPosition->{-0.7,-0.5},LegendSize->0.4]

α=20;   (*Fattore di scala di rappresentazione delle deformazioni*)
indef=(({{(Subscript[x, 1]), (Subscript[y, 1])}}));                             Do[indef=Join[indef,(({{(Subscript[x, i]), (Subscript[y, i])}}))],{i,{4,2,5,3,6,1}}]
TL2def=(({{(Subscript[x, 1])+(Subscript[u, 1])α, (Subscript[y, 1])+(Subscript[v, 1])α}}));    Do[TL2def=Join[TL2def,(({{(Subscript[x, i])+(Subscript[u, i])α, (Subscript[y, i])+(Subscript[v, i])α}}))],{i,{4,2,5,3,6,1}}]
Show[{ListPlot[indef,Joined->True,PlotStyle->{Dashed,Thick, Black}],ListPlot[TL2def,Joined->True,PlotStyle->{Thick, Blue}]},ImageSize->400]

Trave troncata

Soluzione con QL1

⊳ Calcolo della quota di troncamento
 La calcoleremo in modo che rispetti il vincolo sulla distorsione massima dell'elemento QL1

(Subscript[n, fdf])=4;     (Subscript[H, 1])=(Subscript[H, 0])(1-((Subscript[l, 1])/(Subscript[l, 0])));

CooNod=(({{0, (Subscript[l, 1]), (Subscript[l, 1]), 0}, {-(Subscript[H, 0]), -(Subscript[H, 1]), 0, 0}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{(Subscript[x, i])=CooNod[[1,i]],
												(Subscript[y, i])=CooNod[[2,i]]}]

(Subscript[A, 123])=(1/2)Det[(({{1, (Subscript[x, 1]), (Subscript[y, 1])}, {1, (Subscript[x, 2]), (Subscript[y, 2])}, {1, (Subscript[x, 3]), (Subscript[y, 3])}}))];     (Subscript[A, 134])=(1/2)Det[(({{1, (Subscript[x, 1]), (Subscript[y, 1])}, {1, (Subscript[x, 3]), (Subscript[y, 3])}, {1, (Subscript[x, 4]), (Subscript[y, 4])}}))];     (Subscript[A, 124])=(1/2)Det[(({{1, (Subscript[x, 1]), (Subscript[y, 1])}, {1, (Subscript[x, 2]), (Subscript[y, 2])}, {1, (Subscript[x, 4]), (Subscript[y, 4])}}))];

AA=4((Subscript[A, 123])+(Subscript[A, 134]));     BB=4((Subscript[A, 123])-(Subscript[A, 124]));     CC=4((Subscript[A, 134])-(Subscript[A, 124]));

Posto un valore alla distorsione δ  che deve essere minore di  0.5 (per evitare un errore di calcolo troppo grande) calcoliamo la lunghezza di troncamento (Subscript[l, 1]) :

δ=((Sqrt[(BB^2)+(CC^2)])/AA);     Solve[δ==0.4,(Subscript[l, 1])];
Print[" (Subscript[l, 1])= ",(Subscript[l, 1])=Round[%[[1,1,2]],10]," mm \n"]

⊳ Calcolo analitico della matrice di rigidezza

(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}}))=(1/4)(({{(1-ξ)(1-η)}, {(1+ξ)(1-η)}, {(1+ξ)(1+η)}, {(1-ξ)(1+η)}}));
X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);
J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));     a[ξ_,η_]=Det[J];     Print["A= ", A=(∫_(-1)^(+1))((∫_(-1)^(+1))a[ξ,η]\[DifferentialD]ξ)\[DifferentialD]η//N," (mm^2)"]

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))];
i=.;   (Subscript[b, s])=(({{(Overscript[(Subscript[n, i]), x]), 0}, {0, (Overscript[(Subscript[n, i]), y])}, {(Overscript[(Subscript[n, i]), y]), (Overscript[(Subscript[n, i]), x])}}));     For[i=1,i≤(Subscript[n, fdf]),i++,If[i==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]
b[ξ_,η_]=B;     Print["B=",B//Simplify//MatrixForm]

(Subscript[K, QL1])=s(∫_(-1)^(+1))((∫_(-1)^(+1))Det[J](Transpose[B].(Subscript[D, SPT]).B)\[DifferentialD]ξ)\[DifferentialD]η;     (Subscript[K, QL1])=Chop[(Subscript[K, QL1]),(10^(-8))];     Print[(Subscript[K, QL1])//MatrixForm]

⊳ Calcolo delle forze e degli spostamenti

Δ=(({{0}, {0}, {u2}, {v2}, {u3}, {v3}, {0}, {0}}));      F=(({{X1}, {Y1}, {0}, {0}, {0}, {-P}, {X4}, {Y4}})); 
sol=Solve[{F==(Subscript[K, QL1]).Δ},{X1,Y1,u2,v2,u3,v3,X4,Y4}]

(({{(Subscript[u, 1]), (Subscript[u, 2]), (Subscript[u, 3]), (Subscript[u, 4])}, {(Subscript[v, 1]), (Subscript[v, 2]), (Subscript[v, 3]), (Subscript[v, 4])}}))=(({{0, sol[[1,3,2]], sol[[1,5,2]], 0}, {0, sol[[1,4,2]], sol[[1,6,2]], 0}}));

Calcoliamo lo spostamento sull'asse neutro:

(Subscript[u, QL1])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[u, i]))/.η->0/.ξ->-1+(2/(Subscript[l, 1]))x;     (*η->0 asse neutro*)
(Subscript[v, QL1])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[v, i]))/.η->0/.ξ->-1+(2/(Subscript[l, 1]))x ;

Plot[{(Subscript[v, QL1])[x]},{x,0,(Subscript[l, 1])},ImageSize->400,PlotStyle->Thick, 
 AxesLabel->{"mm","(Subscript[v, QL1]) (mm)"},GridLines->Automatic]

α=100;     (*Fattore di scala di rappresentazione delle deformazioni*)
indefo=(({{(Subscript[x, 4]), (Subscript[y, 4])}}));                          Do[indefo=Join[indefo,(({{(Subscript[x, i]), (Subscript[y, i])}}))],{i,1,4}]
QL2def=(({{(Subscript[x, 4])+α (Subscript[u, 4]), (Subscript[y, 4])+α (Subscript[v, 4])}}));   Do[QL2def=Join[QL2def,(({{(Subscript[x, i])+α (Subscript[u, i]), (Subscript[y, i])+α (Subscript[v, i])}}))],{i,1,4}]

Show[{ListPlot[indefo,Joined->True,PlotStyle->{Thick,Dashed, Black}],ListPlot[QL2def,Joined->True,PlotStyle->{Thick, Blue}]},ImageSize->400]

Calcolo della matrice di rigidezza con Gauss

(Subscript[ξg, 1])=(Subscript[ξg, 4])=(Subscript[ηg, 1])=(Subscript[ηg, 2])=-1/(Sqrt[3]);   (Subscript[ξg, 2])=(Subscript[ξg, 3])=(Subscript[ηg, 3])=(Subscript[ηg, 4])=+1/(Sqrt[3]);   
 (Subscript[K, G2])=s(∑_(j=1)^4)a[(Subscript[ξg, j]),(Subscript[ηg, j])]Transpose[b[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[D, SPT]).b[(Subscript[ξg, j
]),(Subscript[ηg, j])];
Print[(Subscript[K, G2])//MatrixForm]

N.B. Il calcolo mediante i punti di Gauss e molto più rapido.
Calcoliamo l'errore percentuale (trascurando i decimali) rispetto il calcolo analitico:

Print["(((Subscript[K, G2]) - (Subscript[K, QL1]))/(Subscript[K, QL1]))%=",(((Subscript[K, G2])-(Subscript[K, QL1]))/(Subscript[K, QL1]))*100//Round//MatrixForm,"%"]

Oss: se l'elemento non fosse distorto le matrici di rifgidezza calcolate analiticamente e con due punti di Gauss sarebbero uguali.

⊳ Calcolo delle forze e degli spostamenti

sol=Solve[{F==(Subscript[K, G2]).Δ},{X1,Y1,u2,v2,u3,v3,X4,Y4}]

(({{(Subscript[u, 1]), (Subscript[u, 2]), (Subscript[u, 3]), (Subscript[u, 4])}, {(Subscript[v, 1]), (Subscript[v, 2]), (Subscript[v, 3]), (Subscript[v, 4])}}))=(({{0, sol[[1,3,2]], sol[[1,5,2]], 0}, {0, sol[[1,4,2]], sol[[1,6,2]], 0}}));     v3=(Subscript[v, 3]);

(Subscript[u, G2])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[u, i]))/.η->0/.ξ->-1+(2/(Subscript[l, 1]))x;     (*η->0 asse neutro*)
(Subscript[v, G2])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[v, i]))/.η->0/.ξ->-1+(2/(Subscript[l, 1]))x ;

Plot[{(Subscript[v, QL1])[x],(Subscript[v, G2])[x]},{x,0,(Subscript[l, 1])},PlotStyle->{{Thick,Red},{Thick,Dashed,Black}},ImageSize->500,PlotLegend->{"(Subscript[v, QL1])","(Subscript[v, G2])"},LegendShadow->None,LegendPosition->{-0.6,-0.6},LegendSize->0.25,PlotRange->{{0,(Subscript[l, 1])},Automatic},GridLines->Automatic]

Come si può osservare i grafici sono praticamente sovrapposti

Soluzione analitica con Eulero bernoulli

J=.;

h[x_]=x (((Subscript[H, 1])-(Subscript[H, 0]))/(Subscript[l, 1]))+(Subscript[H, 0]);     J[x_]=s(((h[x])^3)/12);     M[x_]=P((Subscript[l, 1])- x);

DSolve[{      v''[x]Ε J[x]==M[x],
		v[0]==0,
		v'[0]==0
},v[x],x];
(Subscript[v, EBt])[x_]=%[[1,1,2]];

Plot[{-(Subscript[v, EBt])[x],(Subscript[v, G2])[x]},{x,0,(Subscript[l, 1])},PlotStyle->Thick,ImageSize->500,PlotLegend->{"(Subscript[v, EBt])","(Subscript[v, QL1])"},LegendShadow->None,LegendPosition->{-0.6,-0.6},LegendSize->0.25,PlotRange->{{0,(Subscript[l, 1])},Automatic},GridLines->Automatic]

⊳ Calcolo dell'energia e confronto con QL1

(Subscript[U, EB])=(1/2)(∫_0^(Subscript[l, 1]))(((M[x])^2)/(Ε J[x]))\[DifferentialD]x ; 
(Subscript[U, QL1])=(1/2) Transpose[F].Δ;
Print[" (Subscript[U, EB])= ",(Subscript[U, EB])//N," J \n (Subscript[U, QL1])= ",(Subscript[U, QL1])[[1,1]]," J"]

(Subscript[U, QL1]) è notevolmente più bassa di (Subscript[U, EB]). Ciò è dovuto al fatto che gli elementi QL1 dovrebbero essere 'tozzi' per lavorare bene a flessione. Infatti anche lo spostamento non è ben approssimato. Vedremo cosa succede con 3 elementi

Calcolo dello stato tensionale all'interno della trave

d=y-((Subscript[H, 0])/2)((x/(Subscript[l, 0]))-1);     (Subscript[σ, f])[x_,y_]=((M[x])/(J[x]))d;     τ[x_,y_]=((6P)/(s ((h[x])^3)))((((h[x])^2)/4)-(d^2));
(Subscript[σ, eq])[x_,y_]=(Sqrt[(((Subscript[σ, f])[x,y])^2)+3((τ[x,y])^2)]);

ContourPlot[(Subscript[σ, f])[x,y],{x,0,(Subscript[l, 1])},{y,-(Subscript[H, 0]),0},RegionFunction->Function[{x,y,z},0<(y/(Subscript[H, 0]))-(x/(Subscript[l, 0]))+1<1],ContourLabels->Function[{x,y,z},Text[z,{x,y},Background->White]],Frame->False,ImageSize->300,BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,20},PlotLabel->Style[Framed[(Subscript[σ, f])],16,Blue]]ContourPlot[τ[x,y],{x,0,(Subscript[l, 1])},{y,-(Subscript[H, 0]),0},RegionFunction->Function[{x,y,z},0<(y/(Subscript[H, 0]))-(x/(Subscript[l, 0]))+1<1],ContourLabels->Function[{x,y,z},Text[z,{x,y},Background->White]],Frame->False,ImageSize->300,BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,30},PlotLabel->Style[Framed[τ],16,Blue]]

Show[ContourPlot[(Subscript[σ, eq])[x,y],{x,0,(Subscript[l, 1])},{y,-(Subscript[H, 0]),0},RegionFunction->Function[{x,y,z},0<(y/(Subscript[H, 0]))-(x/(Subscript[l, 0]))+1<1],ContourLabels->Function[{x,y,z},Text[z,{x,y}]],FrameLabel->Automatic,ImageSize->600,BoundaryStyle->{Black,Thin},ColorFunction->(Blend[{White,Red},#]&),Contours->{Automatic,30},AspectRatio->((Subscript[H, 0])/(Subscript[l, 1])),PlotLabel->Style[Framed[(Subscript[σ, eq]) ],16,Blue]],Plot[((Subscript[H, 0])/2)((x/(Subscript[l, 0]))-1),{x,0,(Subscript[l, 0])},PlotStyle->{Thick,DotDashed}]]

Calcolo con 2 QL1

Procediamo con il calcolo a due elementi

Quit[]

Ε=200000;   (Subscript[l, 0])=300;   (Subscript[H, 0])=100;   P=2000 ;
(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     ν=0.3;
 (Subscript[l, 1])=170;     (Subscript[H, 1])=(Subscript[H, 0])(1-((Subscript[l, 1])/(Subscript[l, 0])));
(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}}))=(1/4)(({{(1-ξ)(1-η)}, {(1+ξ)(1-η)}, {(1+ξ)(1+η)}, {(1-ξ)(1+η)}}));
(Subscript[ξg, 1])=(Subscript[ξg, 4])=(Subscript[ηg, 1])=(Subscript[ηg, 2])=-1/(Sqrt[3]);   (Subscript[ξg, 2])=(Subscript[ξg, 3])=(Subscript[ηg, 3])=(Subscript[ηg, 4])=+1/(Sqrt[3]);

(Subscript[n, fdf])=4;    El=2;      
CooNod=(({{x1, x2, x3, x4}, {y1, y2, y3, y4}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{ (Subscript[x, i])=CooNod[[1,i]],
												(Subscript[y, i])=CooNod[[2,i]]}]
X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);
J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=Det[J];     
i=.;   (Subscript[b, s])=(({{(Overscript[(Subscript[n, i]), x]), 0}, {0, (Overscript[(Subscript[n, i]), y])}, {(Overscript[(Subscript[n, i]), y]), (Overscript[(Subscript[n, i]), x])}}));     For[i=1,i≤(Subscript[n, fdf]),i++,If[i==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]
B//MatrixForm

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

Calcolata la matrice B generica calcoliamo le rigidezze degli elemmenti introducendo le coordinate dei nodi

(Subscript[cn, 1])={    x1->0,                                x2->(Subscript[l, 1])/2,                             x3->(Subscript[l, 1])/2,                       x4->0,
	 y1->-(Subscript[H, 0]),                           y2->-((Subscript[H, 0])+(Subscript[H, 1]))/2,            y3->0,                               y4->0};
(Subscript[cn, 2])={    x1->(Subscript[l, 1])/2,                        x2->(Subscript[l, 1]),                                   x3->(Subscript[l, 1]),                             x4->(Subscript[l, 1])/2,
	 y1->-((Subscript[H, 0])+(Subscript[H, 1]))/2,       y2->-(Subscript[H, 1]),                                 y3->0,                               y4->0};

For[i=1,i≤El,i++,{(Subscript[b, i])[ξ_,η_]=B/.(Subscript[cn, i]), (Subscript[a, i])[ξ_,η_]=A/.(Subscript[cn, i]),
					(Subscript[K, l2G,i])=(∑_(j=1)^4)(Subscript[a, i])[(Subscript[ξg, j]),(Subscript[ηg, j])](Transpose[(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[D, SPT]).(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])]),Print[(Subscript[K, l2G,i])//MatrixForm]}]

nod=6;      (Subscript[el, 1])=(({{1}, {3}, {4}, {2}}));  (Subscript[el, 2])=(({{3}, {5}, {6}, {4}}));   
(*  posizione nela matrice -> corrisp. nodo locale, 
	numero inserito -> corrisp. nodo globale        *)
(Subscript[n, loc])=8;   (Subscript[n, glob])=2nod;
H=ConstantArray[0,{El,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤El,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}]}]

For[i=1,i≤El,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤El,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^El)(Subscript[K, i,glob]);
For[i=1,i≤El,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, l2G,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm//Chop

Δ=Transpose[(({{0, 0, 0, 0, u3, v3, u4, v4, u5, v5, u6, v6}}))];
F=Transpose[(({{X1, Y1, X2, Y2, 0, 0, 0, 0, 0, 0, 0, -P}}))];
sol=Solve[{F==(Subscript[K, tot]).Δ},{X1,Y1,X2,Y2,u3,v3,u4,v4,u5,v5,u6,v6}]

(({{(Subscript[u, 1]), (Subscript[u, 2]), (Subscript[u, 3]), (Subscript[u, 4]), (Subscript[u, 5]), (Subscript[u, 6])}, {(Subscript[v, 1]), (Subscript[v, 2]), (Subscript[v, 3]), (Subscript[v, 4]), (Subscript[v, 5]), (Subscript[v, 6])}}))=(({{0, 0, sol[[1,5,2]], sol[[1,7,2]], sol[[1,9,2]], sol[[1,11,2]]}, {0, 0, sol[[1,6,2]], sol[[1,8,2]], sol[[1,10,2]], sol[[1,12,2]]}}))

(({{(Subscript[u, 1,1]), (Subscript[u, 1,2]), (Subscript[u, 1,3]), (Subscript[u, 1,4])}, {(Subscript[v, 1,1]), (Subscript[v, 1,2]), (Subscript[v, 1,3]), (Subscript[v, 1,4])}}))=(({{(Subscript[u, 1]), (Subscript[u, 3]), (Subscript[u, 4]), (Subscript[u, 2])}, {(Subscript[v, 1]), (Subscript[v, 3]), (Subscript[v, 4]), (Subscript[v, 2])}}));     (({{(Subscript[u, 2,1]), (Subscript[u, 2,2]), (Subscript[u, 2,3]), (Subscript[u, 2,4])}, {(Subscript[v, 2,1]), (Subscript[v, 2,2]), (Subscript[v, 2,3]), (Subscript[v, 2,4])}}))=(({{(Subscript[u, 3]), (Subscript[u, 5]), (Subscript[u, 6]), (Subscript[u, 4])}, {(Subscript[v, 3]), (Subscript[v, 5]), (Subscript[v, 6]), (Subscript[u, 4])}}));

(Subscript[v, el1])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[v, 1,i]))/.η->0/.ξ->-1+(2/((Subscript[l, 1])/2))x ;
(Subscript[v, el2])[x_]=((∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[v, 2,i]))/.η->0/.ξ->-1+(2/((Subscript[l, 1])/2))x;

(Subscript[v, Q2])[x_]=(Piecewise[{{(Subscript[v, el1])[x], x≤(Subscript[l, 1])/2}, {(Subscript[v, el2])[x], x≤(Subscript[l, 1])}}]);

Plot[{(Subscript[v, Q2])[x]},{x,0,(Subscript[l, 1])},PlotStyle->Thick,ImageSize->500,PlotRange->{{0,(Subscript[l, 1])},Automatic},AxesOrigin->{0,0},GridLines->Automatic,ExclusionsStyle->{{Dotted,Blue}},AxesLabel->{"mm","(Subscript[v, 2  QL1]) (mm)"}]

Calcolo con 3 QL1

Quit[]

El=3;

Ε=200000;   (Subscript[l, 0])=300;   (Subscript[H, 0])=100;   P=2000 ;
(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     ν=0.3;
 (Subscript[l, 1])=170;     (Subscript[H, 1])=(Subscript[H, 0])(1-((Subscript[l, 1])/(Subscript[l, 0])));
(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}}))=(1/4)(({{(1-ξ)(1-η)}, {(1+ξ)(1-η)}, {(1+ξ)(1+η)}, {(1-ξ)(1+η)}}));
(Subscript[ξg, 1])=(Subscript[ξg, 4])=(Subscript[ηg, 1])=(Subscript[ηg, 2])=-1/(Sqrt[3]);   (Subscript[ξg, 2])=(Subscript[ξg, 3])=(Subscript[ηg, 3])=(Subscript[ηg, 4])=+1/(Sqrt[3]);

(Subscript[n, fdf])=4;          
CooNod=(({{x1, x2, x3, x4}, {y1, y2, y3, y4}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{ (Subscript[x, i])=CooNod[[1,i]],
												(Subscript[y, i])=CooNod[[2,i]]}]
X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);
J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=Det[J];     
i=.;   (Subscript[b, s])=(({{(Overscript[(Subscript[n, i]), x]), 0}, {0, (Overscript[(Subscript[n, i]), y])}, {(Overscript[(Subscript[n, i]), y]), (Overscript[(Subscript[n, i]), x])}}));     For[i=1,i≤(Subscript[n, fdf]),i++,If[i==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]
For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

(Subscript[cn, 1])={    x1->0,                                x2->(Subscript[l, 1])/3,                              x3->(Subscript[l, 1])/3,             x4->0,
	 y1->-(Subscript[H, 0]),                           y2->-(2(Subscript[H, 0])+(Subscript[H, 1]))/3,          y3->0,                     y4->0};
(Subscript[cn, 2])={    x1->(Subscript[l, 1])/3,                        x2->2(Subscript[l, 1])/3,                           x3->2(Subscript[l, 1])/3,          x4->(Subscript[l, 1])/3,
	 y1->-(2(Subscript[H, 0])+(Subscript[H, 1]))/3,    y2->-((Subscript[H, 0])+2(Subscript[H, 1]))/3,           y3->0,                     y4->0};
(Subscript[cn, 3])={   x1->2(Subscript[l, 1])/3,                     x2->(Subscript[l, 1]),                                    x3->(Subscript[l, 1]),                     x4->2(Subscript[l, 1])/3,
	y1->-((Subscript[H, 0])+2(Subscript[H, 1]))/3,     y2->-(Subscript[H, 1]),                                 y3->0,                      y4->0};

For[i=1,i≤El,i++,{(Subscript[b, i])[ξ_,η_]=B/.(Subscript[cn, i]), (Subscript[a, i])[ξ_,η_]=A/.(Subscript[cn, i]),
					(Subscript[K, l2G,i])=(∑_(j=1)^4)(Subscript[a, i])[(Subscript[ξg, j]),(Subscript[ηg, j])](Transpose[(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[D, SPT]).(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])])}]

nod=8;      (Subscript[el, 1])=(({{1}, {3}, {4}, {2}}));  (Subscript[el, 2])=(({{3}, {5}, {6}, {4}}));   (Subscript[el, 3])=(({{5}, {7}, {8}, {6}}));    

(Subscript[n, loc])=8;   (Subscript[n, glob])=2nod;
H=ConstantArray[0,{El,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤El,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}]}]

For[i=1,i≤El,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤El,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^El)(Subscript[K, i,glob]);
For[i=1,i≤El,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, l2G,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm

Δ=Transpose[(({{0, 0, 0, 0, u3, v3, u4, v4, u5, v5, u6, v6, u7, v7, u8, v8}}))];
F=Transpose[(({{X1, Y1, X2, Y2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -P}}))];
sol=Solve[{F==(Subscript[K, tot]).Δ},{X1,Y1,X2,Y2,u3,v3,u4,v4,u5,v5,u6,v6,u7,v7,u8,v8}]

(({{(Subscript[u, 1]), (Subscript[u, 2]), (Subscript[u, 3]), (Subscript[u, 4]), (Subscript[u, 5]), (Subscript[u, 6]), (Subscript[u, 7]), (Subscript[u, 8])}, {(Subscript[v, 1]), (Subscript[v, 2]), (Subscript[v, 3]), (Subscript[v, 4]), (Subscript[v, 5]), (Subscript[v, 6]), (Subscript[v, 7]), (Subscript[v, 8])}}))=(({{0, 0, sol[[1,5,2]], sol[[1,7,2]], sol[[1,9,2]], sol[[1,11,2]], sol[[1,13,2]], sol[[1,15,2]]}, {0, 0, sol[[1,6,2]], sol[[1,8,2]], sol[[1,10,2]], sol[[1,12,2]], sol[[1,14,2]], sol[[1,16,2]]}}));

Sostituzione dei risultati globali negli spostamenti locali degli elementi:

For[j=1,j≤El,j++,    For[i=1,i≤(Subscript[n, fdf]),i++,{    (Subscript[u, j,i])=(Subscript[u, (Subscript[el, j])[[i,1]]]),
											(Subscript[v, j,i])=(Subscript[v, (Subscript[el, j])[[i,1]]])}]]

For[i=1,i≤El,i++,{(Subscript[v, el,i])[x_]=((∑_(j=1)^(Subscript[n, fdf]))(Subscript[n, j])[ξ,η](Subscript[v, i,j]))/.η->0/.ξ->-1+(2/((Subscript[l, 1])/3))x }]

(Subscript[v, Q3])[x_]=(Piecewise[{{(Subscript[v, el,1])[x], x≤(Subscript[l, 1])/3}, {(Subscript[v, el,2])[x], x≤2(Subscript[l, 1])/3}, {(Subscript[v, el,3])[x], x≤(Subscript[l, 1])}}]);

Plot[{(Subscript[v, Q3])[x]},{x,0,(Subscript[l, 1])},PlotStyle->Thick,ImageSize->500,PlotRange->{{0,(Subscript[l, 1])},Automatic},AxesOrigin->{0,0},GridLines->Automatic,ExclusionsStyle->{{Dotted,Blue}},AxesLabel->{"mm","(Subscript[v, 3  QL1]) (mm)"}]

(Subscript[17, 2]) - Diga soggetta a peso proprio e carico idrostatico

⊳ Dati
Per le dimensioni prendo quelle del quadrato dell'ex (Subscript[17, 1]) moltiplicate per 10 così la distorsione rientra nei limiti.
I valor sono quelli di riferimento del calcestruzzo e dell'acqua.

Ε=(10^5)MPa;   χ=6/5;   G=(Ε/(2(1+ν)));   ν=0.3;  
(Subscript[ρ, cem])=2.2*(10^(-6)) (kg/(mm^3));   (Subscript[ρ, acq])=(10^(-6)) (kg/(mm^3));   g=9806(mm/(sec^2));

h=1700mm;   (Subscript[L, 0])=1000mm;   (Subscript[L, 1])=450mm;   s=1mm;

l[y_]=(Subscript[L, 1])+y (((Subscript[L, 0])-(Subscript[L, 1]))/h);   J[y_]=s(((l[y])^3)/12);    A[y_]=l[y] s;

Eulero-Bernoulli

DSolve[{      (* carico idrostatico *) 
			Ε J[y]u''[y]==(Subscript[ρ, acq])g ((y^3)/6),                   
			u[h]==0,
			u'[h]==0,
		
		(* peso proprio *)
			v''[y]+(((Subscript[ρ, cem])g)/Ε)==0,		
			v[h]==0,
			v'[0]==0

},{u[y],v[y]},y];
(Subscript[u, EB])[y_]=%[[1,1,2]];
(Subscript[v, EB])[y_]=%%[[1,2,2]];

Plot[{(Subscript[u, EB])[y],-(Subscript[v, EB])[y]},{y,0,h},PlotStyle->Thick, 
 AxesLabel -> {y, x},PlotStyle->Thick,GridLines->{{500,1000,1500,1700},Automatic},ImageSize->400,PlotLegend->{"(Subscript[u, EB])","(Subscript[v, EB])"},LegendShadow->None,LegendPosition->{0.5,0.3},LegendSize->0.25,AxesStyle->Arrowheads[{0.03}],PlotRange->{{0,1800},{-0.4,0.9}}]

Timoshenko

ϕ[y_]=(∂_y)(Subscript[u, EB])[y];     γ=(∂_y)u[y]-ϕ[y];     T= ((G A[y])/χ)γ;
DSolve[{               T==-(Subscript[ρ, acq])g ((y^2)/4),
			u[h]==0
},u[y],y];
(Subscript[u, Ti])[y_]=%[[1,1,2]];

Plot[{(Subscript[u, Ti])[y],(Subscript[u, EB])[y]},{y,0,h},PlotRange->All,PlotStyle->Thick, 
 AxesLabel -> {y, x},GridLines->Automatic,ImageSize->400,PlotLegend->{"(Subscript[u, Ti])","(Subscript[u, EB])"},LegendShadow->None,LegendPosition->{0.5,0.3},LegendSize->0.25]

QL1

⊳ Matrice di rigidezza con 2 punti di Gauss

(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));    (Subscript[n, fdf])=4;   CooNod=(({{(Subscript[L, 0]), 0, 0, (Subscript[L, 1])}, {h, h, 0, 0}}));
For[i=1,i≤(Subscript[n, fdf]),i++,{       (Subscript[x, i])=CooNod[[1,i]],
						(Subscript[y, i])=CooNod[[2,i]]}]

(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}}))=(1/4)(({{(1-ξ)(1-η)}, {(1+ξ)(1-η)}, {(1+ξ)(1+η)}, {(1-ξ)(1+η)}}));     
 
X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));     a[ξ_,η_]=Det[J];

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))];
i=.;   (Subscript[b, s])=(({{(Overscript[(Subscript[n, i]), x]), 0}, {0, (Overscript[(Subscript[n, i]), y])}, {(Overscript[(Subscript[n, i]), y]), (Overscript[(Subscript[n, i]), x])}}));     For[i=1,i≤(Subscript[n, fdf]),i++,If[i==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]
b[ξ_,η_]=B;

(Subscript[ξg, 1])=(Subscript[ξg, 4])=(Subscript[ηg, 1])=(Subscript[ηg, 2])=-1/(Sqrt[3]);   (Subscript[ξg, 2])=(Subscript[ξg, 3])=(Subscript[ηg, 3])=(Subscript[ηg, 4])=+1/(Sqrt[3]);   
 (Subscript[K, G2,2])=s(∑_(j=1)^4)a[(Subscript[ξg, j]),(Subscript[ηg, j])]Transpose[b[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[D, SPT]).b[(Subscript[ξg, j
]),(Subscript[ηg, j])];
Print["(Subscript[K, G2, 2])=",(Subscript[K, G2,2])//MatrixForm,"\n"]

⊳ Integrazione Selettiva

La matrice di rigidezza calcolata inetramente con 2 punti di Gauss risulta più rigida, per via della deformazione a taglio che, a causa dei vincoli cinematici imposti dalle funzioni di forma, a pura flessione è non nulla (come si può osservare nella fig. qui sopra) . Invece sottointegrando in maniera selettiva solo la componente della rigidità dovuta a taglio, con un solo punto di Gauss si ottiene un calcolo esatto della deformazione a taglio, che risulterà nulla a pura flessione.
Procediamo quindi nel suddividere la matrice B e (Subscript[D, STP]) nelle sottomatrici di flessione e di taglio

(Subscript[b, f])[ξ_,η_]=Take[B,2];        (Subscript[D, f])=Take[ (Subscript[D, SPT]),2,2];              
(Subscript[b, t])[ξ_,η_]=Take[B,-1];     (Subscript[D, t])=Take[ (Subscript[D, SPT]),-1,-1];

(Subscript[K, t])=a[0,0]Transpose[(Subscript[b, t])[0,0]].(Subscript[D, t]).(Subscript[b, t])[0,0];     (Subscript[K, f])=(∑_(j=1)^4)a[(Subscript[ξg, j]),(Subscript[ηg, j])]Transpose[(Subscript[b, f])[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[D, f]).(Subscript[b, f])[(Subscript[ξg, j
]),(Subscript[ηg, j])];
(Subscript[K, G2,1])=(Subscript[K, f])+(Subscript[K, t]);
Print["(Subscript[K, G2, 1])=",(Subscript[K, G2,1])//MatrixForm,"\n"]

⊳ Vettori dei carichi

- Carico idrostatico

p=(Subscript[ρ, acq])g(y)/.y->(h/2)(1-η);
(Subscript[F, acq])=(∫_(-1)^1)p (({{0}, {0}, {((1-η)/2)}, {0}, {((1+η)/2)}, {0}, {0}, {0}}))(h/2)\[DifferentialD]η;         Print["(Subscript[F, acq])=",(Subscript[F, acq])//N//MatrixForm,"\n"]

- Peso proprio

NN=Transpose[(({{(Subscript[n, 1])[ξ,η]}, {(Subscript[n, 2])[ξ,η]}, {(Subscript[n, 3])[ξ,η]}, {(Subscript[n, 4])[ξ,η]}}))];     V=s Det[J];    (Subscript[ρ, tot])=(({{0}, {(Subscript[ρ, cem])}}));

(Subscript[F, peso])=(∫_(-1)^1)(∫_(-1)^1)- g (Subscript[ρ, tot]).NN V\[DifferentialD]ξ\[DifferentialD]η;          Print["(Subscript[F, peso])=",(Subscript[F, peso])//MatrixForm]

Prendiamo le forze applicate ai nodi non vincolati 3 e 4 :

Print["(Subscript[F, peso])=",(Subscript[F, peso])=Join[{0,0,0,0},(Subscript[F, peso])[[All,3]],(Subscript[F, peso])[[All,4]]],"\n"]

⊳ Calcolo degli spostamenti

Si ipotizza di vincolare completamente il nodo 1 e  2.

(Subscript[F, tot,1])=(Subscript[F, acq])+(({{(Subscript[X, 1,1])}, {(Subscript[Y, 1,1])}, {(Subscript[X, 1,2])}, {(Subscript[Y, 1,2])}, {0}, {0}, {0}, {0}}));          (Subscript[Δ, 1])=(({{0}, {0}, {0}, {0}, {(Subscript[u, 1,3])}, {(Subscript[v, 1,3])}, {(Subscript[u, 1,4])}, {(Subscript[v, 1,4])}}));
(Subscript[F, tot,2])=(Subscript[F, peso])+(({{(Subscript[X, 2,1])}, {(Subscript[Y, 2,1])}, {(Subscript[X, 2,2])}, {(Subscript[Y, 2,2])}, {0}, {0}, {0}, {0}}));          (Subscript[Δ, 2])=(({{0}, {0}, {0}, {0}, {(Subscript[u, 2,3])}, {(Subscript[v, 2,3])}, {(Subscript[u, 2,4])}, {(Subscript[v, 2,4])}}));

Do[(* j=1: idro  ,  i=1: selettivo
 j=2: peso  ,  i=2: normale   *)
Print[If[j==1,"F: idrostico \t","F: peso proprio \t"],If[ i==1,"∫K: selettivo","∫K: 2 pti G."]];

sol=Solve[(Subscript[F, tot,j])==(Subscript[K, G2,i]).(Subscript[Δ, j]),{(Subscript[X, j,1]),(Subscript[Y, j,1]),(Subscript[X, j,2]),(Subscript[Y, j,2]),(Subscript[u, j,3]),(Subscript[v, j,3]),(Subscript[u, j,4]),(Subscript[v, j,4])}];     Print[sol];

(({{(Subscript[u, j,i,1]), (Subscript[u, j,i,2]), (Subscript[u, j,i,3]), (Subscript[u, j,i,4])}, {(Subscript[v, j,i,1]), (Subscript[v, j,i,2]), (Subscript[v, j,i,3]), (Subscript[v, j,i,4])}}))=(({{0, 0, sol[[1,5,2]], sol[[1,7,2]]}, {0, 0, sol[[1,6,2]], sol[[1,8,2]]}}));

(Subscript[u, 1,i])[y_]=((∑_(k=1)^(Subscript[n, fdf]))(Subscript[n, k])[ξ,η](Subscript[u, 1,i,k]))/.ξ->0/.η->1-(2/h)y ;   (* ξ=0:sezione mediana, y=h(1-η)/2 *)
(Subscript[v, 2,i])[y_]=((∑_(k=1)^(Subscript[n, fdf]))(Subscript[n, k])[ξ,η](Subscript[v, 2,i,k]))/.ξ->0/.η->1-(2/h)y ;

,{j,{1,2}},{i,{1,2}}];

lp=Plot[{(Subscript[u, EB])[y],(Subscript[u, Ti])[y],(Subscript[u, 1,2])[y],(Subscript[u, 1,1])[y]},{y,0,h},PlotRange->All,PlotStyle->Thick, 
 AxesLabel -> {y, x},GridLines->Automatic,ImageSize->500,PlotLegend->{"(Subscript[u, EB])","(Subscript[u, Ti])","(Subscript[u, 2  pG])","(Subscript[u, sel])"},LegendShadow->None,LegendPosition->{0.5,0.1},LegendSize->0.25,PlotLabel->Framed["Carico idrostatico"]]
Plot[{-(Subscript[v, EB])[y],(Subscript[v, 2,1])[y],(Subscript[v, 2,2])[y]},{y,0,h},PlotRange->All,PlotStyle->Thick, 
 AxesLabel -> {y, x},GridLines->Automatic,ImageSize->500,PlotLegend->{"(Subscript[v, EB])","(Subscript[v, sel])","(Subscript[v, 2  pG])"},LegendShadow->None,LegendPosition->{0.5,-0.5},LegendSize->0.25,PlotLabel->Framed["Peso proprio"]]

Modi di deformazione sulla matrice di rigidezza non selettiva

Si procede ora al calcolo e alla rappresentazione dei modi di deformazione dell'elemento QL1 (non selettivo a 2 pti di Gauss) utilizzato in precedenza.

KEI=Transpose[Eigensystem[(Subscript[K, G2,2])]];      Print["Autovalori","\t Autovettori \n",KEI//Chop//MatrixForm]

Calcolando gli autovalori della matrice di rigidezza dell'elemento si vede che essa ha 8 autovalori (come ci si aspettava), di cui 3 sono nulli.
I tre autovalori nulli infatti corrispondono ai modi dei moti di corpo rigido.

indef=ListPlot[{{(Subscript[x, 1]),(Subscript[y, 1])},{(Subscript[x, 2]),(Subscript[y, 2])},{(Subscript[x, 3]),(Subscript[y, 3])},{(Subscript[x, 4]),(Subscript[y, 4])},{(Subscript[x, 1]),(Subscript[y, 1])}},Joined->True,
PlotStyle->{Thick,PointSize[0.02],Blue,Dashed},Mesh->All];     
FF=200; (* fattore di scala *)

For[i=1,i≤8,i++,
	md=Print["⊳ MODO ",i ,"\n λ=",KEI[[i,1]]//Chop];

		For[j=1,j≤4,j++,
		(Subscript[u, j])=KEI[[i,2,2j-1]];
		(Subscript[v, j])=KEI[[i,2,2j]];
		Δ=If[j==1,Δ={{(Subscript[u, j]),(Subscript[v, j])}},Join[Δ,{{(Subscript[u, j]),(Subscript[v, j])}},2]];
		(Subscript[CoD, j])={(Subscript[x, j])+(Subscript[u, j])FF,(Subscript[y, j])+(Subscript[v, j])FF}];

def=ListPlot[{(Subscript[CoD, 1]),(Subscript[CoD, 2]),(Subscript[CoD, 3]),(Subscript[CoD, 4]),(Subscript[CoD, 1])},Joined->True,PlotStyle->{Thick,PointSize[0.02],Red},Mesh->All,PlotRange->All];
U=Δ.(Subscript[K, G2,2]).Transpose[Δ]; 
nrg=Print[" L'energia è ",U[[1,1]]//Chop," J"];
gr=Show[def,indef,GridLines->Automatic,ImageSize->350];
Print[Grid[({{md}, {gr}, {nrg}})]]]

N.B. Non si hanno in questo caso modi spuri (moti non rigidi con energia di deformazione nulla); infatti dalla formula che ne misura il numero si ha:
M = G N - L - r n = -1     (ove un risultato ⩽0 indica l'0asenza di moti spuri)
G=2 : g.d.l. per nodo ,   N=4 : n° di nodi ,   L=3 : g.d.l. moto rigido ,   r=3 : rango di (Subscript[D, SPT]) ,   n=2 : n° pti di integrazione

20 - Lastra quadrata appoggiata

⊳ Dati

a=1000;     P=1;     p0=(10^(-6));     ν=0.3;     s=1;      Em=206000;
B= ((Em (s^3))/(12 (1-(ν^2)) ));           Df=B(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));

Carico distribuito

Metodo di Ritz

Supponendo che il carico abbia una distribuzione del tipo:

p=Cost*Sin[((m π)/a)x]Sin[((m π)/a)y]

la soluzione dello spostamento avrà forma analoga:

wr[x_,y_]=A Sin[(π/a) x]Sin[(π/a) y];

ove A è una costante che calcoleremo mediante il principio di stazionarietà dell'energia

(({{Crx}, {Cry}, {Crxy}}))=-(({{(∂_(x,x))wr[x,y]}, {(∂_(y,y))wr[x,y]}, {2 (∂_(x,y))wr[x,y]}}));          Cr=(({{Crx}, {Cry}, {Crxy}}));

(*Energia di Deformazione*)
Uf=(1/2)(∫_0^a)((∫_0^a)Transpose[Cr].Df.Cr\[DifferentialD]x)\[DifferentialD]y;
(*Energia dei Carichi*)
W=-(∫_0^a)((∫_0^a)p0 wr[x,y]\[DifferentialD]y)\[DifferentialD]x;

A=Solve[{(∂_A)(W+Uf)==0},{A}][[1,1,2]];

Plot3D[wr[x,y],{x,0,a},{y,0,a},AxesLabel->{"x","y","w"},ImageSize->400]ContourPlot[wr[x,y],{x,0,a},{y,0,a},AxesLabel->{"x","y","z"},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,20},PlotLabel->Style["w (mm)",16]]

⊳ Momenti, tagli e reazioni

Il grafico di My e Ty saranno simmetrici a Mx e Tx quindi non verranno graficati; invece Rx e Ry saranno uguali.

(* MOMENTI *)
(({{Mrx}, {Mry}, {Mrxy}}))=Df.Cr;

(* TAGLIO *)
Trx=B (∂_x)(Crx+Cry);
Try=B (∂_y)(Crx+Cry);

(*REAZIONI sul BORDO *)
Rrx=Trx+(∂_y)Mrxy;
Rry=Try+(∂_x)Mrxy;

(* REAZIONI negli ANGOLI *)
R=2 Abs[Mrxy/.{x->0,y->0}]

ContourPlot[Mrx,{x,0,a},{y,0,a},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,15},PlotLabel->Style["Mx (MPa)",16]]Plot3D[Mrx,{x,0,a},{y,0,a},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain"]
ContourPlot[Mrxy,{x,0,a},{y,0,a},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,15},PlotLabel->Style["Mxy (MPa)",16]]Plot3D[Mrxy,{x,0,a},{y,0,a},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain"]
ContourPlot[Trx,{x,0,a},{y,0,a},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,15},PlotLabel->Style["Tx (MPa)",16]]Plot3D[Trx,{x,0,a},{y,0,a},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain"]
Plot[Rry/.y->0,{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel -> {x, "Ry"},GridLines->Automatic,ImageSize->400,PlotLabel->Style["Ry (y=0)",16]]

Soluzione mediante serie trigonemetriche

Esprimiamo la soluzione dello spostamento trovata con Ritz mediante una serie. La doppia serie trigonometrica converge rapidamente, quindi si posssono usare pochi termini della sommatoria per avere un buon risultato.

w[x_,y_]=((16 p0)/(B (π^6)))(∑_(m=0)^5)(∑_(n=0)^5)((Sin[(1/a)(2m+1)π x]Sin[(1/a)(2n+1)π y])/((2m+1)(2n+1)((((1/(a^2))(((2m+1))^2)+(1/(a^2))(((2n+1))^2)))^2)));

(* CURVATURE *)
(({{Cx}, {Cy}, {Cxy}}))=(({{-(∂_(x,x))w[x,y]}, {-(∂_(y,y))w[x,y]}, {-2 (∂_(x,y))w[x,y]}}));

(* MOMENTI *)
M=(({{Mx}, {My}, {Mxy}}));         (({{Mx}, {My}, {Mxy}}))=Df.(({{Cx}, {Cy}, {Cxy}}));

(* TAGLIO *)
Tx=B (∂_x)(Cx+Cy);
Ty=B (∂_y)(Cx+Cy);

(*REAZIONI sul BORDO *)
Rx=Tx+(∂_y)Mxy;
Ry=Ty+(∂_x)Mxy;

Confrontiamo quindi i valori nella mezzeria per spostamento, taglio e momento, e sul bordo per la reazione

Plot[{w[x,y]/.y->a/2,wr[x,y]/.y->a/2},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "w"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["w (y=a/2)",16]]Plot[{Mx/.y->a/2,Mrx/.y->a/2},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "Mx"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["Mx (y=a/2)",16]]Plot[{Tx/.y->a/2,Trx/.y->a/2},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "Tx"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["Tx (y=a/2)",16]]Plot[{Ry/.y->0,Rry/.y->0},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "Ry"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["Ry (y=0)",16]]

Lastra circolare

Confrontiamo i risultati con quelli di una lastra circolare equivalente:

(* Diametro equivalente *)
Req= (a/(Sqrt[π]));

t[r_]=((p0 r)/(2 ));
 
(({{cr}, {cθ}}))=(({{-(∂_(r,r))wl[r]}, {-(1/r)(∂_r)wl[r]}}));      (({{mr[r_]}, {mθ[r_]}}))=B(({{1, ν}, {ν, 1}})).(({{cr}, {cθ}}));

eq=r(∂_r)mr[r]+mr[r]-mθ[r]==-t[r] r;
Chop[DSolve[{      eq,
			wl[Req]==0,
			wl'[0]==0,
			mr[Req]==0
},wl[r],r],
(10^(-20))]
wl[r_]=%[[1,1,2]];

RevolutionPlot3D[wl[r],{r,0,Req},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain",PlotLabel->Style["w",16]]Plot[{mr[r],mθ[r]},{r,0,Req},AxesOrigin->{0,0},PlotStyle->Thick, 
 AxesLabel ->{x},GridLines->{{100,200,300,400,500,Req},Automatic},ImageSize->400,PlotLegend->{"mr","mθ"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25]

Plot[{Mx/.{x->a/2,y->r+a/2},mr[r]},{r,-Req,Req},PlotStyle->Thick,PlotRange->{{-Req,Req},{0,0.07}},ImageSize->500,PlotLegend->{"■ Mx ","● mr "},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.3,PlotLabel->Style["Confronto",16],GridLines->{{-Req,-400,-200,200,400,Req},Automatic}]

Carico concentrato

Il carico concentrato non sarà altro che una soluzione particolare del carico distribuito.

Metodo di Ritz

wr[x_,y_]=Λ Sin[π x/a]Sin[π y/a];

(({{Crx}, {Cry}, {Crxy}}))=-(({{(∂_(x,x))wr[x,y]}, {(∂_(y,y))wr[x,y]}, {2 (∂_(x,y))wr[x,y]}}));          Cr=(({{Crx}, {Cry}, {Crxy}}));

(*Energia di Deformazione*)
Uf=(1/2)(∫_0^a)((∫_0^a)Transpose[Cr].Df.Cr\[DifferentialD]x)\[DifferentialD]y;

(*Energia dei Carichi*)
W=-P wr[a/2,a/2];

Λ=Solve[{(∂_Λ)(W+Uf)==0},{Λ}][[1,1,2]];

Plot3D[wr[x,y],{x,0,a},{y,0,a},AxesLabel->{"x","y","w"},ImageSize->400]ContourPlot[wr[x,y],{x,0,a},{y,0,a},AxesLabel->{"x","y","z"},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,20},PlotLabel->Style["w (mm)",16]]

⊳ Momenti, tagli e reazioni

Il grafico di My e Ty saranno simmetrici a Mx e Tx quindi non verranno graficati; invece Rx e Ry saranno uguali.

(* MOMENTI *)
(({{Mrx}, {Mry}, {Mrxy}}))=Df.Cr;

(* TAGLIO *)
Trx=B (∂_x)(Crx+Cry);
Try=B (∂_y)(Crx+Cry);

(*REAZIONI sul BORDO *)
Rrx=Trx+(∂_y)Mrxy;
Rry=Try+(∂_x)Mrxy;

(* REAZIONI negli ANGOLI *)
R=2 Abs[Mrxy/.{x->0,y->0}]

ContourPlot[Mrx,{x,0,a},{y,0,a},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,15},PlotLabel->Style["Mx (MPa)",16]]Plot3D[Mrx,{x,0,a},{y,0,a},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain"]
ContourPlot[Mrxy,{x,0,a},{y,0,a},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,15},PlotLabel->Style["Mxy (MPa)",16]]Plot3D[Mrxy,{x,0,a},{y,0,a},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain"]
ContourPlot[Trx,{x,0,a},{y,0,a},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,15},PlotLabel->Style["Tx (MPa)",16]]Plot3D[Trx,{x,0,a},{y,0,a},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain"]
Plot[Rry/.y->0,{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel -> {x, "Ry"},GridLines->Automatic,ImageSize->400,PlotLabel->Style["Ry (y=0)",16]]

Soluzione mediante serie trigonemetriche

w[x_,y_]=((4 P (a^2) )/((π^4)B))(∑_(m=1)^5)(∑_(n=1)^5)((Sin[((m π )/2)]Sin[((n π)/2)])/((((m^2)+(n^2)))^2))Sin[((m π x)/a)]Sin[((n π y )/a)];

(* CURVATURE *)
(({{Cx}, {Cy}, {Cxy}}))=(({{-(∂_(x,x))w[x,y]}, {-(∂_(y,y))w[x,y]}, {-2 (∂_(x,y))w[x,y]}}));

(* MOMENTI *)
M=(({{Mx}, {My}, {Mxy}}));         (({{Mx}, {My}, {Mxy}}))=Df.(({{Cx}, {Cy}, {Cxy}}));

(* TAGLIO *)
Tx=B (∂_x)(Cx+Cy);
Ty=B (∂_y)(Cx+Cy);

(*REAZIONI sul BORDO *)
Rx=Tx+(∂_y)Mxy;
Ry=Ty+(∂_x)Mxy;

Plot[{w[x,y]/.y->a/2,wr[x,y]/.y->a/2},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "w"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["w (y=a/2)",16]]Plot[{Mx/.y->a/2,Mrx/.y->a/2},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "Mx"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["Mx (y=a/2)",16]]Plot[{Tx/.y->a/2,Trx/.y->a/2},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "Tx"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["Tx (y=a/2)",16]]Plot[{Ry/.y->0,Rry/.y->0},{x,0,a},PlotRange->All,PlotStyle->Thick, 
 AxesLabel ->{x, "Ry"},GridLines->Automatic,ImageSize->400,PlotLegend->{"serie","Ritz"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25,PlotLabel->Style["Ry (y=0)",16]]

Confronto con lastra circolare

wl[r_]=.;

t[r_]=(P/(2π r )); 
 
(({{cr}, {cθ}}))=(({{-(∂_(r,r))wl[r]}, {-(1/r)(∂_r)wl[r]}}));      (({{mr[r_]}, {mθ[r_]}}))=B(({{1, ν}, {ν, 1}})).(({{cr}, {cθ}}));

eq=r(∂_r)mr[r]+mr[r]-mθ[r]==-t[r] r;
Chop[DSolve[{      eq,
			wl[Req]==0,
			wl'[0]==0,
			mr[Req]==0
},wl[r],r],
(10^(-20))]
wl[r_]=%[[1,1,2]];

RevolutionPlot3D[wl[r],{r,0,Req},ImageSize->400,Mesh->20,MeshFunctions->{#3&},ColorFunction->"GreenBrownTerrain",PlotLabel->Style["w",16]]Plot[{mr[r],mθ[r]},{r,0,Req},AxesOrigin->{0,0},PlotStyle->Thick, 
 AxesLabel ->{x},GridLines->{{100,200,300,400,500,Req},Automatic},ImageSize->400,PlotLegend->{"mr","mθ"},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.25]

Plot[{Mx/.{x->a/2,y->r+a/2},mr[r]},{r,0,Req},PlotStyle->Thick,PlotRange->{{0,Req},Automatic},ImageSize->500,PlotLegend->{"■ Mx ","● mr "},LegendShadow->None,LegendPosition->{0.55,0.34},LegendSize->0.3,PlotLabel->Style["Confronto",16],GridLines->{{100,200,300,400,500,Req},Automatic}]

21 - Cubo con pressione interna

Show[Graphics3D[{Transparent,EdgeForm[Directive[Thick]],Cuboid[{-500,-500,-1000},{500,500,0}]},Boxed->False,Axes->True,AxesOrigin->{0,0,0},Ticks->{{0,{600,"x"}},{{700,"y"}},{{500,"z"}}}],Graphics3D[{Arrowheads[.03],Arrow[{{0,0,0},{700,0,0}}],Arrow[{{0,0,0},{0,800,0}}],Arrow[{{0,0,-200},{0,0,500}}]}],ImageSize->400]

Metodo di Ritz

Assumiamo l'andamento dello spostamento, a meno di una coztante Z che calcoleremo mediante il principio di stazionarieta dell'energia

w[x_,y_]=Z(((((a^2)/4)-(x^2)))^2)(((((a^2)/4)-(y^2)))^2);

(Subscript[D, STP])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));

Cr=(({{(Subscript[c, x])}, {(Subscript[c, y])}, {(Subscript[c, xy])}}));      (({{(Subscript[c, x])}, {(Subscript[c, y])}, {(Subscript[c, xy])}}))=(({{-(∂_(x,x))w[x,y]}, {-(∂_(y,y))w[x,y]}, {-2 (∂_(x,y))w[x,y]}}));

M=(({{(Subscript[m, x])}, {(Subscript[m, y])}, {(Subscript[m, xy])}}));       (({{(Subscript[m, x])}, {(Subscript[m, y])}, {(Subscript[m, xy])}}))=J (Subscript[D, STP]).(({{(Subscript[c, x])}, {(Subscript[c, y])}, {(Subscript[c, xy])}}));

(* energia di deformazione *)
U=(1/2)(∫_(-a/2)^(a/2))(∫_(-a/2)^(a/2))Transpose[Cr].(J (Subscript[D, STP])).Cr\[DifferentialD]x\[DifferentialD]y;

(* lavoro delle forze esterne *)
W=-(∫_(-a/2)^(a/2))(∫_(-a/2)^(a/2))p w[x,y]\[DifferentialD]x\[DifferentialD]y;

Solve[(∂_Z)U+(∂_Z)W==0,Z]
Z=%[[1,1,2]];

Print["Freccia al centro: f= ",Simplify[w[0,0]]/(-1+(ν^2))*J Ε/B//N," \n freccia esatta:   f= ",-0.00126((p (a^4))/B)]

⊳ Dati

a=1000; ν=0.3; s=10;  Ε=206000;  p=0.1;
J= ((s^3)/(12 ));

Plot3D[w[x,y],{x,-a/2,a/2},{y,-a/2,a/2},AxesLabel->{"x","y","w"},ImageSize->400]ContourPlot[w[x,y],{x,-a/2,a/2},{y,-a/2,a/2},AxesLabel->{"x","y","z"},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,10},PlotLabel->Style["w (mm)",16]]

tensioni

(({{(Subscript[ϵ, xx])}, {(Subscript[ϵ, yy])}, {(Subscript[γ, xy])}}))=-z Cr;          (Subscript[ϵ, f])=(({{(Subscript[ϵ, xx])}, {(Subscript[ϵ, yy])}, {(Subscript[γ, xy])}}));     
(({{(Subscript[σ, xx])}, {(Subscript[σ, yy])}, {(Subscript[τ, xy])}}))=(Subscript[D, STP]).(Subscript[ϵ, f]);         (Subscript[σ, f])[z_]=(({{(Subscript[σ, xx])}, {(Subscript[σ, yy])}, {(Subscript[τ, xy])}}));

⊳ Tensioni membranali
La forza che agisce sulla lastra adiacente il bordo è uguale ad 1/4 del totale della forza che agisce su tale lastra (si scarica su 4 bordi).

(Subscript[σ, n])=((p (a^2))/(4a s));

Calcoliamo invece la tensione dovuta alla flessione nel punto di massimo, cioè per z=s/2  (avendo preso z=0 come piano medio della lastra)

(({{(Subscript[σ, fx])}, {(Subscript[σ, fy])}, {(Subscript[τ, max])}}))=(Subscript[σ, f])[s/2];

(({{(Subscript[σ, xtot])}, {(Subscript[σ, ytot])}}))=(({{(Subscript[σ, fx])+(Subscript[σ, n])}, {(Subscript[σ, fy])+(Subscript[σ, n])}}));          (Subscript[σ, VM])[x_,y_]=(Sqrt[((Subscript[σ, xtot])^2)+((Subscript[σ, ytot])^2)-(Subscript[σ, xtot])(Subscript[σ, ytot])+3((Subscript[τ, max])^2)]);

Plot3D[(Subscript[σ, VM])[x,y],{x,-a/2,a/2},{y,-a/2,a/2},AxesLabel->{"x","y","w"},ImageSize->400,ColorFunction->(ColorData["Rainbow"][#3]&)]ContourPlot[(Subscript[σ, VM])[x,y],{x,-a/2,a/2},{y,-a/2,a/2},ImageSize->300,ContourLabels->Function[{x,y,z},Text[z,{x,y}]],BoundaryStyle->{Black,Thick},ColorFunction->"Rainbow",Contours->{Automatic,10},PlotLabel->Style["(Subscript[σ, VM]) (MPa)",16]]

Calcoliamo la tenione massima, che sarà nella mezzeria dei bordi

Print["(Subscript[σ, max])= (Subscript[σ, VM])[0,a/2]= ",(Subscript[σ, VM])[0,a/2]//Round," MPa \n"]

Sfera equivalente

Req=(((3/(4π))(a^3))^(1/3))//N

(Subscript[σ, 1])=(Subscript[σ, 2])=((p Req)/(2 s));     (Subscript[σ, 3])=-p/2;
(Subscript[σ, sf])=(1/(Sqrt[2]))(Sqrt[((((Subscript[σ, 1])-(Subscript[σ, 2])))^2)+((((Subscript[σ, 3])-(Subscript[σ, 2])))^2)+((((Subscript[σ, 1])-(Subscript[σ, 3])))^2)])MPa

Come si può vedere, la tensione massima sopportata da una sfera con stessa area, è nettamente inferiore

Lastra equivalente

Req=(a/(Sqrt[π]))//N    (* Raggio equivalente, che rende uguali le aree *)

Calcoliamo le tensioni di una lastra circolare incastrata

B=((Ε J)/(1-(ν^2)));        t[r_]=((p r)/(2 ));
 
(({{cr}, {cθ}}))=(({{-(∂_(r,r))v[r]}, {-(1/r)(∂_r)v[r]}}));     (({{mr[r_]}, {mθ[r_]}}))=B(({{1, ν}, {ν, 1}})).(({{cr}, {cθ}}));

eq=r(∂_r)mr[r]+mr[r]-mθ[r]==-t[r] r;


Chop[DSolve[{      eq,
			v[Req]==0,
			v'[Req]==0,
			v'[0]==0
},v[r],r],
(10^(-12))]
v[r_]=%[[1,1,2]];

w[r_]=If[r>a/2,Null,w[x,y]/.{x->0,y->r}];
mx[r_]=If[r>a/2,Null,(Subscript[m, x])/.{x->0,y->r}];

Plot[{w[r],v[r]},{r,0,Req},PlotStyle->Thick,PlotRange->{{0,Req}},ImageSize->450,PlotLegend->{"■ w ","● v "},LegendShadow->None,LegendPosition->{0.5,0.3},LegendSize->0.3,PlotLabel->Style["Confronto",16],GridLines->{{100,200,300,400,500,Req},Automatic}]Plot[{mx[r],mr[r],mθ[r]},{r,0,Req},PlotStyle->Thick,PlotRange->{{0,Req}},ImageSize->450,PlotLegend->{"■ mx ","● mr ","● mθ"},LegendShadow->None,LegendPosition->{0.5,0.3},LegendSize->0.3,GridLines->{{100,200,300,400,500,Req},Automatic}]

⊳ Calcolo delle tensioni

H=Solve[{4(a^3)==π (Req^2) Hi },{Hi}][[1,1,2]];     (* altezza per avere un volume uguale al cubo *)

σn=(1/2)((p(2 Req π H))/((2 π Req s)));   (* tensione membranale *)

(({{σr[r_,z_]}, {σθ[r_,z_]}}))=z(({{mr[r]}, {mθ[r]}}))/J;

(* COMPONGO con Von Mises *)
σVMlastra[r_,z_]= (1/(Sqrt[2]))(Sqrt[(((σr[r,s]-σθ[r,s]))^2)+(((σθ[r,s]-σn))^2)+(((σn-σθ[r,s]))^2)]);

Plot[σVMlastra[r,s/2],{r,0,Req},ImageSize->400,PlotStyle->Thick,PlotLabel->Style["Tensione composta secondo Von Mises",16],AxesOrigin->{0,0},GridLines->{{100,200,300,400,500,Req},{50,100,150,200,250}},Filling->Axis]
Print["(Subscript[σ, max])= (Subscript[σ, VM])[r,s/2]: ",Chop[Maximize[σVMlastra[r,s/2],r],1]]

22 - Nastro trasportatore

Risolvere il nastro trasportatore riportato in figura.

Di cui si riporta un disegno della sezione del tamburo.

⊳ Dati

Ε=206000;    g=9.806m/(sec^2);     b=750mm;     a=300mm;     (Subscript[R, t])=300mm;

l=100m;               (* Lunghezza del nastro *)
s=20mm;              (* spessore della lastra laterale del tamburo *)
k=0.07;                (* coefficiente relativo al nastro *)
H=0;                       (* H è il dislivello del nastro *)
(Subscript[R, p02])=360MPa;     (* Tensione di snervamento del materiale *)
FS=3;                     (* fattore di sicurezza dell' albero *)

S=0.15(((2b (10^(-3))))^2);    (* Sezione occupata dal materiale trasportato in (m^2)*)
γ=1000 kg/(m^3);            (* Densità materiale trasportato sul nastro trasportatore *)
v=5m/sec;                  (* Velocità di avanzamento natro *)
G=3.6S v γ ;                 (* Portata del nastro Tonnellate/Ora *) 

Ν=(k l+H)((g G)/3.6);     Print["Potenza installata: N= ",Ν (10^(-3))//Round," kW"]
T=(Ν/v);                           Print["Tiro del nastro: T= ",T (10^(-3))//Round," kN\n"]

⊳ Calcolo del raggio dell'albero

(Subscript[M, f,max])=T a;     (Subscript[J, A])=π(((Subscript[R, A])^4)/4);     (Subscript[σ, f,max])=((Subscript[M, f,max])/(Subscript[J, A]))(Subscript[R, A]);         FindRoot[((Subscript[R, p02])/FS)==(Subscript[σ, f,max]),{(Subscript[R, A]),1}];          
Print["(Subscript[R, A])=",(Subscript[R, A])=Ceiling[%[[1,2]],5]," mm \n"]

Calcolo del momento incognito M trasemsso tra lastra e tamburo

L'albero inflettendosi, deforma la lastra, la cui rigidezza produce un momento resistente che si trasmette all'incastro con l'albero.	Per calcolare tale momento, calcoleremo la rotazione relativa dell'albero e della lastra dovuti ai carichi esterni e al momento incognito, quindi uguagliandole ricaveremo il valore del momento trasmesso.

⊳ Rotazione dell'albero

(Subscript[ϕ, A])=((((Subscript[M, f,max])-M)b)/(Ε (Subscript[J, A])))

⊳ Rotazione della lastra

Calcoliamo dapprima le equazioni della lastra

(({{(Subscript[c, r])}, {(Subscript[c, θ])}, {(Subscript[c, rθ])}}))=(({{(∂_(r,r))w[r,θ]}, {(1/r)(∂_r)w[r,θ]+(1/(r^2))(∂_(θ,θ))w[r,θ]}, {2((1/(r^2))(∂_θ)w[r,θ]-(1/r)(∂_(r,θ))w[r,θ])}}));     
(Subscript[D, STP])=(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));           (({{(Subscript[m, r])[r_,θ_]}, {(Subscript[m, θ])[r_,θ_]}, {(Subscript[m, rθ])[r_,θ_]}}))=-B (Subscript[D, STP]).(({{(Subscript[c, r])}, {(Subscript[c, θ])}, {(Subscript[c, rθ])}}));
Print["(({{(Subscript[m, r])}, {(Subscript[m, θ])}, {(Subscript[m, rθ])}}))= ",((1/(-B))%//MatrixForm)*-B]

B=((Ε (Subscript[J, L]))/(1-(ν^2)));     (Subscript[J, L])=((s^3)/12);     ν=0.3;

Si utilizza l'equazione di equilibrio di Airy che considera anche la tensione tangenziale prodotta dal momento torcente asimmetrico

Dw2=(∂_(r,r))w[r,θ]+(1/r)(∂_r)w[r,θ]+(1/(r^2))(∂_(θ,θ))w[r,θ];
tr[r_,θ_]=-B(∂_r)Dw2;
tθ[r_,θ_]=-(B/r)(∂_θ)Dw2;

Airy=(∂_(r,r))Dw2+(1/r)(∂_r)Dw2+(1/(r^2))(∂_(θ,θ))Dw2==0;
Collect[%,r]//TraditionalForm

Si assume una soluzione w composta da due funzioni, una del raggio e una dell'angolo, quindi si sostituisce nell'equazione di Airy

w[r_,θ_]=f[r] Cos[θ];

Airy//Simplify//TraditionalForm

A questo punto si risolve l'equazione funzione del raggio con le condizioni al contorno:

	1) per simmetria lo spostamento sia nullo al centro
	2) supposto rigido il tamburo, sia nulla la rotazione esterna della lastra (al raggio (Subscript[R, t]))
	3) essendo la sezione della lastra, corrispondente al raggio dell'albero, rigida si pone:
		w((Subscript[R, A]))=w'((Subscript[R, A]))*(Subscript[R, A])
	    in tal modo si simula il comportamento rigido della sezione centrale che in pratica è come se potesse ruotare.
	4) che i momenti esterni siano in equilibrio con quelli interni, cioè che M trasmesso dall'albero sia uguale alla reazione all'incastro sul  tamburo della lastra

DSolve[Airy,f[r],r]
f[r_]=%[[1,1,2]];

Chop[
sol=Solve[{        w[(Subscript[R, t]),θ]==0,
			((∂_r)w[r,θ]/.r->(Subscript[R, t]))==0,
			(w[r,θ]==(∂_r)w[r,θ](Subscript[R, A]))/.r->(Subscript[R, A]),
			(* Problema assialsimmetrico => mr, mθ e tθ integrati sono nulli *)
			M==(∫_0^(2π))tr[(Subscript[R, t]),θ]((Subscript[R, t])^2)Cos[θ]\[DifferentialD]θ-(∫_0^(2π))(Subscript[m, rθ])[(Subscript[R, t]),θ](Subscript[R, t])Sin[θ]\[DifferentialD]θ     
},{C[1],C[2],C[3],C[4]}]
,(10^(-22))]

w[r_,θ_]=Chop[     w[r,θ]/.{C[2]->sol[[1,1,2]],
						C[1]->sol[[1,2,2]],
						C[3]->sol[[1,3,2]],
						C[4]->sol[[1,4,2]]},(10^(-22))]

La rotazione varrà:

(Subscript[ϕ, L])=((∂_r)w[r,0])/.r->(Subscript[R, A])

A questo punto uguagliando la rotazione dell'alberpo e della lastra ricaviamo il momento incognito trasmesso

Solve[(Subscript[ϕ, A])==(Subscript[ϕ, L]),M]
M=%[[1,1,2]];

RevolutionPlot3D[w[r,θ],{r,(Subscript[R, A]),(Subscript[R, t])},{θ,0,2π},ImageSize->450,Mesh->20,MeshFunctions->{#3&},ColorFunction->"Rainbow",PlotLabel->Style["w",16]]

Calcolo della tensione massima

(({{σr}, {σθ}, {τ}}))=B (Subscript[D, STP]).(-z(({{(Subscript[c, r])}, {(Subscript[c, θ])}, {(Subscript[c, rθ])}})));

Componiamo secondo Von Mises le tensioni e calcoliamomole sulla superficie del disco dove sono massime, quindi calcoliamo la tensione massima

σVM=(Sqrt[((σr)^2)+((σθ)^2)-σr σθ + 3 (τ^2)])/.z->s/2;

Print["(Subscript[σ, max])= ",Maximize[σVM/.r->(Subscript[R, A]),θ]]

RevolutionPlot3D[{σVM},{r,(Subscript[R, A]),(Subscript[R, t])},{θ,0,2π},ImageSize->450,Mesh->20,MeshFunctions->{#3&},ColorFunction->"TemperatureMap",PlotLabel->Style["(Subscript[σ, VM])",16],PlotRange->{Automatic,Automatic,Full}]

24 - Lastra forata sottoposta a flessione

Utilizzando la teoria esposta da Timoshenko: ricaviamo analiticamente la sollecitazione massima in una piastra indefinita soggetta a momento flettente (Subscript[m, 0]) nella direzione di x. Utilizzando le equazioni di Navier calcoleremo due funzioni dello spostamento: la prima sarà (Subscript[w, 1]) della lastra senza foro, la seconda (Subscript[w, 2]) la calcoleremo supponendo di rimuovere il materiale all'interno della periferia del foro e facendo sì che sovrapposta alla prima ripristini le condizioni al contorno della lastra forata.

Calcolo analitico (Timoshenko)

⊳ Calcolo di (Subscript[w, 1])
Procediamo calcolando le curvature dovute a (Subscript[m, 0]) e quindi sostituiamole nell'equazione dello spostamento

(Subscript[D, STP])=(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     Solve[-B (Subscript[D, STP]).(({{(Subscript[c, x])}, {(Subscript[c, y])}, {(Subscript[c, xy])}}))==(({{(Subscript[m, 0])}, {0}, {0}})),{(Subscript[c, x]),(Subscript[c, y]),(Subscript[c, xy])}]
(({{(Subscript[c, x])}, {(Subscript[c, y])}, {(Subscript[c, xy])}}))=(({{%[[1,2,2]]}, {%[[1,3,2]]}, {%[[1,1,2]]}}));

(Subscript[w, 1])[x_,y_]=((Subscript[c, x])/2)(x^2)+((Subscript[c, y])/2)(y^2)+(Subscript[c, 1])x+(Subscript[c, 2])y+(Subscript[c, 3]);

prendendo come riferimento il centro della lastra, le tre costanti si annullano

(Subscript[c, 1])=(Subscript[c, 2])=(Subscript[c, 3])=0;     Print["(Subscript[w, 1])=",Collect[(Subscript[w, 1])[x,y],{(Subscript[m, 0]),B,-1+(ν^2)}]//Simplify]

Passaggio alle coordinate polari:

(({{(Subscript[c, r1])}, {(Subscript[c, θ1])}, {(Subscript[c, rθ1])}}))=(({{(∂_(r,r))(Subscript[w, p1])[r,θ]}, {(1/r)(∂_r)(Subscript[w, p1])[r,θ]+(1/(r^2))(∂_(θ,θ))(Subscript[w, p1])[r,θ]}, {2((1/r)(∂_(r,θ))(Subscript[w, p1])[r,θ]-(1/(r^2))(∂_θ)(Subscript[w, p1])[r,θ])}}));     (({{(Subscript[m, r1])}, {(Subscript[m, θ1])}, {(Subscript[m, rθ1])}}))=-B (Subscript[D, STP]).(({{(Subscript[c, r1])}, {(Subscript[c, θ1])}, {(Subscript[c, rθ1])}}));
(Subscript[w, p1])[r_,θ_]=(Subscript[w, 1])[r Cos[θ],r Sin[θ]];

Calcoliamo le reazioni vincolari, considerando che i tagli saranno nulli in questo caso

(Subscript[t, r1])=0;     (Subscript[t, θ1])=0;
(Subscript[r, r1])=(Subscript[t, r1])+(1/r)(∂_θ)(Subscript[m, rθ1]);     (Subscript[r, θ1])=(Subscript[t, θ1])+(∂_r)(Subscript[m, rθ1]);

⊳ Calcolo di (Subscript[w, 2])
Scriviamo l'equazione del secondo spostamento che soddisfa le condizioni al contorno per la lastra infinita
{ ({{r=∞, =>, M=0, ,T=0}})

(Subscript[w, p2])[r_,θ_]=-(((Subscript[m, 0]) (a^2))/(2 B))(a1 Log[r]+(a2+ a3((a^2)/(r^2)))Cos[2θ]);
(* MOMENTI *)
(({{(Subscript[c, r2])}, {(Subscript[c, θ2])}, {(Subscript[c, rθ2])}}))=(({{(∂_(r,r))(Subscript[w, p2])[r,θ]}, {(1/r)(∂_r)(Subscript[w, p2])[r,θ]+(1/(r^2))(∂_(θ,θ))(Subscript[w, p2])[r,θ]}, {2(-(1/(r^2))(∂_θ)(Subscript[w, p2])[r,θ]+(1/r)(∂_(r,θ))(Subscript[w, p2])[r,θ])}}));       (({{(Subscript[m, r2])}, {(Subscript[m, θ2])}, {(Subscript[m, rθ2])}}))=-B (Subscript[D, STP]).(({{(Subscript[c, r2])}, {(Subscript[c, θ2])}, {(Subscript[c, rθ2])}}));
(*TAGLIO*)
Δw2=(∂_(r,r))(Subscript[w, p2])[r,θ]+(1/r)(∂_r)(Subscript[w, p2])[r,θ]+(1/(r^2))(∂_(θ,θ))(Subscript[w, p2])[r,θ];
(Subscript[t, r2])=-B(∂_r)Δw2;
(Subscript[t, θ2])=-(B/r)(∂_θ)Δw2;
(* REAZIONI VINCOLARI *)
(Subscript[r, r2])=(Subscript[t, r2])+(1/r)(∂_θ)(Subscript[m, rθ2]);
(Subscript[r, θ2])=(Subscript[t, θ2])+(∂_r)(Subscript[m, rθ2]);

Quindi per calcolare le costanti di (Subscript[w, 2]) imponiamo le condizioni al contorno ai due spostamenti sovraposti, che daranno un momento ed una reazione radiali nulli sul bordo del foro:	(Piecewise[{{r=a, (Subscript[m, r1])+(Subscript[m, r2])=0}, {r=a, (Subscript[r, r1])+(Subscript[r, r2])}}])

(Subscript[r, r1a])=(Subscript[r, r1])/.r->a;          (Subscript[m, r1a])=(Subscript[m, r1])/.r->a;
(Subscript[r, r2a])=(Subscript[r, r2])/.{r->a};     (Subscript[m, r2a])=(Subscript[m, r2])/.{r->a};

(Subscript[m, rTot])=(Subscript[m, r1a])+(Subscript[m, r2a])//Simplify
(Subscript[r, rTot])=(Subscript[r, r1a])+(Subscript[r, r2a])//Simplify

(* verifichiamo l'equazione del momento radiale anche per un valore qualsiasi di θ *)
(Subscript[m, rI])=(Subscript[m, rTot])/.{θ->π/6};

sol1=Solve[{(Subscript[m, rI])==0,(Subscript[m, rTot])==0,(Subscript[r, rTot])==0},{a1,a2,a3}]//Simplify
(({{a1}, {a2}, {a3}}))=(({{%[[1,1,2]]}, {%[[1,2,2]]}, {%[[1,3,2]]}}));

(Subscript[w, tot])[r_,θ_]=(Subscript[w, p1])[r,θ]+(Subscript[w, p2])[r,θ];     (Subscript[w, TOT])[x_,y_]=(Subscript[w, tot])[(Sqrt[(x^2)+(y^2)]),ArcTan[y/x]];

⊳ Calcolo della tensione massima
introduciamo il rapporto λ=(a/s)

J=((s^3)/12);      B=((Ε J)/(1-(ν^2)));      
dat={Ε->200000,ν->1/3,a->λ,(Subscript[m, 0])->100,s->1};

vediamo i grafici per un rapporto di λ pari a 3 e quindi un corrispondente raggio del foro

Rforo=3;
(* Spostamento *)     ((Subscript[w, TOT])[x,y]/.dat)//FullSimplify;
Plot3D[%/.λ->Rforo,{x,-10,10},{y,-10,10},RegionFunction->Function[{x,y,z},Rforo<(Sqrt[(x^2)+(y^2)])],ImageSize->400,AxesLabel->{"x","y","w"}]

(({{(Subscript[M, tr])[r_,θ_]}, {(Subscript[M, tθ])[r_,θ_]}, {(Subscript[M, trθ])[r_,θ_]}}))=(({{(Subscript[m, r1])}, {(Subscript[m, θ1])}, {(Subscript[m, rθ1])}}))+(({{(Subscript[m, r2])}, {(Subscript[m, θ2])}, {(Subscript[m, rθ2])}})) ;     (Subscript[M, tot])[r_,θ_]=(({{(Subscript[M, tr])[r,θ]}, {(Subscript[M, tθ])[r,θ]}, {(Subscript[M, trθ])[r,θ]}}));
(Subscript[M, TOT])[x_,y_]=(Subscript[M, tot])[(Sqrt[(x^2)+(y^2)]),ArcTan[y/x]]/.dat;

ContourPlot[(Subscript[M, TOT])[x,y][[1,1]]/.λ->Rforo,{x,-10,10},{y,-10,10},RegionFunction->Function[{x,y,z},Rforo<(Sqrt[(x^2)+(y^2)])],ImageSize->280,ContourLabels->Function[{x,y,z},Text[z,{x,y},Background->White]],Frame->False,ImageSize->300,BoundaryStyle->{Black,Thick},ColorFunction->"TemperatureMap",Contours->{Automatic,20}]ContourPlot[(Subscript[M, TOT])[x,y][[2,1]]/.λ->Rforo,{x,-10,10},{y,-10,10},RegionFunction->Function[{x,y,z},Rforo<(Sqrt[(x^2)+(y^2)])],ImageSize->280,ContourLabels->Function[{x,y,z},Text[z,{x,y},Background->White]],Frame->False,ImageSize->300,BoundaryStyle->{Black,Thick},
ColorFunction->"TemperatureMap",Contours->{Automatic,30}]

Il fattore di concentrazione si calcola per il massimo valore di (Subscript[M, tθ])[a] che sarà per θ=(π/2)

(Subscript[M, max])=(Subscript[M, tθ])[a,π/2]//Simplify

Il fattore di concentrazione se si trascura il taglio, come si osserva, è indipendente dal rapporto λ:

(Subscript[k, m])=((Subscript[M, max])/(Subscript[m, 0]));      Print["Coefficiente analitico\t (Subscript[k, m])= ",(Subscript[k, m])=(Subscript[k, m])/.dat//Simplify//N,"\n"]

Taglio

(Subscript[t, tot])[r_,θ_]=(Subscript[t, θ1])+(Subscript[t, θ2]);     (Subscript[t, xy])[x_,y_]=(Subscript[t, tot])[(Sqrt[(x^2)+(y^2)]),ArcTan[y/x]]/.dat;
Plot3D[(Subscript[t, xy])[x,y]/.λ->Rforo,{x,-5,5},{y,-5,5},RegionFunction->Function[{x,y,z},Rforo<(Sqrt[(x^2)+(y^2)])],ImageSize->300,PlotRange->All,ColorFunction->"TemperatureMap"]

θm=Maximize[(Subscript[t, tot])[a,θ]/.dat/.λ->1,θ][[2,1,2]];       Print["θm= ",((θm//N)/π//Rationalize)π]

(Subscript[t, max])=(Subscript[t, tot])[a,θm];     ((Subscript[t, max])/(Subscript[M, max]))/.dat

Quindi il coefficientedi concentrazione degli sforzi per valori di λ piccoli non può più essere calcolato indipendentemente dal taglio.

Coefficienti del Peterson

Confrontiamo il risultato analitico ottenuti con quelli ricavati da Peterson:

(Subscript[k, Pet])[λ_]=3-0.947(Sqrt[2λ])+0.384λ;

Plot[{(Subscript[k, Pet])[λ],(Subscript[k, m])},{λ,0,3},AxesOrigin->{0,0},GridLines->Automatic,PlotStyle->Thick,PlotRange->{0,3},ImageSize->500,AxesLabel->{λ}]

A - Gauss

pG=3;

ord=2 pG-1;   Print["ordine dei polinomi: ",ord]
pol=ConstantArray[0,ord+1];
For[i=0,i≤ord, i++,pol[[i+1]]=(ξ^i)(Subscript[c, i])]; Print[pol]
poly=ConstantArray[0,{pG,ord+1}];
For[j=1,j≤pG,j++,{For[i=0,i≤ord,i++,poly[[j,i+1]]=((Subscript[ξ, j])^i)(Subscript[c, i])],Print[poly[[j]]]}]

(Subscript[I, e])=(∫_(-1)^(+1))pol\[DifferentialD]ξ;     (OverTilde[I]) = (∑_(j=1)^pG)(Subscript[H, j])poly[[j]];
Print["(Subscript[I, e])= ",(Subscript[I, e])//MatrixForm,"\t (OverTilde[I])= ",(OverTilde[I])//MatrixForm]

x=ConstantArray[0,pG]; h=ConstantArray[0,pG];
For[j=1,j≤pG,j++,{x[[j]]=(Subscript[ξ, j]),h[[j]]=(Subscript[H, j])}];
pp=Join[x,h]
sol=Solve[(Subscript[I, e]) == (OverTilde[I]), pp]

For[i=1,i≤pG,i++,{(Subscript[H, i])=sol[[1,pG+1-i,2]],(Subscript[ξ, i])=sol[[1,i+pG,2]],Print[i,") Pto: ",(Subscript[ξ, i]),"\t Peso: ",(Subscript[H, i])]}]

(Subscript[I, Gauss])=(∑_(i=1)^pG)(Subscript[H, i])*f[(Subscript[ξ, i])]

B - Assemblaggio automatico degli elementi

Elementi trave

in serie

el=3;

nodi=(el+1);   (Subscript[n, loc])=4;   (Subscript[n, glob])=2nodi;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{
For[j=1,j≤4,j++,H[[i,j,j +(i-1) 2]]=1],
Print[H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

(Subscript[K, loc])[J_,l_]=((Ε J)/(l^3))(({{12, 6 l, -12, 6 l}, {6 l, 4 (l^2), -6 l, 2 (l^2)}, {-12, -6 l, 12, -6 l}, {6 l, 2 (l^2), -6 l, 4 (l^2)}}));
For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc])[(Subscript[J, i]),(Subscript[l, i])][[jc,jr]]]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

in parallelo

el=3;   nod=3;
(Subscript[el, 1])=(({{1}, {2}}));  (Subscript[el, 2])=(({{2}, {3}}));  (Subscript[el, 3])=(({{3}, {2}}));

(Subscript[n, loc])=4;   (Subscript[n, glob])=2nod;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤2,j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

(Subscript[K, loc])[J_,l_]=((Ε J)/(l^3))(({{12, 6 l, -12, 6 l}, {6 l, 4 (l^2), -6 l, 2 (l^2)}, {-12, -6 l, 12, -6 l}, {6 l, 2 (l^2), -6 l, 4 (l^2)}}));
For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc])[(Subscript[J, i]),(Subscript[l, i])][[jc,jr]]]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

TL1

Strutturale

(Subscript[n, fdf])=3;   el=2;

CooNod=(({{x1, x2, x3}, {y1, y2, y3}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{ (Subscript[x, i])=CooNod[[1,i]],
											(Subscript[y, i])=CooNod[[2,i]]}]

(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}}))=(({{ξ}, {η}, {1-ξ-η}})); 

X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=(1/2)Det[J];    

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

(Subscript[b, s])=(({{(Overscript[(Subscript[n, j]), x]), 0}, {0, (Overscript[(Subscript[n, j]), y])}, {(Overscript[(Subscript[n, j]), y]), (Overscript[(Subscript[n, j]), x])}}));     For[j=1,j≤(Subscript[n, fdf]),j++,If[j==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]

(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     ν=0.3;

(Subscript[K, TL1])=A(Transpose[B].(Subscript[D, SPT]).B);

(Subscript[K, loc,1])=(Subscript[K, TL1])/.{     x1->1,x2->4,x3->2,
			y1->1,y2->1,y3->3};
(Subscript[K, loc,2])=(Subscript[K, TL1])/.{     x1->4,x2->2,x3->4,
			y1->1,y2->3,y3->4};
%//MatrixForm

nod=4;
(Subscript[el, 1])=(({{1}, {2}, {3}}));  (Subscript[el, 2])=(({{2}, {3}, {4}}));

(Subscript[n, loc])=6;   (Subscript[n, glob])=2nod;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm

Termico

(Subscript[n, fdf])=3;   el=2;

CooNod=(({{x1, x2, x3}, {y1, y2, y3}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{ (Subscript[x, i])=CooNod[[1,i]],
											(Subscript[y, i])=CooNod[[2,i]]}]

(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}}))=(({{ξ}, {η}, {1-ξ-η}})); 

X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=(1/2)Det[J];    

(Subscript[b, t])=(({{(Overscript[(Subscript[n, j]), x])}, {(Overscript[(Subscript[n, j]), y])}}));     For[j=1,j≤(Subscript[n, fdf]),j++,If[j==1,B=(Subscript[b, t]),B=Join[B,(Subscript[b, t]),2]]]
Print[B//MatrixForm]
For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

(Subscript[K, LT])=A k(Transpose[B].B);

(Subscript[K, lt,1])=(Subscript[K, LT])/.{     x1->1,x2->4,x3->2,
			y1->1,y2->1,y3->3};
(Subscript[K, lt,2])=(Subscript[K, LT])/.{     x1->4,x2->2,x3->4,
			y1->1,y2->3,y3->4};
%//MatrixForm

nod=4;
(Subscript[el, 1])=(({{1}, {2}, {3}}));  (Subscript[el, 2])=(({{2}, {3}, {4}}));

(Subscript[n, loc])=3;   (Subscript[n, glob])=nod;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,j,(Subscript[el, i])[[j]]]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, lt,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm

QL1

Strutturale

(Subscript[n, fdf])=4;    el=2;
(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     ν=0.3;

CooNod=(({{x1, x2, x3, x4}, {y1, y2, y3, y4}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{ (Subscript[x, i])=CooNod[[1,i]],
											(Subscript[y, i])=CooNod[[2,i]]}]

(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}}))=(1/4)(({{(1-ξ)(1-η)}, {(1+ξ)(1-η)}, {(1+ξ)(1+η)}, {(1-ξ)(1+η)}})); 

X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=Det[J];     

i=.;   (Subscript[b, s])=(({{(Overscript[(Subscript[n, i]), x]), 0}, {0, (Overscript[(Subscript[n, i]), y])}, {(Overscript[(Subscript[n, i]), y]), (Overscript[(Subscript[n, i]), x])}}));     For[i=1,i≤(Subscript[n, fdf]),i++,If[i==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]
Print[B//MatrixForm]
For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

(Subscript[CN, 1])={   x1->1,x2->2,x3->2,x4->1,
	y1->1,y2->1,y3->3,y4->3};
(Subscript[CN, 2])={   x1->2,x2->3,x3->3,x4->2,
	y1->1,y2->1,y3->3,y4->3};

For[i=1,i≤el,i++,{(Subscript[b, i])[ξ_,η_]=B/.(Subscript[CN, i]), (Subscript[a, i])[ξ_,η_]=A/.(Subscript[CN, i]),
					(Subscript[K, loc,i])=(∫_(-1)^(+1))((∫_(-1)^(+1))(Transpose[(Subscript[b, i])[ξ,η]].(Subscript[D, SPT]).(Subscript[b, i])[ξ,η])(Subscript[a, i])[ξ,η]\[DifferentialD]ξ)\[DifferentialD]η;
Print[(Subscript[K, loc,i])//MatrixForm]}]

nod=6;  
(Subscript[el, 1])=(({{1}, {2}, {5}, {6}}));  (Subscript[el, 2])=(({{2}, {3}, {4}, {5}}));

(Subscript[n, loc])=8;   (Subscript[n, glob])=2nod;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm

(Subscript[ξg, 1])=(Subscript[ξg, 4])=(Subscript[ηg, 1])=(Subscript[ηg, 2])=-1/(Sqrt[3]);   (Subscript[ξg, 2])=(Subscript[ξg, 3])=(Subscript[ηg, 3])=(Subscript[ηg, 4])=+1/(Sqrt[3]);   
For[i=1,i≤el,i++,{  (Subscript[K, l2G,i])=(∑_(j=1)^4)(Subscript[a, i])[(Subscript[ξg, j]),(Subscript[ηg, j])]Transpose[(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[D, SPT]).(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])],
Print[(Subscript[K, l2G,i])//MatrixForm]}]

(Subscript[K, l2G,1])-(Subscript[K, loc,1])//Chop

Termico

(Subscript[n, fdf])=4;    el=2;

CooNod=(({{x1, x2, x3, x4}, {y1, y2, y3, y4}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{ (Subscript[x, i])=CooNod[[1,i]],
											(Subscript[y, i])=CooNod[[2,i]]}]

(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}}))=(1/4)(({{(1-ξ)(1-η)}, {(1+ξ)(1-η)}, {(1+ξ)(1+η)}, {(1-ξ)(1+η)}})); 

X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=Det[J];     

(Subscript[b, t])=(({{(Overscript[(Subscript[n, j]), x])}, {(Overscript[(Subscript[n, j]), y])}}));     For[j=1,j≤(Subscript[n, fdf]),j++,If[j==1,B=(Subscript[b, t]),B=Join[B,(Subscript[b, t]),2]]]
Print[B//MatrixForm]
For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

(Subscript[CN, 1])={   x1->1,x2->2,x3->2,x4->1,
	y1->1,y2->1,y3->3,y4->3};
(Subscript[CN, 2])={   x1->2,x2->3,x3->3,x4->2,
	y1->1,y2->1,y3->3,y4->4};

For[i=1,i≤el,i++,{(Subscript[b, i])[ξ_,η_]=B/.(Subscript[CN, i]), (Subscript[a, i])[ξ_,η_]=A/.(Subscript[CN, i]),
					(Subscript[K, lt,i])=k(∫_(-1)^(+1))((∫_(-1)^(+1))(Transpose[(Subscript[b, i])[ξ,η]].(Subscript[b, i])[ξ,η])(Subscript[a, i])[ξ,η]\[DifferentialD]ξ)\[DifferentialD]η;
Print[(Subscript[K, lt,i])//MatrixForm]}]

nod=6;  
(Subscript[el, 1])=(({{1}, {2}, {5}, {6}}));  (Subscript[el, 2])=(({{2}, {3}, {4}, {5}}));

(Subscript[n, loc])=4;   (Subscript[n, glob])=nod;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,j,(Subscript[el, i])[[j]]]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, lt,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm

(Subscript[ξg, 1])=(Subscript[ξg, 4])=(Subscript[ηg, 1])=(Subscript[ηg, 2])=-1/(Sqrt[3]);   (Subscript[ξg, 2])=(Subscript[ξg, 3])=(Subscript[ηg, 3])=(Subscript[ηg, 4])=+1/(Sqrt[3]);   

For[i=1,i≤el,i++,{  (Subscript[K, l2G,i])=k(∑_(j=1)^4)(Subscript[a, i])[(Subscript[ξg, j]),(Subscript[ηg, j])]Transpose[(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])]].(Subscript[b, i])[(Subscript[ξg, j
]),(Subscript[ηg, j])],
Print[(Subscript[K, l2G,i])//MatrixForm//Simplify]}]

((Subscript[K, l2G,1])-(Subscript[K, lt,1]))//Simplify

TL2

(Subscript[n, fdf])=6;   el=2;

CooNod=(({{x1, x2, x3, x4, x5, x6}, {y1, y2, y3, y4, y5, y6}}));     For[i=1,i≤(Subscript[n, fdf]),i++,{     (Subscript[x, i])=CooNod[[1,i]],
														(Subscript[y, i])=CooNod[[2,i]]}]
(Subscript[L, 1])=1-ξ-η;   (Subscript[L, 2])=ξ;   (Subscript[L, 3])=η;
(({{(Subscript[n, 1])[ξ_,η_]}, {(Subscript[n, 2])[ξ_,η_]}, {(Subscript[n, 3])[ξ_,η_]}, {(Subscript[n, 4])[ξ_,η_]}, {(Subscript[n, 5])[ξ_,η_]}, {(Subscript[n, 6])[ξ_,η_]}}))=(({{(Subscript[L, 1])(2(Subscript[L, 1])-1)}, {(Subscript[L, 2])(2(Subscript[L, 2])-1)}, {(Subscript[L, 3])(2(Subscript[L, 3])-1)}, {4(Subscript[L, 1])(Subscript[L, 2])}, {4(Subscript[L, 2])(Subscript[L, 3])}, {4(Subscript[L, 1])(Subscript[L, 3])}})); 

X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[n, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=(1/2)Det[J];

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[n, i]), x])}, {(Overscript[(Subscript[n, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[n, i])[ξ,η]}, {(∂_η)(Subscript[n, i])[ξ,η]}}))]

(Subscript[b, s])=(({{(Overscript[(Subscript[n, j]), x]), 0}, {0, (Overscript[(Subscript[n, j]), y])}, {(Overscript[(Subscript[n, j]), y]), (Overscript[(Subscript[n, j]), x])}}));     For[j=1,j≤(Subscript[n, fdf]),j++,If[j==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]

CN={     x1->0,x2->2,x3->0,x4->1,x5->1,x6->0,
	y1->0,y2->0,y3->4,y4->0,y5->2,y6->2};
B=B/.CN;    A=A/.CN;

(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     ν=0.3;

(Subscript[K, TL2])=(∫_0^1)(∫_0^(1-ξ))Det[J](Transpose[B].(Subscript[D, SPT]).B)\[DifferentialD]η\[DifferentialD]ξ;

-----------------------------------------------------------------------------------------------------------------------------------

(Subscript[K, loc,2])=(Subscript[K, TL2])/.{     x1->2,x2->2,x3->0,x4->2,x5->1,x6->1,
			y1->4,y2->0,y3->4,y4->2,y5->2,y6->4};

nod=9;
(Subscript[el, 1])=(({{1}, {2}, {3}, {4}, {5}, {6}}));  (Subscript[el, 2])=(({{8}, {2}, {3}, {7}, {5}, {9}}));

(Subscript[n, loc])=12;   (Subscript[n, glob])=2nod;
H=ConstantArray[0,{el,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤el,i++,{For[j=1,j≤(Subscript[n, fdf]),j++,{H[[i,2j-1,(Subscript[el, i])[[j]]2-1]]=1,H[[i,2j,(Subscript[el, i])[[j]]2]]=1}],Print["el",i,H[[i]]//MatrixForm]}]

For[i=1,i≤el,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤el,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^el)(Subscript[K, i,glob]);
%//MatrixForm

For[i=1,i≤el,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc,i])[[jc,jr]]]]]
(Subscript[K, tot])//MatrixForm//FullSimplify//Chop//N

Costruzione di Macchine

1. Calcolo delle molle secondo la norma UNI EN 13906-1

(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Inizializzazione **)

ansIniz=ChoiceDialog[TextCell["Progetto di una molla ad elica cilindrica fabbricata con filo a sezione circolare secondo la norma 
UNI EN 13906-1:2003.  Specifica: molla di compressione avvolta a freddo con diametro di avvolgimento  
massimo limitato: D≤200mm. \n Procedere?"],WindowSize->{Automatic,All}];
If[ToExpression[ansIniz],Null,Quit[]]

<<PlotLegends`;
Off[FindRoot::lstol];
mollaN=0;     
ans0=True;
\[KernelIcon]=0;

MessageDialog[ProgressIndicator[Dynamic[\[KernelIcon]],{0,11},ImageSize->{300,30}],WindowMargins->{{Automatic,0},{Automatic,0}},WindowSize->{All,All}];

(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Grafici, Immagini e Tabelle **)

(* Dati del tipo di acciaio *)
dat2=(({{Ε, G, ρ}, {MPa, MPa, kg/(dm^3)}, {206000, 81500, 7.85}, {206000, 79500, 7.85}, {185000, 70000, 7.9}, {195000, 73000, 7.9}, {185000, 70000, 7.9}}));   

 in=1;(*grado di interpolazione*)

(* EN 10270-1 *)
LL=Interpolation[{{1,1720},{2,1520},{4,1320},{8,1120},{10,1060},{17,Null}},InterpolationOrder->in];  
MM=Interpolation[{{1,1980},{2,1760},{4,1530},{8,1310},{12,1180},{17,1070}},InterpolationOrder->in];
HH=Interpolation[{{1,2230},{2,1980},{4,1740},{8,1490},{12,1350},{17,1220}},InterpolationOrder->in];

(* EN 10270-2 *)
FD=Interpolation[{{1,1810},{2,1670},{4,1540},{8,1380},{12,1280},{17,1250}},InterpolationOrder->in];
TD=Interpolation[{{1,1860},{2,1720},{4,1570},{6,1470},{8,1390},{10,1390},{17,Null}},InterpolationOrder->in];
VD=Interpolation[{{1,2080},{2,1960},{4,1860},{6,1760},{8,1670},{10,1670},{17,Null}},InterpolationOrder->in];

(* EN 10270-3 *)
I1=Interpolation[{{1,2050},{2,1850},{3.5,1650},{6,1500},{10,1350}},InterpolationOrder->in];     (*I1: X10CrNi18-8*)
I1ht=I1[d]+150;     (*Rinvenimento*)
I2=Interpolation[{{1,1800},{2,1600},{3.5,1450},{6,1300},{10,1250}},InterpolationOrder->in];     (*I2: X7CrNiAl17-7*)             
I2ph=I2[d]+250;     (*Precipitation Hardening*)
I3=Interpolation[{{1,1400},{2,1300},{3.5,1300},{6,1250},{10,1200}},InterpolationOrder->in];    (*I3: X1NiCrMoCu25-20-5*)  
I3ht=I3[d]+50;     (*Rinvenimento*)

(* Diagrammi di Goodman *)(*l'indice indica il diametro*)
(Subscript[DH, 10])=Interpolation[{{0,320},{510,710},{710,710}},InterpolationOrder->1];(Subscript[DH, 8])=Interpolation[{{0,350},{550,750},{750,750}},InterpolationOrder->1];
(Subscript[DH, 5])=Interpolation[{{0,390},{600,830},{830,830}},InterpolationOrder->1];(Subscript[DH, 3])=Interpolation[{{0,420},{670,920},{920,920}},InterpolationOrder->1];
(Subscript[DH, 2])=Interpolation[{{0,450},{730,990},{990,990}},InterpolationOrder->1];
(Subscript[Ttp, 10])=Interpolation[{{0,400},{430,710},{710,710}},InterpolationOrder->1];(Subscript[Ttp, 8])=Interpolation[{{0,420},{450,750},{750,750}},InterpolationOrder->1];
(Subscript[Ttp, 5])=Interpolation[{{0,470},{510,830},{830,830}},InterpolationOrder->1];(Subscript[Ttp, 3])=Interpolation[{{0,510},{560,920},{920,920}},InterpolationOrder->1];
(Subscript[Ttp, 2])=Interpolation[{{0,550},{610,1000},{1000,1000}},InterpolationOrder->1];
(Subscript[Tbp, 10])=Interpolation[{{0,360},{370,650},{650,650}},InterpolationOrder->1];(Subscript[Tbp, 8])=Interpolation[{{0,360},{370,650},{650,650}},InterpolationOrder->1];
(Subscript[Tbp, 5])=Interpolation[{{0,380},{410,700},{700,700}},InterpolationOrder->1];(Subscript[Tbp, 3])=Interpolation[{{0,400},{450,770},{770,770}},InterpolationOrder->1];
(Subscript[Tbp, 2])=Interpolation[{{0,450},{490,810},{810,810}},InterpolationOrder->1];
(Subscript[Tb, 10])=Interpolation[{{0,310},{500,650},{650,650}},InterpolationOrder->1];(Subscript[Tb, 8])=Interpolation[{{0,310},{500,650},{650,650}},InterpolationOrder->1];
(Subscript[Tb, 5])=Interpolation[{{0,300},{530,700},{700,700}},InterpolationOrder->1];(Subscript[Tb, 3])=Interpolation[{{0,330},{560,760},{760,760}},InterpolationOrder->1];
(Subscript[Tb, 2])=Interpolation[{{0,350},{610,810},{810,810}},InterpolationOrder->1];
(Subscript[Vb, 7])=Interpolation[{{0,390},{330,650},{650,650}},InterpolationOrder->1];(Subscript[Vb, 5])=Interpolation[{{0,400},{340,670},{670,670}},InterpolationOrder->1];
(Subscript[Vb, 3])=Interpolation[{{0,450},{370,720},{720,720}},InterpolationOrder->1];(Subscript[Vb, 2])=Interpolation[{{0,480},{380,760},{760,760}},InterpolationOrder->1];
(Subscript[Vbp, 7])=Interpolation[{{0,520},{160,650},{650,650}},InterpolationOrder->1];(Subscript[Vbp, 5])=Interpolation[{{0,540},{170,670},{670,670}},InterpolationOrder->1];
(Subscript[Vbp, 3])=Interpolation[{{0,560},{200,720},{720,720}},InterpolationOrder->1];(Subscript[Vbp, 2])=Interpolation[{{0,580},{220,760},{760,760}},InterpolationOrder->1];
(Subscript[X1, 6])=Interpolation[{{0,320},{570,700},{700,700}},InterpolationOrder->1];(Subscript[X1, 4])=Interpolation[{{0,320},{640,750},{750,750}},InterpolationOrder->1];
(Subscript[X1, 3])=Interpolation[{{0,390},{630,800},{800,800}},InterpolationOrder->1];(Subscript[X1, 2])=Interpolation[{{0,430},{700,900},{900,900}},InterpolationOrder->1];
(Subscript[X2, 6])=Interpolation[{{0,350},{440,700},{700,700}},InterpolationOrder->1];(Subscript[X2, 4])=Interpolation[{{0,350},{500,750},{750,750}},InterpolationOrder->1];
(Subscript[X2, 3])=Interpolation[{{0,400},{550,850},{850,850}},InterpolationOrder->1];(Subscript[X2, 2])=Interpolation[{{0,450},{600,950},{950,950}},InterpolationOrder->1];

(*descrizione dei materiali*)
SL="Acciao di classe SL  EN 10270-1, patentato e trafilato          \n     -";
SM="Acciao di classe SM  EN 10270-1, patentato e trafilato          \n     -";
SH="Acciao di classe SH  EN 10270-1, patentato e trafilato          \n     -";
FDC="Acciao di classe FDC  EN 10270-2, bonificato con tempra in olio\n     -";
dh="Acciao di classe DH  EN 10270-1, patentato e trafilato          \n     -";
ttp="Acciao di classe TD  EN 10270-2, patentato e trafilato         \n   pallinatura";
tbp="Acciao di classe TD  EN 10270-2, bonificato con tempra in olio \n   pallinatura";
tb="Acciao di classe TD  EN 10270-2, bonificato con tempra in olio  \n     -";
vb="Acciao di classe VD  EN 10270-2, bonificato con tempra in olio  \n     -";
vbp="Acciao di classe TD  EN 10270-2, bonificato con tempra in olio \n   pallinatura";
x1="Acciaio inossidabile X10CrNi18\[Hyphen]8  EN 10270-3                    \n     -";
x2="Acciaio inossidabile X7CrNiAl17-7  EN 10270-3                   \n     -";
x3="Acciaio inossidabile X1NiCrMoCu25-20-5  EN 10270-3              \n     -";
x1h="Acciaio inossidabile X10CrNi18\[Hyphen]8  EN 10270-3                   \n     Rinvenimento";
x2h="Acciaio inossidabile X7CrNiAl17-7  EN 10270-3                  \n     Precipitation Hardening";
x3h="Acciaio inossidabile X1NiCrMoCu25-20-5  EN 10270-3             \n     Rinvenimento";

img0=;               img1= ;               img2=;               img3=;

(Subscript[v, 0.5])=;(Subscript[v, 0.7])=;(Subscript[v, 1])=;(Subscript[v, 2])=;        img4=;


(*======================================================================================================================================================*)
(*** Ciclo while totale del progetto ***)

While[ans0,  
If[mollaN>0,(Subscript[D, max])=.;Δf=.;(Subscript[P, max])=.;(Subscript[P, min])=.;(Subscript[D, a])=.;ϕ=.;n=.;w=.;(Subscript[L, max])=.;(Subscript[L, 0])=.;(Subscript[L, min])=.;ν=.];
ctrl=0;
\[KernelIcon]=0;

(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Inserimento dati, Calcolo e stima dei primi valori **)

int0=Grid[({{Image[img0,ImageSize->400]}, {Text["INSERIRE I VALORI"]}, {Text["( (Subscript[D, max]): ingombro massimo radiale 
Δf=(Subscript[f, max])-(Subscript[f, min]): variazione massima della freccia )"]}}),Spacings->{1,1}];
dat1=Input[int0,Grid[({{Null, HoldForm[(Subscript[D, max])], HoldForm[Δf], HoldForm[(Subscript[P, max])], HoldForm[(Subscript[P, min])]}, {TextCell["u.d.m"], Text[mm], Text[mm], Text[Ν], Text[Ν]}, {TextCell["valore"], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}}),Frame->All,Spacings->{3.5,1}],
		WindowTitle->"Dati di progetto",WindowSize->{Automatic,All}];
If[dat1==$Canceled,Exit[]];

{null,(Subscript[D, max]),Δf,(Subscript[P, max]),(Subscript[P, min])}=dat1[[1,3]];

(* Stima del diametro (Subscript[D, a]) di avvolgimento *)
 (Subscript[D, a])=Round[0.95(Subscript[D, max])-((200-(Subscript[D, max]))/100)-((Subscript[P, max])/250),0.1];     If[(Subscript[D, a])>200,{MessageDialog["Diametro esterno troppo grande"],Exit[]}];
w=((Subscript[D, a])/d);                    (*rapporto di avvolgimento*)     
k=If[3≤w≤21,((4w-1)/(4w-4))+(0.615/w),Null];        (*Incremento della tensione sul diametro interno secondo Wahl*)     
τk=((8 (Subscript[P, max]) (Subscript[D, a]))/(π (d^3))) k;  (*Tensione massima stimata*)

(Subscript[τ, tr])[d_]=τk/0.56;     (* (Subscript[τ, amm])=0.56 R; allora pongo (Subscript[τ, tr])=τk/0.56 per confrontarlo con i valori di R dei materiali *)

\[KernelIcon]++;


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Scelta del materiale **)

(* Scelta del tipo di acciaio e del tipo di carico *)
ans2=ChoiceDialog["Tipo di acciaio:",{"al carbonio o legato"->CoL,"inossidabile"->inox}];

ans3=ChoiceDialog["Tipo di carico:\n(N è il numero di cicli)",{" N < 10^4 \n Statico "->stat," N > 10^4 \n Dinamico "->din}];
Switch[ans3,din,fl=Input["Inserire il valore della frequenza dei cicli in Hertz"]*Hz;
				VD=(Piecewise[{{VD, d≤7}, {Null, d>7}}]) (*dati presenti solo fino a d=7*);carico="dinamico",
		    stat,fl=_;VD=Interpolation[{{1,2080},{2,1960},{4,1860},{6,1760},{8,1670},{10,1670},{17,Null}},
				InterpolationOrder->in];carico="statico"];

(* Si assegna il grafico delle curve dei materiali, le intestazioni e i tasti di scelta, da visualizzare nella scelta del materiale *)
Switch[ans3,
			stat,gr1=Plot[{(Subscript[τ, tr])[d],LL[d],MM[d],HH[d],FD[d],TD[d],VD[d]},{d,1,17},PlotStyle->{{Thick,Dashed,Black},{Thick,ColorData["Rainbow",0]},{Thick,ColorData["Rainbow",0.2]},{Thick,ColorData["Rainbow",0.4]},{Thick,ColorData["Rainbow",1]},{Thick,ColorData["Rainbow",0.8]},{Thick,ColorData["Rainbow",0.6]}},Ticks->{Range[1,17],Range[0,2500,100]},GridLines->{Range[1,17],Range[0,2500,100]}, ImageSize->600,PlotLegend->{"R","L","M","H","FDC","TDCrV","VDSiCr"},LegendShadow->None,LegendPosition->{0.66,0.1},LegendSize->{0.3,0.5},PlotRange->{{1,17},{1000,2300}},AxesOrigin->{1,1000}];
gr2=Plot[{(Subscript[τ, tr])[d],I1[d],I2[d],I3[d],I1ht,I2ph,I3ht},{d,1,10},PlotStyle->{{Thick,Dashed,Black},{Thick,ColorData["Rainbow",0]},{Thick,ColorData["Rainbow",0.2]},{Thick,ColorData["Rainbow",0.4]},{Thick,ColorData["Rainbow",1]},{Thick,ColorData["Rainbow",0.8]},{Thick,ColorData["Rainbow",0.6]}},Ticks->{Range[1,10],Range[0,2500,100]},GridLines->{Range[1,10],Range[0,2500,100]}, ImageSize->600,PlotLegend->{"R","I1","I2","I3","I1ht","I2ph","I3ht"},LegendShadow->None,LegendPosition->{0.75,0.15},LegendSize->{0.21,0.45},PlotRange->{{1,10},{1000,2300}},AxesOrigin->{1,1000}],
			din,
gr1=Plot[{(Subscript[τ, tr])[d],HH[d],TD[d],VD[d]},{d,1,10},PlotStyle->{{Thick,Dashed,Black},Thick,Thick,Thick},Ticks->{Range[1,10],Range[0,2500,100]},GridLines->{Range[1,10],Range[0,2500,100]}, ImageSize->600,PlotLegend->{"R","H","TDCrV","VDSiCr"},LegendShadow->None,LegendPosition->{0.66,0.3},LegendSize->{0.3,0.3},PlotRange->{{1,10},{1000,2300}},AxesOrigin->{1,1000}];
gr2=Plot[{(Subscript[τ, tr])[d],I1ht,I2ph},{d,1,6},PlotStyle->{{Thick,Dashed,Black},{Thick},{Thick},{Thick}},Ticks->{Range[1,10],Range[0,2500,100]},GridLines->{Range[1,10],Range[0,2500,100]}, ImageSize->600,PlotLegend->{"R","I1 ht","I2 ph"},LegendShadow->None,LegendPosition->{0.76,0.3},LegendSize->{0.2,0.3},PlotRange->{{1,6},{1000,2300}},AxesOrigin->{1,1000}]
	];
\[KernelIcon]++;

tx1=TextCell["R: Tensione a traz. equival. alla τ della Pmax
L,M,H: Acciaio non legato patentato e trafilato EN 10270:1 \nFDC,TDCrV,VDSiCr: Acciaio legato bonificato EN 10270:2 "];     tx2=TextCell["R: Tensione a trazione equivalente alla τ della Pmax \nAcciai inossidabili EN 10270:3        I1 X10CrNi18-8
\t\t\t\t I2: X7CrNiAl17-7 \n\t\t\t\t I3: X1NiCrMoCu25-20-5 \n\t\t\t\t ht: Rinvenimento, \n\t\t\t\t ph: Precipitation Hardening"];
Switch[ans3,stat,tx3=TextCell["DH, TDCrV, VDSiCr, X10CrNi18-8, X7CrNiAl17-7: materiali più adatti alla fatica"],
			din,tx3=TextCell["Selezione di materiali adatti a lavorare a fatica"]];

l1=" L "->1;  m2=" M "->2;  h3=" H "->3;
f4=" FDC "->4;  t5=" TDCrV "->5;  v6=" VDSiCr "->6;
i7=" I1 "->7;   i8=" I2 "->8;  i9=" I3 "->9;
i7h=" I1 ht "->10;     i8h=" I2 ph "->11;     i9h=" I3 ht "->12;

sw1=Switch[ans2,CoL,Switch[ans3,stat,{l1,m2,h3,f4,t5,v6},
							       din,{h3,t5,v6}],
			     inox,Switch[ans3,stat,{i7,i7h,i8,i8h,i9,i9h},
							        din,{i7h,i8h}]];

(* Scelta del materiale *)
sm=ChoiceDialog[Grid[({{Switch[ans2,CoL,Grid[({{tx1}, {tx3}, {gr1}})],inox,Grid[({{tx2}, {tx3}, {gr2}})]]}, {"Scegliere il materiale:"}})],sw1,WindowTitle->"Scelta del materiale",WindowSize->{Automatic,All}];

\[KernelIcon]++;


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Calcolo e scelta di vari parametri **)

(* Assegnazione della curva di resistenza del materiale scelto e dei corrispondenti valori di E,G,ρ *)

Switch[ans2, CoL,If[sm≤3, (({{Ε, G, ρ}}))={dat2[[3]]},(({{Ε, G, ρ}}))={dat2[[4]]}],
			inox,(({{Ε, G, ρ}}))=Switch[sm,     7,{dat2[[5]]},     8,{dat2[[6]]},     9,{dat2[[7]]},     10,{dat2[[5]]},     11,{dat2[[6]]},     12,{dat2[[7]]}]];

RM=Switch[sm,    1,LL[d],    2,MM[d],    3,HH[d],    4,FD[d],    5,TD[d],    6,VD[d],
			7,I1[d],    8,I2[d],    9,I3[d],    10,I1ht,    11,I2ph,    12,I3ht];  

(* Calcolo del diametro del filo minimo che resiste *)
fr1=FindRoot[RM==(Subscript[τ, tr])[d],{d,(Subscript[D, a])/21}];     
df=Ceiling[fr1[[1,2]],0.1];

(* Modifica dei valori di E,G in base alla temperatura di esercizio *)
In1=Input["Inserire la temperatura di esercizio della molla in °C. \n Range della normativa -50°<T<250°"];
ΔT=In1;     If[ΔT==$Canceled||ΔT<-50||ΔT>250,{MessageDialog["Temperatura non compresa nel range"],Exit[]}];
T=Interpolation[{{-50,2},{250,-6.5}},InterpolationOrder->1];

Gc=G (((100+T[ΔT])/100)) ;Εc=Ε (((100+T[ΔT])/100)) ;   
\[KernelIcon]++;

(* Scelta della tipologia dell' estremità della molla *)
ans4=ChoiceDialog["Molla con estremità:",{"molata"->mol,"non molata"->nnm}];
(({{m}, {(Subscript[L, c])}, {estremità}}))=Switch[ans4,     mol,(({{(((Subscript[L, 0])-ϕ)/n)}, {nt ϕ}, {"molate"}})),     nnm,(({{(((Subscript[L, 0])-2.5ϕ)/n)}, {(nt+1.5) ϕ}, {"non molate"}}))];
Switch[ans4,   mol,δn=0,   nnm,δn=1.5];

(* Calcolo di Rigidezza e frecce massima e minima in funzione di ϕ e n *)
K=((Gc (ϕ^4))/(8 ((Subscript[D, a])^3)n));
(Subscript[f, min])=(Subscript[P, min])/K;
(Subscript[f, max])=Δf+(Subscript[f, min]);  

\[KernelIcon]++;


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Calcolo dei diametri del filo e del rispettivo numero di spire **)

(* Inizializzazioni e assegnazione delle condizioni *)
 i=0;  j=.;  ii=0;   
Switch[ans3,  stat,If[2≤sm≤4,cnd1=ϕ≤17,cnd1=ϕ≤10],
			din,Switch[sm,3,cnd1=ϕ≤10,5,cnd1=ϕ≤10,6,cnd1=ϕ≤7,10,cnd1=ϕ≤6,11,cnd1=ϕ≤6]];     (*limite sul diametro massimo del filo*)

(* Calcolo iterativo del numero di spire in funzione dell'incremento del diametro *)
While[i==0||cnd1,   ϕ=df+0.1i;   n=.;n=Solve[n==((Gc (ϕ^4) (Subscript[f, max]))/(8 (Subscript[P, max]) ((Subscript[D, a])^3))),n][[1,1,2]];   (Subscript[ne, i])=Ceiling[n,0.25];  (Subscript[nt, i])=Round[n,0.01];  (Subscript[ϕf, i])=ϕ;  i++];    

(* Calcolo dei valori da inserire nella tabella di scelta di (ϕ,n) e creazione della stessa *)
L0=(Subscript[ne, j]) (0.001 ((5 ((Subscript[D, a])^2) )/(Subscript[ϕf, j]))+0.1 (Subscript[ϕf, j]))+(((Subscript[ne, j])+δn)+2)(Subscript[ϕf, j])+(Subscript[P, max]) ((8 ((Subscript[D, a])^3)(Subscript[ne, j]))/(Gc ((Subscript[ϕf, j])^4)));      (*L0=(Subscript[S, a])+(Subscript[n, tot]).ϕ+(Subscript[f, max])*)
ΔDe=((5(m^2)-4m (Subscript[ϕf, j])-((Subscript[ϕf, j])^2))/(50 (Subscript[D, a])))/.{n->(Subscript[ne, j]),(Subscript[L, 0])->L0};   (*(Subscript[ΔD, e])*)            W=(Subscript[D, a])/(Subscript[ϕf, j]);   (*w*)
txt0=(({{Text["n°iterazione:      i"]}, {Text["diametro filo:     ϕ"]}, {Text["n°spire teorico:  nt"]}, {Text["n°spire effett.:  ne"]}, {Text["rapp. di avvolg.:  w"]}, {Text["lungh. a riposo:  L0"]}, {Text["De d'ingombro:  Dmax"]}}));   nfw=(({{j}, {(Subscript[ϕf, j])}, {(Subscript[nt, j])}, {(Subscript[ne, j])}, {Round[W,0.1]}, {Round[L0,0.1]}, {Round[(Subscript[D, a])+ΔDe+(Subscript[ϕf, j]),0.1]}})); 

For[j=0,j<i,j++,
If[j==0,NFW=Join[txt0,nfw,2],
	If[Abs[(Subscript[ne, j])-(Subscript[nt, j])]<0.08  &&  L0≤630  &&  4≤W  &&  W≤20  &&  ((Subscript[D, a])+ΔDe)<200  &&  (Subscript[ne, j])≥2  &&  ii<12,
	NFW=Join[NFW,nfw,2];
	ii++]
	]
];

txt1=Text["ϕ[i=0] è il diametro minimo che rispetta la condizione di resistenza; i successivi rispettano la condizione:"];
txt2=Text["|ne-nt|<0.08 (minimizza la differenza tra il Δf scelto e quello effettivo su cui grava l'arrotondamento di n)
 avendo inserito solo i primi 12 valori che rispettano i limiti :  4<w<20  &  L0<630mm  &  D<200mm"];
txt3=Text["Scegliere la coppia (ϕ,ne) ed inserire il n° dell' iterazione (i) corrispondente; o premere [Cancel]."];

int1=Grid[({{txt1}, {txt2}, {txt3}, {Grid[NFW,Frame->All]}})];

\[KernelIcon]++;


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Scelta del diametro del filo e del rispettivo numero di spire **)

If[ans3==din,txt4=Switch[sm,   3,TextCell["dh: "<>dh],
							5,TextCell["ttp: "<>ttp<>"\ntbp: "<>tbp<>"\ntb: "<>tb],
							6,TextCell["vb: "<>vb<>"\nvbp: "<>vbp],
							10,TextCell["x1h: "<>x1h],
							11,TextCell["x2h: "<>x2h]]];     

dmat=$Canceled;
(*ciclo che permette di provare più scelte di ϕ nel caso di carico dinamico finchè non si trova quello che soddisfa la verifica a fatica*)
While[dmat==$Canceled,     
(* Scelta di (ϕ,n) e assegnazione dei valori scelti *)
iter=Input[int1,"i",WindowTitle->"Scelta diametro-n°spire",WindowSize->{Automatic,All}];     
If[iter==$Canceled,Goto[end]];
ϕ=(Subscript[ϕf, iter]); 
n=(Subscript[ne, iter]);     
w=((Subscript[D, a])/ϕ);      k=((w+0.5)/(w-0.75));
(Subscript[τ, max])=((8 (Subscript[D, a]) (Subscript[P, max]))/(π (ϕ^3)))k;      (Subscript[τ, min])=((8 (Subscript[D, a]) (Subscript[P, min]))/(π (ϕ^3)))k;     Δτ=(Subscript[τ, max])-(Subscript[τ, min]);

(* Verifica a fatica del valore scelto di ϕ *)
Switch[ans3,stat,Break[],     (* Se il caso è statico il ciclo termina *)
			din,ϕff=2;     (*selezione del primo diametro, tra quelli testati,che risulta maggiore di quello scelto ϕ*)
				(*diametri testati sperimentalmente per determinare il diagramma di Goodman di ogni materiale*)
				vdf1={3,5,8,10};  vdf2={3,5,7};  vdf3={3,4,6};            
				vdf=Switch[sm,3,vdf1,5,vdf1,6,vdf2,10,vdf3,11,vdf3];
				Do[fi=ϕff;If[ϕff>ϕ,Break[]],{ϕff,vdf}];    
				(*curve del grafico*)       
				arg=Switch[sm,3,{(Subscript[DH, fi])[t0]},5,{(Subscript[Ttp, fi])[t0],(Subscript[Tbp, fi])[t0],(Subscript[Tb, fi])[t0]},6,{(Subscript[Vb, fi])[t0],(Subscript[Vbp, fi])[t0]},10,{(Subscript[X1, fi])[t0]},11,{(Subscript[X2, fi])[t0]}];     
				(*opzioni del grafico*)
				opt=Switch[sm,3,{{Thick,Blue},Style["\[SelectionPlaceholder] dh ",Darker[Blue],Bold]},
							   5,{{{Thick,Darker[Blue]},{Thick,Darker[Green]},{Thick,Darker[Red]}},
								Style["\[SelectionPlaceholder] ttp ",Darker[Blue],Bold]Style["\[SelectionPlaceholder] tbp \n",Darker[Green],Bold]Style["\[SelectionPlaceholder] tb \n",Darker[Red],Bold]},
						 	  6,{{{Thick,Darker[Blue]},{Thick,Darker[Green]}},Style["\[SelectionPlaceholder] vb \n",Darker[Blue],Bold]Style["\[SelectionPlaceholder] vbp ",Darker[Green],Bold]},
						   	10,{{Thick,Blue},Style["\[SelectionPlaceholder] x1h ",Darker[Blue],Bold]},
						   	11,{{Thick,Blue},Style["\[SelectionPlaceholder] x2h ",Darker[Blue],Bold]}];     
				 (*grafico di Goodman*)
				show=Show[Plot[arg,{t0,0,1000},PlotRange->All,GridLines->Automatic,PlotStyle->opt[[1]],AxesOrigin->{0,0},
						RegionFunction->Function[{x,y},y≥x],AxesLabel->{"(Subscript[τ, min])","(Subscript[τ, max])"},ImageSize->400],
						Plot[t0,{t0,0,1000},PlotRange->All,PlotStyle->{Black}],
						Graphics[{Arrowheads[{-0.04,0.04}],Thick,Arrow[{{(Subscript[τ, min]),(Subscript[τ, min])},{(Subscript[τ, min]),(Subscript[τ, max])}}],
								Text[Style["Δτ",18],{(Subscript[τ, min])+50,(((Subscript[τ, min])+(Subscript[τ, max]))/2)}],
								Text[Style[opt[[2]],20],{900,300},Background->White]}]];    
					txt5=TextCell["Diagramma di Goodman per 10^7 cicli per un diametro del filo ϕ:"];
				  txt6=TextCell["Inserire il codice del materiale che verifica la condizione di resistenza a fatica."];
					txt7=TextCell["Se nessuno la verifica, premere [Cancel] e scegliere un diametro del filo maggiore."]; 
				  txt8=TextCell["Se si desidera terminare il programma premere [Ok] senza inserire nulla."];
					dmat=Input[Grid[({{txt5}, {ϕ}, {txt6}, {txt7
txt8}, {Grid[({{Image[img3,ImageSize->180], show}})]}, {txt4}})],\[Placeholder],WindowSize->{Automatic,All}]
	]
];
\[KernelIcon]++;

If[dmat==\[Placeholder],Exit[]];
Switch[ans3,stat,dmat=Switch[sm,    1,SL,    2,SM,    3,SH,    4,FDC,    5,tb,    6,vb,    7,x1,    8,x2,    9,x3,     10,x1h,     11,x2h,     12,x3h];Se=Null,
			din,Se=Switch[dmat,    dh,(Subscript[DH, fi]),    ttp,(Subscript[Ttp, fi]),    tbp,(Subscript[Tbp, fi]),    tb,(Subscript[Tb, fi]),    vb,(Subscript[Vb, fi]),    vbp,(Subscript[Vbp, fi]),    x1h,(Subscript[X1, fi]),    x2h,(Subscript[X2, fi])]]

 nt=n+2;     (*numero totale spire*)
If[w<4,{MessageDialog["Rapporto di avvolgimento (w=D/d) fuori dal campo di applicazione: troppo piccolo."],Exit[]}];
If[w>20,{MessageDialog["Rapporto di avvolgimento (w=D/d) fuori dal campo di applicazione: troppo grande."],Exit[]}];

(* Fattori di sicurezza *)
FSs=((0.56RM)/(Subscript[τ, max]))/.d->ϕ;     (*statico*)
Switch[ans3,din,FSd=Round[((Se[(Subscript[τ, min])])/(Subscript[τ, max])),0.01],stat,FSd=_;];     (*dinamico*)


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Scelta della lunghezza sotto carico minimo **)

Sa=n (0.001 ((5 ((Subscript[D, a])^2) )/ϕ)+0.1 ϕ);     (*Somma delle distanze minime fra le spire attive adiacenti*)
(Subscript[L, min])=(Subscript[L, c])+Sa;
(Subscript[f, max])=(Subscript[P, max])/K;
L0min=(Subscript[L, min])+(Subscript[f, max]);     L0max=630;     (*lunghezze della molla libera minima e massima ammissibili*)
If[L0min>L0max,{MessageDialog["Lunghezza minima della molla fuori dal campo di applicazione. ridurre il numero di spire."],Exit[]}];
Lmax=L0max-(Subscript[f, min]);   Lmin=L0min-(Subscript[f, min]);     (*lunghezze della molla sotto carico minimo massima e minima ammissibile*)

(* Verifica dell'instabilità e scelta del coefficiente di appoggio *)
sk=(((Subscript[L, 0]) 0.5)/(1-(G/Ε))) (1-(Sqrt[((1-(G/Ε))/(0.5+(G/Ε))) (((((π (Subscript[D, a]))/(ν (Subscript[L, 0])))))^2)]));     (*freccia che produce cedimento per instabilità *)
cp1=ContourPlot[sk/(Subscript[f, max]),{ν,0.5,2},{(Subscript[L, 0]),L0max,L0min},Frame->True,FrameTicks->{{0.5,1,0.7,2},Automatic},FrameLabel->{ν,(Subscript[L, 0])},Contours->{-3,-2,-1.5,-1,-.5,0,0.5,{1,Thick},1.5,2,3,5,10,15,20},ContourLabels->(Text[Framed[#3],{#1,#2},Background->White]&),AspectRatio->1.2,ImageSize->300,Mesh->{{0.5,0.7,1,2},Range[Round[L0min,10],Round[L0max,10],20]},MeshFunctions->{#1&,#2&},ColorFunction->(Blend[{Red,White,Green},#]&),PlotLabel->" sk: freccia che produce cedimento per instabilità \n (Subscript[f, max]): freccia dovuta al carico massimo (Subscript[P, max]) \n"];

\[KernelIcon]++;

ν=ChoiceDialog[Grid[(({{Grid[(({{Text["Grafico di  sk/(Subscript[f, max])  in funzione di  ν  e  (Subscript[L, 0])"], Text["Tipi di alloggi e relativi coeff. di appoggio ν"]}, {cp1, Image[img2,ImageSize->200]}})),Spacings->4]}, {Text["Scegliere il valore di ν (associato al tipo di alloggio) tale che la coppia di valori (ν, (Subscript[L, 0])) che si intende usare, 
verifichino la stabilità della molla, e quindi valga  sk/(Subscript[f, max]) > 1  "]}}))],{" 0.5 "->0.5," 0.7 "->0.7,"  1  "->1,"  2  "->2},WindowTitle->"Scelta del tipo di alloggiamento",WindowSize->{Automatic,All}];

L0min=FindRoot[sk/(Subscript[f, max])==1,{(Subscript[L, 0]),1}][[1,2]];     (*lunghezza minima ammissibile*)
Lmin=Max[Lmin,L0min-(Subscript[f, min])];

(* Scelta della lunghezza della molla soto carico minimo *)
Δf=(Subscript[f, max])-(Subscript[f, min]);     (*freccia effettiva*)
(Subscript[L, max])=Input[Grid[({{Text["La differenza Δf=(Subscript[f, max])-(Subscript[f, min]) effettiva, dovuta all'arrotondamento \ndel diametro del filo e del numero di spire, è:"]}, {Grid[({{"Δf=", ⌈Δf⌉ mm}})]}, {Text["scegliere la lunghezza (Subscript[L, max]) della molla sotto carico minimo t.c."]}, {⌈Lmin⌉mm<(Subscript[L, max])<⌊Lmax⌋ mm}})]];If[(Subscript[L, max])==$Canceled,Exit[]];
(Subscript[L, min])=(Subscript[L, max])-Δf;
(Subscript[L, 0])=(Subscript[L, max])+(Subscript[f, min]);

\[KernelIcon]++;


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Calcolo dei parametri rimanenti **)

(Subscript[ΔD, e])=((5(m^2)-4m ϕ-(ϕ^2))/(50 (Subscript[D, a])));     (*max variazione del diametro esterno sotto carico*)
     
(Subscript[D, e])=(Subscript[D, a])+ϕ;     Dmax=(Subscript[ΔD, e])+(Subscript[D, e]);     If[Dmax>630,{MessageDialog["Diametro massimo di ingobro effettivo maggiore di (Subscript[D, max])"],Exit[]}];
Di=(Subscript[D, a])-ϕ;
(Subscript[f, c])=(Subscript[L, 0])-(Subscript[L, c]);     (Subscript[P, cth])=K (Subscript[f, c]);     (Subscript[τ, c])=((8 (Subscript[D, a]) (Subscript[P, cth]))/(π (ϕ^3))) k;     (*valori per molla a pacco*)
ΔL=(Subscript[L, max])-(Subscript[L, min]);     ΔP=(Subscript[P, max])-(Subscript[P, min]);
dϕ=(Piecewise[{{0.02, ϕ<1.7}, {0.03, ϕ<4}, {0.04, ϕ<7}, {0.05, ϕ<10}, {0.07, ϕ<11}, {0.08, ϕ<4}, {0.09, ϕ<18}}]);        (*tolleranza del diametro del filo*)
(*frequenza naturale*)
fe=((3560 ϕ)/(n ((Subscript[D, a])^2)))(Sqrt[(G/((10^6) ρ))])(Sqrt[1000(((100))^3)]);     
p=(ρ/(10^3))(nt*(Subscript[D, a])π*π ((ϕ^2)/4));

\[KernelIcon]++;


(*------------------------------------------------------------------------------------------------------------------------------------------------------*)
(** Scheda dei dati **)

grid0=Grid[({{Grid[({{TextCell["Materiale:\n Trattamenti:  "], TextCell[dmat]}}),Frame->True,FrameStyle->Gray]}, {Grid[(({{TextCell["Modulo di elasticità  E"], Round[Εc]MPa, TextCell["Modulo di elast. tan.  G"], Round[Gc]MPa}, {TextCell["Tipo di carico"], TextCell[carico], TextCell["Freq. cicli di lavoro"], fl}, {TextCell["Temperatura di esercizio"], ΔT °C, TextCell["Estremità: chiuse e "], TextCell[estremità]}, {TextCell["Rigidezza"], Grid[({{Round[K,0.1], TextCell["N/mm"]}})], TextCell["Peso"], Round[p,1]gr}})),
Dividers->{{1->Black,2->Gray,3->Thick,4->Gray,5->Black},{1->Black,2->Gray,3->Gray,4->Gray,5->Black}},Spacings->{1.9,1}]}})];
tab1=({{TextCell["Diametro del filo"], HoldForm[ϕ], ϕ, mm}, {TextCell["Tolleranza di ϕ"], HoldForm[δϕ], ±dϕ, mm}, {TextCell["Diametro di avvolgim."], HoldForm[D], (Subscript[D, a]), mm}, {TextCell["Diametro esterno"], HoldForm[(Subscript[D, e])], (Subscript[D, e]), mm}, {TextCell["Incremento max di De"], HoldForm[+(Subscript[ΔD, e])], Round[(Subscript[ΔD, e]),0.1], mm}, {TextCell["Diametro esterno max"], HoldForm[(Subscript[D, max])], Round[Dmax,0.1], mm}, {TextCell["Diametro interno"], HoldForm[(Subscript[D, i])], Di, mm}, {TextCell["Lunghezza a riposo"], HoldForm[(Subscript[L, 0])], Round[(Subscript[L, 0]),0.1], mm}, {TextCell["n° spire attive"], HoldForm[n], n, _}, {TextCell["n° spire totali"], HoldForm[nt], nt, _}, {TextCell["Rapp. di avvolgim."], HoldForm[w], Round[w,0.1], _}, {TextCell["Frequenza naturale"], HoldForm[(Subscript[𝒻, e])], Round[fe,1], Hz}});
grid1=Grid[tab1,Frame->{False,All},Dividers->{{2->Gray,3->Gray,4->Gray}},Spacings->{1,1}];
grid2=Grid[({{Framed[Image[img1,ImageSize->280],FrameStyle->Gray], grid1}})];

grid3=Grid[(({{HoldForm[(Subscript[P, max])], (Subscript[P, max]), Ν, HoldForm[(Subscript[f, max])], Round[(Subscript[f, max]),0.1], mm, HoldForm[(Subscript[L, min])], Round[(Subscript[L, min]),0.1], mm, HoldForm[(Subscript[τ, max])], Round[(Subscript[τ, max]),0.1], MPa}, {HoldForm[(Subscript[P, min])], (Subscript[P, min]), Ν, HoldForm[(Subscript[f, min])], Round[(Subscript[f, min]),0.1], mm, HoldForm[(Subscript[L, max])], Round[(Subscript[L, max]),0.1], mm, HoldForm[(Subscript[τ, min])], Round[(Subscript[τ, min]),0.1], MPa}, {HoldForm[(Subscript[P, cth])], Round[(Subscript[P, cth]),0.1], Ν, HoldForm[(Subscript[f, c])], Round[(Subscript[f, c]),0.1], mm, HoldForm[(Subscript[L, c])], Round[(Subscript[L, c]),0.1], mm, HoldForm[(Subscript[τ, c])], Round[(Subscript[τ, c]),0.1], MPa}, {HoldForm[ΔP], ΔP , Ν, HoldForm[Δf], Round[Δf,0.1], mm, HoldForm[ΔL], Round[ΔL,0.1], mm, HoldForm[Δτ], Round[Δτ,0.1], MPa}})),Dividers->{{1->Black,2->Gray,3->Gray,4->Thick,5->Gray,6->Gray,7->Thick,8->Gray,9->Gray,10->Thick,11->Gray,12->Gray,13->Black},{1->Black,2->Gray,3->Gray,4->Gray,5->Black}},Spacings->{1.9,1}];

grid04=Grid[(({{TextCell["Coefficiente di sicurezza statico"], Round[FSs,0.01]}, {TextCell["Coefficiente di sicurezza dinamico"], FSd}})),Dividers->{{1->Gray,2->Gray,3->Gray},{1->Gray,2->Gray,3->Gray}},Spacings->{1,1}];

(Subscript[v, 0.5])=;(Subscript[v, 0.7])=;(Subscript[v, 1])=;(Subscript[v, 2])=;        img4=;

grid4=Grid[({{Framed[Image[img4,ImageSize->150],FrameStyle->Gray], Grid[({{Grid[({{grid04, Null, Null, Null}})]}, {Null}, {Null}, {Grid[({{TextCell["\t\t\t   Coefficiente di appoggio: \tν="], ν}})]}, {Null}})], Image[(Subscript[v, ν]),ImageSize->50]}})];
grid5=Grid[({{grid0}, {grid2}, {grid3}, {grid4}, {Grid[({{Image[,ImageSize->20], TextCell["PisaneschiG",Underlined,Italic,"Subsubsection"]}})]}}),Dividers->{{},{1->Black,5->Gray}},Spacings->1.5];

mollaN++;
SetDirectory[NotebookDirectory[]];
str1="Molla n°";
str2=StringJoin[str1,ToString[mollaN]];
str3=".pdf";
str4=StringJoin[str2,str3];
nb=CreateDocument[{Grid[({{TextCell[str2,"Title"], TextCell["   Progetto secondo la UNI EN 13906-1","Subtitle"]}})],
TextCell["Molla di compressione avvolta a freddo ad elica cilindrica fabbricata con filo a sezione circolare."],grid5}];
Export[str4,nb];

\[KernelIcon]++;

ctrl=1;
Label[end];

ans0=Switch[ctrl,0,ChoiceDialog[TextCell["[Ok] se si desidera fare un nuovo tentativo, [Cancel] per terminare."]],
1,ChoiceDialog[TextCell["Il progetto è stato salvato nella cartella di questo file in PDF. Procedere con un altro progetto?"],WindowSize->{Automatic,All}]]

(*Fine del ciclo*)]
Quit[]

2. Solutore di travi in parallelo nel piano a sezione circolare

nb=CreateDocument[];
NotebookWrite[nb,Cell["Dati del calcolo","Subsection"]]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*1 CREAZIONE DELLA STRUTTURA *)

(*inserimento degli elementi e dei nodi*)
tx0=TextCell["Inserire il numero di elementi e di nodi totale:","Input"];
gr0=Grid[({{TextCell["n° elem"], TextCell["n° nodi"]}, {\[Placeholder], \[Placeholder]}}),Frame->All,Spacings->{4,2}];
EN=Input[tx0,gr0,FieldSize->15];   {El,nodi}=EN[[1,2]];
(*gradi di liberta locali e globali*)
(Subscript[n, loc])=6;   (Subscript[n, glob])=3nodi;

(*assegnazione dei nodi a ciascun elemento*)
nodel={};
For[i=1,i≤El,i++,nodel=Join[nodel,{{el[i],\[Placeholder],\[Placeholder]}}]];    
gr1=Grid[nodel,Frame->True,Dividers->{Gray,Black},Spacings->{3,1}];
tx1=TextCell["Associare ad ogni elemento el[i], i rispettivi nodi:","Input"];
map=Input[tx1,gr1,FieldSize->14];
For[i=1,i≤El,i++,(Subscript[el, i])=map[[1,i,2;;3]]]

(*inserimento delle coordinate dei nodi*)
coo={{nodo[n°]},{𝒳 [mm]},{𝒴 [mm]}};
For[i=1,i≤nodi,i++,coo=Join[coo,{{i},{\[Placeholder]},{\[Placeholder]}},2]];
gr2=Grid[coo\[Transpose],Frame->True,Dividers->{Thick,Gray},Spacings->{2,1.5}];
tx2=TextCell["Inserire le coordinate di ogni nodo","Input"];
coonod=Input[tx2,gr2,FieldSize->Medium];
For[i=1,i≤nodi,i++,{(Subscript[nx, i]),(Subscript[ny, i])}=coonod[[1,i+1,2;;3]];cn[i]={(Subscript[nx, i]),(Subscript[ny, i])}]

(*inserimaneto dei dati geometrici e fisici degli elementi*)
geo={{elem[n°]},{HoldForm[Ε×(10^5)[MPa]]},{d [mm]}};
For[i=1,i≤El,i++,geo=Join[geo,{{el[i]},{\[Placeholder]},{\[Placeholder]}},2]]
gr3=Grid[geo\[Transpose],Frame->True,Dividers->{Thick,Gray},Spacings->{2,1}];
tx3=TextCell["Inserire i valori per ogni elemento el[i]","Input"];
dat=Input[tx3,gr3,FieldSize->Medium];

NotebookWrite[nb,{ToBoxes[EN],ToBoxes[map],ToBoxes[coonod],ToBoxes[dat]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*2 CREAZIONE DELLA MATRICE DI RIGIDEZZA *)

(*COLLOCAZIONE DELLE MATRICI LOCALI ESPANSE NELLA GLOBALE*)
NotebookWrite[nb,Cell["\nMatrici di passaggio da locale a globale","Text"]]
H=SparseArray[ConstantArray[0,{El,(Subscript[n, loc]),(Subscript[n, glob])}]];
For[i=1,i≤El,i++,
	For[j=1,j≤2,j++,
		For[k=1,k≤3,k++,H[[i,(j-1)3+k,((Subscript[el, i])[[j]]-1)3+k]]=1]];
	NotebookWrite[nb,Cell[ToBoxes[H[[i]]//MatrixForm,StandardForm]]];
	(Subscript[K, i,loc])=Array[(Subscript[κ, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}];
	(Subscript[K, i,glob])=H[[i]]\[Transpose].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=SparseArray[(∑_(i=1)^El)(Subscript[K, i,glob])];
NotebookWrite[nb,{Cell["\nMatrice globale <mappa>","Text"],Cell[ToBoxes[(Subscript[K, tot])//MatrixForm,StandardForm]]}]

(*PASSAGGIO DEL SISTEMA DI RIFERIMENTO DA LOCALE A GLOBALE*)
(*l'asse x è baricentrico, l'asse z è preso giacente nel piano XY positivo del sistema di riferimento globale*)

(*Coordinate del secondo nodo dell'elemento con primo nodo trasferito al centro degli assi del sistema di riferimento globale*)
For[i=1,i≤El,i++,{(Subscript[dx, i]),(Subscript[dy, i])}=cn[(Subscript[el, i])[[2]]]-cn[(Subscript[el, i])[[1]]];];   i=.;

(*norme*)   
norm2=(Sqrt[((Subscript[dx, i])^2)+((Subscript[dy, i])^2)]);

(*matrice dei coseni direttori *)
o=(({{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}));
Rp[i_]=(({{((Subscript[dx, i])/norm2), ((Subscript[dy, i])/norm2), 0}, {((-(Subscript[dy, i]))/norm2), ((Subscript[dx, i])/norm2), 0}, {0, 0, 1}}));  (* rotazione nel piano XY *)

(*matrici di rotazione*)
NotebookWrite[nb,Cell["\nMatrici dei coseni direttori","Text"]]

For[i=1,i≤El,i++,(Subscript[λ, i])=Rp[i];
					NotebookWrite[nb,Cell[ToBoxes[(Subscript[λ, i])//MatrixForm]]];
					(Subscript[l, i])=norm2;
					(Subscript[T, i])=SparseArray[ArrayFlatten[(({{(Subscript[λ, i]), o}, {o, (Subscript[λ, i])}}))]]]
(* Oss: (Subscript[λ, i])\[Transpose]=((Subscript[λ, i])^(-1))  =>  (Subscript[T, i])\[Transpose]=((Subscript[T, i])^(-1)) *)


(*TIPOLOGIA DELLA MATRICE DI RIGIDEZZA*)
Jy=π((d^4)/64);   A=π ((d^4)/4);   
(Subscript[K, tip])[Ε_,d_,l_]=SparseArray[(({{((A Ε)/l), 0, 0, -((A Ε)/l), 0, 0}, {0, ((12 Ε Jy)/(l^3)), -((6 Ε Jy)/(l^2)), 0, -((12 Ε Jy)/(l^3)), -((6 Ε Jy)/(l^2))}, {0, -((6 Ε Jy)/(l^2)), ((4 Ε Jy)/l), 0, ((6 Ε Jy)/(l^2)), ((2 Ε Jy)/l)}, {-((A Ε)/l), 0, 0, ((A Ε)/l), 0, 0}, {0, -((12 Ε Jy)/(l^3)), ((6 Ε Jy)/(l^2)), 0, ((12 Ε Jy)/(l^3)), ((6 Ε Jy)/(l^2))}, {0, -((6 Ε Jy)/(l^2)), ((2 Ε Jy)/l), 0, ((6 Ε Jy)/(l^2)), ((4 Ε Jy)/l)}}))];

(*sostituzione dei dati, rotazione delle matrici locali e sostituzione nella matrice globale <mappa>*)
For[i=1,i≤El,i++,{(Subscript[Ε, i]),(Subscript[d, i])}=dat[[1,i+1,2;;3]]*{(10^5),1};
					(Subscript[K, loc,i])=(Subscript[K, tip])[(Subscript[Ε, i]),(Subscript[d, i]),(Subscript[l, i])];
					(Subscript[K, rot,i])=(Subscript[T, i]).(Subscript[K, loc,i]).(Subscript[T, i])\[Transpose];
	For[jr=1,jr≤(Subscript[n, loc]),jr++,
		For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[κ, jr,jc])[i]=(Subscript[K, rot,i])[[jc,jr]]]]]
NotebookWrite[nb,{Cell["\nMatrice globale finale","Text"],Cell[ToBoxes[(Subscript[K, tot])//N//MatrixForm,StandardForm]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*3 VETTORE DEGLI SPOSTAMENTI *)

(*raffigurazione tridimensionale*)
node={};element={};
axis={Red,Arrow[{{0,0},{100,0}}],Arrow[{{0,0},{0,100}}],Black,Text[Style[Y,20,Bold],{-5,90}],Text[Style[X,20,Bold],{90,-5}]};
For[i=1,i≤nodi,i++,node=Join[node,{Black,Thick,Circle[{(Subscript[nx, i]),(Subscript[ny, i])},4],Text[Style[i,24,Darker[Blue],Bold],{(Subscript[nx, i])+10,(Subscript[ny, i])+10}]}]]
For[i=1,i≤El,i++,element=Join[element,{Thickness[0.01],Green,EdgeForm[{Thin,Gray}],Line[{{(Subscript[nx, (Subscript[el, i])[[1]]]),(Subscript[ny, (Subscript[el, i])[[1]]])},{(Subscript[nx, (Subscript[el, i])[[2]]]),(Subscript[ny, (Subscript[el, i])[[2]]])}}]}]]
j1=Join[element,node,axis] ;Im1=Graphics[{j1},Axes->True,ImageSize->Medium];
MessageDialog[Im1,WindowSize->{All,All},WindowMargins->{{0,Automatic},{Automatic,0}}];
NotebookWrite[nb,{Cell["\nVincoli","Text"],Cell[BoxData[ToBoxes[Im1],"Output"]]}]

(*inserimento dei vincoli*)
vinc=(({{TextCell["nodo"], TextCell["u(x)"], TextCell["u(y)"], TextCell["θ(z)"]}}));
For[i=1,i≤nodi,i++,vinc=Join[vinc,(({{Style[i,Bold,16], f, f, f}}))]];
tx4=TextCell["Inserire 0 se lo spostamento/rotazione è vincolato, altrimenti lasciare ƒ.
Se lo spostamento/rotazione invece è imposto, iserirne il valore in millimetri/radianti"];
vincoli=Input[tx4,Grid[vinc,Frame->All,Spacings->{1.5,1}],WindowTitle->"Dati degli elementi",WindowSize->{Automatic,All},WindowMargins->{{Automatic,0},{Automatic,0}}];
V=vincoli[[1]];
NotebookWrite[nb,Cell[ToBoxes[vincoli,StandardForm]]]

(*vettore degli spostamenti*)
Vs={};Δ={};
For[i=1,i≤nodi,i++,    Vs=Join[Vs,V[[2;;nodi+1,2;;4]][[i]]];
						Δ=Join[Δ,{(Subscript[ux, i]),(Subscript[uy, i]),(Subscript[θz, i])}]]
dd=Δ;
For[i=1,i≤(Subscript[n, glob]),i++,If[Vs[[i]]≠0,Δ[[i]]=Vs[[i]];Vs[[i]]=1];
						  If[Vs[[i]]==f,Vs[[i]]=1]]
 Δ=Δ*Vs;
NotebookWrite[nb,{Cell["\nVettore degli spostamenti","Text"],Cell[ToBoxes[Δ,StandardForm]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*4 VETTORE DELLE FORZE *)

(*vettore delle reazioni incognite*)
R={};Vf=Vs; ff={};
For[i=1,i≤(Subscript[n, glob]),i++,If[Vs[[i]]==1,Vf[[i]]=0,Vf[[i]]=1]]
For[i=1,i≤nodi,i++,R=Join[R,{(Subscript[Rx, i]),(Subscript[Ry, i]),(Subscript[Mz, i])}]];   
R=R*Vf;
For[i=1,i≤nodi,i++,ff=Join[ff,{(Subscript[Fx, i]),(Subscript[Fy, i]),(Subscript[Mz, i])}]]

(*inserimento delle forze esterne applicate*)
tx5=TextCell["Aggiungere uno ad uno i carichi, infine premere TERMINA:"];
tx6=TextCell["Inserire i dati sul carico: il nodo ove applicato applicato, il valore e le coordinate globali di un pto appartenente al vettore 
(il verso del carico che si considera è quello dal nodo di applicazione al pto inserito)"];
gr4=Grid[(({{TextCell["Nodo di applicazione"], \[Placeholder]}, {TextCell["Carico [N or N/mm]"], \[Placeholder]}, {TextCell["Coordinate pto [mm]"], Grid[(({{x, \[Placeholder]}, {y, \[Placeholder]}})),Frame->All,FrameStyle->Gray,Spacings->{4}]}})),Frame->All];
ans0=1;nc=0;(*nc:contatore dei carichi inseriti*)
While[ans0≠0 ,
ans0=ChoiceDialog[tx5,{"AGGIUNGI FORZA"->1,"AGGIUNGI MOMENTO"->2,"TERMINA"->0},WindowTitle->"Vettore dei carichi"];
nc++;If[ans0>0,P[nc]=Input[tx6,gr4,FieldSize->25,WindowSize->{Automatic,All},WindowMargins->{{Automatic,0},{Automatic,Automatic}}];
				P[nc]=Join[{{ans0}},{P[nc][[1,1;;2,2]]},{P[nc][[1,3,2,1,All,2]]}]]
];

(*traslazione nodo di applicazione dei vettori forza al centro del sistema globale*)
For[i=1,i<nc,i++,{(Subscript[px, i]),(Subscript[py, i])}=P[i][[3]];cp[i]={(Subscript[px, i]),(Subscript[py, i])};(*coordinate del 2° pto del vettore*)
					{(Subscript[cx, i]),(Subscript[cy, i])}=cp[i]-cn[P[i][[2,1]]]]

(*proiezione del vettore forza lungo gli assi del sistema globale*)
i=.;
norm=(Sqrt[((Subscript[cx, i])^2)+((Subscript[cy, i])^2)]);     Rc[i_]={((Subscript[cx, i])/norm),((Subscript[cy, i])/norm)};
For[i=1,i<nc,i++,]
F=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i<nc,i++,     Switch[P[i][[1,1]], 1,(Subscript[Fglob, i])=P[i][[2,2]]*Rc[i]; 
											F[[(P[i][[2,1]]*3-2);;(P[i][[2,1]]*3-1)]]+=(Subscript[Fglob, i]),
										2,F[[P[i][[2,1]]*3]]+=P[i][[2,2]]]];
FR=F+R;
NotebookWrite[nb,{Cell["\nVettore delle forze e delle reazioni","Text"],Cell[ToBoxes[FR,StandardForm]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*5 SOLUZIONE DEL SISTEMA *)

(*Vettore delle incognite *)
inc=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i≤(Subscript[n, glob]),i++,Switch[Vs[[i]], 0,inc[[i]]=R[[i]]
									,1,inc[[i]]=Δ[[i]]]]
(*Soluzione*)
sol=Solve[(Subscript[K, tot]).Δ==(FR),inc]//N;
NotebookWrite[nb,{Cell["Soluzione","Text"],Cell[ToBoxes[sol[[1]],StandardForm]]}]

(*sostituzione dei risultati*)
For[j=1,j≤(Subscript[n, glob]),j++,For[i=1,i≤(Subscript[n, glob]),i++,
Switch[sol[[1,i,1]],  R[[j]],  R[[j]]=sol[[1,i,2]],
					  Δ[[j]],  Δ[[j]]=sol[[1,i,2]]]
]]
FR=F+R;
NotebookWrite[nb,{Cell["\nMatrici delle forze e degli spostamenti risolte","Text"],
Cell[ToBoxes[Grid[(({{ff//MatrixForm, FR//N//MatrixForm, Null, Null, dd//MatrixForm, Δ//N//MatrixForm}}))]]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*6 ELEMENTI *)

(*assegnazione spostamenti e forze negli elementi *)
NotebookWrite[nb,Cell["\t{Fx1\tFy1\tFz1\tMx1\tMy1\tMz1\tFx2\tFy2\tFz2\tMx2\tMy2\tMz2}","Text"]]
For[i=1,i≤El,i++,(Subscript[δ, i])=Join[Δ[[(Subscript[el, i])[[1]]*3-2;;(Subscript[el, i])[[1]]*3]],Δ[[(Subscript[el, i])[[2]]*3-2;;(Subscript[el, i])[[2]]*3]]];
					(Subscript[f, i])=Chop[(Subscript[K, loc,i]).(Subscript[T, i])\[Transpose].(Subscript[δ, i]),0.1];
					NotebookWrite[nb,Cell[ToBoxes[({{elemento, i, Round[(Subscript[f, i]),0.1]}})//MatrixForm,StandardForm]]]]

Quit[]

3. Solutore automatico di travi in serie nel piano

El=Input["Inserire il numero di elementi",,FieldSize->2];
nodi=(El+1);   (Subscript[n, loc])=6;   (Subscript[n, glob])=3nodi;
Print["\n\n____________________________________________________________________________________________________\n
DATI E SOLUZIONE"]

(* Creazione di matrici di trasformazione delle matrici di rigidezza da locali a globali *)
Print["\nMatrici di trasformazione locale->globale"]
H=ConstantArray[0,{El,(Subscript[n, loc]),(Subscript[n, glob])}];
For[i=1,i≤El,i++,{
For[j=1,j≤(Subscript[n, loc]),j++,H[[i,j,j +(i-1) 3]]=1],
Print[i,")",H[[i]]//MatrixForm]}]


(* Creazione della matrice globale assemblata *)
Print["\nMappa della matrice globale di rigidezza"];
For[i=1,i≤El,i++,(Subscript[K, i,loc])=Array[(Subscript[k, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}]]
For[i=1,i≤El,i++,(Subscript[K, i,glob])=Transpose[H[[i]]].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=(∑_(i=1)^El)(Subscript[K, i,glob]);
%//MatrixForm


(* Assegnazione del tipo di matrice locale e sostituzione degli elementi nella matrice globale *)
(Subscript[K, loc])[Ε_,J_,A_,l_]=(({{((A Ε)/l), 0, 0, -((A Ε)/l), 0, 0}, {0, ((12 J Ε)/(l^3)), ((6 J Ε)/(l^2)), 0, -((12 J Ε)/(l^3)), ((6 J Ε)/(l^2))}, {0, ((6 J Ε)/(l^2)), ((4 J Ε)/l), 0, -((6 J Ε)/(l^2)), ((2 J Ε)/l)}, {-((A Ε)/l), 0, 0, ((A Ε)/l), 0, 0}, {0, -((12 J Ε)/(l^3)), -((6 J Ε)/(l^2)), 0, ((12 J Ε)/(l^3)), -((6 J Ε)/(l^2))}, {0, ((6 J Ε)/(l^2)), ((2 J Ε)/l), 0, -((6 J Ε)/(l^2)), ((4 J Ε)/l)}}));
For[i=1,i≤El,i++,For[jr=1,jr≤(Subscript[n, loc]),jr++,For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[k, jr,jc])[i]=(Subscript[K, loc])[(Subscript[Ε, i]),(Subscript[J, i]),(Subscript[A, i]),(Subscript[l, i])][[jc,jr]]]]]
(Subscript[K, tot])=(∑_(i=1)^El)(Subscript[K, i,glob]);


(* Inserimento dei dati sulla geometria ed il materiale di ogni elemento *)
sez=ChoiceDialog["Forma della sezione:",{"Circolare"->cir,"Rettangolare"->ret}];
Switch[sez,       cir,For[i=1,i≤El,i++,(Subscript[J, i])=((π ((Subscript[d, i])^4))/64); (Subscript[A, i])=π (((Subscript[d, i])^2)/4)],
			ret,For[i=1,i≤El,i++,(Subscript[J, i])=(((Subscript[b, i]) ((Subscript[d, i])^3))/12); (Subscript[A, i])=(Subscript[b, i]) (Subscript[d, i])]];
For[i=1,i≤El,i++,
	Switch[sez,
			cir,     If[i==1,dat=(({{TextCell["dato"], HoldForm[Ε *(10^5)], HoldForm[l ], HoldForm[d ]}, {TextCell["u.d.m."], MPa, mm, mm}, {(Subscript[el, 1]), \[Placeholder], \[Placeholder], \[Placeholder]}})),dat=Join[dat,(({{(Subscript[el, i]), \[Placeholder], \[Placeholder], \[Placeholder]}}))]],
			ret,     If[i==1,dat=(({{TextCell["dato"], HoldForm[Ε*(10^5) ], HoldForm[l ], HoldForm[h ], HoldForm[b]}, {TextCell["u.d.m."], MPa, mm, mm, mm}, {(Subscript[el, 1]), \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}})),dat=Join[dat,(({{(Subscript[el, i]), \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}}))]]
]];

DAT=Input["Inserire i dati per ogni elemento",Grid[dat,Frame->All,Spacings->{3.5,1}],WindowTitle->"Dati degli elementi",WindowSize->{Automatic,All}]

DAT[[1,3;;(2+El),2]]=DAT[[1,3;;(2+El),2]]*(10^5);
For[i=1,i≤El,i++,
			Switch[sez,    cir,{(Subscript[Ε, i]),(Subscript[l, i]),(Subscript[d, i])}=DAT[[1,i+2,2;;4]]; (Subscript[A, i])=π ((Subscript[d, i])^2)/4,
						ret,{(Subscript[Ε, i]),(Subscript[l, i]),(Subscript[d, i]),(Subscript[b, i])}=DAT[[1,i+2,2;;5]]; (Subscript[A, i])=(Subscript[d, i])(Subscript[b, i])]
];
Print["\nMatrice globale di rigidezza"]
ScientificForm[(Subscript[K, tot])//N//MatrixForm,1]


(* Raffigurazione degli elementi e dei nodi *)
Σl=Unevaluated[(∑_(j=1)^i)(Subscript[l, j])];     ΣL=(∑_(j=1)^El)(Subscript[l, j]);      element={};(Subscript[d, 0])=(Subscript[d, 1]);
For[i=0,i≤El,i++,If[i==0,node={Dashing[{}],Darker[Blue],Thick,Circle[{0,0},0.1],Text[Style[i+1,20],{0,0.3}]};
							axis={Arrow[{{-2,0},{-1,0}}],Text[Style[x,20],{-0.5,0}],Arrow[{{-2,0},{-2,2}}],Text[Style[y,20],{-1.5,2}],
								Circle[{-2,0},1,{Pi/6,3Pi/2}],Text[Style[θ,20],{-2.5,0}]}  ,
					node=Join[node,{Darker[Blue],Thick,Circle[{Σl/100,0},0.1],Text[Style[i+1,20],{Σl/100,0.3}]}];
					element=Join[element,{Thick,LightGray,EdgeForm[{Thin,Gray}],Rectangle[{(Σl-(Subscript[l, i]))/100,(Subscript[d, i])/100},{Σl/100,-(Subscript[d, i])/100}],
								Text[Style[i,24,Gray],{(Σl-(Subscript[l, i])/2)/100,0.5+(Subscript[d, i])/100}]}]]
]
gr0=Graphics[{Join[axis,element,node,{Black,Thin,DotDashed,Line[{{-0.2,0},{ΣL/100+0.2,0}}]}]},ImageSize->Large]


(* Vettore degli spostamenti *)
For[i=1,i≤nodi,i++,
	  If[i==1,vinc=(({{TextCell["nodo"], TextCell["u(x)"], TextCell["v(y)"], TextCell["θ(z)"]}, {Style[i,Italic,16], 1, 1, 1}})),vinc=Join[vinc,(({{Style[i,Italic,16], 1, 1, 1}}))]]
];

txt0=TextCell["Inserire 0 se lo spostamento/rotazione è bloccato, altrimenti lasciare 1."];

V=Input[Grid[({{txt0}, {gr0}})],Grid[vinc,Frame->All,Spacings->{3.5,1}],WindowTitle->"Dati degli elementi",WindowSize->{Automatic,All}][[1]];

Vs={};Δ={};
For[i=1,i≤nodi,i++,    Vs=Join[Vs,V[[2;;nodi+1,2;;4]][[i]]];
						Δ=Join[Δ,{(Subscript[u, i]),(Subscript[v, i]),(Subscript[θ, i])}]]
Δ=Vs*Δ;  

(* Vettore delle forze *)
R={};Vf=Vs;  For[i=1,i≤(Subscript[n, glob]),i++,If[Vs[[i]]==1,Vf[[i]]=0,Vf[[i]]=1]]
For[i=1,i≤nodi,i++,R=Join[R,{(Subscript[Rx, i]),(Subscript[Ry, i]),(Subscript[Mv, i])}]];   R=R*Vf; 
F=ConstantArray[0,(Subscript[n, glob])];
text1=TextCell["Aggiungere uno ad uno ogni tipo di carico, infine premere TERMINA:"];
ans0=1;
While[ans0≠0,
ans0=ChoiceDialog[text1,{"Forza f(x)"->1,"Forza f(y)"->2,"Momento"->3,"TERMINA"->0},WindowTitle->"Vettore dei carichi"];
If[ans0≠0,P=Input[Grid[({{gr0}, {"Inserire i valori:"}})],Grid[(({{TextCell["nodo"], \[Placeholder]}, {TextCell["carico(N)"], \[Placeholder]}})),Frame->All,Spacings->6],WindowSize->{Automatic,All}][[1,All,2]];  F[[(P[[1]]-1)*3+ans0]]+=P[[2]];]
];
Print["\nVettori degli spostamenti e delle forze"]
Print["Δ=",Δ//MatrixForm,"\tF=",(F+R)//MatrixForm]


(* Vettore delle incognite *)
inc=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i≤3nodi,i++,Switch[Vs[[i]],0,inc[[i]]=R[[i]]
									,1,inc[[i]]=Δ[[i]]]]


(* Soluzione ed estrazione risultati *)
Print["\nSoluzione"]
sol=Solve[(Subscript[K, tot]).Δ==F+R,inc]//N//Chop

For[j=1,j≤(Subscript[n, glob]),j++,For[i=1,i≤(Subscript[n, glob]),i++,
Switch[sol[[1,i,1]],  R[[j]],  R[[j]]=sol[[1,i,2]],
					  Δ[[j]],  Δ[[j]]=sol[[1,i,2]]]
]]
Print["Δ=",Δ//MatrixForm,"\tF=",F//MatrixForm]

For[i=1,i≤El,i++,(Subscript[δ, i])=Δ[[1+(i-1)(Subscript[n, loc])/2;;(Subscript[n, loc])/2(i+1)]]]



(* Funzioni di forma e grafici degli spostamenti *)
i=.;     ξ=(2/L)(x-r);     r=((l1+l2)/2);     L=l2-l1;     l1=Σl-(Subscript[l, i]);     l2=Σl;     Ν=(({{(1-ξ)/2}, {(1/4)(2-3ξ+(ξ^3))}, {(L/8)(1-ξ-(ξ^2)+(ξ^3))}, {(1+ξ)/2}, {(1/4)(2+3ξ-(ξ^3))}, {(L/8)(-1-ξ+(ξ^2)+(ξ^3))}}));
For[i=1,i≤El,i++,(Subscript[nt, i])=Transpose[{0,1,1,0,1,1}*Ν]; (Subscript[na, i])=Transpose[{1,0,0,1,0,0}*Ν]]
trave={}; asta={};
For[i=1,i≤El,i++,trave=Join[trave,{{(Subscript[nt, i]).(Subscript[δ, i]),x≤Σl}}]; asta=Join[asta,{{(Subscript[na, i]).(Subscript[δ, i]),x≤Σl}}]]
deft[x_]=Piecewise[trave];
defa[x_]=Piecewise[asta];
ti={0}; For[i=1,i≤El,i++,ti=Join[ti,{Σl}]]

Plot[defa[x],{x,0,ΣL},PlotStyle->Thick,AxesLabel->{"x (mm)","f (mm)"},PlotLabel->Style[Framed["Deformazione assiale"]],ImageSize->500, AxesOrigin->{0,0},ExclusionsStyle->{{Dashed}},Filling->Axis,GridLines->{ti,Automatic}]Plot[deft[x],{x,0,ΣL},PlotStyle->Thick,AxesLabel->{"x (mm)","f (mm)"},PlotLabel->Style[Framed["Freccia nel piano xy"]],ImageSize->500, AxesOrigin->{0,0},ExclusionsStyle->{{Dashed}},Filling->Axis,GridLines->{ti,Automatic}]


(* Stato tensionale *)
teq={};     i=.;
Switch[sez,      cir,(Subscript[b, i])=(Sqrt[((Subscript[d, i])^2)-4(y^2)]);  (Subscript[S, i])=(((Subscript[b, i])^3)/12),	ret,(Subscript[S, i])=((Subscript[b, i])/2)((((Subscript[d, i])^2)/4)-(y^2))]; 

τ=(((Subscript[f1, i])(Subscript[S, i]))/((Subscript[b, i])(Subscript[J, i])));     (Subscript[σ, n])=((Subscript[n1, i])/(Subscript[A, i]));          (Subscript[σ, f])=({{((Subscript[m1, i])/(Subscript[J, i]))y,((Subscript[m2, i])/(Subscript[J, i]))y}}.{ ((1-ξ)/2) , ((1+ξ)/2) })[[1]];    

Print["\nForze agenti negli elementi\nn) { n1 , f1 , m1 , n2 , f2 , m2 }"]
For[i=1,i≤El,i++,{(Subscript[n1, i]),(Subscript[f1, i]),(Subscript[m1, i]),(Subscript[n2, i]),(Subscript[f2, i]),(Subscript[m2, i])}=(Subscript[K, i,loc]).(Subscript[δ, i]);
					Print[i,") ",(Subscript[K, i,loc]).(Subscript[δ, i])//Chop];
					teq=Join[teq,{{(Sqrt[((((Subscript[σ, f])+(Subscript[σ, n])))^2)+3 (τ^2)]),x≤Σl}}]]
(Subscript[σ, eq])[x_,y_]=Piecewise[teq];

di={};
For[i=1,i≤El,i++,di=Join[di,{{(Subscript[d, i]),x≤Σl}}]]
ϕ=Piecewise[di];
rmax=0;
For[i=1,i≤El,i++,If[rmax<(Subscript[d, i])/2,rmax=(Subscript[d, i])/2]]

cp=ContourPlot[(Subscript[σ, eq])[x,y],{x,0,ΣL},{y,-rmax,rmax},ContourLabels->Function[{x,y,z},Text[z,{x,y}]],FrameLabel->Automatic,BoundaryStyle->{Black,Thin},ColorFunction->"TemperatureMap",Contours->{Automatic,20},ImageSize->{Full,400},PlotLabel->Style[Framed[(Subscript[σ, eq])],16,Blue],PlotRange->All,AspectRatio->20rmax/ΣL,RegionFunction->Function[{x,y,z},-ϕ/2<y<ϕ/2]]
MessageDialog[cp,WindowSize->Large];

Print["\nValore massimo della tensione per ogni elemento"]
For[i=1,i≤El,i++,Print[i,") (Subscript[σ, max]):",FindMaximum[{teq[[i,1]],Abs[y]<(Subscript[d, i])/2 && Σl-(Subscript[l, i])<x<Σl},{x,y}]]]

Quit[]

4. Solutore di travi nello spazio a sezione circolare

nb=CreateDocument[];
NotebookWrite[nb,Cell["Dati del calcolo","Subsection"]]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*1 CREAZIONE DELLA STRUTTURA *)

(*inserimento degli elementi e dei nodi*)
tx0=TextCell["Inserire il numero di elementi e di nodi totale:","Input"];
gr0=Grid[({{TextCell["n° elem"], TextCell["n° nodi"]}, {\[Placeholder], \[Placeholder]}}),Frame->All,Spacings->{4,2}];
EN=Input[tx0,gr0,FieldSize->15];   {El,nodi}=EN[[1,2]];
(*gradi di liberta locali e globali*)
(Subscript[n, loc])=12;   (Subscript[n, glob])=6nodi;

(*assegnazione dei nodi a ciascun elemento*)
nodel={};
For[i=1,i≤El,i++,nodel=Join[nodel,{{el[i],\[Placeholder],\[Placeholder]}}]];    
gr1=Grid[nodel,Frame->True,Dividers->{Gray,Black},Spacings->{3,1}];
tx1=TextCell["Associare ad ogni elemento el[i], i rispettivi nodi:","Input"];
map=Input[tx1,gr1,FieldSize->14];
For[i=1,i≤El,i++,(Subscript[el, i])=map[[1,i,2;;3]]]

(*inserimento delle coordinate dei nodi*)
coo={{nodo[n°]},{𝒳 [mm]},{𝒴 [mm]},{𝒵 [mm]}};
For[i=1,i≤nodi,i++,coo=Join[coo,{{i},{\[Placeholder]},{\[Placeholder]},{\[Placeholder]}},2]];
gr2=Grid[coo\[Transpose],Frame->True,Dividers->{Thick,Gray},Spacings->{2,1.5}];
tx2=TextCell["Inserire le coordinate di ogni nodo","Input"];
coonod=Input[tx2,gr2,FieldSize->Medium];
For[i=1,i≤nodi,i++,{(Subscript[nx, i]),(Subscript[ny, i]),(Subscript[nz, i])}=coonod[[1,i+1,2;;4]];cn[i]={(Subscript[nx, i]),(Subscript[ny, i]),(Subscript[nz, i])}]

(*inserimaneto dei dati geometrici e fisici degli elementi*)
geo={{elem[n°]},{HoldForm[Ε×(10^5)[MPa]]},{d [mm]}};
For[i=1,i≤El,i++,geo=Join[geo,{{el[i]},{\[Placeholder]},{\[Placeholder]}},2]]
gr3=Grid[geo\[Transpose],Frame->True,Dividers->{Thick,Gray},Spacings->{2,1}];
tx3=TextCell["Inserire i valori per ogni elemento el[i]","Input"];
dat=Input[tx3,gr3,FieldSize->Medium];

NotebookWrite[nb,{ToBoxes[EN],ToBoxes[map],ToBoxes[coonod],ToBoxes[dat]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*2 CREAZIONE DELLA MATRICE DI RIGIDEZZA *)

(*COLLOCAZIONE DELLE MATRICI LOCALI ESPANSE NELLA GLOBALE*)
NotebookWrite[nb,Cell["\nMatrici di passaggio da locale a globale","Text"]]
H=SparseArray[ConstantArray[0,{El,(Subscript[n, loc]),(Subscript[n, glob])}]];
For[i=1,i≤El,i++,
	For[j=1,j≤2,j++,
		For[k=1,k≤6,k++,H[[i,(j-1)6+k,((Subscript[el, i])[[j]]-1)6+k]]=1]];
	NotebookWrite[nb,Cell[ToBoxes[H[[i]]//MatrixForm,StandardForm]]];
	(Subscript[K, i,loc])=Array[(Subscript[κ, ##])[i]&,{(Subscript[n, loc]),(Subscript[n, loc])}];
	(Subscript[K, i,glob])=H[[i]]\[Transpose].(Subscript[K, i,loc]).H[[i]]]
(Subscript[K, tot])=SparseArray[(∑_(i=1)^El)(Subscript[K, i,glob])];
NotebookWrite[nb,{Cell["\nMatrice globale <mappa>","Text"],Cell[ToBoxes[(Subscript[K, tot])//MatrixForm,StandardForm]]}]

(*PASSAGGIO DEL SISTEMA DI RIFERIMENTO DA LOCALE A GLOBALE*)
(*l'asse x è baricentrico, l'asse z è preso giacente nel piano XY positivo del sistema di riferimento globale*)

(*Coordinate del secondo nodo dell'elemento con primo nodo trasferito al centro degli assi del sistema di riferimento globale*)
For[i=1,i≤El,i++,{(Subscript[dx, i]),(Subscript[dy, i]),(Subscript[dz, i])}=cn[(Subscript[el, i])[[2]]]-cn[(Subscript[el, i])[[1]]];];   i=.;

(*norme*)
norm3=(Sqrt[((Subscript[dx, i])^2)+((Subscript[dy, i])^2)+((Subscript[dz, i])^2)]);    
norm2=(Sqrt[((Subscript[dx, i])^2)+((Subscript[dy, i])^2)]);
norm1=(Sqrt[((Subscript[dx, i])^2)+((Subscript[dy, i])^2)+(dyz^2)]);
dyz=((((Subscript[dx, i])^2)+((Subscript[dy, i])^2))/(Subscript[dz, i]));

(*matrice dei coseni direttori *)
R[i_]=(({{((Subscript[dx, i])/norm3), ((Subscript[dy, i])/norm3), ((Subscript[dz, i])/norm3)}, {((-(Subscript[dx, i]))/norm1), ((-(Subscript[dy, i]))/norm1), (dyz/norm1)}, {((Subscript[dy, i])/norm2), ((-(Subscript[dx, i]))/norm2), 0}}));     o=(({{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}));
Rp[i_]=(({{((Subscript[dx, i])/norm2), ((Subscript[dy, i])/norm2), 0}, {((-(Subscript[dy, i]))/norm2), ((Subscript[dx, i])/norm2), 0}, {0, 0, 1}}));  (* rotazione nel piano XY *)

(*matrici di rotazione*)
NotebookWrite[nb,Cell["\nMatrici dei coseni direttori","Text"]]
For[i=1,i≤El,i++,If[(Subscript[dx, i])==0&&(Subscript[dy, i])==0,(Subscript[λ, i])=(({{0, 0, 1}, {1, 0, 0}, {0, 1, 0}})),(* x=Z, y=X, x=Y *)
					If[(Subscript[dx, i])==0&&(Subscript[dz, i])==0,(Subscript[λ, i])=(({{0, 1, 0}, {0, 0, 1}, {1, 0, 0}})),(* x=Y, y=Z, z=X *)
					If[(Subscript[dy, i])==0&&(Subscript[dz, i])==0,(Subscript[λ, i])=(({{1, 0, 0}, {0, 1, 0}, {0, 0, 1}})), (* x=X, y=Y, z=Z *)
					If[(Subscript[dz, i])==0,                        (Subscript[λ, i])=Rp[i], 
					(*else*)			(Subscript[λ, i])=R[i]]]]];

					NotebookWrite[nb,Cell[ToBoxes[(Subscript[λ, i])//MatrixForm]]];

					(Subscript[l, i])=norm3;
					(Subscript[T, i])=SparseArray[ArrayFlatten[(({{(Subscript[λ, i]), o, o, o}, {o, (Subscript[λ, i]), o, o}, {o, o, (Subscript[λ, i]), o}, {o, o, o, (Subscript[λ, i])}}))]]]
(* Oss: (Subscript[λ, i])\[Transpose]=((Subscript[λ, i])^(-1))  =>  (Subscript[T, i])\[Transpose]=((Subscript[T, i])^(-1)) *)


(*TIPOLOGIA DELLA MATRICE DI RIGIDEZZA*)
Jy=Jz=π((d^4)/64);   Jp=Jy/2;   A=π ((d^4)/4);   G=(Ε/(2(1+ν)));   ν=0.3;
(Subscript[K, tip])[Ε_,d_,l_]=SparseArray[(({{((A Ε)/l), 0, 0, 0, 0, 0, -((A Ε)/l), 0, 0, 0, 0, 0}, {0, ((12Ε Jz)/(l^3)), 0, 0, 0, ((6Ε Jz)/(l^2)), 0, -((12 Ε Jz)/(l^3)), 0, 0, 0, ((6 Ε Jz)/(l^2))}, {0, 0, ((12 Ε Jy)/(l^3)), 0, -((6 Ε Jy)/(l^2)), 0, 0, 0, -((12 Ε Jy)/(l^3)), 0, -((6 Ε Jy)/(l^2)), 0}, {0, 0, 0, ((G Jp)/l), 0, 0, 0, 0, 0, -((G Jp)/l), 0, 0}, {0, 0, -((6 Ε Jy)/(l^2)), 0, ((4 Ε Jy)/l), 0, 0, 0, ((6 Ε Jy)/(l^2)), 0, ((2 Ε Jy)/l), 0}, {0, ((6 Ε Jz)/(l^2)), 0, 0, 0, ((4 Ε Jz)/l), 0, -((6 Ε Jz)/(l^2)), 0, 0, 0, ((2Ε Jz)/l)}, {-((A Ε)/l), 0, 0, 0, 0, 0, ((A Ε)/l), 0, 0, 0, 0, 0}, {0, -((12 Ε Jz)/(l^3)), 0, 0, 0, -((6 Ε Jz)/(l^2)), 0, ((12Ε Jz)/(l^3)), 0, 0, 0, -((6 Ε Jz)/(l^2))}, {0, 0, -((12 Ε Jy)/(l^3)), 0, ((6 Ε Jy)/(l^2)), 0, 0, 0, ((12 Ε Jy)/(l^3)), 0, ((6 Ε Jy)/(l^2)), 0}, {0, 0, 0, -((G Jp)/l), 0, 0, 0, 0, 0, ((G Jp)/l), 0, 0}, {0, 0, -((6 Ε Jy)/(l^2)), 0, ((2 Ε Jy)/l), 0, 0, 0, ((6 Ε Jy)/(l^2)), 0, ((4 Ε Jy)/l), 0}, {0, ((6 Ε Jz)/(l^2)), 0, 0, 0, ((2Ε Jz)/l), 0, -((6 Ε Jz)/(l^2)), 0, 0, 0, ((4 Ε Jz)/l)}}))];

(*sostituzione dei dati, rotazione delle matrici locali e sostituzione nella matrice globale <mappa>*)
For[i=1,i≤El,i++,{(Subscript[Ε, i]),(Subscript[d, i])}=dat[[1,i+1,2;;3]]*{(10^5),1};
					(Subscript[K, loc,i])=(Subscript[K, tip])[(Subscript[Ε, i]),(Subscript[d, i]),(Subscript[l, i])];
					(Subscript[K, rot,i])=(Subscript[T, i]).(Subscript[K, loc,i]).(Subscript[T, i])\[Transpose];
	For[jr=1,jr≤(Subscript[n, loc]),jr++,
		For[jc=1,jc≤(Subscript[n, loc]),jc++,(Subscript[κ, jr,jc])[i]=(Subscript[K, rot,i])[[jc,jr]]]]]
NotebookWrite[nb,{Cell["\nMatrice globale finale","Text"],Cell[ToBoxes[(Subscript[K, tot])//MatrixForm,StandardForm]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*3 VETTORE DEGLI SPOSTAMENTI *)

(*raffigurazione tridimensionale*)
node={};element={};
axis={Red,Arrow[{{0,0,0},{100,0,0}}],Arrow[{{0,0,0},{0,100,0}}],Arrow[{{0,0,0},{0,0,100}}],Black,Text[Style[Y,20,Bold],{-5,90,-5}],Text[Style[X,20,Bold],{90,-5,-5}],Text[Style[Z,20,Bold],{-5,-5,90}]};
For[i=1,i≤nodi,i++,node=Join[node,{Cyan,Thick,Sphere[{(Subscript[nx, i]),(Subscript[ny, i]),(Subscript[nz, i])},4],Text[Style[i,24,Darker[Blue],Bold],{(Subscript[nx, i])+10,(Subscript[ny, i])+10,(Subscript[nz, i])+10}]}]]
For[i=1,i≤El,i++,element=Join[element,{Thick,Green,Opacity[0.4],EdgeForm[{Thin,Gray}],Cylinder[{{(Subscript[nx, (Subscript[el, i])[[1]]]),(Subscript[ny, (Subscript[el, i])[[1]]]),(Subscript[nz, (Subscript[el, i])[[1]]])},{(Subscript[nx, (Subscript[el, i])[[2]]]),(Subscript[ny, (Subscript[el, i])[[2]]]),(Subscript[nz, (Subscript[el, i])[[2]]])}},3]}]]
j1=Join[node,axis,element] ;Im1=Graphics3D[{j1},Axes->True,ImageSize->Large,FaceGrids->{{0,0,-1},{0,1,0},{-1,0,0}}];
MessageDialog[Im1,WindowSize->{All,All},WindowMargins->{{0,Automatic},{Automatic,0}}];
NotebookWrite[nb,{Cell["\nVincoli","Text"],Cell[BoxData[ToBoxes[Im1],"Output"]]}]

(*inserimento dei vincoli*)
vinc=(({{TextCell["nodo"], TextCell["u(x)"], TextCell["u(y)"], TextCell["u(z)"], TextCell["θ(x)"], TextCell["θ(y)"], TextCell["θ(z)"]}}));
For[i=1,i≤nodi,i++,vinc=Join[vinc,(({{Style[i,Bold,16], f, f, f, f, f, f}}))]];
tx4=TextCell["Inserire 0 se lo spostamento/rotazione è vincolato, altrimenti lasciare ƒ.
Se lo spostamento/rotazione invece è imposto, iserirne il valore in millimetri/radianti"];
vincoli=Input[tx4,Grid[vinc,Frame->All,Spacings->{1.5,1}],WindowTitle->"Dati degli elementi",WindowSize->{Automatic,All},WindowMargins->{{Automatic,0},{Automatic,0}}];
V=vincoli[[1]];
NotebookWrite[nb,Cell[ToBoxes[vincoli,StandardForm]]]

(*vettore degli spostamenti*)
Vs={};Δ={};
For[i=1,i≤nodi,i++,    Vs=Join[Vs,V[[2;;nodi+1,2;;7]][[i]]];
						Δ=Join[Δ,{(Subscript[ux, i]),(Subscript[uy, i]),(Subscript[uz, i]),(Subscript[θx, i]),(Subscript[θy, i]),(Subscript[θz, i])}]]
dd=Δ;
For[i=1,i≤(Subscript[n, glob]),i++,If[Vs[[i]]≠0,Δ[[i]]=Vs[[i]];Vs[[i]]=1];
						  If[Vs[[i]]==f,Vs[[i]]=1]]
 Δ=Δ*Vs;
NotebookWrite[nb,{Cell["\nVettore degli spostamenti","Text"],Cell[ToBoxes[Δ,StandardForm]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*4 VETTORE DELLE FORZE *)

(*vettore delle reazioni incognite*)
R={};Vf=Vs; ff={};
For[i=1,i≤(Subscript[n, glob]),i++,If[Vs[[i]]==1,Vf[[i]]=0,Vf[[i]]=1]]
For[i=1,i≤nodi,i++,R=Join[R,{(Subscript[Rx, i]),(Subscript[Ry, i]),(Subscript[Rz, i]),(Subscript[Mx, i]),(Subscript[My, i]),(Subscript[Mz, i])}]];   
R=R*Vf;
For[i=1,i≤nodi,i++,ff=Join[ff,{(Subscript[Fx, i]),(Subscript[Fy, i]),(Subscript[Fz, i]),(Subscript[Mx, i]),(Subscript[My, i]),(Subscript[Mz, i])}]]

(*inserimento delle forze esterne applicate*)
tx5=TextCell["Aggiungere uno ad uno i carichi, infine premere TERMINA:"];
tx6=TextCell["Inserire i dati sul carico: il nodo ove applicato applicato, il valore e le coordinate globali di un pto appartenente al vettore 
(il verso del carico che si considera è quello dal nodo di applicazione al pto inserito)"];
gr4=Grid[(({{TextCell["Nodo di applicazione"], \[Placeholder]}, {TextCell["Carico [N or N/mm]"], \[Placeholder]}, {TextCell["Coordinate pto [mm]"], Grid[(({{x, \[Placeholder]}, {y, \[Placeholder]}, {z, \[Placeholder]}})),Frame->All,FrameStyle->Gray,Spacings->{4}]}})),Frame->All];
ans0=1;nc=0;(*nc:contatore dei carichi inseriti*)
While[ans0≠0 ,
ans0=ChoiceDialog[tx5,{"AGGIUNGI FORZA"->1,"AGGIUNGI MOMENTO"->2,"TERMINA"->0},WindowTitle->"Vettore dei carichi"];
nc++;If[ans0>0,P[nc]=Input[tx6,gr4,FieldSize->25,WindowSize->{Automatic,All},WindowMargins->{{Automatic,0},{Automatic,Automatic}}];
				P[nc]=Join[{{ans0}},{P[nc][[1,1;;2,2]]},{P[nc][[1,3,2,1,All,2]]}]]
];

(*traslazione nodo di applicazione dei vettori forza al centro del sistema globale*)
For[i=1,i<nc,i++,{(Subscript[px, i]),(Subscript[py, i]),(Subscript[pz, i])}=P[i][[3]];cp[i]={(Subscript[px, i]),(Subscript[py, i]),(Subscript[pz, i])};(*coordinate del 2° pto del vettore*)
					{(Subscript[cx, i]),(Subscript[cy, i]),(Subscript[cz, i])}=cp[i]-cn[P[i][[2,1]]]]

(*proiezione del vettore forza lungo gli assi del sistema globale*)
i=.;
norm=(Sqrt[((Subscript[cx, i])^2)+((Subscript[cy, i])^2)+((Subscript[cz, i])^2)]);     Rc[i_]={((Subscript[cx, i])/norm),((Subscript[cy, i])/norm),((Subscript[cz, i])/norm)};
For[i=1,i<nc,i++,(Subscript[Fglob, i])=P[i][[2,2]]*Rc[i];]
F=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i<nc,i++,     Switch[P[i][[1,1]], 1,F[[(P[i][[2,1]]*6-5);;(P[i][[2,1]]*6-3)]]+=(Subscript[Fglob, i]),
										2,F[[(P[i][[2,1]]*6-2);;P[i][[2,1]]*6]]+=(Subscript[Fglob, i])]];
FR=F+R;
NotebookWrite[nb,{Cell["\nVettore delle forze e delle reazioni","Text"],Cell[ToBoxes[FR,StandardForm]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*5 SOLUZIONE DEL SISTEMA *)

(*Vettore delle incognite *)
inc=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i≤(Subscript[n, glob]),i++,Switch[Vs[[i]], 0,inc[[i]]=R[[i]]
									,1,inc[[i]]=Δ[[i]]]]
(*Soluzione*)
sol=Solve[(Subscript[K, tot]).Δ==(FR),inc]//N;
NotebookWrite[nb,{Cell["Soluzione","Text"],Cell[ToBoxes[sol[[1]],StandardForm]]}]

(*sostituzione dei risultati*)
For[j=1,j≤(Subscript[n, glob]),j++,For[i=1,i≤(Subscript[n, glob]),i++,
Switch[sol[[1,i,1]],  R[[j]],  R[[j]]=sol[[1,i,2]],
					  Δ[[j]],  Δ[[j]]=sol[[1,i,2]]]
]]
FR=F+R;
NotebookWrite[nb,{Cell["\nMatrici delle forze e degli spostamenti risolte","Text"],
Cell[ToBoxes[Grid[(({{ff//MatrixForm, FR//N//MatrixForm, Null, Null, dd//MatrixForm, Δ//N//MatrixForm}}))]]]}]

(*---------------------------------------------------------------------------------------------------------------------------------*)
(*6 ELEMENTI *)

(*assegnazione spostamenti e forze negli elementi *)
NotebookWrite[nb,Cell["\t{Fx1\tFy1\tFz1\tMx1\tMy1\tMz1\tFx2\tFy2\tFz2\tMx2\tMy2\tMz2}","Text"]]
For[i=1,i≤El,i++,(Subscript[δ, i])=Join[Δ[[(Subscript[el, i])[[1]]*6-5;;(Subscript[el, i])[[1]]*6]],Δ[[(Subscript[el, i])[[2]]*6-5;;(Subscript[el, i])[[2]]*6]]];
					(Subscript[f, i])=Chop[(Subscript[K, loc,i]).(Subscript[T, i])\[Transpose].(Subscript[δ, i]),0.1];
					NotebookWrite[nb,Cell[ToBoxes[({{elemento, i, Round[(Subscript[f, i]),0.1]}})//MatrixForm,StandardForm]]]]

(*Spostamento dei nodi*)
node={};element={};
For[i=1,i≤nodi,i++,node=Join[node,{Opacity[1],Magenta,Thick,Sphere[{(Subscript[nx, i]),(Subscript[ny, i]),(Subscript[nz, i])}+10Δ[[6i-5;;6i-3]],3]}]]
For[i=1,i≤El,i++,element=Join[element,{Thick,Black,Dashed,Opacity[0.8],Line[{{(Subscript[nx, (Subscript[el, i])[[1]]]),(Subscript[ny, (Subscript[el, i])[[1]]]),(Subscript[nz, (Subscript[el, i])[[1]]])}+10(Subscript[δ, i])[[1;;3]],{(Subscript[nx, (Subscript[el, i])[[2]]]),(Subscript[ny, (Subscript[el, i])[[2]]]),(Subscript[nz, (Subscript[el, i])[[2]]])}+10(Subscript[δ, i])[[7;;9]]}]}]]
j2=Join[j1,node,element];Im2=Graphics3D[{j2},Axes->True,ImageSize->Large,FaceGrids->{{0,0,-1},{0,1,0},{-1,0,0}}];
NotebookWrite[nb,{Cell["\nSpostamento dei nodi ×10","Text"],Cell[BoxData[ToBoxes[Im2],"Output"]]}]

(* STATO TENSIONALE *)   
 i=.;
ξ=(2/(Subscript[l, i]))(x-((Subscript[l, i])/2));     J=π(((Subscript[d, i])^4)/64);     jp=J/2;
τ=((Subscript[mt, i])/jp)y;     (Subscript[σ, n])=((Subscript[n, i])/(A/.d->(Subscript[d, i])));     (Subscript[σ, f])=({{((Subscript[mf1, i])/J)y,((Subscript[mf2, i])/J)y}}.{ ((1-ξ)/2) , ((1+ξ)/2) })[[1]];    
NotebookWrite[nb,Cell["\nTensione equivalente negli elementi","Text"]]
(*hp:taglio trascurabile*)
For[i=1,i≤El,i++,
	(Subscript[mf1, i])=(Sqrt[(((Subscript[f, i])[[5]])^2)+(((Subscript[f, i])[[6]])^2)]);      (Subscript[mf2, i])=(Sqrt[(((Subscript[f, i])[[11]])^2)+(((Subscript[f, i])[[12]])^2)]);     (Subscript[mt, i])=(Subscript[f, i])[[4]];     (Subscript[n, i])=(Subscript[f, i])[[1]];
	(Subscript[σ, eq,i])[x_,y_]=(Sqrt[((((Subscript[σ, f])+(Subscript[σ, n])))^2)+3 (τ^2)]);

	cp=ContourPlot[(Subscript[σ, eq,i])[x,y],{x,0,(Subscript[l, i])},{y,-(Subscript[d, i])/2,(Subscript[d, i])/2},ContourLabels->Function[{x,y,z},Text[z,{x,y}]],FrameLabel->Automatic,BoundaryStyle->{Black,Thin},ColorFunction->"TemperatureMap",Contours->{Automatic,20},ImageSize->{750,250},PlotLabel->Style[Framed[(Subscript[σ, i,eq])],16,Blue],AspectRatio->Full];
	NotebookWrite[nb,Cell[BoxData[ToBoxes[cp],"Output"]]]]

(*Valore massimo*)
NotebookWrite[nb,Cell["\nValore massimo della tensione per ogni elemento","Text"]]
For[i=1,i≤El,i++,max=Maximize[{(Subscript[σ, eq,i])[x,y],Abs[y]<(Subscript[d, i])/2 && 0<x<(Subscript[l, i])},{x,y}];
NotebookWrite[nb,{Cell[ToBoxes[Grid[({{i, TextCell[") σ_max:"], max}})],StandardForm]]}]]

Quit[]

5. Calcolo della fatica (Goodman-Smith, Woholer, Roark)

(*========================================================================================================================*)
(*INSERIMENTO DEI DATI SUL MATERIALE E SUL TIPO DI GEOMETRIA*)

nome=Grid[({{TextCell["Materiale:"], TextCell[InputString["Inserire il nome del materiale"],"Subsubtitle"]}})];

tx01=TextCell["Inserire la tensione a rottura e modificare i valori noti.\n"];
tx02=TextCell["Oss: il valore assunto della tensione all'origine è preso 
	dalla UNI 7670. Può essere altrimenti sostituito con 
	il valore derivante dalla costruzionegeometrica del 
	diagramma di Goodman-Smith: "InputField[(2/3)(Subscript[σ, R]),FieldSize->{2,1.5}]];
tx03=TextCell[" (tensione a rottura)"]HoldForm[(Subscript[σ, R])];in01=InputField[Dynamic[(Subscript[σ, R])],FieldSize->{5,1}];
tx04=TextCell[" (tensione a snervamento)"]HoldForm[(Subscript[σ, S])];in02=InputField[Dynamic[(Subscript[σ, S])],FieldSize->{5,1.5}];
tx05=TextCell[" (tensione limite per un ciclo all'inversione)"]HoldForm[(Subscript[σ, inv])];in03=InputField[Dynamic[(Subscript[σ, inv])],FieldSize->{5,1.5}];
tx06=TextCell[" (tensione limite per un ciclo all'origine)"]HoldForm[(Subscript[σ, o])];in04=InputField[Dynamic[(Subscript[σ, o])],FieldSize->{5,1.5}];

gr01=Grid[({{TextCell["Costruzione geometrica del diagramma di Goodman-Smith"]}, {Framed[Image[,ImageSize->300]]}})];

gr02=Grid[({{tx03, TextCell[":"], in01, TextCell["MPa"]}, {tx04, TextCell[":"], in02, TextCell["MPa"]}, {tx05, TextCell[":"], in03, TextCell["MPa"]}, {tx06, TextCell[":"], in04, TextCell["MPa"]}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];
gr03=Grid[({{tx01}, {gr02}, {Null}, {tx02}}),Alignment->Left];
(Subscript[σ, S])=(4/5)(Subscript[σ, R]);     (Subscript[σ, inv])=(1/2)(Subscript[σ, R]);    (Subscript[σ, o])=(5/3)(Subscript[σ, inv]);

ChoiceDialog[Grid[({{gr03, Null, gr01}}),Alignment->Top],WindowSize->{800,All}];

(Subscript[σ, mO])=((Subscript[σ, o])/2);     (Subscript[σ, mS])=(((Subscript[σ, S])-(Subscript[σ, inv]))/((Subscript[σ, o])-(Subscript[σ, inv])))(Subscript[σ, mO]);     

(Subscript[σ, GS])[σm_]=If[σm≤(Subscript[σ, mS]),σm (((Subscript[σ, o])-(Subscript[σ, inv]))/((Subscript[σ, o])/2))+(Subscript[σ, inv]),
		If[σm≤(Subscript[σ, S]),   (Subscript[σ, S])]];

(*------------------------------------------------------------------------------------------------------------------------*)
(*geometria dell'intaglio*)
(Subscript[fg, 1])=;(Subscript[fg, 2])=;(Subscript[fg, 3])=;(Subscript[fg, 4])=;
(Subscript[fg, 5])=;(Subscript[fg, 6])=;(Subscript[fg, 7])=;(Subscript[fg, 8])=;
pm={};For[i=1,i<9,i++,pm=Join[pm,{Framed[Image[(Subscript[fg, i]),ImageSize->150],FrameStyle->Blue,RoundingRadius->2]->i}]]
pm=Join[pm,{Framed[Image[,ImageSize->127],FrameMargins->15,FrameStyle->Blue,RoundingRadius->2]->9,
		Framed[Image[,ImageSize->127],FrameMargins->15,FrameStyle->Blue,RoundingRadius->2]->10}];
tx10=TextCell["Scegliere la geometria per il calcolo del coefficiente teorico elastico di concentrazione delle tensioni K_t:","Subsubtitle"];

gct=ChoiceDialog[tx10,pm,WindowSize->{900,450}];


(*========================================================================================================================*)
(*INIZIALIZZAZIONE DATI, IMMAGINI, FORMULE E GRIGLIE DI CALCOLO*)

(*------------------------------------------------------------------------------------------------------------------------*)
(*dati su coefficienti teorici elastici di concentrazione delle tensioni dal Roark*)
r1=2h/d;   r2=h/r;   r3=2r/d;   r4=r1/2;   r5=2r/h;
(*1 gct*)(Subscript[L, 1])=0.25≤r2≤{50,TextCell["4 se fless. perpend."]};	
	(*st1*)(({{(Subscript[c1, 1,1])}, {(Subscript[c2, 1,1])}, {(Subscript[c3, 1,1])}, {(Subscript[c4, 1,1])}}))=(({{If[0.25≤r2≤2,0.85+2.63(Sqrt[r2])-0.41r2,0.83+2.07(Sqrt[r2])-0.01r2]}, {If[0.25≤r2≤2,-1.12-4.83(Sqrt[r2])+2.58r2,2.73-4.16(Sqrt[r2])+0.18r2]}, {If[0.25≤r2≤2,3.56-0.51(Sqrt[r2])-2.4r2,-8.86+5.32(Sqrt[r2])-0.32r2]}, {If[0.25≤r2≤2,-2.29+2.71(Sqrt[r2])+0.24r2,6.29-3.37(Sqrt[r2])+0.15r2]}}));
	(*st2*)(({{(Subscript[c1, 1,2])}, {(Subscript[c2, 1,2])}, {(Subscript[c3, 1,2])}, {(Subscript[c4, 1,2])}}))=(({{If[0.25≤r2≤2,0.72+2.85(Sqrt[r2])-0.5r2,0.83+2.07(Sqrt[r2])-0.01r2]}, {If[0.25≤r2≤2,-1.84-5.75(Sqrt[r2])+1.31r2,0.02-5.38(Sqrt[r2])+0.13r2]}, {If[0.25≤r2≤2,7.25-1.89(Sqrt[r2])+1.65r2,-0.86+6.46(Sqrt[r2])-0.2r2]}, {If[0.25≤r2≤2,-5.14+4.79(Sqrt[r2])-2.46r2,1-3.15(Sqrt[r2])+0.08r2]}}));	(*st4*)(({{(Subscript[c1, 1,4])}, {(Subscript[c2, 1,4])}, {(Subscript[c3, 1,4])}, {(Subscript[c4, 1,4])}}))=(({{1.03+0.83(Sqrt[r2])+0.01r2}, {-1.23-1.65(Sqrt[r2])+0.12r2}, {3.34-0.75(Sqrt[r2])+0.47r2}, {-2.14+1.57(Sqrt[r2])-0.6r2}}));
(*2 gct*)(Subscript[L, 2])=0.5≤r2≤4;	
	(*st1*)(({{(Subscript[c1, 2,1])}, {(Subscript[c2, 2,1])}, {(Subscript[c3, 2,1])}, {(Subscript[c4, 2,1])}}))=(({{0.72+2.4(Sqrt[r2])-0.13r2}, {1.98-11.49(Sqrt[r2])+2.21r2}, {-4.41+18.75(Sqrt[r2])-4.6r2}, {2.71-9.66(Sqrt[r2])+2.51r2}}));	(*st2*)(({{(Subscript[c1, 2,2])}, {(Subscript[c2, 2,2])}, {(Subscript[c3, 2,2])}, {(Subscript[c4, 2,2])}}))=(({{0.72+2.39(Sqrt[r2])-0.13r2}, {-0.43-8.83(Sqrt[r2])+1.52r2}, {2.16+10.97(Sqrt[r2])-2.46r2}, {-1.46-4.54(Sqrt[r2])+1.06r2}}));
(*3 gct*)(Subscript[L, 3])=0.1≤r2≤20;
	(*st1*)(({{(Subscript[c1, 3,1])}, {(Subscript[c2, 3,1])}, {(Subscript[c3, 3,1])}, {(Subscript[c4, 3,1])}}))=(({{If[0.1≤r2≤2,1+(Sqrt[r2])-0.03r2,1.04+0.98(Sqrt[r2])-0.04r2]}, {If[0.1≤r2≤2,-0.11-0.59(Sqrt[r2])+0.31r2,-0.07-0.16(Sqrt[r2])-0.01r2]}, {If[0.1≤r2≤2,0.24-(Sqrt[r2])+0.27r2,-3.42+1.22(Sqrt[r2])-0.005r2]}, {If[0.1≤r2≤2,-0.13+0.58(Sqrt[r2])-0.01r2,3.45-2.05(Sqrt[r2])+0.05r2]}}));
	(*st2*)(({{(Subscript[c1, 3,2])}, {(Subscript[c2, 3,2])}, {(Subscript[c3, 3,2])}, {(Subscript[c4, 3,2])}}))=(({{If[0.1≤r2≤2,1+(Sqrt[r2])-0.03r2,1.04+0.98(Sqrt[r2])-0.04r2]}, {If[0.1≤r2≤2,-0.27-2.4(Sqrt[r2])+0.75r2,-3.6+1.62(Sqrt[r2])-0.43r2]}, {If[0.1≤r2≤2,0.68-1.13(Sqrt[r2])-0.9r2,6.08-5.61(Sqrt[r2])+1.16r2]}, {If[0.1≤r2≤2,-0.41+0.27(Sqrt[r2])+0.19r2,-2.53+3(Sqrt[r2])-0.69r2]}}));
(*6 gct*)(Subscript[L, 6])=0.25≤r2≤50;
	(*st1*)(({{(Subscript[c1, 6,1])}, {(Subscript[c2, 6,1])}, {(Subscript[c3, 6,1])}, {(Subscript[c4, 6,1])}}))=(({{If[0.25≤r2≤2,0.46+3.35(Sqrt[r2])-0.77r2,0.93+1.92(Sqrt[r2])-0.004r2]}, {If[0.25≤r2≤2,3.13-15.96(Sqrt[r2])+7.4r2,0.54-3.71(Sqrt[r2])+0.04r2]}, {If[0.25≤r2≤2,-6.91+29.3(Sqrt[r2])-16.1r2,-2.54+3.44(Sqrt[r2])-0.01r2]}, {If[0.25≤r2≤2,4.33-16.7(Sqrt[r2])+9.47r2,2.07-1.65(Sqrt[r2])-0.03r2]}}));
	(*st2*)(({{(Subscript[c1, 6,2])}, {(Subscript[c2, 6,2])}, {(Subscript[c3, 6,2])}, {(Subscript[c4, 6,2])}}))=(({{If[0.25≤r2≤2,0.46+3.35(Sqrt[r2])-0.77r2,0.94+1.92(Sqrt[r2])+0.004r2]}, {If[0.25≤r2≤2,0.89-12.72(Sqrt[r2])+4.59r2,-0.55-5.33(Sqrt[r2])+0.09r2]}, {If[0.25≤r2≤2,0.29+15.48(Sqrt[r2])-6.39r2,0.75+6.28(Sqrt[r2])-0.12r2]}, {If[0.25≤r2≤2,-0.63-6.12(Sqrt[r2])+2.57r2,-0.14-2.88(Sqrt[r2])+0.03r2]}}));
	(*st3*)(({{(Subscript[c1, 6,3])}, {(Subscript[c2, 6,3])}, {(Subscript[c3, 6,3])}, {(Subscript[c4, 6,3])}}))=(({{If[0.25≤r2≤2,1.25+0.26(Sqrt[r2])+0.49r2,1.65+0.61(Sqrt[r2])+0.04r2]}, {If[0.25≤r2≤2,-3.03+3.27(Sqrt[r2])-3.63r2,-4.79-0.31(Sqrt[r2])-0.22r2]}, {If[0.25≤r2≤2,7.2-11.3(Sqrt[r2])+8.32r2,8.46-0.96(Sqrt[r2])+0.39r2]}, {If[0.25≤r2≤2,-4.41+7.75(Sqrt[r2])-5.18r2,-4.31+0.66(Sqrt[r2])-0.12r2]}}));
(*7 gct*)(Subscript[L, 7])=0.25≤r2≤{20,TextCell["4 se fless. perpend."]};
	(*st1*)(({{(Subscript[c1, 7,1])}, {(Subscript[c2, 7,1])}, {(Subscript[c3, 7,1])}, {(Subscript[c4, 7,1])}}))=(({{If[0.25≤r2≤2,0.93+1.15(Sqrt[r2])-0.09r2,1.23+0.83(Sqrt[r2])-0.01r2]}, {If[0.25≤r2≤2,0.01-3.03(Sqrt[r2])+0.95r2,-1.83-0.32(Sqrt[r2])-0.05r2]}, {If[0.25≤r2≤2,-0.3+3.98(Sqrt[r2])-1.74r2,2.24-0.52(Sqrt[r2])+0.18r2]}, {If[0.25≤r2≤2,0.37-2.1(Sqrt[r2])+0.88r2,-0.63+0.01(Sqrt[r2])-0.12r2]}}));
	(*st2*)(({{(Subscript[c1, 7,2])}, {(Subscript[c2, 7,2])}, {(Subscript[c3, 7,2])}, {(Subscript[c4, 7,2])}}))=(({{If[0.25≤r2≤2,0.93+1.15(Sqrt[r2])-0.09r2,1.23+0.83(Sqrt[r2])-0.01r2]}, {If[0.25≤r2≤2,0.01-3.3(Sqrt[r2])+0.84r2,-3.79+0.96(Sqrt[r2])-0.26r2]}, {If[0.25≤r2≤2,0.85+1.72(Sqrt[r2])-0.5r2,7.34-4.83(Sqrt[r2])+0.86r2]}, {If[0.25≤r2≤2,-0.79+0.42(Sqrt[r2])-0.25r2,-3.81+3.05(Sqrt[r2])-0.6r2]}}));	(*st3*)(({{(Subscript[c1, 7,3])}, {(Subscript[c2, 7,3])}, {(Subscript[c3, 7,3])}, {(Subscript[c4, 7,3])}}))=(({{0.95+0.68(Sqrt[r2])-0.05r2}, {-0.49-1.82(Sqrt[r2])+0.52r2}, {1.62+0.91(Sqrt[r2])-0.53r2}, {-1.08+0.23(Sqrt[r2])+0.07r2}}));
(*8 gct*)(Subscript[L, 8])={r4≤0.9,r3≤0.3};
	(*st1*)(({{(Subscript[c1, 8,1])}, {(Subscript[c2, 8,1])}, {(Subscript[c3, 8,1])}, {(Subscript[c4, 8,1])}}))=(({{3}, {2.78+1.53r4-4.38 (r4^2)}, {-0.42-12.78r4+22.78 (r4^2)}, {16.84+16.68r4-40(r4^2)}}));	(*st2*)(({{(Subscript[c1, 8,2])}, {(Subscript[c2, 8,2])}, {(Subscript[c3, 8,2])}, {(Subscript[c4, 8,2])}}))=(({{3}, {-6.69-1.62r4+4.43(r4^2)}, {44.7+10.7r4-19.9(r4^2)}, {-53.3-26r4+43.3(r4^2)}}));	(*st3*)(({{(Subscript[c1, 8,3])}, {(Subscript[c2, 8,3])}, {(Subscript[c3, 8,3])}, {(Subscript[c4, 8,3])}}))=(({{4}, {-6.79+1.13r4-0.13(r4^2)}, {38.4-7.24r4+6.5 (r4^2)}, {-44.6-7.43r4+58.7(r4^2)}}));
(Subscript[L, 4])=(Subscript[L, 5])=Null;

(*------------------------------------------------------------------------------------------------------------------------*)
(*dati per il calcolo del coefficiente per lo stato superficiale*)
(Subscript[Ra, 1])=Interpolation[{{300,1.3},{600,1.6},{900,2.1},{1200,2.75}},InterpolationOrder->2];
(Subscript[Ra, 2])=Interpolation[{{300,1.2},{600,1.5},{900,1.9},{1200,2.4}},InterpolationOrder->2];
(Subscript[Ra, 3])=Interpolation[{{300,1.15},{600,1.3},{900,1.53},{1200,1.75}},InterpolationOrder->2];
(Subscript[Ra, 4])=Interpolation[{{300,1.1},{600,1.12},{900,1.2},{1200,1.32}},InterpolationOrder->2];
(Subscript[Ra, 5])=Interpolation[{{300,1.08},{600,1.09},{900,1.1},{1200,1.1}},InterpolationOrder->2];
(Subscript[Ra, 6])=Interpolation[{{300,1.01},{600,1.04},{900,1.05},{1200,1.05}},InterpolationOrder->2];
(Subscript[Ra, 7])=Interpolation[{{300,1},{600,1.02},{900,1.02},{1200,1.02}},InterpolationOrder->2];
tx14=TextCell["Stato superficiale:"];in14=PopupMenu[Dynamic[μ],{1->"Ra > 75",2->"40 < Ra ≤ 75",3->"16 < Ra ≤ 40",4->"4 < Ra ≤ 16",
5->"1.6 < Ra ≤ 4",6->"0.6 < Ra ≤ 1.6",7->"0.25 < Ra ≤ 0.6",0->"Ra ≤ 0.25"},FieldSize->8,AutoAction->True];u4=TextCell["μm"];

(*dati per il calcolo del coefficiente per la corrosione*)
(Subscript[Co, 1])=Interpolation[{{300,1.5},{600,2},{900,2.9},{1200,4.1}},InterpolationOrder->2];
(Subscript[Co, 2])=Interpolation[{{300,2},{600,3},{900,4.5},{1200,6.5}},InterpolationOrder->2];
tx15=TextCell["Corrosione:"];in15=PopupMenu[Dynamic[\[ConstantC]],{0->"no",1->"Acqua dolce",2->"Acqua salata"},FieldSize->8,AutoAction->True];u5=Null;

(*------------------------------------------------------------------------------------------------------------------------*)
(*dati per il calcolo dell'intaglio*)
gr10=Grid[({{TextCell["Valori consigliati di r:"], TextCell["0.48 acciaio normale"]}, {Null, TextCell["0.25 acciaio ricotto o normalizzato"]}, {Null, TextCell["0.06 acciaio bonificato\n"]}}),Alignment->Left];
tx16=TextCell["Raggio del grano cristallino:"];in16=InputField[Dynamic[ρ],Number,FieldSize->10];u6=TextCell["mm"];

gr11=Grid[({{tx16, in16, u6}, {tx14, in14, u4}, {tx15, in15, u5}}),Alignment->{{Right,Left}}];

mtrx1=If[gct==4,(({{TextCell["h:"], InputField[Dynamic[h],Number,FieldSize->5], TextCell["mm"]}, {TextCell["r:"], InputField[Dynamic[r],Number,FieldSize->5], TextCell["mm"]}})),
						  (({{TextCell["d:"], InputField[Dynamic[d],Number,FieldSize->5], TextCell["mm"]}, {TextCell["h:"], InputField[Dynamic[h],Number,FieldSize->5], TextCell["mm"]}, {TextCell["r:"], InputField[Dynamic[r],Number,FieldSize->5], TextCell["mm"]}}))];
mtrx2=(({{ TextCell["Coefficiente teorico elastico"] , HoldForm[(Subscript[k, t])], Null}, {TextCell["di concentrazione delle tensioni:"], InputField[Dynamic[(Subscript[k, t,j])],Number,FieldSize->5], Null}, {TextCell["Raggio di raccordo dell'intaglio:"], InputField[Dynamic[r],Number,FieldSize->5], TextCell["mm"]}}));

gr12=If[gct<9,Grid[({{Image[(Subscript[fg, gct]),ImageSize->180], Grid[({{Grid[mtrx1]}, {(Subscript[L, gct])}})]}})],	If[gct==9,Grid[mtrx2],Null]];
gr14=Grid[({{gr10}, {gr11}, {Null}, {gr12}})];     j=1;
DialogInput[DialogNotebook[{gr14,Button[Framed["Procedere", FrameStyle->{Green}],DialogReturn[]]}],WindowSize->{All,All}];

G0=Grid[({{TextCell["Dati della verifica a fatica\n","Subtitle"]}, {nome}, {gr02}, {Null}, {gr11}, {gr12}}),Alignment->Left];

(*------------------------------------------------------------------------------------------------------------------------*)
(*tipo di sollecitazione*)
(Subscript[st1, 1])=;(Subscript[st2, 1])=;(Subscript[st4, 1])=;(Subscript[st1, 2])=;(Subscript[st2, 2])=;
(Subscript[st1, 3])=;(Subscript[st2, 3])=;(Subscript[st1, 4])=;(Subscript[st2, 4])=;(Subscript[st1, 5])=;(Subscript[st2, 5])=;(Subscript[st4, 5])=;
(Subscript[st1, 6])="Tensione assiale";(Subscript[st2, 6])="Tensione Flessionale";(Subscript[st3, 6])="Tensione tangenziale";

ST=If[gct==1||gct==5,Grid[({{TextCell["Tipo:"], Framed[1], Image[(Subscript[st1, gct]),ImageSize->100], Null, Framed[2], Image[(Subscript[st2, gct]),ImageSize->100], Null, Framed[4], Image[(Subscript[st4, gct]),ImageSize->100]}})],
		If[gct<6,Grid[({{TextCell["Tipo:"], Framed[1], Image[(Subscript[st1, gct]),ImageSize->100], Null, Framed[2], Image[(Subscript[st2, gct]),ImageSize->100]}})]
				,Grid[({{TextCell["Tipo:"], Framed[1], TextCell[(Subscript[st1, 6]),"Subsubsection"], Null, Framed[2], TextCell[(Subscript[st2, 6]),"Subsubsection"], Null, Framed[3], TextCell[(Subscript[st3, 6]),"Subsubsection"]}})]]];

gr13=If[gct==4,DST={1->"σ2=0 | M2=0",2->"σ1=σ2 | M1=νM2",3->"σ2=-σ1 | M2=M1"};
			Grid[({{TextCell["Tensione applicata tipo: "], InputField[Dynamic[st],Number,FieldSize->3]}, {Null, PopupMenu[Dynamic[dst],DST,AutoAction->True]}}),Alignment->Left],
			Grid[({{TextCell["Tensione applicata tipo: "], InputField[Dynamic[st],Number,FieldSize->3]}}),Alignment->Left] ];
gr16=Grid[({{ST}, {gr13}})];

(*------------------------------------------------------------------------------------------------------------------------*)
(*caratteristiche del ciclo*)
tx11=TextCell["Numero dei cicli:"];in11=InputField[Dynamic[(Subscript[n, λ])],Number,FieldSize->10];u1=Null;
tx12=TextCell["Tensione superiore:"];in12=InputField[Dynamic[(Subscript[σ, sup,λ])],Number,FieldSize->10];u2=TextCell["MPa"];
tx13=TextCell["Tensione inferiore:"];in13=InputField[Dynamic[(Subscript[σ, inf,λ])],Number,FieldSize->10];u3=TextCell["MPa"];
gr15=Grid[({{tx11, in11, u1}, {tx12, in12, u2}, {tx13, in13, u3}})];


(*========================================================================================================================*)
(*CALCOLO PER OGNI SERIE DI CICLI CICLO*)

ans1=True;     GG=Null;

While[ans1,
λ=0;   ans2=True;    gg=Null;     title=StringJoin["Serie di cicli n° ",ToString[j]];

DialogInput[DialogNotebook[{gr16,Button[Framed["Procedere", FrameStyle->{Green}],DialogReturn[]]}],WindowSize->{All,All},WindowTitle->title];
p1=If[st==4,3,st];   p2=dst;     
state=Grid[({{TextCell["Tensione applicata: "], If[gct==4,Grid[({{ST[[1,1,3st]]}, {DST[[p2,2]]}})],ST[[1,1,3st]]]}})];


(*------------------------------------------------------------------------------------------------------------------------*)(*coefficiente teorico elastico di concentrazione*)
If[gct≤8,
(Subscript[k, t,j])=If[gct==1||gct==3||gct==7||gct==8,   (Subscript[c1, gct,st])+(Subscript[c2, gct,st])r1+(Subscript[c3, gct,st])(r1^2)+(Subscript[c3, gct,st])(r1^3),
Switch[gct,    2,   (Subscript[c1, gct,st])+(Subscript[c2, gct,st])r4+(Subscript[c3, gct,st])(r4^2)+(Subscript[c3, gct,st])(r4^3),
			6,   (Subscript[c1, gct,st])+(Subscript[c2, gct,st])r3+(Subscript[c3, gct,st])(r3^2)+(Subscript[c3, gct,st])(r3^3),
			4,Switch[st, 1,Switch[dst,      1, 3,
										2, 2,
										3, 4],
						2,Switch[dst,    1,1.79+(0.25/(0.39+r5))-(0.81/(1+(r5^2)))+(0.26/(1+(r5^3))),
										2, 1.85+(0.51/(0.7+r5))-(0.21/(1+(r5^2)))+(0.36/(1+(r5^3))),
										3, 2]],
			5,Switch[st,1, 3-3.13r3+3.66(r3^2)-1.53(r3^3),
						   2, 2,
						   4, (1.79+(0.25/(0.39+r5))-(0.81/(1+(r5^2)))+(0.26/(1+(r5^3))))(1-1.04r3+1.22(r3^2))]]]];

(*------------------------------------------------------------------------------------------------------------------------*)(*coefficiente di concentrazione delle tensioni effettivo*)
(Subscript[k, f,j])=If[gct≤9,1+(((Subscript[k, t,j])-1)/(1+(Sqrt[ρ/r]))),1];

(*coefficienti per la corrosione e lo stato superficiale*)
(Subscript[k, l,j])=If[μ==0,1,(Subscript[Ra, μ]) [(Subscript[σ, R])]];
(Subscript[k, c,j])=If[\[ConstantC]==0,1,(Subscript[Co, \[ConstantC]]) [(Subscript[σ, R])]];

(*cefficiente di adeguamento al tipo di tensione*)
(Subscript[k, tt,j])=Switch[st,    1,0.8,           (*trazione o compressione*)
				2,1,4,1,    (*flessione*)
				3,(1/(Sqrt[3]))];      (*tensione tangenziale*)



(*------------------------------------------------------------------------------------------------------------------------*)
(*Calcolo per la serie di cicli del tipo di stato tensionale scelto*)
While[ans2,
λ++;

DialogInput[DialogNotebook[{gr15,Button[Framed["Procedere", FrameStyle->{Green}],DialogReturn[]]}],WindowSize->{All,All},WindowTitle->title];
carci=(({{tx11, HoldForm[n], Round[(Subscript[n, λ])], u1}, {tx12, HoldForm[(Subscript[σ, sup])], Round[(Subscript[σ, sup,λ]),0.1], u2}, {tx13, HoldForm[(Subscript[σ, inf])], Round[(Subscript[σ, inf,λ]),0.1], u3}}));     
(Subscript[σlist, j])=If[λ==1,{(Subscript[σ, inf,λ]),(Subscript[σ, sup,λ])},Join[(Subscript[σlist, j]),{(Subscript[σ, inf,λ]),(Subscript[σ, sup,λ])}]];

(*calcolo grafico di goodman*)
(Subscript[k, gs])=((Subscript[k, f,j])/(Subscript[k, tt,j]))(Subscript[k, l,j])(Subscript[k, c,j]);
(Subscript[σ, m,λ])=(((Subscript[σ, sup,λ])+(Subscript[σ, inf,λ]))/2)(Subscript[k, gs])//Abs;
(Subscript[σ, a,λ])=(((Subscript[σ, sup,λ])-(Subscript[σ, inf,λ]))/2)(Subscript[k, gs])//Abs;
(Subscript[σ, fGS,λ])=(Subscript[σ, m,λ])+(Subscript[σ, a,λ]);
(Subscript[FS, GS,λ])=(((Subscript[σ, GS])[(Subscript[σ, m,λ])])/(Subscript[σ, fGS,λ]));

(*diagramma di Goodman-Smith*)plot0=Plot[{(Subscript[σ, GS])[σm],σm},{σm,0,(Subscript[σ, S])},PlotRange->{{0,(Subscript[σ, R])},{0,(Subscript[σ, R])}},GridLines->Automatic,PlotStyle->{{Darker[Red],Thick},{Black,Dashed}},AxesOrigin->{0,0},Filling->{1->{2}},FillingStyle->Directive[Opacity[0.2],Green],AspectRatio->1,AxesLabel->{HoldForm[(Subscript[σ, m])],MPa},ImageSize->500];
graph0=Graphics[{Arrowheads[{-0.04,0.04}],Thick,Darker[Blue],Arrow[{{(Subscript[σ, m,λ]),(Subscript[σ, m,λ])},{(Subscript[σ, m,λ]),(Subscript[σ, fGS,λ])}}],Text[Style["(Subscript[σ, a])",18,Black],{(Subscript[σ, m,λ])+30,(Subscript[σ, m,λ])+(Subscript[σ, a,λ])/1.5}]} ];
ans0=ChoiceDialog[Show[plot0,graph0,PlotRange->All],WindowSize->{520,All},WindowTitle->"Diagramma di Goodman-Smith"];
If[ans0,True,Quit[]];

(*griglie dei risultati*)
grG=Grid[({{TextCell["Tensione media:"], HoldForm[(Subscript[σ, m])], Round[(Subscript[σ, m,λ]),0.1], TextCell["MPa"]}, {TextCell["Tensione alternata:"], HoldForm[(Subscript[σ, a])], Round[(Subscript[σ, a,λ]),0.1], TextCell["MPa"]}, {TextCell["Tensione nominale"], HoldForm[(Subscript[σ, fGS])], Round[(Subscript[σ, fGS,λ]),0.1], TextCell["MPa"]}, {TextCell["Coefficiente di sicurezza: "], HoldForm[(Subscript[FS, GS])], Round[(Subscript[FS, GS,λ]),0.01], TextCell[""]}}),Alignment->Left];
grf0=Grid[({{TextCell[StringJoin["Ciclo n° ",ToString[λ]],"Subsubtitle"]}, {Null}, {Grid[carci]}, {Null}, {TextCell["Goodman-Smith","Subsubsection"]}, {grG}}),Alignment->Left];
grf2=Grid[({{grf0, Show[plot0,graph0,ImageSize->{350,350}]}}),Spacings->{3,3},Alignment->Top];

gg=Grid[({{gg}, {grf2}}),Alignment->Left];

ans2=ChoiceDialog[TextCell["Aggiungere un altro ciclo in fase dello stesso tipo di tensione?"],WindowTitle->title]
];
(Subscript[σ, max,j])=Max[(Subscript[σlist, j])];     (Subscript[σ, min,j])=Min[(Subscript[σlist, j])];     (Subscript[n, tot,j])=(∑_(i=1)^λ)(Subscript[n, i]);

(*------------------------------------------------------------------------------------------------------------------------*)
(*calcolo woholer UNI 7670*)
(Subscript[σ, f])=((Subscript[σ, inv])/((Subscript[k, f,j])(Subscript[k, l,j])(Subscript[k, c,j])));
(Subscript[σ, Rw])=If[st==3,((Subscript[σ, R])/(Sqrt[3])),(Subscript[σ, R])];

(*coefficiente del rapporto k*)
(Subscript[K, j])=((Subscript[σ, min,j])/(Subscript[σ, max,j]));         (Subscript[k, k,j])=(Piecewise[{{(5/(3-2(Subscript[K, j]))), (Subscript[K, j])<0}, {((5/3)/(1-(1-(((Subscript[σ, f])5/3)/(Subscript[σ, R])))(Subscript[K, j]))), 0≤(Subscript[K, j])}}]);

(Subscript[σ, D,j])=(Subscript[σ, f])(Subscript[k, k,j])(Subscript[k, tt,j]);

(*pendenza della curva*)
tg=((Log[2*(10^6)]-Log[8*(10^3)])/(Log[(Subscript[σ, Rw])]-Log[(Subscript[σ, D,j])]));

(*fattore di spettro delle tensioni*)
(Subscript[k, m])=(∑_(i=1)^λ)((Subscript[n, i])/(Subscript[n, tot,j]))(((((Subscript[σ, sup,i])/(Subscript[σ, max,j]))))^tg);     (Subscript[n, eq,j])=(Subscript[n, tot,j])*(Subscript[k, m]);     (Subscript[k, n,j])=If[λ==1,1,(∑_(i=1)^λ)(((((Subscript[n, i])/(Subscript[n, eq,j]))))^(1/tg))];

(Subscript[σ, W])[Ν_]=(Piecewise[{{(Subscript[σ, Rw]), Ν<8*(10^3)}, {(Subscript[σ, D,j])(((((2*(10^6))/Ν)))^(1/tg)), Ν≤2*(10^6)}, {(Subscript[σ, D,j]), Ν>2*(10^6)}}]);

(*coefficienti di correzione della probabilità*)
{ps,Σ,Λ}=ChoiceDialog["Scegliere la probabilità di sopravvivenza della curva di Woholer:\n(di default è 50%)",{Framed["30%",FrameMargins->10,RoundingRadius->1]->{30,0.92,0.75},Framed["50%",FrameMargins->10,RoundingRadius->1]->{50,1,1},Framed["90%",FrameMargins->10,RoundingRadius->1]->{90,1.46,2.5},Framed["95%",FrameMargins->10,RoundingRadius->1]->{95,1.67,5},Framed["100%",FrameMargins->10,RoundingRadius->1]->{100,4.17,10}}];
(Subscript[σ, p,j])=(Subscript[σ, max,j])*(Subscript[k, n,j])*Σ;   
(Subscript[n, p,j])=(Subscript[n, eq,j])*Λ;
(Subscript[σ, lW,j])=(Subscript[σ, W])[(Subscript[n, p,j])];

(*diagramma di woholer*)
{li,ls}=If[(Subscript[σ, p,j])>1.2(Subscript[σ, Rw]),{0./Σ (Subscript[σ, D,j]),1.2(Subscript[σ, p,λ])},{0.8/Σ (Subscript[σ, p,j]),1.2(Subscript[σ, Rw])}];
scw=If[Ν≤(Subscript[n, p,j]),(Subscript[σ, p,j]),Null];
ti={{50,50}};For[i=1,i<1.2(Subscript[σ, Rw])/100,i++,ti=Join[ti,i{{100,100}}]];ti=Join[ti,{{(Subscript[σ, p,j]),(Subscript[σ, p,j])//Round},{(Subscript[σ, D,j]),(Subscript[σ, D,j])//Round},{(Subscript[σ, Rw]),(Subscript[σ, Rw])//Round}}];
gi={50};For[i=1,i<1.2(Subscript[σ, Rw])/100,i++,gi=Join[gi,i{100}]];gi=Join[gi,{(Subscript[σ, p,j]),(Subscript[σ, D,j]),(Subscript[σ, Rw])}];
log1=LogLogPlot[(Subscript[σ, W])[Ν],{Ν,(10^3),2*(10^7)},PlotRange->{li,ls},ImageSize->{700,500},AspectRatio->Full,GridLines->{Automatic,gi},PlotStyle->Thick,AxesLabel->{"Numero di cicli","MPa"},Ticks->{Automatic,ti}];log2=LogLogPlot[scw,{Ν,(10^3),2*(10^7)},Filling->Axis,PlotStyle->{Thin,Dashed,Black},Mesh->{{(Subscript[n, p,j])-(Subscript[n, p,j])/100}},MeshStyle->Directive[PointSize[Large],Darker[Red]]];
ans3=ChoiceDialog[Show[log1,log2],WindowSize->{620,All},WindowTitle->"Diagramma di Woholer"];
If[ans3,True,Quit[]];

(*------------------------------------------------------------------------------------------------------------------------*)
(*calcolo del danno*)
(Subscript[n, w])=(Piecewise[{{(Subscript[n, p,j])((((((Subscript[σ, W])[(Subscript[n, p,j])])/(Subscript[σ, p,j]))))^tg), (Subscript[σ, p,j])≥(Subscript[σ, D,j])}, {Infinity, (Subscript[σ, p,j])<(Subscript[σ, D,j])}}]);
(Subscript[danno, j])=((Subscript[n, p,j])/(Subscript[n, w]));

grW=Grid[({{TextCell["Percentuale di sopravvivenza:  "], ps, HoldForm[%]}, {TextCell["Tensione di verifica corretta alla %:  "], Round[(Subscript[σ, p,j]),0.1], TextCell["MPa"]}, {TextCell["Numero di cicli eq. corretti alla %:  "], Round[(Subscript[n, p,j])], TextCell[""]}, {TextCell["Valore della tensione sulla curva di"], Null, Null}, {TextCell["Woholer al numero di cicli equivalenti:\n"], Round[(Subscript[σ, lW,j]),0.1], TextCell["MPa"]}, {TextCell["Danno:  "], Round[(Subscript[danno, j]),0.01], TextCell[""]}}),Alignment->Left,Spacings->2];

(*------------------------------------------------------------------------------------------------------------------------*)
(*griglie dati*)
grf1=Grid[({{TextCell["Coefficiente teorico elastico di concentrazione:"], HoldForm[(Subscript[k, t])], Round[(Subscript[k, t,j]),0.01]}, {TextCell["Coefficiente di concentrazione delle tensioni effettivo:"], HoldForm[(Subscript[k, f])], Round[(Subscript[k, f,j]),0.01]}, {TextCell["Coefficiente per la corrosione:"], HoldForm[(Subscript[k, c])], Round[(Subscript[k, c,j]),0.01]}, {TextCell["Coefficiente per lo stato superficiale:"], HoldForm[(Subscript[k, l])], Round[(Subscript[k, l,j]),0.01]}, {TextCell["Coefficiente di adeguamento al tipo di tensione:"], HoldForm[(Subscript[k, tt])], Round[(Subscript[k, tt,j]),0.01]}, {TextCell["Rapporto tra tensione max e min:"], HoldForm[K], Round[(Subscript[K, j]),0.01]}, {TextCell["Coefficiente del rapporto K:"], HoldForm[(Subscript[k, k])], Round[(Subscript[k, k,j]),0.01]}, {TextCell["Fattore di spettro delle tensioni:"], HoldForm[(Subscript[k, m])], Round[(Subscript[k, m]),0.01]}, {TextCell["Coefficiente del numero di cicli equivalente:"], HoldForm[(Subscript[k, n])], Round[(Subscript[k, n,j]),0.01]}}),Alignment->Left];
grf2=Grid[({{TextCell["Diagramma di Woholer","Subsubtitle"]}, {Show[log1,log2,ImageSize->{600,350}]}, {grW}}),Spacings->{1,2},Alignment->Left];


grf4=Grid[({{TextCell["Serie di cicli n°","Section"], Framed[j]}}),Alignment->Left];
GG=Grid[({{GG}, {grf4}, {state}, {grf1}, {gg}, {grf2}, {Null}}),Spacings->{1,3},Alignment->Left];
j++;
ans1=ChoiceDialog["Aggiungere un altra serie di cicli in fase di un'altro tipo di tensione?"]
]

(*========================================================================================================================*)
(*fine*)

GT=Grid[({{G0}, {GG}}),Spacings->3,Alignment->Left];

SetDirectory[NotebookDirectory[]];
Export["Verifica a fatica.pdf",Framed[GT//MatrixForm,FrameMargins->50]];

Quit[]

6. Ruote Dentate Normali Cilindriche a Denti Dritti ad Evolvente

nb=CreateDocument[];
NotebookWrite[nb,Cell["Dati del calcolo","Subsection"]]

(*___________________________________________________________________________________________________________________*)
(* INSERIMENTO dei DATI *)

tx00=TextCell["Interasse tra gli alberi"];in00=InputField[Dynamic[a],FieldSize->{5,1}];
tx01=TextCell["Rapporto di trasmissione"];in01=InputField[Dynamic[u],FieldSize->{5,1}];
tx02=TextCell["Massima potenza trasmissibile richiesta"];in02=InputField[Dynamic[P],FieldSize->{5,1}];
tx03=TextCell["Minima velocità di rotazione del pignone"];in03=InputField[Dynamic[nmin],FieldSize->{5,1}];
tx04=TextCell["Massima velocità di rotazione del pignone"];in04=InputField[Dynamic[nmax],FieldSize->{5,1}];
tx05=TextCell["Angolo di spinta della trasmissione"];in05=InputField[Dynamic[αdeg],FieldSize->{5,1}];

gr0=Grid[({{tx00, TextCell[":"], in00, TextCell["mm"]}, {tx01, TextCell[":"], in01, Null}, {tx02, TextCell[":"], in02, TextCell["W"]}, {tx03, TextCell[":"], in03, TextCell["rpm"]}, {tx04, TextCell[":"], in04, TextCell["rpm"]}, {tx05, TextCell[":"], in05, TextCell["°"]}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];

ChoiceDialog[gr0,WindowSize->{400,All}];
α=αdeg*(π/180.);

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nDATI\n"]}, {gr0}})]]]]

(*___________________________________________________________________________________________________________________*)
(* CALCOLO delle GEOMETRIE *)

zmin=(2/((Sqrt[u^2+(1+2u)Sin[α]^2])-u))//Ceiling;

sol=Solve[{a==m*((x1+x2)/2),u==(x2/x1)},{x1,x2}];
z1=Round[Norm[x1/.sol]];
z2=Round[Norm[x2/.sol]];

ans0=0;
While[ans0==0,
ChoiceDialog[Grid[({{TextCell["Inserire il valore del modulo scegliendo fra quelli normati (UNI-6586) "]}, {TextCell["{20 ,16 ,12 ,10 ,8 ,6 ,5 ,4 ,3 ,2.5 ,2 ,1.5 ,1.25 ,1 ,0.75 ,0.5}"]}, {TextCell["{22 ,18 ,14 ,11 ,9 ,7 ,5.5 ,4.5 ,3.5 ,2.75 ,2.25 ,1.75 ,1.375 ,1.125}"]}, {InputField[Dynamic[m],FieldSize->{5,1}]}})]];

gr1=Grid[({{TextCell["N° denti pignone"], TextCell["z1"], z1}, {TextCell["N° denti ruota"], TextCell["z2"], z2}, {TextCell["N° denti minimo"], TextCell["zmin"], zmin}, {TextCell["Modulo"], TextCell["m"], m}, {TextCell["Interasse effettivo"], TextCell["a"], aeff=m*((z1+z2)/2.)}, {TextCell["Gioco"], TextCell["g"], g=Round[(m/4),0.01]}, {TextCell["Addendum"], TextCell["ha"], ha=Round[m,0.01]}, {TextCell["Dedendum"], TextCell["hf"], hf=Round[1.25*m,0.01]}, {TextCell["Altezza dente"], TextCell["h"], h=Round[2.25*m,0.01]}, {TextCell["Spessore e vano"], TextCell["s=v"], s=Round[π*(m/2),0.01];v=s}, {TextCell["Larghezza"], TextCell["b"], b=Round[10*m,0.01]}, {TextCell["Passo"], TextCell["p"], p=Round[π*m,0.01]}, {Null, TextCell["\nPIGNONE"], Null}, {TextCell["Diametro primitivo"], TextCell["d1"], d1=Round[m*z1,0.01]}, {TextCell["Diametro di testa"], TextCell["da1"], da1=Round[d1+2m,0.01]}, {TextCell["Diametro di piede"], TextCell["df1"], df1=Round[d1-2*hf,0.01]}, {TextCell["Diametro base"], TextCell["db1"], db1=Round[d1*Cos[α],0.01]}, {Null, TextCell["\nRUOTA"], Null}, {TextCell["Diametro primitivo"], TextCell["d2"], d2=Round[m*z2,0.01]}, {TextCell["Diametro di testa"], TextCell["de2"], da2=Round[d2+2m,0.01]}, {TextCell["Diametro di piede"], TextCell["di2"], df2=Round[d2-2*hf,0.01]}, {TextCell["Diametro base"], TextCell["db2"], db2=Round[d2*Cos[α],0.01]}}),Spacings->{2,0.5},Alignment->{{Left,Left,Right}}];

ans0=ChoiceDialog[gr1,{"Procedere"->1,"Cambiare modulo"->0}];
]

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nGEOMETRIA\n"]}, {gr1}})]]]]

(*___________________________________________________________________________________________________________________*)
(* CALCOLO delle FORZE *)

gr2=Grid[({{TextCell["Velocità angolare minima pignone"], TextCell["ωmin"], ωmin=((nmin*2*π)/60)//Round, TextCell["[rad/sec]"]}, {TextCell["Velocità angolare massima pignone"], TextCell["ωmax"], ωmax=((nmax*2*π)/60)//Round, TextCell["[rad/sec]"]}, {TextCell["Velocità minima punto di contatto"], TextCell["vmin"], vmin=ωmin*Min[d1,d2]/1000, TextCell["[m/sec]"]}, {TextCell["Velocità massima punto di contatto"], TextCell["vmax"], vmax=ωmax*Min[d1,d2]/1000, TextCell["[m/sec]"]}, {TextCell["Forza massima"], TextCell["Ft"], Ftmax=(P/vmin), TextCell["[N]"]}, {TextCell["Coppia torcente massima pignone"], TextCell["T1"], T1max=((Ftmax*d1)/2000), TextCell["[N*m]"]}, {TextCell["Coppia torcente massima pignone"], TextCell["T2"], T2max=((Ftmax*d2)/2000), TextCell["[N*m]"]}}),Spacings->{2,0.5},Alignment->{{Left,Left,Right,Left}}];
V=((vmin+vmax)/2);

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nCARATTERISTICHE di FUNZIONAMENTO\n"]}, {gr2}})]]]];

(*___________________________________________________________________________________________________________________*)
(* CALCOLO dei COEFFICIENTI K *)

(*Coefficiente di applicazione Ka*)
Ka=1.;
(*Coefficiente dinamico interno Kv*)
accuracy=ChoiceDialog[TextCell["Selezionare il grado di accuratezza secondo la normativa ISO 1328-1"],{"3"->3,"4"->4,"5"->5,"6"->6,"7"->7,"8"->8,"9"->9,"10"->10,"11"->11,"12"->12}];

K1=Switch[accuracy,   3,2.1,  4,3.9,  5,7.5,   6,14.9,   7,26.8,   8,39.1,   9,52.8,   10,76.6,   11,102.6,   12,146.3];
K2=0.0193;
K3=Which[((V*z1)/100)(Sqrt[((u^2)/(1+u^2))])≤ 0.2,   2.0,
		((V*z1)/100)(Sqrt[((u^2)/(1+u^2))])> 0.2,   2.071-0.357*((V*z1)/100)*(Sqrt[((u^2)/(1+u^2))])];
Kv=If[Ka*(Ftmax/b)<100, 1+((K1/100)+K2)*((V*z1)/100)*K3*(Sqrt[((u^2)/(1+u^2))]),   
					1+((K1/(Ka*(Ftmax/b)))+K2)*((V*z1)/100)*K3*(Sqrt[((u^2)/(1+u^2))])];
Kfβ=KHβ^If [(b/h)<3,(1/(1+1/3+(1/3)^2)),(1/(1+h/b+(h/b)^2))];

gr3=Grid[({{TextCell["Coefficiente di applicazione"], TextCell["Ka"], Ka}, {TextCell["Coefficiente dinamico interno"], TextCell["Kv"], Kv}, {TextCell["Coefficiente di carico della faccia a pitting"], TextCell["Khβ"], KHβ=1.}, {TextCell["Coefficiente di carico trasversale a pitting"], TextCell["Khα"], KHα=1.}, {TextCell["Coefficiente di carico della faccia a flessione"], TextCell["Kfβ"], Kfβ}, {TextCell["Coefficiente di carico trasversale a flessione"], TextCell["Kfα"], Kfα=KHα}}),Spacings->{2,0.5},Alignment->{{Left,Left,Right}}];

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nGrado di accuratezza secondo la normativa ISO 1328-1\n"]}, {accuracy}, {Null}, {TextCell["\nCOEFFICIENTI DI CORREZIONE GENERICI(ISO 6336-1)\n"]}, {gr3}})]]]];

(*___________________________________________________________________________________________________________________*)
(* DATI per le VERIFICHE *)

(*Scelta della classe di appartenenza del materiale*)
ChoiceDialog[Grid[({{TextCell["Inserire il numero corrispondente alla categoria cui appartiene il materiale:"]}, {Null}, {mat[1]=TextCell["1: Acciaio lavorato normalizzato a basso contenuto di carbonio"]}, {mat[2]=TextCell["2: Acciaio a basso contenuto di carbonio da lingotto di colata"]}, {mat[3]=TextCell["3: Ghisa nera malleabile a struttura perlitica"]}, {mat[4]=TextCell["4: Ghisa sferoidale a stuttura perlitica"]}, {mat[5]=TextCell["5: Ghisa sferoidale a stuttura bainitica"]}, {mat[6]=TextCell["6: Ghisa sferoidale a stuttura ferritica"]}, {mat[7]=TextCell["7: Ghisa grigia"]}, {mat[8]=TextCell["8: Acciaio al carbonio/lega d'acciaio lavorati e temprati"]}, {mat[9]=TextCell["9: Acciaio al carbonio/leghe d'acciaio da lingotto di colata, temprati"]}, {mat[10]=TextCell["10: Acciaio da cementazione temprato"]}, {mat[11]=TextCell["11: Acciaio temprato a fiamma o ad induzione"]}, {mat[12]=TextCell["12: Acciaio da nitrurazione"]}, {mat[13]=TextCell["13: Acciaio temprato e nitrurato "]}, {mat[14]=TextCell["14: Acciaio temprato e nitrocarburato "]}, {Null}, {InputField[Dynamic[mater],FieldSize->{5,1}]}}),Spacings->1,Alignment->Left],WindowSize->{400,450}];

qual[1]="ML: modesto";     qual[2]="MQ: medio";     qual[3]="ME: molto alto";
quality=ChoiceDialog["Selezionare il livello di affidabilità delle procedure di controllo:",{qual[1]->1,qual[2]->2,qual[3]->3}];

acciaio[1]="Acciaio al carbonio";acciaio[2]="Acciaio legato";acciaio[3]="null";
acc=If[mater==8||mater==9,ChoiceDialog["Selezionare la composizione dell'acciaio",{acciaio[1]->1,acciaio[2]->2}],3];

tx10=TextCell["Fattore di sicurezza della resistenza al pitting"];in10=InputField[Dynamic[SHmin],FieldSize->{7,1}];
tx11=TextCell["Numero di cicli cui il pezzo è sottoposto"];in11=InputField[Dynamic[cicli],FieldSize->{7,1}];
tx12=TextCell["Modulo di resistenza a trazione E del materiale"];in12=InputField[Dynamic[El],FieldSize->{7,1}];
tx13=TextCell["Coefficiente di Poisson ν"];in13=InputField[Dynamic[ν],FieldSize->{7,1}];
tx14=If[mater==10,TextCell["Durezza al cuore"],TextCell["Durezza del materiale"]];in14=InputField[Dynamic[dur],FieldSize->{7,1}];
wh14=Which[mater<8,TextCell["HBW"],mater==10,TextCell["HRC"],mater≥8,TextCell["HV"]];

gr4=Grid[({{tx10, TextCell[":"], in10, Null}, {tx11, TextCell[":"], in11, Null}, {tx12, TextCell[":"], in12, TextCell["MPa"]}, {tx13, TextCell[":"], in13, Null}, {tx14, TextCell[":"], in14, wh14}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];

ChoiceDialog[Grid[({{mat[mater]}, {Grid[({{TextCell["Tipo di acciaio: "], acciaio[acc]}, {TextCell["Livello di affidabilità delle procedure di controllo: "], qual[quality]}})]}, {Null}, {gr4}})],WindowSize->{400,All}];

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nDATI per le VERIFICHE\n"]}, {gr4}})]]]];

(*___________________________________________________________________________________________________________________*)
(* VERIFICA A PITTING (ISO 6336-2) *)

(*Fattore di zona*)
Zh=N[(Sqrt[(2/(Cos[α]*Sin[α]))]),{Infinity,3}]; 

(*Calcolo M1 e M2*)
τ1=((2π)/z1);     τ2=((2π)/z2);
ξfw1=Min[Abs[Tan[α]],Abs[(Tan[ArcCos[(db2/da2)]]-Tan[α])*(z2/z1)]];     ξaw1=ξfw2*(z2/z1);
ξfw2=Min[Abs[Tan[α]],Abs[(Tan[ArcCos[(db1/da1)]]-Tan[α])*(z1/z2)]];     ξaw2=ξfw1*(z1/z2);

εα=((ξfw1+ξaw1)/(τ1)); (*Rapporto di contatto trasversale*)
M1=((Tan [α])/(Sqrt[((Sqrt[((da1^2)/(db1^2))-1])-((2π)/z1))*((Sqrt[((da2^2)/(db2^2))-1])-(εα-1)*((2π)/z2))]));     
M2=((Tan [α])/(Sqrt[((Sqrt[((da2^2)/(db2^2))-1])-((2π)/z2))*((Sqrt[((da1^2)/(db1^2))-1])-(εα-1)*((2π)/z1))]));

(*Coefficienti Zd e Zb di contatto della singola coppia di denti*)
If[εα≤1,MessageDialog["εα<=1: CASO NON COPERTO DALLA NORMATIVA ISO 6336"]]
Zb=If[M1≤1,1,M1];
Zd=If[M2≤1,1,M2];

(*Coefficiente di elasticità Ze*)
Ze=(Sqrt[(El/(2π*(1-ν^2)))]);

(*Coefficiente del rapporto di contatto Zϵ*)
Zε=(Sqrt[((4-εα)/3)]);

(*Calcolo del coefficiente di durata Znt*)
perm =DialogInput[DialogNotebook[{TextCell["Selezionare il grado di pitting ammissibile"],
Button["Limitato pitting ammesso",DialogReturn[1]]
Button["Nessun pitting ammesso",DialogReturn[2]]}]];
Znt=Which [mater≤5 ||  8≤mater≤11 ,
		Switch [perm    ,1,Which [cicli≤6*(10^5), 1.6,  (10^5)<cicli≤(10^8), 1.3,  (10^8)<cicli<(10^10), 1., cicli≥(10^10), 0.85]
					,2,Which [cicli≤6*(10^5), 1.6,  (10^5)<cicli≤(10^8), 1.,     (10^8)<cicli<(10^10), 1., cicli≥(10^10), 0.85]],
		mater<14,        Which [cicli≤6*(10^5), 1.3,  (10^5)<cicli≤(10^8), 1.,  cicli≥(10^8), 0.85],
		mater==14,      Which [cicli≤6*(10^5), 1.1,  (10^5)<cicli≤(10^8), 1.,  cicli≥(10^8), 0.85]];

(*Calcolo deille tensioni ammissibili σHlim e σFlim*)
Which [ mater==1 ,   Which[    quality≤2,Ah=1.;Bh=190;Af=0.455;Bf=69,
						quality==3,Ah=1.520;Bh=250;Af=0.386;Bf=147],
	 mater==2,    Which[     quality≤2,Ah=0.986;Bh=131;Af=0.313;Bf=62,
						quality==3,Ah=1.143;Bh=237;Af=0.254;Bf=137],
	 mater==3,   Which[     quality≤2,Ah=1.371;Bh=143;Af=0.345;Bf=77,
						quality==3,Ah=1.333;Bh=267;Af=0.403;Bf=128],
	4≤mater≤6,Which[     quality≤2,Ah=1.434;Bh=211;Af=0.350;Bf=119,
						quality==3,Ah=1.500;Bh=250;Af=0.380;Bf=134],
	mater==7,      Which[     quality≤2,Ah=1.033;Bh=132;Af=0.256;Bf=8,
						quality==3,Ah=1.465;Bh=122;Af=0.200;Bf=53],
	mater==8,Switch[acc,      1,Switch[quality,1,Ah=0.963;Bh=283;Af=0.250;Bf=108,
											2,Ah=0.925;Bh=360;Af=0.240;Bf=163,
											3,Ah=0.838;Bh=432;Af=0.283;Bf=202],
							2,Switch[quality,1,Ah=1.313;Bh=188;Af=0.423;Bf=104,
											  2,Ah=1.313;Bh=373;Af=0.425;Bf=187,
											  3,Ah=2.213;Bh=260;Af=0.358;Bf=231]],
	mater==9, Switch[acc,      1,Which[  quality≤2,Ah=0.831;Bh=300;Af=0.224;Bf=117,
									quality==3,Ah=0.951;Bh=345;Af=0.286;Bf=167],
							2,Which[  quality≤2,Ah=1.276;Bh=298;Af=0.224;Bf=117,
									quality==3,Ah=1.350;Bh=356;Af=0.356;Bf=186]],
	mater==10, Switch[quality,    1,Ah=0;Bh=1300;Af=0;Bf=312,
								2,Switch[hh,1,Ah=0;Bh=1500;Af=0;Bf=425,
											2,Ah=0;Bh=1500;Af=0;Bf=461,
											3,Ah=0;Bh=1500;Af=0;Bf=500],
								3,Ah=0;Bh=1650;Af=0;Bf=525],
	mater==11,  Switch[quality,    1,Ah=0.740;Bh=602;Af=0.305;Bf=76,
								2,Ah=0.541;Bh=882;Af=0.138;Bf=290,
								3,Ah=0.505;Bh=1013;Af=0.271;Bf=237],
	mater==12,  Switch[quality,    1,Ah=0;Bh=1125;Af=0;Bf=270,
								2,Ah=0;Bh=1250;Af=0;Bf=420,
								3,Ah=0;Bh=1450;Af=0;Bf=468],
	mater==13,  Switch[quality,    1,Ah=0;Bh=788;Af=0;Bf=258,
								2,Ah=0;Bh=998;Af=0;Bf=363,
								3,Ah=0;Bh=1217;Af=0;Bf=432],
	mater==14,  Switch[quality,    1,Ah=0;Bh=650;Af=0;Bf=224,
								2,Ah=1.167;Bh=425;Af=0.653;Bf=94,
								3,Ah=0;Bh=950;Af=0;Bf=388]
];
σHlim=Ah*dur+Bh;
σFlim=Af*dur+Bf;

(*Inserimento dei vari fattori restanti*)
Zl=1.;     Zv=1.;     Zr=0.95;     Zβ=1.;     Zw=1.;     Zx=1.;
tx20=TextCell["Fattore di lubrificazione"];in20=InputField[Dynamic[Zl],FieldSize->{5,1}];
tx21=TextCell["Fattore di velocità"];in21=InputField[Dynamic[Zv],FieldSize->{5,1}];
tx22=TextCell["Fattore di rugosità"];in22=InputField[Dynamic[Zr],FieldSize->{5,1}];
tx23=TextCell["Fattore dell'angolo d'elica"];in23=InputField[Dynamic[Zβ],FieldSize->{5,1}];
tx24=TextCell["Fattore di durezza"];in24=InputField[Dynamic[Zw],FieldSize->{5,1}];
tx25=TextCell["Fattore di dimensione"];in25=InputField[Dynamic[Zx],FieldSize->{5,1}];
gr5=Grid[({{tx20, TextCell[" Zl:"], in20}, {tx21, TextCell[" Zv:"], in21}, {tx22, TextCell[" Zr:"], in22}, {tx23, TextCell[" Zβ:"], in23}, {tx24, TextCell[" Zw:"], in24}, {tx25, TextCell[" Zx:"], in25}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];
ChoiceDialog[Grid[({{TextCell["Se non noti, lasciare i valori di default"]}, {gr5}})],WindowSize->{400,All}];


(*Calcolo della tensione ammissibile a pressione*)
σHp=((σHlim)/SHmin)*Znt*Zl*Zv*Zr*Zw*Zx;

(*Calcolo della tensione indotta sul dente dalla Ft*)
σH0=Zh*Ze*Zε*Zβ*(Sqrt[(Ftmax/(d1*b))*((u+1)/u)]);
σH1=Zb*σH0(Sqrt[Ka*Kv*KHα*KHβ]);
σH2=Zd*σH0(Sqrt[Ka*Kv*KHα*KHβ]);

Which[σH1>σHp && σH2>σHp,verpit="NESSUNA DELLE DUE RUOTE RISPETTA IL COEFFICIENTE DI SICUREZZA ASSEGNATO A PITTING",
	σH1>σHp,verpit="IL PIGNONE NON RISPETTA IL COEFFICIENTE DI SICUREZZA ASSEGNATO A PITTING",
	σH2>σHp,verpit="LA RUOTA NON RISPETTA IL COEFFICIENTE DI SICUREZZA ASSEGNATO A PITTING",
	σH1≤σHp&&σH2≤σHp,verpit="ENTRAMBE LE RUOTE RISPETTANO IL COEFFICIENTE DI SICUREZZA ASSEGNATO A PITTING"];

ver=DialogInput[DialogNotebook[{TextCell[verpit],
Button["Procedi con le verifiche",DialogReturn[1]],
Button["Termina il calcolo",DialogReturn[2]],
},WindowTitle->"VERIFICA A PITTING (ISO 6336-2)"]];
If[ver==2,Exit[]];

(*Fattore di sicurezza*)
SH = Min [σHp/σH1,σHp/σH2]*SHmin;

grP=Grid[({{TextCell["Fattore di sicurezza minimo richiesto"], TextCell["Shmin"], SHmin,  }, {TextCell["Tensione ammissibile a pressione"], TextCell["σHp"], σHp, TextCell["MPa"]}, {TextCell["Tensione a pressione (corretta) pignone"], TextCell["σH1"], σH1, TextCell["MPa"]}, {TextCell["Tensione a pressione (corretta) ruota"], TextCell["σH2"], σH2, TextCell["MPa"]}, {TextCell["Fattore di sicurezza effettivo"], TextCell["Sh"], SH,  }, {TextCell["Coefficiente di zona"], TextCell["Zh"], Zh,  }, {TextCell["Coefficiente di primo contatto singolo pignone"], TextCell["Zb"], Zb,  }, {TextCell["Coefficiente di primo contatto singolo ruota"], TextCell["Zd"], Zd,  }, {TextCell["Coefficiente di elasticità"], TextCell["Ze"], Ze,  }, {TextCell["Coefficiente del rapporto di contatto"], TextCell["Zε"], Zε,   }, {TextCell["Life Factor"], TextCell["Znt"], Znt,  }, {TextCell["Coefficiente di lubrificazione"], TextCell["Zl"], Zl,  }, {TextCell["Coefficiente di velocità"], TextCell["Zv"], Zv,  }, {TextCell["Coefficiente di rugosità"], TextCell["Zr"], Zr,  }, {TextCell["Coefficiente di durezza di tempra"], TextCell["Zw"], Zw,  }, {TextCell["Coefficiente di taglia"], TextCell["Zx"], Zx,  }, {TextCell["Coeficiente d'elica"], TextCell["Zβ"], Zβ,  }}),Spacings->{2,0.5},Alignment->{{Left,Left,Right,Left}}];

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nVERIFICA A PITTING (ISO 6336-2)\n"]}, {TextCell[verpit]}, {grP}})]]]];

(*___________________________________________________________________________________________________________________*)
(* VERIFICA A FLESSIONE (ISO 6336-2) *)

Sfmin=Input ["Inserire il fattore di sicurezza minimo relativo alla flessione",1.4];
β=0;
z1n=(z1/(Cos[β]^3));     z2n=(z2/(Cos[β]^3));     εαn=((εα)/(Cos[β]^2));     d1n=(d1/(Cos[β]^2));     d2n=(d2/(Cos[β]^2));

pbn=π*m*Cos[α];     αn=α;     αfen=α;     mn=m;     db1n=d1n*Cos[α];     db2n=d2n*Cos[α];     da1n=d1n+da1-d1;     da2n=d2n+da2-d2;

de1n=2*√(((((Sqrt[((((da1n/2)))^2)-((((db1n/2)))^2)])-((π*d1*Cos[β]Cos[αn])/(Abs[z1]))*(εαn-1)))^2)+((((db1n/2)))^2));
de2n=2*√(((((Sqrt[((((da2n/2)))^2)-((((db2n/2)))^2)])-((π*d1*Cos[β]Cos[αn])/(Abs[z1]))*(εαn-1)))^2)+((((db2n/2)))^2));

αen1=ArcCos[(db1n/de1n)];     αen2=ArcCos[(db2n/de2n)];

spr=0;     ρfp=0.3mn;     ρfpv=ρfp;     T=π/3;     hfp=hf;

Ea=(π/4)*mn-hfp*Tan[αn]+(spr/(Cos[αn]))-(1-Sin[αn])*((ρfp)/(Cos[αn]));

x=0;
G=((ρfpv)/mn)-(hfp/mn)+x;
H1=(2/z1n)*((π/2)-(Ea/mn))-T;H2=(2/z2n)*((π/2)-(Ea/mn))-T;
θ11=(2/z1n)*Tan[(π/6)]-H1;θ12=(2/z1n)*Tan[θ11]-H1;θ13=(2/z1n)*Tan[θ12]-H1;θ14=(2/z1n)*Tan[θ13]-H1;θ15=(2/z1n)*Tan[θ14]-H1;θ1=(2/z1n)*Tan[θ15]-H1;
θ21=(2/z2n)*Tan[(π/6)]-H2;θ22=(2/z2n)*Tan[θ21]-H2;θ23=(2/z2n)*Tan[θ22]-H2;θ24=(2/z2n)*Tan[θ23]-H2;θ25=(2/z2n)*Tan[θ24]-H2;θ2=(2/z2n)*Tan[θ25]-H2;
sfn1=mn*(z1n*Sin[(π/3)-θ1]+(Sqrt[3])*((G/(Cos[θ1]))-((ρfpv)/mn)));sfn2=mn*(z2n*Sin[(π/3)-θ2]+(Sqrt[3])*((G/(Cos[θ2]))-((ρfpv)/mn)));
ρf1=mn*(((ρfpv)/mn)+((2*G^2)/(Cos[θ1]*(z1n*Cos[θ1]^2-2*G))));ρf2=mn*(((ρfpv)/mn)+((2*G^2)/(Cos[θ2]*(z2n*Cos[θ2]^2-2*G))));
γe1=((0.5*π+2*Tan[αn]*x)/z1n);γe2=((0.5*π+2*Tan[αn]*x)/z2n);
hfe1=(1/2)*((Cos[γe1]-Sin[γe1]*Tan[αfen])*(de1n/mn)-z1n*Cos[(π/3)-θ1]*((G/(Cos[θ1]))-((ρfpv)/mn)));
hfe2=(1/2)*((Cos[γe2]-Sin[γe2]*Tan[αfen])*(de2n/mn)-z2n*Cos[(π/3)-θ2]*((G/(Cos[θ2]))-((ρfpv)/mn)));

(*Coefficiente di forma Yf*)
Yf1=((6*hfe1*Cos[αfen]/mn)/((((sfn1/mn))^2)*Cos[αn]));
Yf2=((6*hfe2*Cos[αfen]/mn)/((((sfn2/mn))^2)*Cos[αn]));

(*Coefficiente di correzione della tensione Ys*)
L1=Abs[(sfn1/hfe1)];L2=Abs[(sfn2/hfe2)];
qs1=Abs[(sfn1/(2*ρf1))];qs2=Abs[(sfn2/(2*ρf2))];
Ys1=(1.2+0.13*L1)*(qs1^(1/(1.21+(2.3/L1))));
Ys2=(1.2+0.13*L2)*(qs2^(1/(1.21+(2.3/L2))));

(*Coefficiente d'elica Yβ*)
Yβ1=1;Yβ2=1;

(*Fattore dello spessore dell'anello Yb*)
ChoiceDialog[Grid[({{TextCell["Distanza massima tra la circonferenza di piede e il foro:"]}, {Grid[({{TextCell["del pignone :"], InputField[Dynamic[sr1],FieldSize->{5,1}], TextCell["mm"]}, {TextCell["della ruota :"], InputField[Dynamic[sr2],FieldSize->{5,1}], TextCell["mm"]}})]}})]];
ht1=h;     ht2=h;
If[(sr1/mn)≥ 1.2,Yb1=1.,If[1.2≥(sr1/mn)≥0.5,Yb1=1.15*Log[8.324*(mn/sr1)],errori++]];
If[(sr2/mn)≥ 1.2,Yb2=1.,If[1.2≥(sr2/mn)≥0.5,Yb2=1.15*Log[8.324*(mn/sr2)],errori++]];

(*Coefficiente di profondità del dente Ydt*)
Ydt=Which[accuracy>4,1,
		accuracy≤ 4,Which[2.05≤εαn≤2.5 , -0.666*εαn+2.366,   εαn>2.5, 0.7]];

(*Fattore di correzione della tensione Yst*)
Yst=2.0;

(*Calcolo del coefficiente Ynt*)
Ynt=Which [mater≤5 || 8≤mater≤11 , Which[cicli≤10^4, 2.5,     10^4<cicli≤3 10^6, (10.978/(cicli^0.160646))],
	mater==10 || mater==11 ,               Which[cicli≤10^3,  2.5,    10^3<cicli≤3 10^6, (5.51158/(cicli^0.114445))],
	6≤mater≤7 || 12≤mater≤13 ,  Which [cicli≤10^3, 1.6,    10^3<cicli≤3 10^6, (2.40011/(cicli^0.0587073))],
	mater== 14 ,                                              Which[cicli≤10^3, 1.1,     10^3<cicli≤3 10^6, (1.19428/(cicli^0.0119043))],
	3*(10^6)<cicli<(10^10),  (1.34825/(cicli^0.0200351)),     cicli>10^10,   0.85];

(*Inserimento dei vari fattori restanti*)
Yδrelt1=1.;     Yδrelt2=1.;     Yrrelt1=1.;     Yrrelt2=1.;     Yx=1.;
tx30=TextCell["Coefficiente di sensibilità all'intaglio pignone"];in30=InputField[Dynamic[Yδrelt1],FieldSize->{5,1}];
tx31=TextCell["Coefficiente di sensibilità all'intaglio ruota"];in31=InputField[Dynamic[Yδrelt2],FieldSize->{5,1}];
tx32=TextCell["Coefficiente di rugosità pignone"];in32=InputField[Dynamic[Yrrelt1],FieldSize->{5,1}];
tx33=TextCell["Coefficiente di rugosità ruota"];in33=InputField[Dynamic[Yrrelt2],FieldSize->{5,1}];
tx34=TextCell["Coefficiente di taglia"];in34=InputField[Dynamic[Yx],FieldSize->{5,1}];
gr6=Grid[({{tx30, TextCell[" Yδrel1:"], in30}, {tx31, TextCell[" Yδrel2:"], in31}, {tx32, TextCell[" Yrrelt1:"], in32}, {tx33, TextCell[" Yrrelt2:"], in33}, {tx34, TextCell[" Yx:"], in34}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];
ChoiceDialog[Grid[({{TextCell["Se non noti, lasciare i valori di default"]}, {gr6}})],WindowSize->{400,All}];


(*Calcolo delle tensioni alla base del dente indotta da Ft corrette*)
σf1=(Ftmax/(b*mn))*Yf1*Ys1*Yβ1*Yb1*Ydt*Ka*Kv*Kfβ*Kfα;
σf2=(Ftmax/(b*mn))*Yf2*Ys2*Yβ2*Yb2*Ydt*Ka*Kv*Kfβ*Kfα;

(*Calcolo delle tensioni ammissibili corrette*)
σfp1=((σFlim*Yst*Ynt)/Sfmin)Yδrelt1*Yrrelt1*Yx;
σfp2=((σFlim*Yst*Ynt)/Sfmin)Yδrelt1*Yrrelt1*Yx;

(*Verifica*)
Which[σf1>σfp1 && σf2>σfp2,verfle="NESSUNA DELLE DUE RUOTE RISPETTA IL COEFFICIENTE DI SICUREZZA ASSEGNATO A FLESSIONE",
	σH1>σfp1,verfle="IL PIGNONE NON RISPETTA IL COEFFICIENTE DI SICUREZZA ASSEGNATO A FLESSIONE",
	σf2>σfp2,verfle="LA RUOTA NON RISPETTA IL COEFFICIENTE DI SICUREZZA ASSEGNATO A FLESSIONE",
	σf1≤σfp1&&σf2≤σfp2,verfle="ENTRAMBE LE RUOTE RISPETTANO IL COEFFICIENTE DI SICUREZZA ASSEGNATO A FLESSIONE"];

ver=DialogInput[DialogNotebook[{TextCell[verfle],
Button["Procedi con la stampa dei risultati",DialogReturn[1]],
Button["Termina il calcolo",DialogReturn[2]],
},WindowTitle->"VERIFICA A FLESSIONE (ISO 6336-3)"]];
If[ver==2,Exit[]];

(*Fattore di sicurezza*)
SF = Min [σfp1/σH1,σfp2/σH2]*Sfmin;

grF=Grid [({{TextCell["Fattore di sicurezza minimo richiesto"], TextCell["Sfmin"], Sfmin,  }, {TextCell["Tensione ammissibile a flessione per il pignone"], TextCell["σfp1"], σfp1, TextCell["MPa"]}, {TextCell["Tensione ammissibile a flessione per la ruota"], TextCell["σfp2"], σfp2, TextCell["MPa"]}, {TextCell["Tensione a pressione (corretta) pignone"], TextCell["σf1"], σf1, TextCell["MPa"]}, {TextCell["Tensione a pressione (corretta) ruota"], TextCell["σf2"], σf2, TextCell["MPa"]}, {TextCell["Fattore di sicurezza effettivo"], TextCell["Sh"], SF,  }, {TextCell["Coefficiente di forma pignone"], TextCell["Yf1"], Yf1,  }, {TextCell["Coefficiente di forma ruota"], TextCell["Yf2"], Yf2,  }, {TextCell["Coefficiente di correzione della tensione pignone"], TextCell["Ys1"], Ys1,  }, {TextCell["Coefficiente di correzione della tensione ruota"], TextCell["Ys2"], Ys2,  }, {TextCell["Coefficiente d'elica "], TextCell["Yβ"], Yβ1,  }, {TextCell["Coefficiente di spessore del bordo pignone "], TextCell["Yb1"], Yb1,  }, {TextCell["Coefficiente di spessore del bordo ruota "], TextCell["Yb2"], Yb2,  }, {TextCell["Coefficiente di concentrazione delle tensioni"], TextCell["Yst"], Yst,  }, {TextCell["Life Factor"], TextCell["Ynt"], Ynt,  }, {TextCell["Coefficiente di sensibilità all'intaglio pignone"], TextCell["Yδrel1"], Yδrelt1,  }, {TextCell["Coefficiente di sensibilità all'intaglio ruota"], TextCell["Yδrel2"], Yδrelt2,  }, {TextCell["Coefficiente di rugosità pignone"], TextCell["Yrrelt1"], Yrrelt1,  }, {TextCell["Coefficiente di rugosità ruota"], TextCell["Yrrelt2"], Yrrelt2,  }, {TextCell["Coefficiente di taglia"], TextCell["Yx"], Yx,  }}),Spacings->{2,0.5},Alignment->{{Left,Left,Right,Left}}];

NotebookWrite[nb,Cell[ToBoxes[Grid[({{TextCell["\nVERIFICA A FLESSIONE (ISO 6336-3)\n"]}, {TextCell[verfle]}, {grF}})]]]];

Exit[]

7. Soluzione di una trave incastrata mediante elementi TL1

nb=CreateDocument[];
NotebookWrite[nb,Cell["Dati del calcolo","Subsection"]]

(*-----------------------------------------------------------------------------------------------------*)
(* MESH *)

(* Inserimento delle caratteristiche geometriche e fisiche e suddivisione della trave in elmenti *)

tx00=TextCell["Modulo elastico"];in00=InputField[Dynamic[Ε],FieldSize->{7,1}];
tx01=TextCell["Lunghezza (asse x)"];in01=InputField[Dynamic[l],FieldSize->{7,1}];
tx02=TextCell["Altezza (asse y)"];in02=InputField[Dynamic[h],FieldSize->{7,1}];
tx03=TextCell["N° nodi lungo x"];in03=InputField[Dynamic[n],FieldSize->{7,1}];
tx04=TextCell["N° nodi lungo y"];in04=InputField[Dynamic[m],FieldSize->{7,1}];
tx05=TextCell["Coeff. di Poisson"];in05=InputField[Dynamic[ν],FieldSize->{7,1}];

nod=m*n;
el=2(m-1)(n-1);

gr0=Grid[({{tx00, TextCell[":"], in00, TextCell["MPa"]}, {tx05, TextCell[":"], in05, Null}, {tx01, TextCell[":"], in01, TextCell["mm"]}, {tx02, TextCell[":"], in02, TextCell["mm"]}, {tx03, TextCell[":"], in03, Null}, {tx04, TextCell[":"], in04, Null}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];
ChoiceDialog[gr0,WindowSize->{250,All}];

NotebookWrite[nb,Cell[ToBoxes[gr0]]]


(*-----------------------------------------------------------------------------------------------------*)

(* Scelta del tipo di mesh e Associazione dei nodi all' elemento *)

mesh=ChoiceDialog["Scegliere il tipo di meshiatura in base alla disposizione degli elementi",{" Identica tra righe e colonne "->1," Invertita ogni colonna "->2," Invertita ogni riga "->3," Invertita ogni riga e colonna "->4},WindowSize->{Automatic,All}];

Switch[mesh,    1,cross1=True;   cross2=ans;   cross3=ans;    cross4=ans;
			,2,cross1=False;cross2=!ans;cross3=ans;   cross4=ans;
			,3,cross1=True;   cross2=ans;   cross3=!ans;cross4=!ans;
			,4,cross1=True;   cross2=!ans;cross3=!ans;cross4=!ans;]

ans=cross1;
For[i=0,i≤ n-1,i++,
ans=cross2;
For[j=1,j≤m-1,j++,
	If[ans,
	(*el.disp.*)k=2 (j+(m-1) i)-1;
				(Subscript[n1, k])=m (i+1)+j;
				(Subscript[n2, k])=j+1+m i;
				(Subscript[n3, k])=j+m i;
	  (*el.pari*)k=2 (j+(m-1) i);
				(Subscript[n1, k])=j+1+m i;
				(Subscript[n2, k])=m (i+1)+j;
				(Subscript[n3, k])=m (i+1)+j+1;
	ans=cross3,
	(*el.disp.*)k=2 (j+(m-1) i)-1;
				(Subscript[n1, k])=j+m i;
				(Subscript[n2, k])=m (i+1)+j+1;
				(Subscript[n3, k])=m (i+1)+j;
 	 (*el.pari*)k=2 (j+(m-1) i);
				(Subscript[n1, k])=m (i+1)+j+1;
				(Subscript[n2, k])=j+m i;
				(Subscript[n3, k])=j+1+m i;
	ans=cross4]]];

Δx=(l/(n-1));
Δy=(h/(m-1));

(* Associazione delle coordinate ai nodi *)

coo=ConstantArray[0,{nod,3}];

For[i=0,i≤n-1,i++,For[j=1,j≤m,j++,
coo[[j+i m]]={Δx i,Δy (j-1)}
]]

(* Rappresentazione grafica *)

IND={};
For[k=1,k≤el,k++,elind[k]={coo[[(Subscript[n1, k])]],coo[[(Subscript[n2, k])]],coo[[(Subscript[n3, k])]],coo[[(Subscript[n1, k])]]};
IND=Append[IND,ListPlot[elind[k],Joined->True,PlotStyle->{Thick,Black}]]]

sh1=Show[IND,GridLines->Automatic,ImageSize->Large,AspectRatio->Automatic];
NotebookWrite[nb,Cell[BoxData[ToBoxes[sh1],"Output"]]]


(*-----------------------------------------------------------------------------------------------------*)
(* MATRICE DI RIGIDEZZA *)

(* Creazione della matrice di rigidezza dell'elemento finito TL1 *)
(*NB: le matrici saranno tutte identiche essendo uguale la disposizione e le distanze relative dei nodi di ogni elemento*)

i=.;j=.;
(Subscript[n, fdf])=3;

For[i=1,i≤(Subscript[n, fdf]),i++,
					(Subscript[x, i])=elind[1][[i,1]];
					(Subscript[y, i])=elind[1][[i,2]]]

(({{(Subscript[Ν, 1])[ξ_,η_]}, {(Subscript[Ν, 2])[ξ_,η_]}, {(Subscript[Ν, 3])[ξ_,η_]}}))=(({{ξ}, {η}, {1-ξ-η}}));
 
X[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[Ν, i])[ξ,η](Subscript[x, i]);     Y[ξ_,η_]=(∑_(i=1)^(Subscript[n, fdf]))(Subscript[Ν, i])[ξ,η](Subscript[y, i]);

J=(({{(∂_ξ)X[ξ,η], (∂_ξ)Y[ξ,η]}, {(∂_η)X[ξ,η], (∂_η)Y[ξ,η]}}));      A=(1/2)Det[J];    

For[i=1,i≤(Subscript[n, fdf]),i++,(({{(Overscript[(Subscript[Ν, i]), x])}, {(Overscript[(Subscript[Ν, i]), y])}}))=Inverse[J].(({{(∂_ξ)(Subscript[Ν, i])[ξ,η]}, {(∂_η)(Subscript[Ν, i])[ξ,η]}}))]

(Subscript[b, s])=(({{(Overscript[(Subscript[Ν, j]), x]), 0}, {0, (Overscript[(Subscript[Ν, j]), y])}, {(Overscript[(Subscript[Ν, j]), y]), (Overscript[(Subscript[Ν, j]), x])}}));     For[j=1,j≤(Subscript[n, fdf]),j++,If[j==1,B=(Subscript[b, s]),B=Join[B,(Subscript[b, s]),2]]]
(Subscript[D, SPT])=(Ε/(1-(ν^2)))(({{1, ν, 0}, {ν, 1, 0}, {0, 0, ((1-ν)/2)}}));     

(Subscript[K, TL1])=SparseArray[A(Transpose[B].(Subscript[D, SPT]).B)];

NotebookWrite[nb,{Cell["\nMatrice di rigidezza dell'elemento","Text"],Cell[ToBoxes[(Subscript[K, TL1])//MatrixForm]]}]

(* Inserimento dei blocchi associati ai g.d.l. della matrice locale di rigidezza nei blocchi della matrice globale *)

(Subscript[n, glob])=2nod;
Kg=ConstantArray[0,{(Subscript[n, glob]),(Subscript[n, glob])},SparseArray];

(*blocchi*)

aa=(Subscript[K, TL1])[[1;;2,1;;2]];     ab=(Subscript[K, TL1])[[1;;2,3;;4]];      ac=(Subscript[K, TL1])[[1;;2,5;;6]];
ba=(Subscript[K, TL1])[[3;;4,1;;2]];     bb=(Subscript[K, TL1])[[3;;4,3;;4]];     bc=(Subscript[K, TL1])[[3;;4,5;;6]];
ca=(Subscript[K, TL1])[[5;;6,1;;2]];     cb=(Subscript[K, TL1])[[5;;6,3;;4]];      cc=(Subscript[K, TL1])[[5;;6,5;;6]];

(*somma dei blocchi locali di ogni elemento ai blocchi della matrice globale corrispondenti agli stessi g.d.l. *)

For[k=1,k≤el,k++,
  Kg[[(Subscript[n1, k])*2-1;;(Subscript[n1, k])*2,(Subscript[n1, k])*2-1;;(Subscript[n1, k])*2]]+=aa;
Kg[[(Subscript[n1, k])*2-1;;(Subscript[n1, k])*2,(Subscript[n2, k])*2-1;;(Subscript[n2, k])*2]]+=ab;
Kg[[(Subscript[n1, k])*2-1;;(Subscript[n1, k])*2,(Subscript[n3, k])*2-1;;(Subscript[n3, k])*2]]+=ac;
Kg[[(Subscript[n2, k])*2-1;;(Subscript[n2, k])*2,(Subscript[n1, k])*2-1;;(Subscript[n1, k])*2]]+=ba;
Kg[[(Subscript[n2, k])*2-1;;(Subscript[n2, k])*2,(Subscript[n2, k])*2-1;;(Subscript[n2, k])*2]]+=bb;
Kg[[(Subscript[n2, k])*2-1;;(Subscript[n2, k])*2,(Subscript[n3, k])*2-1;;(Subscript[n3, k])*2]]+=bc;
Kg[[(Subscript[n3, k])*2-1;;(Subscript[n3, k])*2,(Subscript[n1, k])*2-1;;(Subscript[n1, k])*2]]+=ca;
Kg[[(Subscript[n3, k])*2-1;;(Subscript[n3, k])*2,(Subscript[n2, k])*2-1;;(Subscript[n2, k])*2]]+=cb;
Kg[[(Subscript[n3, k])*2-1;;(Subscript[n3, k])*2,(Subscript[n3, k])*2-1;;(Subscript[n3, k])*2]]+=cc;]


(*-----------------------------------------------------------------------------------------------------*)
(* VETTORI DI SPOSTAMENTI E FORZE *)

(*vettore degli spostamenti*)

Δ={};
For[i=1,i≤nod,i++,    Δ=Join[Δ,{(Subscript[ux, i]),(Subscript[uy, i])}]]

(*inserimento dei vincoli al bordo*)

vinc=(({{TextCell["nodo"], TextCell["u(x)"], TextCell["u(y)"]}}));
For[i=1,i≤m,i++,vinc=Join[vinc,(({{Style[i,Bold,16], (Subscript[ux, i]), (Subscript[uy, i])}}))]];
tx4=TextCell["Vincoli del bordo SX.\nInserire 0 se lo spostamento è vincolato.\nNB la numerazione dei nodi nella mesh va dal basso(1) all'alto(n)"];
vincoli=Input[tx4,Grid[vinc,Frame->All,Spacings->{4,1}],WindowSize->{260,All},WindowMargins->{{Automatic,Automatic},{Automatic,0}}];
Vs=vincoli[[1]];

For[i=1,i≤m,i++, Δ[[2i-1;;2i]]=Vs[[1+i,2;;3]]]

NotebookWrite[nb,{Cell["\nVettore degli spostamenti","Text"],Cell[ToBoxes[Δ,StandardForm]]}]

(*vettore delle reazioni incognite*)

R=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i≤m,i++,If[Vs[[1+i,2;;3]][[1]]==0, R[[2i-1]]=(Subscript[Rx, i])];
					If[Vs[[1+i,2;;3]][[2]]==0, R[[2i]]=(Subscript[Ry, i])]]

(*inserimento e distribuzione della forza esterna applicata in un vettore forza*)

ChoiceDialog[Grid[({{TextCell["Inserire il valore del carico da distribuire sul bordo DX \n(N: orizzontale,  T: verticale) :"]}, {Grid[({{InputField[Dynamic[Ν]], Newton}})]}, {Grid[({{InputField[Dynamic[T]], Newton}})]}})]];
F=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i≤m,i++,  F[[(Subscript[n, glob])-2m+2i-1]]=R[[(Subscript[n, glob])-2m+2i-1]]+Ν/m//N;
					F[[(Subscript[n, glob])-2m+2i]]=R[[(Subscript[n, glob])-2m+2i]]+T/m//N]

NotebookWrite[nb,{Cell["\nVettore delle reazioni e delle forze esterne","Text"],Cell[ToBoxes[(F+R),StandardForm]]}]


(*-----------------------------------------------------------------------------------------------------*)
(* SOLUZIONE *)

(*Vettore delle incognite *)

inc=ConstantArray[0,(Subscript[n, glob])];
For[i=1,i≤(Subscript[n, glob]),i++, inc=R+Δ]

(*Soluzione*)

sol=Solve[Kg.Δ==R+F,inc]//N;
NotebookWrite[nb,{Cell["\nSoluzione","Text"],Cell[ToBoxes[sol,StandardForm]]}]

(*sostituzione dei risultati*)

For[j=1,j≤(Subscript[n, glob]),j++,For[i=1,i≤(Subscript[n, glob]),i++,
Switch[sol[[1,i,1]],  R[[j]],  R[[j]]=sol[[1,i,2]],
					   Δ[[j]],  Δ[[j]]=sol[[1,i,2]]]]]

FR=F+R;
NotebookWrite[nb,{Cell["\nMatrici delle forze e degli spostamenti risolte","Text"],
Cell[ToBoxes[Grid[(({{FR//N}, {Null}, {Δ//N}}))]]]}]


(*---------------------------------------------------------------------------------------------------------------------------------*)
(* SPOSTAMENTI E FORZE NEGLI ELEMENTI *)

(*assegnazione spostamenti e forze negli elementi*)

For[i=1,i≤el,i++,(Subscript[δ, i])=Join[Δ[[(Subscript[n1, i])*2-1;;(Subscript[n1, i])*2]],Δ[[(Subscript[n2, i])*2-1;;(Subscript[n2, i])*2]],Δ[[(Subscript[n3, i])*2-1;;(Subscript[n3, i])*2]]];
					(Subscript[f, i])=Chop[(Subscript[K, TL1]).(Subscript[δ, i]),0.1]]

(*coordinate dei nodi sotto carico con spostamento in scala x10 e grafico*)

cood=ConstantArray[0,nod];
For[i=1,i≤nod,i++,cood[[i]]=coo[[i]]+10*Δ[[{2i-1,2i}]]]
DEF={};
For[k=1,k≤el,k++,eldef[k]={cood[[(Subscript[n1, k])]],cood[[(Subscript[n2, k])]],cood[[(Subscript[n3, k])]],cood[[(Subscript[n1, k])]]};
DEF=Append[DEF,ListPlot[eldef[k],Joined->True,PlotStyle->{Thick,Red}]]]

sh2=Show[IND,DEF,GridLines->Automatic,ImageSize->Large,AspectRatio->Automatic];
NotebookWrite[nb,{Cell["\nSpostamento dei nodi ×10","Text"],Cell[BoxData[ToBoxes[sh2],"Output"]]}]

(*calcolo della forza nei lati degli elementi: differenza delle forze orizzontali e verticali dei nodi che congiungono un lato, quindi composizione vettoriale delle due differenze e calcolo della massima tra tutte, quindi grafico*)

max=0;
For[k=1,k≤el,k++,(Subscript[f1, k])=(Sqrt[((((Subscript[f, k])[[1]]-(Subscript[f, k])[[3]]))^2)+((((Subscript[f, k])[[2]]-(Subscript[f, k])[[4]]))^2)]);(*1-2*)
					(Subscript[f2, k])=(Sqrt[((((Subscript[f, k])[[3]]-(Subscript[f, k])[[5]]))^2)+((((Subscript[f, k])[[4]]-(Subscript[f, k])[[6]]))^2)]);(*2-3*)
					(Subscript[f3, k])=(Sqrt[((((Subscript[f, k])[[5]]-(Subscript[f, k])[[1]]))^2)+((((Subscript[f, k])[[6]]-(Subscript[f, k])[[2]]))^2)]);(*3-1*)

For[i=1,i≤el,i++,max=Max[max,(Subscript[f1, k]),(Subscript[f2, k]),(Subscript[f3, k])]]]

NotebookWrite[nb,{Cell["\nValore massimo assoluto della forza","Text"],Cell[ToBoxes[(Grid[({{Null, Round[max], Newton}})])]]}]

FORZA={};
For[k=1,k≤el,k++,elforza[k]=Join[{Thick,ColorData["Rainbow"][(Subscript[f1, k])/max],Line[{cood[[(Subscript[n1, k])]],cood[[(Subscript[n2, k])]]} ]},
								{Thick,ColorData["Rainbow"][(Subscript[f2, k])/max],Line[{cood[[(Subscript[n2, k])]],cood[[(Subscript[n3, k])]]}]},
								{Thick,ColorData["Rainbow"][(Subscript[f3, k])/max],Line[{cood[[(Subscript[n3, k])]],cood[[(Subscript[n1, k])]]}]}];
FORZA=Append[FORZA,elforza[k]]];

sca=;
gr1=Graphics[FORZA,GridLines->Automatic,ImageSize->Large];
im1=Image[sca,ImageSize->Medium];

NotebookWrite[nb,{Cell["\nDistribuzione della forza","Text"],Cell[BoxData[ToBoxes[gr1],"Output"]]}]
NotebookWrite[nb,Cell[BoxData[ToBoxes[im1],"Output"]]]


Exit[]

Pseudo Rigid Body Model

1. Howell PRB 1R Model

1.1. Cantilever beam with a force at the free end

SystemOpen["C:\\Users\\PiGre\\Desktop\\wip\\ThesisReview\\3-4. Model\\Howell - Compliant Mechanisms _ PRBM _ Cantilever Beam.pdf"]

1.1.1. Theory

ϕ=ArcTan[(1/(-n))];
Θ=ArcTan[(b/(a-l(1-γ)))];

Average of the characteristic radius factor

γ[n_]=({{\[Piecewise], ({{0.841655-0.0067807n+0.000438(n^2), 0.5<n<10}, {0.852144-0.0182867n, -1.8316<n≤0.5}, {0.912364+0.01455928n, -5<n≤-1.8316}})}});
(Subscript[γ, ave])=0.8517;

Coordinate of beam end (a/l) and angular deflection

(Subscript[x, 0])=1-γ[n](1-Cos[Θ]); (*(a/l)*)
(Subscript[y, 0])=γ[n] Sin[Θ];  (*(b/l)*)
(Subscript[θ, 0])=(Subscript[c, ϑ])Θ;

Stiffness coefficient and torsional spring constant

(α^2)==(((Subscript[F, t]) (l^2))/(Ε i))
(α^2)==(Subscript[k, ϑ]) Θ

η=(Sqrt[1+(n^2)]);
F=P η;
(Subscript[F, t])=F Sin[ϕ-Θ];
(*T==K θ,T==(Subscript[F, t])γl*)
eq1=(Subscript[F, t])==((K Θ)/(γ[n] l));

(Subscript[k, ϑ])[n_]=({{\[Piecewise], ({{3.024112+0.121290n+0.003169(n^2), -5<n<-2.5}, {1.96765-2.61602n-3.7381(n^2)-2.649437(n^3)-0.891906(n^4)-0.113063(n^5), -2.5<n≤-1}, {2.654855-0.0509896n+0.0126749(n^2)-0.00142039(n^3)+0.0000584525(n^4), -1<n≤10}})}});
(Subscript[k, ϑ,ave])=2.65;
K=γ[n] (Subscript[k, ϑ])[n]((Ε Ι)/l);

Stress

(Subscript[M, ave])=P a+n P b;
d=h/2;
Ι=((w (h^3))/12);
A=w h;
(Subscript[σ, top])=-(((Subscript[M, ave])d)/Ι)-((n P)/A);
(Subscript[σ, bot])=(((Subscript[M, ave])d)/Ι)-((n P)/A);

1.1.2. Example

1.1.2.1. Calculation of the vertical force required to cause a vertical deflection b=254mm

a) Assuming the force only vertical

dat1={Ε->200000,l->508,w->31.75,h->25.4/32,b->254,n->0,(Subscript[c, ϑ])->1.24,ϕ->π/2};
Print["γ= ",γ[n]/.dat1,"\n(Subscript[k, ϑ])= ",(Subscript[k, ϑ])[n]/.dat1,"\nγl= ",γ[n] l/.dat1,"\nK= ",K/.dat1]

Solve[(b/l)==(Subscript[y, 0]),Θ]/.dat1;
(OverBar[Θ])=%[[1,1,2]]; 
dat1=Append[dat1,Θ->(OverBar[Θ])];
Print["Θ= ",Round[(OverBar[Θ])*180/π],"°"];

Solve[eq1,P]/.dat1;
Print["P= ",Round[(OverBar[P])=%[[1,1,2]],0.1]," N"];
dat1=Append[dat1,P->(OverBar[P])];

Solve[(a/l)==(Subscript[x, 0]),a]/.dat1;
Print["a= ",Round[(OverBar[a])=%[[1,1,2]],0.1]," mm"];
dat1=Append[dat1,a->(OverBar[a])];

(Subscript[σ, top])/.dat1
(Subscript[σ, bot])/.dat1
(Subscript[θ, 0])*180/π/.dat1

b) Assuming the force act with an angle ϕ=135°

(OverBar[Θ])=.;(OverBar[P])=.;(OverBar[a])=.;
dat2={Ε->200000,l->508,w->31.75,h->25.4/32,b->254,(Subscript[c, ϑ])->1.24,ϕ->135°};
(OverBar[n])=((-1)/(Tan[ϕ]))/.dat2
dat2=Append[dat2,n->(OverBar[n])];
Print["γ= ",γ[n]/.dat2,"\n(Subscript[k, ϑ])= ",(Subscript[k, ϑ])[n]/.dat2,"\nγl= ",γ[n] l/.dat2,"\nK= ",K/.dat2]

Solve[(b/l)==(Subscript[y, 0]),Θ]/.dat2;
(OverBar[Θ])=%[[1,1,2]]
dat2=Append[dat2,Θ->(OverBar[Θ])];
Print["Θ= ",Round[(OverBar[Θ])*180/π],"°"];

Solve[eq1,P]/.dat2;
Print["P= ",Round[(OverBar[P])=%[[1,1,2]],0.1]," N"];
dat2=Append[dat2,P->(OverBar[P])];

F/.dat2

Solve[(a/l)==(Subscript[x, 0]),a]/.dat2;
Print["a= ",Round[(OverBar[a])=%[[1,1,2]],0.1]," mm"];
dat2=Append[dat2,a->(OverBar[a])];

(Subscript[σ, top])/.dat2
(Subscript[σ, bot])/.dat2
(Subscript[θ, 0])*180/π/.dat2

Quit[]

2. Su PRB 3R Model

SystemOpen["C:\\Users\\PiGre\\Desktop\\wip\\ThesisReview\\3-4. Model\\Su - A Pseudo_Rigid_Body 3R Model for Determining Large Deflection of Cantilever Beams Subject to Tip Loads.pdf"]

2.1. Generic tip loads

2.1.1. Forward and Inverse Kinematic Equations

Definition of the non-dimensional force index, load ratio and Characteristic radius factor

α=(((Subscript[F, 0]) (l^2))/(2Ε Ι));     κ=((β^2)/(4α));     β=(((Subscript[M, 0])l)/(Ε Ι));

(Subscript[γ, 0])+(Subscript[γ, 1])+(Subscript[γ, 2])+(Subscript[γ, 3])==1;

Tip point Q=((((Subscript[Q, x]),(Subscript[Q, y])))^T) and slope angle (Subscript[θ, 0]) calculated via forward kinematic and Jacobian matrix

(Subscript[c, 1])=Cos[(Subscript[θ, 1])]; (Subscript[s, 1])=Sin[(Subscript[θ, 1])]; (Subscript[c, 12])=Cos[(Subscript[θ, 1])+(Subscript[θ, 2])]; (Subscript[s, 12])=Sin[(Subscript[θ, 1])+(Subscript[θ, 2])]; (Subscript[c, 123])=Cos[(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3])]; (Subscript[s, 123])=Sin[(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3])];

(Subscript[Q, x])=(Subscript[γ, 0])+(Subscript[γ, 1])(Subscript[c, 1])+(Subscript[γ, 2])(Subscript[c, 12])+(Subscript[γ, 3])(Subscript[c, 123]);
(Subscript[Q, y])=(Subscript[γ, 0])+(Subscript[γ, 1])(Subscript[s, 1])+(Subscript[γ, 2])(Subscript[s, 12])+(Subscript[γ, 3])(Subscript[s, 123]);
(Subscript[θ, 0])=(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3]);

J=(({{(∂_(Subscript[θ, 1]))(Subscript[Q, x]), (∂_(Subscript[θ, 2]))(Subscript[Q, x]), (∂_(Subscript[θ, 3]))(Subscript[Q, x])}, {(∂_(Subscript[θ, 1]))(Subscript[Q, y]), (∂_(Subscript[θ, 2]))(Subscript[Q, y]), (∂_(Subscript[θ, 3]))(Subscript[Q, y])}, {(∂_(Subscript[θ, 1]))(Subscript[θ, 0]), (∂_(Subscript[θ, 2]))(Subscript[θ, 0]), (∂_(Subscript[θ, 3]))(Subscript[θ, 0])}}));

%//MatrixForm

given Q and (Subscript[θ, 0]) computation of the PRB angle by analytical inverse kinematic (Tsai)

(Subscript[p, x])=(Subscript[Q, x])-(Subscript[γ, 3])Cos[(Subscript[θ, 0])]-(Subscript[γ, 0]);
(Subscript[p, y])=(Subscript[Q, y])-(Subscript[γ, 3])Sin[(Subscript[θ, 0])];

(Subscript[θ, 2])=({{{, ({{+ArcCos[(((Subscript[p, x])+(Subscript[p, y])-((Subscript[γ, 1])^2)-((Subscript[γ, 2])^2))/(2(Subscript[γ, 1])(Subscript[γ, 2])))], (Subscript[p, y])<0}, {-ArcCos[(((Subscript[p, x])+(Subscript[p, y])-((Subscript[γ, 1])^2)-((Subscript[γ, 2])^2))/(2(Subscript[γ, 1])(Subscript[γ, 2])))], (Subscript[p, y])>0}})}});
(Subscript[θ, 1])=ArcTan[sθ1,cθ1];
(Subscript[θ, 3])=(Subscript[θ, 0])-(Subscript[θ, 1])-(Subscript[θ, 2]);

sθ1=(((Subscript[p, x])((Subscript[γ, 1])+(Subscript[γ, 2])Cos[(Subscript[θ, 2])])+(Subscript[p, y])(Subscript[γ, 2])Sin[(Subscript[θ, 2])])/(((Subscript[γ, 1])^2)+((Subscript[γ, 2])^2)+2(Subscript[γ, 1])(Subscript[γ, 2])Cos[(Subscript[θ, 2])]));     cθ1=(((Subscript[p, y])((Subscript[γ, 1])+(Subscript[γ, 2])Cos[(Subscript[θ, 2])])-(Subscript[p, x])(Subscript[γ, 2])Sin[(Subscript[θ, 2])])/(((Subscript[γ, 1])^2)+((Subscript[γ, 2])^2)+2(Subscript[γ, 1])(Subscript[γ, 2])Cos[(Subscript[θ, 2])]));

2.1.2. Static Equations

Torques at the three pin joints

(({{(Subscript[τ, 1])}, {(Subscript[τ, 2])}, {(Subscript[τ, 3])}}))=(J^T)(({{(Subscript[F, x])l}, {(Subscript[F, y])l}, {(Subscript[M, 0])}}))

(Subscript[F, x])=(Subscript[F, 0])Cos[ϕ]
(Subscript[F, y])=(Subscript[F, 0])Sin[ϕ]

Assuming that the spring torques are proportional to the PRB angles

(Subscript[τ, i])=(Subscript[k, i])(Subscript[θ, i])

where the spring stiffness (Subscript[k, i ])can be normalized into

(Subscript[k, i])=(Subscript[k, (Subscript[θ, i])])(((Ε Ι)/l))

substituting

SE=(({{(Subscript[k, (Subscript[θ, 1])])(Subscript[θ, 1])}, {(Subscript[k, (Subscript[θ, 2])])(Subscript[θ, 2])}, {(Subscript[k, (Subscript[θ, 3])])(Subscript[θ, 3])}}))==J\[Transpose].(({{2 α Cos[ϕ]}, {2α Sin[ϕ]}, {β}}))

2.1.3. Optimized PRB 3R Model Coefficients

(Subscript[γ, 0])=0.1;     (Subscript[γ, 1])=0.35;     (Subscript[γ, 2])=0.4;      (Subscript[γ, 3])=0.15;
(Subscript[k, (Subscript[θ, 1])])=3.51;     (Subscript[k, (Subscript[θ, 2])])=2.99;     (Subscript[k, (Subscript[θ, 3])])=2.58;

2.1.4. Example

dat3={Ε->200000,l->508,w->31.75,h->25.4/32,(Subscript[p, y])->254,ϕ->135°,(Subscript[F, 0])->1.739,(Subscript[M, 0])->0};
Ι=((w (h^3))/12);

FindRoot[SE/.dat3,{{(Subscript[θ, 1]),0},{(Subscript[θ, 2]),0},{(Subscript[θ, 3]),0}}];
sol={(Subscript[θ, 1])->%[[1,2]],(Subscript[θ, 2])->%[[2,2]],(Subscript[θ, 3])->%[[3,2]]}

(Subscript[θ, 0])*180/π/.sol

3. Serially Layered-flat Spring Compliant Joint

SystemOpen["C:\\Users\\PiGre\\Desktop\\wip\\ThesisReview\\3-4. Model\\Kozuka,Arata - Compliant_Parallel Mechanism for High Precision Machine with a Wide Range of Working Area.pdf"]

3.1. Model with k=∞

nb=CreateDocument[];
NotebookWrite[nb,Cell["Data","Subsection"]]

(*--------------------------------------------------------------------------------------*)
(* k=∞ *)
(Subscript[F, 0])=0;

(* Optimized PRB 3R Model Coefficients *)

(Subscript[γ, 0])=0.1;     (Subscript[γ, 1])=0.35;     (Subscript[γ, 2])=0.4;      (Subscript[γ, 3])=0.15;
(Subscript[k, (Subscript[θ, 1])])=3.51;     (Subscript[k, (Subscript[θ, 2])])=2.99;     (Subscript[k, (Subscript[θ, 3])])=2.58;

(* non-dimensional index and inertia momentum*)

α=(((Subscript[F, 0]) (l^2))/(2Ε Ι));     β=(((Subscript[M, 0])l)/(Ε Ι));     Ι=((w (t^3))/12);

(* Kinekatic equation *)

(Subscript[c, 1])=Cos[(Subscript[θ, 1])]; (Subscript[s, 1])=Sin[(Subscript[θ, 1])]; (Subscript[c, 12])=Cos[(Subscript[θ, 1])+(Subscript[θ, 2])]; (Subscript[s, 12])=Sin[(Subscript[θ, 1])+(Subscript[θ, 2])]; (Subscript[c, 123])=Cos[(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3])]; (Subscript[s, 123])=Sin[(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3])];

(Subscript[Q, x])=(Subscript[γ, 0])+(Subscript[γ, 1])(Subscript[c, 1])+(Subscript[γ, 2])(Subscript[c, 12])+(Subscript[γ, 3])(Subscript[c, 123]);
(Subscript[Q, y])=(Subscript[γ, 0])+(Subscript[γ, 1])(Subscript[s, 1])+(Subscript[γ, 2])(Subscript[s, 12])+(Subscript[γ, 3])(Subscript[s, 123]);
θ0=(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3]);

J=(({{(∂_(Subscript[θ, 1]))(Subscript[Q, x]), (∂_(Subscript[θ, 2]))(Subscript[Q, x]), (∂_(Subscript[θ, 3]))(Subscript[Q, x])}, {(∂_(Subscript[θ, 1]))(Subscript[Q, y]), (∂_(Subscript[θ, 2]))(Subscript[Q, y]), (∂_(Subscript[θ, 3]))(Subscript[Q, y])}, {(∂_(Subscript[θ, 1]))θ0, (∂_(Subscript[θ, 2]))θ0, (∂_(Subscript[θ, 3]))θ0}}));

(* Static Equations *)

SE=(({{(Subscript[k, (Subscript[θ, 1])])(Subscript[θ, 1])}, {(Subscript[k, (Subscript[θ, 2])])(Subscript[θ, 2])}, {(Subscript[k, (Subscript[θ, 3])])(Subscript[θ, 3])}}))==J\[Transpose].(({{2 α Cos[ϕ]}, {2α Sin[ϕ]}, {β}}));

(* Sistem *)

eq=(Subscript[θ, 0])==(Subscript[θ, 1])+(Subscript[θ, 2])+(Subscript[θ, 3]); (* (Subscript[θ, i0]) rotazione totale generico elemento i *)
Syst=Append[SE[[1]],{eq[[1]]}]==Append[SE[[2]],{eq[[2]]}]; (*4 eq. system*)

(* Inserction of the geometrical and phisical characteristic and number of elements *)

tx00=TextCell["Young's Modulus"];in00=InputField[Dynamic[Ε],FieldSize->{7,1}];
tx01=TextCell["Poisson's Coefficient"];in01=InputField[Dynamic[ν],FieldSize->{7,1}];
tx02=TextCell["Beam's Lenght"];in02=InputField[Dynamic[l],FieldSize->{7,1}];
tx03=TextCell["Beam's Thickness"];in03=InputField[Dynamic[t],FieldSize->{7,1}];
tx04=TextCell["Beam's Width"];in04=InputField[Dynamic[w],FieldSize->{7,1}];
tx05=TextCell["Height Between"];in05=InputField[Dynamic[h],FieldSize->{7,1}];
tx06=TextCell["Elements Number"];in06=InputField[Dynamic[n],FieldSize->{7,1}];
tx08=PopupMenu[Dynamic[unk],{0->"Angular Deflection",1->"Moment on tip"},FieldSize->10,AutoAction->True];
in08=Dynamic[If[unk==0,InputField[Dynamic[(Subscript[θ, tot])],FieldSize->{7,1}],InputField[Dynamic[(Subscript[M, 0])],FieldSize->{7,1}]]];
udm08=TextCell[Dynamic[If[unk==0,"rad","M*mm"]]];
gr0=Grid[({{tx00, TextCell[":"], in00, TextCell["MPa"]}, {tx01, TextCell[":"], in01, Null}, {tx02, TextCell[":"], in02, TextCell["mm"]}, {tx03, TextCell[":"], in03, TextCell["mm"]}, {tx04, TextCell[":"], in04, TextCell["mm"]}, {tx05, TextCell[":"], in05, TextCell["mm"]}, {tx06, TextCell[":"], in06, Null}, {tx08, TextCell[":"], in08, udm08}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];
ChoiceDialog[gr0,WindowSize->{350,All}];
NotebookWrite[nb,Cell[ToBoxes[gr0]]]

 (* Generic Solution of the system *)

inc=If[ValueQ[(Subscript[M, 0])],{(Subscript[θ, 1]),(Subscript[θ, 2]),(Subscript[θ, 3]),(Subscript[θ, 0])},{(Subscript[θ, 1]),(Subscript[θ, 2]),(Subscript[θ, 3]),(Subscript[M, 0])}];
s1=Solve[Syst,inc];

(*If[ValueQ[(Subscript[M, 0])],      (Subscript[θ, i0])=(Subscript[θ, 0]);(Subscript[θ, tot])=(Subscript[θ, i0])*n;,
,(Subscript[θ, i0])=(Subscript[θ, tot])/n;s1= s1/.(Subscript[θ, 0])->(Subscript[θ, i0]);]*)
 
NotebookWrite[nb,{Cell["\nSoluzione","Text"],Cell[ToBoxes[s1\[Transpose]//MatrixForm]]}]

For[j=1,j≤Length[inc],j++,For[i=0,i<Length[inc],i++[
If[s1[[1,j,1]]==(Subscript[M, 0]),(Subscript[M, 0])=s1[[1,j,2]],If[s1[[1,j,1]] ==(Subscript[θ, i]) , (Subscript[θ, i])=s1[[1,j,2]]]]]]]

d=t/2;
σ=(((Subscript[M, 0])d)/Ι);

gr1=Grid[({{Null, Null}, {TextCell["Momentum"], (Subscript[M, 0])}, {TextCell["Deflection"], (Subscript[θ, tot])}, {TextCell["Tension"], σ}}),Spacings->{1,1},Alignment->{{Right,Left}}];
NotebookWrite[nb,Cell[ToBoxes[gr1//MatrixForm]]]

dat3={l->6,t->0.2,h->10,w->20,Ε->206000,ν->0.3,n->3}
42.5*π/180
Maxθ=%;
MaxS=1080;

3.2. Generic model

Loaded by force and moment in a generic point P.
Hp: the angle of the force respect the upper free tip point tangent is fixed

n=3;
(* Optimized PRB 3R Model Coefficients *)

(Subscript[γ, 0])=0.1;     (Subscript[γ, 1])=0.35;     (Subscript[γ, 2])=0.4;      (Subscript[γ, 3])=0.15;     (*length coefficient*)
(Subscript[k, (Subscript[θ, 1])])=3.51;     (Subscript[k, (Subscript[θ, 2])])=2.99;     (Subscript[k, (Subscript[θ, 3])])=2.58;   

α=(((Subscript[F, 0]) (l^2))/(2Ε Ι));     (* Non-dimensional force index *)

(*Functions and definitions*)

c1[r_]=Cos[(Subscript[θ1, r])]; s1[r_]=Sin[(Subscript[θ1, r])]; c12[r_]=Cos[(Subscript[θ1, r])+(Subscript[θ2, r])]; s12[r_]=Sin[(Subscript[θ1, r])+(Subscript[θ2, r])]; c123[r_]=Cos[(Subscript[θ1, r])+(Subscript[θ2, r])+(Subscript[θ3, r])]; s123[r_]=Sin[(Subscript[θ1, r])+(Subscript[θ2, r])+(Subscript[θ3, r])];

P={Px,Py};     (*loads point referred to the fixed reference system*)

(Subscript[Q, n])={(Subscript[Qx, n]),(Subscript[Qy, n])};

{(Subscript[Ox, 0]),(Subscript[Oy, 0])}={0,0};

Θ[r_]=(∑_(i=1)^r)(Subscript[θ0, i]);     Θ[0]=0;

(*ϕ0: beginning angle of (Subscript[F, 0]) respect the Tan in the n-th free tip*)
(Subscript[ϕ, 0])=ϕ0+Θ[n];

(* Force and Transport Loads *)

(Subscript[F, x])=(Subscript[F, 0])Cos[(Subscript[ϕ, n])];     (Subscript[F, y])=(Subscript[F, 0])Sin[(Subscript[ϕ, n])];

(Subscript[Q, n0])={l*Mod[n,2],n*h};    (*coordinates of the tip point when undeflected respect the fixed reference system*)

(*arms of (Subscript[F, 0]) considering that P is rigid respect the n-th free tip point and the load angle remain constant respect (OverBar[PQ])*)
{(Subscript[b, x]),(Subscript[b, y])}=Norm[P-(Subscript[Q, n0])]*{Sin[Θ[n]],Cos[Θ[n]]};     

(Subscript[M, t])=(Subscript[F, y])(Subscript[b, x])-(Subscript[F, x])(Subscript[b, y]);   (*moment transported to the free tip of the n-th beam*)

Mn=(Subscript[M, 0])+(Subscript[M, t]);   (*total moment acting on the n-th beam*)

For[j=1,j≤n,j++,

(* Kinekatic equation *)

(*adimensional coordinates (Σγ=1) of the free tip of the r-th beam referred to the r-th reference system*)
(Subscript[qx, j])=(Subscript[γ, 0])+(Subscript[γ, 1])c1[j]+(Subscript[γ, 2])c12[j]+(Subscript[γ, 3])c123[j];     
(Subscript[qy, j])=(Subscript[γ, 0])+(Subscript[γ, 1])s1[j]+(Subscript[γ, 2])s12[j]+(Subscript[γ, 3])s123[j];
(Subscript[θ0, j])=(Subscript[θ1, j])+(Subscript[θ2, j])+(Subscript[θ3, j]);     (* rotation of the tip point of the r-th element*)   

(Subscript[q, j])={(Subscript[qx, j])l,(Subscript[qy, j])l,1};   (*dimensional coordinates*)

(Subscript[J, j])=(({{(∂_(Subscript[θ1, j]))(Subscript[qx, j]), (∂_(Subscript[θ2, j]))(Subscript[qx, j]), (∂_(Subscript[θ3, j]))(Subscript[qx, j])}, {(∂_(Subscript[θ1, j]))(Subscript[qy, j]), (∂_(Subscript[θ2, j]))(Subscript[qy, j]), (∂_(Subscript[θ3, j]))(Subscript[qy, j])}, {(∂_(Subscript[θ1, j]))(Subscript[θ0, j]), (∂_(Subscript[θ2, j]))(Subscript[θ0, j]), (∂_(Subscript[θ3, j]))(Subscript[θ0, j])}}));

(*Points and angles*)

(* (Subscript[ϕ, 0]): angle of (Subscript[F, 0]) respect (Subscript[x, 0]) *)
(Subscript[ϕ, j])=(Subscript[ϕ, 0])-Θ[j-1]+(1-Mod[j,2])π;   (*angle of load respect the r-th ref. system*)

(Subscript[ψ, j])=Θ[j-1]+(1-Mod[j,2])π;   (*angle of the r-th ref. system respect the fixed one*)   

(*r-th origin reference system referred to the fixed reference system*)
If[j==1,
{(Subscript[Ox, j]),(Subscript[Oy, j])}={(Subscript[Ox, 0]),(Subscript[Oy, 0])},
{(Subscript[Ox, j]),(Subscript[Oy, j])}=(Subscript[Q, j-1])+h{-Sin[Θ[j-1]],Cos[Θ[j-1]]}];  

   (Subscript[o, j])={(Subscript[Ox, j]),(Subscript[Oy, j])};     

(*roto-translational matrix of the r-th reference system respect the fixed one*)
(Subscript[R, j])=(({{Cos[(Subscript[ψ, j])], -Sin[(Subscript[ψ, j])], (Subscript[Ox, j])}, {Sin[(Subscript[ψ, j])], Cos[(Subscript[ψ, j])], (Subscript[Oy, j])}, {0, 0, 1}}));  

(*coordinates of the generic r-th free tip point referred to the fixed reference system*)
{(Subscript[Qx, j]),(Subscript[Qy, j]),null}=(Subscript[R, j]).(Subscript[q, j]);

(Subscript[Q, j])={(Subscript[Qx, j]),(Subscript[Qy, j])};     

{(Subscript[dx, j]),(Subscript[dy, j])}=(Subscript[Q, n])-(Subscript[Q, j]);

(Subscript[M, j])=Mn+(Subscript[F, y])(Subscript[dx, j])-(Subscript[F, x])(Subscript[dy, j]);   (*generic moment acting on the r-th beam*)

(* Non-dimensional moment index *)

(Subscript[β, j])=(((Subscript[M, j])l)/(Ε Ι))      
]

(* Equations generations for each elements *)
For[j=1,j≤n,j++,
FM=(Subscript[J, j])\[Transpose].(({{2 α Cos[(Subscript[ϕ, j])]}, {2α Sin[(Subscript[ϕ, j])]}, {(Subscript[β, j])}}));
eq[j+n(j-1)]= (Subscript[k, (Subscript[θ, 1])])(Subscript[θ1, j])==FM[[1,1]];
eq[j+n(j-1)+1]=(Subscript[k, (Subscript[θ, 2])])(Subscript[θ2, j])==FM[[2,1]];
eq[j+n(j-1)+2]=(Subscript[k, (Subscript[θ, 3])])(Subscript[θ3, j])==FM[[3,1]];
Var[j]={{(Subscript[θ1, j]),0},{(Subscript[θ2, j]),0},{(Subscript[θ3, j]),0}};
]

 Σ={eq[1],eq[2],eq[3]};                    V=Var[1];
For[j=2,j≤n,j++,   Σ=Join[Σ,{eq[j+n(j-1)],eq[j+n(j-1)+1],eq[j+n(j-1)+2]}];
					V=Join[V,Var[j]]]

dat={t->0.2,(Subscript[F, 0])->2,w->20,Ε->206000,Px->3,Py->122,ϕ0->π,(Subscript[M, 0])->0,h->5.5,l->6,Ι->((20 (0.2^3))/12)};

sol=FindRoot[Σ/.dat,V/.dat]

(Subscript[θ0, 1])*180/π/.dat/.sol
(Subscript[θ0, 2])*180/π/.dat/.sol
(Subscript[θ0, 3])*180/π/.dat/.sol
θtot=%+%%+%%%

(Subscript[ψ, 1])*180/π/.dat/.sol
(Subscript[ψ, 2])*180/π/.dat/.sol
(Subscript[ψ, 3])*180/π/.dat/.sol

(Subscript[ϕ, 1])*180/π/.dat/.sol
(Subscript[ϕ, 2])*180/π/.dat/.sol
(Subscript[ϕ, 3])*180/π/.dat/.sol

(Subscript[M, 1])/.dat/.sol
(Subscript[M, 2])/.dat/.sol
(Subscript[M, 3])/.dat/.sol

(Subscript[q, 1])/.dat/.sol
(Subscript[q, 2])/.dat/.sol
(Subscript[q, 3])/.dat/.sol

(Subscript[Q, 3])/.dat/.sol
(Subscript[Q, 2])/.dat/.sol
(Subscript[Q, 1])/.dat/.sol

(Subscript[o, 3])/.dat/.sol
(Subscript[o, 2])/.dat/.sol
(Subscript[o, 1])/.dat/.sol

d=t/2;
A=w t;
Ν[r_]=(Subscript[F, 0])Cos[(Subscript[ϕ, r])];
(Subscript[σ, top])[r_]=-(((Subscript[M, r])d)/Ι)-((Ν[r])/A);
(Subscript[σ, bot])[r_]=(((Subscript[M, r])d)/Ι)-((Ν[r])/A);

For[j=1,j≤n,j++,
Print[j,")\t (Subscript[σ, top])=",-(((Subscript[M, j])d)/Ι)-((Ν[j])/A)/.dat/.sol,"\n\t\t (Subscript[σ, bot])=",(((Subscript[M, j])d)/Ι)-((Ν[j])/A)/.dat/.sol]]

4. nSFS

Quick data

Quit[]

mv

Em=210000;
Px=0;Py=0;
F0=0;fi0=0;
tmax=40*π/180.;
kgs=1.2;
n=3;

mf

Em=210000;
Px=l/20.;Py=300;
F0=1;fi0=π;
M0=200;
kgs=1.2;
n=3;

Inizialization values, parameters and symbols

(* Inserction of the geometrical and phisical characteristic and number of elements *)

gr=Grid[({{TextCell["Elements Number"], InputField[Dynamic[n],FieldSize->{2,1}]}})];
ChoiceDialog[gr,WindowSize->{350,All}]
Stress=ConstantArray[0,2n];     (*vector of the stress value*)

Sz=w (t^3)/12; (*moment of inertia*)
Ar=w t;     (*Area*)
b=4.6t;   (*with this ratio the deformability of the rigid part is equal to 1/1000 of the flexible one*)

tx0=TextCell["Phisical & geometrical parameters","Subsubtitle"];
tx00=TextCell["Young's Modulus"];in00=InputField[Dynamic[Em],FieldSize->{7,1}];
tx01=TextCell["Poisson's Coefficient"];in01=InputField[Dynamic[nu],FieldSize->{7,1}];
tx02=TextCell["Beam's Lenght"];in02=InputField[Dynamic[l],FieldSize->{7,1}];
tx03=TextCell["Beam's Thickness"];in03=InputField[Dynamic[t],FieldSize->{7,1}];
tx04=TextCell["Beam's Width"];in04=InputField[Dynamic[w],FieldSize->{7,1}];
tx07=TextCell["Cross section area"];in07=InputField[Dynamic[Ar],FieldSize->{7,1}];
tx05=TextCell["Moment of Inertia"];in05=InputField[Dynamic[Sz],FieldSize->{7,2}];
tx06=TextCell["Height Between"];in06=InputField[Dynamic[h],FieldSize->{7,1}];
tx13=TextCell["Rigid body length"];in13=InputField[Dynamic[b],FieldSize->{7,1}];
tx1=TextCell["Force & moment parameters","Subsubtitle"];
tx08=TextCell["Moment applyed"];in08=InputField[Dynamic[M0],FieldSize->{7,1}];
tx09=TextCell["Force applyed"];in09=InputField[Dynamic[F0],FieldSize->{7,1}];
tx10=TextCell["Application point x coordinate"];in10=InputField[Dynamic[Px],FieldSize->{7,1}];
tx11=TextCell["Application point y coordinate"];in11=InputField[Dynamic[Py],FieldSize->{7,1}];
tx12=TextCell["Angle of the force applied"];in12=InputField[Dynamic[fi0 ],FieldSize->{7,1}];
tx13=TextCell["Maximum total deflection"];in13=InputField[Dynamic[tmax ],FieldSize->{7,1}];

gr01=Grid[({{tx00, TextCell[":"], in00, TextCell["MPa"]}, {tx01, TextCell[":"], in01, Null}, {tx02, TextCell[":"], in02, TextCell["mm"]}, {tx03, TextCell[":"], in03, TextCell["mm"]}, {tx04, TextCell[":"], in04, TextCell["mm"]}, {tx07, TextCell[":"], in07, TextCell["mm^2"]}, {tx05, TextCell[":"], in05, TextCell["mm^3"]}, {tx06, TextCell[":"], in06, TextCell["mm"]}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];
gr02=Grid[({{tx08, TextCell[":"], in08, TextCell["N*mm"]}, {tx09, TextCell[":"], in09, TextCell["N"]}, {tx10, TextCell[":"], in10, TextCell["mm"]}, {tx11, TextCell[":"], in11, TextCell["mm"]}, {tx12, TextCell[":"], in12, TextCell["rad"]}, {tx13, TextCell[":"], in13, TextCell["rad"]}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];

gr1=Grid[({{tx0}, {gr01}, {tx1}, {gr02}}),Spacings->{0.2,1},Alignment->{Right}];
ChoiceDialog[gr1,WindowSize->{350,All}];(*NotebookWrite[nb,Cell[ToBoxes[gr0]]]*)
  
(* Optimized PRB 3R Model Coefficients *)

cd0=ChoiceDialog["Choose the optimizated parameters",{TextCell["Su parameters"]->1,TextCell["Chen parameters"]->2}];

Switch[cd0,1,(*Su coefficients*)
g0=0.1;     g1=0.35;     g2=0.4;      g3=0.15;     (*length coefficient*)
kt1=3.51;     kt2=2.99;     kt3=2.58;        (*spring coefficient*)
		,2,(*Chen coefficients*)
g0=0.125;     g1=0.35;     g2=0.388;      g3=0.136;     
kt1=3.25;     kt2=2.84;     kt3=2.95;   ]

(* Functions and starting definitions of points *)

c1[r_]=Cos[theta1[r]]; s1[r_]=Sin[theta1[r]]; c12[r_]=Cos[theta1[r]+theta2[r]]; s12[r_]=Sin[theta1[r]+theta2[r]]; c123[r_]=Cos[theta1[r]+theta2[r]+theta3[r]]; s123[r_]=Sin[theta1[r]+theta2[r]+theta3[r]];

P={Px,Py};     (*loads point referred to the fixed reference system (center of the first element)*)

Q[n]={Qx[n],Qy[n]};     (*n-th tip point respect the fixed reference system*)

{Ox[0],Oy[0]}={0,0};     (*center of the fixed reference system*)

Qn0={l*Mod[n,2],(n-1)*h};    (*coordinates of the tip point when undeflected respect the fixed reference system*)

thetaSum[r_]=(∑_(i=1)^r)theta0[i];     thetaSum[0]=0;     (*sum of the angle until the r_th element*)

(*ϕ0: beginning angle of (Subscript[F, 0]) respect the fixed reference system in the n-th free tip*)
fi[0]=fi0+thetaSum[n];

(* Force and Transport Loads *)

F0x=F0 Cos[fi[0]];     (*proietcion on the fixed references system*)
F0y=F0 Sin[fi[0]];

(*arms of (Subscript[F, 0]) considering that P is rigid respect the n-th free tip point and the load angle remain constant respect (OverBar[PQ])*)
{bx,by}=P-Qn0;    
{bx0,by0}={bx Cos[thetaSum[n]]-by Sin[thetaSum[n]],by Cos[thetaSum[n]]+bx Sin[thetaSum[n]]};
Mt=F0y bx0-F0x by0;  (*moment transported to the free tip of the n-th beam*)

Mn=M0+Mt;   (*total moment acting on the n-th beam*)

For[j=1,j≤n,j++,

(* Kinekatic equation *)

(*adimensional coordinates (Σγ=1) of the free tip of the r-th beam referred to the j-th reference system*)
qx[j]=g0+g1 c1[j]+g2 c12[j]+g3 c123[j];     
qy[j]=g1 s1[j]+g2 s12[j]+g3 s123[j];
theta0[j]=theta1[j]+theta2[j]+theta3[j];     (* rotation of the tip point of the j-th element*)   

q[j]={qx[j],qy[j]};   (*dimensional coordinates*)

J[j]=(({{(∂_(theta1[j]))qx[j], (∂_(theta2[j]))qx[j], (∂_(theta3[j]))qx[j]}, {(∂_(theta1[j]))qy[j], (∂_(theta2[j]))qy[j], (∂_(theta3[j]))qy[j]}, {(∂_(theta1[j]))theta0[j], (∂_(theta2[j]))theta0[j], (∂_(theta3[j]))theta0[j]}}));     (*Jacobian matrix*)

(*Points and angles*)

(* (Subscript[ϕ, 0]): angle of (Subscript[F, 0]) respect (Subscript[x, 0]) *)
fi[j]=fi[0]-thetaSum[j-1]+(1-Mod[j,2])π;   (*angle of load respect the j-th ref. system*)

psi[j]=thetaSum[j-1]+(1-Mod[j,2])π;   (*angle of the j-th ref. system respect the fixed one*)   

(*j-th origin reference system referred to the fixed reference system*)
If[j==1,
{Ox[j],Oy[j]}={Ox[0],Oy[0]},
{Ox[j],Oy[j]}=Q[j-1]+h{-Sin[thetaSum[j-1]],Cos[thetaSum[j-1]]}];  

   o[j]={Ox[j],Oy[j]};     

(*roto-translational matrix of the j-th reference system respect the fixed one*)
RT[j]=(({{Cos[psi[j]], -Sin[psi[j]], Ox[j]}, {Sin[psi[j]], Cos[psi[j]], Oy[j]}, {0, 0, 1}}));  

(*coordinates of the generic j-th free tip point referred to the fixed reference system*)
{Qx[j],Qy[j],null}=RT[j].{qx[j]l,qy[j]l,1};

Q[j]={Qx[j],Qy[j]};     

{dx[j],dy[j]}=Q[n]-Q[j];

M[j]=Mn+F0y dx[j]-F0x dy[j];   (*generic moment acting on the j-th beam*)

(* Non-dimensional force, moment and loads ratio index *)

alfa=((F0 (l^2))/(2Em Sz));     beta[j]=((M[j]l)/(Em Sz));      kappa[j]=(((beta[j])^2)/(4alfa));   

(* contact points referred respect the fixed reference system*)

{Aix[j],Aiy[j]}=Q[j]+{t/2Sin[thetaSum[j]],-t/2Cos[thetaSum[j]]};
Ai[j]={Aix[j],Aiy[j]};
{Ax[j],Ay[j]}=Ai[j]+(((-1))^j){-b Cos[thetaSum[j]],-b Sin[thetaSum[j]]};
A[j]={Ax[j],Ay[j]};

{Bix[j],Biy[j]}=o[j]+{-t/2Sin[thetaSum[j-1]],t/2Cos[thetaSum[j-1]]};
Bi[j]={Bix[j],Biy[j]};
{Bx[j],By[j]}=Bi[j]+(((-1))^j){b Cos[thetaSum[j-1]],b Sin[thetaSum[j-1]]};
B[j]={Bx[j],By[j]};

(*Stress*)
fN[j]=F0 Cos[fi[j]-thetaSum[j-1]];     (*axial force*)
Fx=F0 Cos[fi[j]];     (*Proiections of the force in the n-th system*)
Fy=F0 Sin[fi[j]];
Mo[j]=M[j]+Fx*qy[j]l+Fy*qx[j]l;     (*Momentum applied at the origin of the beam*)


Stress[[(j-1)2+1]]=(-((Mo[j]t/2)/Sz)-((fN[j])/Ar))kgs;     (*Top*)
Stress[[2j]]=(((Mo[j]t/2)/Sz)-((fN[j])/Ar))kgs;     (*Bottom*)
];

(*Solid geometry points*)
{Bx[0],By[0]}={l+b,-h/2};
B[0]={Bx[0],By[0]};
{Bix[0],Biy[0]}={l,-h/2};
Bi[0]={Bix[0],Biy[0]};
S1={0,-h/2};
S2={-b,-h};     
S3={l+b,-h};
S4=Q[n]+{-(h/2)Sin[thetaSum[n]],(h/2)Cos[thetaSum[n]]};
{Ax[n+1],Ay[n+1]}=S4+{(((-1))^n)(l+b)Cos[thetaSum[n]],(((-1))^n)(l+b)Sin[thetaSum[n]]};
A[n+1]={Ax[n+1],Ay[n+1]};
{Aix[n+1],Aiy[n+1]}=A[n+1]+{(((-1))^(n+1))b Cos[thetaSum[n]],(((-1))^(n+1))b Sin[thetaSum[n]]};
Ai[n+1]={Aix[n+1],Aiy[n+1]};
S6=A[n+1]+{-(h/2)Sin[thetaSum[n]],+(h/2)Cos[thetaSum[n]]};
S5=S6+{(((-1))^(n+1))(2b+l)Cos[thetaSum[n]],(((-1))^(n+1))(2b+l)Sin[thetaSum[n]]};

(* centre of rotation *)

ac=Tan[thetaSum[n]];
G={Gx,Gy};
{Ix,Iy}=(Ai[n+1]+S4)/2;
Gx=l/2;
Gy=Iy+((Ix-Gx)/ac);
gi=Image[,ImageSize->10];

(*Check contact value distances*)

For[j=1,j≤n+1,j++,
l1[j]=Norm[A[j]-B[j-1]]+Norm[A[j]-Bi[j-1]]-b;
l2[j]=Norm[B[j-1]-A[j]]+Norm[B[j-1]-Ai[j]]-b;
ll[j]=l1[j]*l2[j]
];
Contact=(∏_(j=1)^(n+1))ll[j];

Stress concentration factor

(*Material*)

tx22=TextCell[" (ultimate strenght)"]HoldForm[(Subscript[σ, u])];in22=InputField[Dynamic[Su],FieldSize->{5,1.2}];
tx23=TextCell[" (yeld stress)"]HoldForm[(Subscript[σ, y])];in23=InputField[Dynamic[Sy],FieldSize->{5,1.2}];

gr20=Grid[({{tx22, TextCell[":"], in22, TextCell["MPa"]}, {tx23, TextCell[":"], in23, TextCell["MPa"]}}),Spacings->{0.2,1},Alignment->{{Right,Left}}];

Su=1.25Sy;     

(*Stress concentration coefficients from Roark*)
r1=2H/d;
r2=H/R;

L=0.1≤r2≤20;
	(*st1*)(({{(Subscript[c1, 1])}, {(Subscript[c2, 1])}, {(Subscript[c3, 1])}, {(Subscript[c4, 1])}}))=(({{If[0.1≤r2≤2,1+(Sqrt[r2])-0.03r2,1.04+0.98(Sqrt[r2])-0.04r2]}, {If[0.1≤r2≤2,-0.11-0.59(Sqrt[r2])+0.31r2,-0.07-0.16(Sqrt[r2])-0.01r2]}, {If[0.1≤r2≤2,0.24-(Sqrt[r2])-0.27r2,-3.42+1.22(Sqrt[r2])-0.005r2]}, {If[0.1≤r2≤2,-0.13+0.58(Sqrt[r2])-0.01r2,3.45-2.05(Sqrt[r2])+0.05r2]}}));
	(*st2*)(({{(Subscript[c1, 2])}, {(Subscript[c2, 2])}, {(Subscript[c3, 2])}, {(Subscript[c4, 2])}}))=(({{If[0.1≤r2≤2,1+(Sqrt[r2])-0.03r2,1.04+0.98(Sqrt[r2])-0.04r2]}, {If[0.1≤r2≤2,-0.27-2.4(Sqrt[r2])+0.75r2,-3.6+1.62(Sqrt[r2])-0.43r2]}, {If[0.1≤r2≤2,0.68-1.13(Sqrt[r2])-0.9r2,6.08-5.61(Sqrt[r2])+1.16r2]}, {If[0.1≤r2≤2,-0.41+0.27(Sqrt[r2])+0.19r2,-2.53+3(Sqrt[r2])-0.69r2]}}));

(*Surface concentration coefficient*)
(Subscript[Ra, 1])=Interpolation[{{300,1.3},{600,1.6},{900,2.1},{1200,2.75}},InterpolationOrder->1];
(Subscript[Ra, 2])=Interpolation[{{300,1.2},{600,1.5},{900,1.9},{1200,2.4}},InterpolationOrder->1];
(Subscript[Ra, 3])=Interpolation[{{300,1.15},{600,1.3},{900,1.53},{1200,1.75}},InterpolationOrder->1];
(Subscript[Ra, 4])=Interpolation[{{300,1.1},{600,1.12},{900,1.2},{1200,1.32}},InterpolationOrder->1];
(Subscript[Ra, 5])=Interpolation[{{300,1.08},{600,1.09},{900,1.1},{1200,1.1}},InterpolationOrder->1];
(Subscript[Ra, 6])=Interpolation[{{300,1.01},{600,1.04},{900,1.05},{1200,1.05}},InterpolationOrder->1];
(Subscript[Ra, 7])=Interpolation[{{300,1},{600,1.02},{900,1.02},{1200,1.02}},InterpolationOrder->1];
tx24=TextCell["Stato superficiale:"];in24=PopupMenu[Dynamic[μ],{1->"Ra > 75",2->"40 < Ra ≤ 75",3->"16 < Ra ≤ 40",4->"4 < Ra ≤ 16",
5->"1.6 < Ra ≤ 4",6->"0.6 < Ra ≤ 1.6",7->"0.25 < Ra ≤ 0.6",0->"Ra ≤ 0.25"},FieldSize->8,AutoAction->True];u4=TextCell["μm"];

(*Notch data*)
gr21=Grid[({{TextCell["Valori consigliati di r:"], TextCell["0.48 acciaio normale"]}, {Null, TextCell["0.25 acciaio ricotto o normalizzato"]}, {Null, TextCell["0.06 acciaio bonificato\n"]}}),Alignment->Left];
tx26=TextCell["Raggio del grano cristallino:"];in26=InputField[Dynamic[ρ],Number,FieldSize->10];u6=TextCell["mm"];

gr22=Grid[({{tx26, in26, u6}, {tx24, in24, u4}}),Alignment->{{Right,Left}}];

mtrx1=(({{TextCell["d:"], InputField[Dynamic[d],Number,FieldSize->5], TextCell["mm"]}, {TextCell["h:"], InputField[Dynamic[H],Number,FieldSize->5], TextCell["mm"]}, {TextCell["r:"], InputField[Dynamic[R],Number,FieldSize->5], TextCell["mm"]}}));

(*Notch geometry*)
fg=;
gr23=Grid[({{Image[fg,ImageSize->180], Grid[({{Grid[mtrx1]}, {L}})]}})];
gr24=Grid[({{gr21}, {gr22}, {Null}, {gr23}})];  

(*Load typology*)
st1=;st2=;

ST=Grid[({{TextCell["Tipo:"], Framed[1], Image[st1,ImageSize->100], Null, Framed[2], Image[st2,ImageSize->100]}})];

gr25=Grid[({{TextCell["Tensione applicata tipo: "], InputField[Dynamic[st],Number,FieldSize->3]}}),Alignment->Left] ;
gr26=Grid[({{ST}, {gr25}})];

gr00=Grid[({{gr20}, {Null}, {gr24}, {Null}, {gr26}})];

DialogInput[DialogNotebook[{gr00,Button[Framed["Procedere", FrameStyle->{Green}],DialogReturn[]]}],WindowSize->{All,All},WindowTitle->"STRESS CONCENTRATION COEFFICIENT DATA"];  

(*coefficiente teorico elastico di concentrazione*)
(Subscript[k, t])= (Subscript[c1, st])+(Subscript[c2, st])r1+(Subscript[c3, st])(r1^2)+(Subscript[c4, st])(r1^3);

(*coefficiente di concentrazione delle tensioni effettivo*)
(Subscript[k, f])=1+(((Subscript[k, t])-1)/(1+(Sqrt[ρ/R])));

(*coefficienti per lo stato superficiale*)
(Subscript[k, l])=If[μ==0,1,(Subscript[Ra, μ]) [Su]];

kgs=(Subscript[k, f])(Subscript[k, l]);

Equilibrium Equations for each elements

For[j=1,j≤n,j++,
FM[j]=J[j]\[Transpose].(({{2(alfa Cos[fi[j]])}, {2(alfa Sin[fi[j]])}, {beta[j]}}));
KT[j]=(({{ kt1 theta1[j]}, {kt2 theta2[j]}, {kt3 theta3[j]}}));

     (*equilibrium equations*)
ee=KT[j]==FM[j];

eq[j,1]=ee[[All,1,1]];
eq[j,2]=ee[[All,2,1]];
eq[j,3]=ee[[All,3,1]];
     (*variables vectors and starting point for the root calculation*)
var[j]={{theta1[j],0},{theta2[j],0},{theta3[j],0}};
]

              (*equations used to be saved for MATLAB*)
EE=ConstantArray[0,n*3];
VV=ConstantArray[0,n*3];
Si=ConstantArray[0,{n,3}];
For[j=1,j≤n,j++,      EE[[3*j-2]]= (KT[j]-FM[j])[[1,1]];
					EE[[3*j-1]]=(KT[j]-FM[j])[[2,1]];
					EE[[3*j-0]]=(KT[j]-FM[j])[[3,1]];
					VV[[1+(j-1)3;;j*3]]={theta1[j],theta2[j],theta3[j]};

(*Internal stress*)
For[i=1,i≤3,i++,
τ=KT[j][[i,1]]*((Em*Sz)/l);
Si[[j,i]]=(((τ*t/2)/Sz))kgs];
];

Print and save equations

Simplify

EE=EE//Simplify;
Contact=Contact//Simplify;
Stress=Stress//Simplify;
Gy=G[[2]]//Simplify;

SetDirectory[NotebookDirectory[]];
<<ToMatlab.m

cdh=ChoiceDialog["Choice of height:",{"Variable"->False,"Fixed_min"->True}];
If[cdh,change={h->th[3n+1]},change={}];     (* the h will be considered like one of the variables in the finding root program and an equation is added to the vector of equilibrium equations: is cancellation imply that the value of h is as lower as possible, such that when the higher stress limit is reached, contact is reached too*)

If[NumberQ[tmax],M0=.;F0=0;fi0=0;ej="_mv";
				ow5=OpenWrite["tmax.m"];
				WriteMatlab[tmax,ow5,"th_max"];
				Close[ow5];
				,ej=""];
(*In this case theta max is fixed and saved and the case load is chosen as compose just by the moment (variable)*)

For[j=1,j≤n,j++,change=Join[change,{theta1[j]->th[3j-2],theta2[j]->th[3j-1],theta3[j]->th[3j]}];
]

If[cdh,EE=Append[EE,Contact];
		namefilemat1=StringJoin[ToString[n],StringJoin["e_Equations_hf",ej,".m"]];
		namefilemat3=StringJoin[ToString[n],StringJoin["e_Stress_hf",ej,".m"]];
		namefilemat5=StringJoin[ToString[n],StringJoin["e_Center_hf",ej,".m"]]
	,namefilemat1=StringJoin[ToString[n],StringJoin["e_Equations_hv",ej,".m"]];
		namefilemat3=StringJoin[ToString[n],StringJoin["e_Stress_hv",ej,".m"]];
		namefilemat4=StringJoin[ToString[n],StringJoin["e_Contact_hv",ej,".m"]];
		namefilemat5=StringJoin[ToString[n],StringJoin["e_Center_hv",ej,".m"]];
		ow4=OpenWrite[namefilemat4];
		WriteMatlab[Contact/.change,ow4];
		Close[ow4];
];

ow1=OpenWrite[namefilemat1];
WriteMatlab[EE/.change,ow1];
Close[ow1];

ow3=OpenWrite[namefilemat3];
WriteMatlab[Stress/.change,ow3];
Close[ow3];

ow5=OpenWrite[namefilemat5];
WriteMatlab[Gy/.change,ow5];
Close[ow5];

Numeric Solutions and data printing

kgs=1.2;
Sy=1080;

(*check value*)

cd1=ChoiceDialog["Activate contatct checking?"];
lcontact=cd1;    (*Switch on/off contact analisys*)
d1=(10^(-4))b;        (*variance check*)
cd2=ChoiceDialog["Activate Stress limit checking?"];
lstress=cd2;    (*Switch on/off stress limit*)
d2=Sy/(0.5nc);                    (*variance check*)
slim1=nv/2;slim2=nv;     (*default number of iterations*)


(*numeric value Kozuka*)
t=0.2;
w=20;
Em=206000;
h=6;
l=6;
Sz=((20 (0.2^3))/12);
Ar=20*0.2;
b=2;

Px=l/2;Py=100+h;     (*point of application of the loads*)
Fe=2;     (*force max value*)
fi0e=π;     (*angle of application of the force value*)
Me=0;     (*moment max value*)
Sl=Sy;     (*admissible stress value*)

(*Initialization loads value*)

nc=100;     (*number of steps*)
f={0};     (*vector of force steps*)
m={0};     (*vector of moment steps*)
df=Abs[Fe]/nc*2;
dm=Abs[Me]/nc*2;

If[Fe==0,f=ConstantArray[0,nc+2];,
f=Join[f,Range[df,Fe,df]];
AppendTo[f,0];
f=Join[f,Range[df,Fe,df]];]

If[Me==0,m=ConstantArray[0,nc+2];,
If[Sign[Me]==-1,m=Join[m,Reverse[Range[Me,-dm,dm]]],m=Join[m,Range[dm,Me,dm]]];
AppendTo[m,0];
Me=-Me;     (*the force is only inverted the angle*)
If[Sign[Me]==-1,m=Join[m,Reverse[Range[Me,-dm,dm]]],m=Join[m,Range[dm,Me,dm]]];]

MS={};
VG={};
tip0={};
tipPi={};
nv=Length[f];     (*total length of the loads vectors = n+2*)
For[i=1,i≤n,i++,Lim1[i]=False;Lim2[i]=False;sl1[i]=nc+3;sl2[i]=nc+3];     (*initializing limit check value*)


(*iterative cicle*)

For[s=1;ni=0,s≤nv,s++;ni++,     (*ni: effective steps done*)

If[s>nv/2,fi0=fi0e-π,fi0=fi0e];     (*inversion of the angle*)
ϕ0[s]=fi0;

Sys={};     (*vector of the equilibrium equations*)
V={};     (*vectors of the variables*)


(*check stress limit*)

If[s>1,For[j=1,j≤n,j++,load[j,s]={}]];     

For[j=1,j≤n,j++,
     (*sw: check contact switch, FL,ML: limit value*)
If[s≤Round[nv/2],     sw[j,s]=Lim1[j];FL[j]=FL1[j];ML[j]=ML1[j],
					sw[j,s]=Lim2[j];FL[j]=FL2[j];ML[j]=ML2[j]];     (*choice of wich sideit's considered for each j-th element*)

If[sw[j,s] , load[j,s]={F0->FL[j],M0->ML[j]},    (*limitation force element that have reached the limit stress blocking loads increment*)
			load[j,s]={F0->f[[s]],M0->m[[s]]}     (*incremented values*)
		 
];
V=Join[V,var[j]];
Sys=Join[Sys,{eq[j,1]/.load[j,s],eq[j,2]/.load[j,s],eq[j,3]/.load[j,s]}]
];

sol[s]=FindRoot[Sys,V];     (*Numerical solution*)

(* Check contact *)

If[lcontact,
For[j=1,j≤n+1,j++,
check[j,s]=(ll[j]/.sol[s])≤d1;     (*checking if there's a contact*)
If[check[j,s],     (*limitation force element with contact blocking loads increment*)
If[j==1,
If[s≤Round[nv/2],    Lim1[j]=True;
					If[!NumberQ[FL1[j]],FL1[j]=f[[s+1]];ML1[j]=m[[s+1]];sl1[j]=s],
					Lim2[j]=True;
					If[!NumberQ[FL2[j]],FL2[j]=f[[s+1]];ML2[j]=m[[s+1]];sl2[j]=s]]];
If[j==n+1,
If[s≤Round[nv/2],     Lim1[j-1]=True;
					If[!NumberQ[FL1[j-1]],FL1[j-1]=f[[s+1]];ML1[j-1]=m[[s+1]];sl1[j-1]=s],
					Lim2[j-1]=True;
					If[!NumberQ[FL2[j-1]],FL2[j-1]=f[[s+1]];ML2[j-1]=m[[s+1]];sl2[j-1]=s]]];
If[1<j≤n,
If[s≤Round[nv/2],     Lim1[j]=True;Lim1[j-1]=True;
					If[!NumberQ[FL1[j]],FL1[j]=f[[s+1]];ML1[j]=m[[s+1]];sl1[j]=s];
					If[!NumberQ[FL1[j-1]],FL1[j-1]=f[[s+1]];ML1[j-1]=m[[s+1]];sl1[j-1]=s],
					Lim2[j]=True;Lim2[j-1]=True;
					If[!NumberQ[FL2[j]],FL2[j]=f[[s+1]];ML2[j]=m[[s+1]];sl2[j]=s];
					If[!NumberQ[FL2[j-1]],FL2[j-1]=f[[s+1]];ML2[j-1]=m[[s+1]];sl2[j-1]=s]]]
]
]
];

(*load ratio parameter and inflection parameter*)
vs={};
For[j=1,j≤n,j++,    If[(M[j]/.sol[s]/.load[j,s])==0,     κ[j,s]=0,
					If[f[[s]]==0,   κ[j,s]=∞,
								     κ[j,s]=kappa[j]/.sol[s]/.load[j,s]]];
					ι[j,s]=Abs[Cos[(theta0[j]-fi[j])/.sol[s]]+κ[j,s]];     (*inflection parameter: valid for 7°<ϕ<181°*)

(*Tension*)
stress[j,s]=Max[Stress[[j,All]]/.sol[s]/.load[j,s]];
vs=Join[vs,{stress[j,s]}]
];
MaxStress[s]=Max[vs];
MS=Join[MS,{MaxStress[s]}];

(*Deflection*)
θtot[s]=0;
For[i=1,i≤n,i++,    (Subscript[θ, 0])[i,s]= theta0[i]*180/π/.sol[s];
					θtot[s]=θtot[s]+(Subscript[θ, 0])[i,s]];
(*Points and lines*)
square[s]={};
lines[s]={};
color[s]={};
square[s]={Polygon[{Ai[n],S4,Ai[n+1],A[n+1],S6,S5,A[n]}/.sol[s]],Polygon[{B[1],S2,S3,B[0],Bi[0],S1,Bi[1]}/.sol[s]]};

For[j=1,j≤n,j++,
(Subscript[x1, j])=g0; 
(Subscript[y1, j])=0;
{(Subscript[X1, j]),(Subscript[Y1, j]),null}=RT[j].{(Subscript[x1, j])l,(Subscript[y1, j])l,1};
(Subscript[p1, j])={(Subscript[x1, j]),(Subscript[y1, j])};
(Subscript[P1, j])={(Subscript[X1, j]),(Subscript[Y1, j])};

(Subscript[x2, j])=g0+g1 c1[j];  
(Subscript[y2, j])=0+g1 s1[j];
{(Subscript[X2, j]),(Subscript[Y2, j]),null}=RT[j].{(Subscript[x2, j])l,(Subscript[y2, j])l,1};
(Subscript[p2, j])={(Subscript[x2, j]),(Subscript[y2, j])};
(Subscript[P2, j])={(Subscript[X2, j]),(Subscript[Y2, j])};

(Subscript[x3, j])=g0+g1 c1[j]+g2 c12[j];     
(Subscript[y3, j])=0+g1 s1[j]+g2 s12[j];
{(Subscript[X3, j]),(Subscript[Y3, j]),null}=RT[j].{(Subscript[x3, j])l,(Subscript[y3, j])l,1};
(Subscript[p3, j])={(Subscript[x3, j]),(Subscript[y3, j])};
(Subscript[P3, j])={(Subscript[X3, j]),(Subscript[Y3, j])};

(Subscript[li, j])[s]={{0,0},(Subscript[p1, j]),(Subscript[p2, j]),(Subscript[p3, j]),q[j]}/.sol[s];
(Subscript[Li, j])[s]={o[j],(Subscript[P1, j]),(Subscript[P2, j]),(Subscript[P3, j]),Q[j ]}/.sol[s];

If[1<j,(Subscript[sp, j])[s]={Ai[j-1],A[j-1],B[j],Bi[j]}/.sol[s];
		square[s]=Join[square[s],{Polygon[(Subscript[sp, j])[s]]}]];

lines[s]=Join[lines[s],{(Subscript[Li, j])[s]}];

If[s≤Round[nv/2],If[s<sl1[j],color[s]=Join[color[s],{Blue}],
							color[s]=Join[color[s],{Red}]],
				If[s<sl2[j],color[s]=Join[color[s],{Blue}],
							color[s]=Join[color[s],{Red}]]]

];

(*load point referred to the centre of rotation (Gc: correct)*)

Gc[s]=({{\[Piecewise], ({{{l/2,h(n-1)/2}, s==1||s==nv/2+1}, {G/.sol[s], True}})}});
VG=Join[VG,{{ni,Gc[s][[2]]}}];

P0=(Q[n]+{bx0,by0})/.sol[s];
PG=P0-Gc[s];
tipPi=Join[tipPi,{PG}];

plx={-2(l+b),3(l+b)};ply={-h,(n+0.5) h};
ratio=Norm[ply]/Norm[plx];
pl[s]=ListLinePlot[lines [s],Mesh->All,MeshStyle->Directive[PointSize[Medium],Black],AspectRatio->ratio,PlotStyle->Directive[color[s],AbsoluteThickness[72/2.54t]],PlotRange->{plx,ply}];
ps[s]=Graphics[{Gray,square[s]}];

(*Limitation stress*)
If[lstress,
If[Sl-MaxStress[s]<d2,If[s≤Round[nv/2],slim1=s;s=nv/2,
										slim2=s;Break[]]]]

](*cicle end*)

ss=Join[Reverse[Range[1,slim1]],Range[nv/2+1,slim2]];

Anime=Animate[Grid[({{Show[pl[ss[[s]]],ps[ss[[s]]],ListPlot[{Gc[ss[[s]]]},PlotMarkers->gi],ImageSize->{800,500}], Grid[({{TextCell["Force appl"], InputField[Dynamic[Round[f[[ss[[s]]]],0.01]],FieldSize->5], TextCell["N"]}, {TextCell["fi0"], InputField[Dynamic[ϕ0[ss[[s]]]*180/π],FieldSize->5], TextCell["Deg"]}, {TextCell["Moment app"], InputField[Dynamic[Round[m[[ss[[s]]]],0.01]],FieldSize->5], TextCell["N*mm"]}, {TextCell["Transp.M. 3"], InputField[Dynamic[Round[M[3]/.sol[ss[[s]]]/.load[3,ss[[s]]],0.01]],FieldSize->5], TextCell["N*mm"]}, {TextCell["Transp.M. 2"], InputField[Dynamic[Round[M[2]/.sol[ss[[s]]]/.load[2,ss[[s]]],0.01]],FieldSize->5], TextCell["N*mm"]}, {TextCell["Transp.M. 1"], InputField[Dynamic[Round[M[1]/.sol[ss[[s]]]/.load[1,ss[[s]]],0.01]],FieldSize->5], TextCell["N*mm"]}, {TextCell["Deflect. 3"], InputField[Dynamic[Round[(Subscript[θ, 0])[3,ss[[s]]],0.1]],FieldSize->5], TextCell["Deg"]}, {TextCell["Deflect. 2"], InputField[Dynamic[Round[(Subscript[θ, 0])[2,ss[[s]]],0.1]],FieldSize->5], TextCell["Deg"]}, {TextCell["Deflect. 1"], InputField[Dynamic[Round[(Subscript[θ, 0])[1,ss[[s]]],0.1]],FieldSize->5], TextCell["Deg"]}, {TextCell["Tot deflect."], InputField[Dynamic[Round[θtot[ss[[s]]],0.1]],FieldSize->5], TextCell["Deg"]}, {TextCell["κ_3"], InputField[InputField[Dynamic[Round[κ[3,ss[[s]]],0.01]],FieldSize->5],FieldSize->5], Null}, {TextCell["κ_2"], InputField[InputField[Dynamic[Round[κ[2,ss[[s]]],0.01]],FieldSize->5],FieldSize->5], Null}, {TextCell["κ_1"], InputField[InputField[Dynamic[Round[κ[1,ss[[s]]],0.01]],FieldSize->5],FieldSize->5], Null}, {TextCell["Stress_3"], InputField[Dynamic[Round[stress[3,ss[[s]]]]],FieldSize->5], TextCell["MPa"]}, {TextCell["Stress_2"], InputField[Dynamic[Round[stress[2,ss[[s]]]]],FieldSize->5], TextCell["MPa"]}, {TextCell["Stress_1"], InputField[Dynamic[Round[stress[1,ss[[s]]]]],FieldSize->5], TextCell["MPa"]}, {TextCell["inflex_3"], InputField[Dynamic[Round[ι[3,ss[[s]]],0.01]],FieldSize->5], Null}, {TextCell["inflex_2"], InputField[Dynamic[Round[ι[2,ss[[s]]],0.01]],FieldSize->5], Null}, {TextCell["inflex_1"], InputField[Dynamic[Round[ι[1,ss[[s]]],0.01]],FieldSize->5], Null}})]}})],{s,1,ni,1},AnimationRunning->False,AnimationRate->nc/20];

tipP=Join[Reverse[tipPi[[1;;slim1]]],tipPi[[(slim1+1);;ni]]];
MaxS=Join[Reverse[MS[[1;;slim1]]],MS[[(slim1+1);;ni]]];
graph=ListLinePlot[tipP];

SetDirectory[NotebookDirectory[]];
<<ToMatlab.m

If[NumberQ[s],
ow2=OpenWrite["data.m"];
WriteMatlab[tipP,ow2,"tipP"];
WriteMatlab[MaxS,ow2,"MaxS"];
Close[ow2];

ChoiceDialog[Grid[({{Anime, Grid[({{TextCell["Point of loading x,y coordinates"]}, {graph}, {Null}, {TextCell["Center of rotation y coordinate"]}, {ListLinePlot[VG]}})]}})],WindowSize->All];

cda=ChoiceDialog["Do you want to save the animation movie?"];
If[cda,Export["Serially Layered_flat Spring.avi",Anime]];
]

Comparison pin max stress, internal max stress

ds=ConstantArray[0,nv];
For[s=1,s≤ni,s++,Ss=Abs[Si/.sol[ss[[s]]]];
ds[[ss[[s]]]]=MaxStress[ss[[s]]]-Max[Ss]];
ListLinePlot[ds]