|
|
|
Ho modificato il foglio dando la possibilità all'utente di modificare sia lo spessore minimo delle fibre che il numero massimo di fibre da utilizzare nella integrazione, inoltre grazie a quanto detto a proposito di modifica della ampiezza dati di origine dei grafici (topic Gestione grafici excel via VBA) ho reso possibile la scelta da parte dell'utente del numero di punti utili per tracciare il grafico del dominio di rottura.
Implementata la tecnica di infittimento punti del dominio di rottura qualora non vada a convergenza col numero punti scelto dall'utente, di cui se ne era parlato circa un anno fa nel topic "Verifica di sezioni complesse in ca. agli SLE ed agli SLU", tecnica utile per ridurre i tempi di elaborazione.
CODICE Ricalcola:
Dim flag_convergenza As Boolean
Dim flag_circa As Boolean
Dim index As Integer
Call calcola_MomentiRottura(dominio_slu, soll(25 + n_c), MomentiRottura, flag_convergenza, flag_circa, index)
'Controlliamo la convergenza
If Not flag_convergenza Then
'se non converge infittiamo i punti del contorno del dominio localmente e ricalcoliamo
'npt --> punti del dominio iniziali
'ninf --> numero massimo di infittimenti locali consentiti
'pfis --> numero di punti fisici effettivamente calcolati
'pvt --> numero punti virtuali corrispondenti ad un infittimento globale equivalente
'pfis=(npt*2^ninf)
'pvt=(pfis-npt)*npt
'esempi:
'caso npt=4 ninf=6 corrisponde a 256 punti fisici ed almeno 1008 punti virtuali
'caso npt=8 ninf=5 corrisponde a 256 punti fisici ed almeno 1984 punti virtuali
'caso npt=16 ninf=4 corrisponde a 256 punti fisici ed almeno 3840 punti virtuali
'caso npt=32 ninf=3 corrisponde a 256 punti fisici ed almeno 7168 punti virtuali
'caso npt=64 ninf=2 corrisponde a 256 punti fisici ed almeno 12288 punti virtuali
'caso npt=128 ninf=1 corrisponde a 256 punti fisici ed almeno 16384 punti virtuali
'caso npt=256 ninf=0 corrisponde a 256 punti fisici ed 0 punti virtuali
'caso npt=4 ninf=5 corrisponde a 128 punti fisici ed almeno 496 punti virtuali
'caso npt=8 ninf=4 corrisponde a 128 punti fisici ed almeno 960 punti virtuali
'caso npt=16 ninf=3 corrisponde a 128 punti fisici ed almeno 1792 punti virtuali
'caso npt=32 ninf=2 corrisponde a 128 punti fisici ed almeno 3072 punti virtuali
'caso npt=64 ninf=1 corrisponde a 128 punti fisici ed almeno 4096 punti virtuali
'caso npt=128 ninf=0 corrisponde a 128 punti fisici ed 0 punti virtuali
'caso npt=4 ninf=4 corrisponde a 64 punti fisici ed almeno 240 punti virtuali
'caso npt=8 ninf=3 corrisponde a 64 punti fisici ed almeno 448 punti virtuali
'caso npt=16 ninf=2 corrisponde a 64 punti fisici ed almeno 768 punti virtuali
'caso npt=32 ninf=1 corrisponde a 64 punti fisici ed almeno 1024 punti virtuali
'caso npt=64 ninf=0 corrisponde a 64 punti fisici ed 0 punti virtuali
'caso npt=4 ninf=3 corrisponde a 32 punti fisici ed almeno 112 punti virtuali
'caso npt=8 ninf=2 corrisponde a 32 punti fisici ed almeno 192 punti virtuali
'caso npt=16 ninf=1 corrisponde a 32 punti fisici ed almeno 256 punti virtuali
'caso npt=32 ninf=0 corrisponde a 32 punti fisici ed 0 punti virtuali
'caso npt=4 ninf=2 corrisponde a 16 punti fisici ed almeno 32 punti virtuali
'caso npt=8 ninf=1 corrisponde a 16 punti fisici ed almeno 64 punti virtuali
'caso npt=16 ninf=0 corrisponde a 16 punti fisici ed 0 punti virtuali
'caso npt=4 ninf=1 corrisponde a 8 punti fisici ed almeno 16 punti virtuali
'caso npt=8 ninf=0 corrisponde a 8 punti fisici ed 0 punti virtuali
'caso npt=4 ninf=0 corrisponde a 4 punti fisici ed 0 punti virtuali
If NMaxDom < pfis Then '32
If flag_circa Then
Call Infittimento_Dominio_locale(dominio_slu, NMaxDom, index)
GoTo Ricalcola
Else
'fallimento totale niente soluzione infittimento locale impossibile
'tentiamo con infittimento globale
Call Infittimento_Dominio_globale(dominio_slu, NMaxDom)
GoTo Ricalcola
End If
Else
If Not flag_circa Then
'fallimento totale niente soluzione
Sheets(3).Range("Mrxd") = 0#
Sheets(3).Range("Mryd") = 0#
End If
End If
End If
'-----------------------------------------------------------------
' Infittimento_Dominio_locale
'
' Infittimento punti del dominio solo dove serve
' accorgimento che consente a partà di precisione di velocizzare
' il calcolo consumando meno memoria
'-----------------------------------------------------------------
Private Sub Infittimento_Dominio_locale(ByRef dominio_slu As Dominio_Rottura, NMaxDom As Integer, index As Integer)
Dim i As Integer
Dim k As Integer
' infittiamo i punti del dominio localmente
NMaxDom = NMaxDom + NMaxDom
' ingrandisco campo dati mantenendo i vecchi valori calcolati
ReDim Preserve dominio_slu.mrx(1 To NMaxDom)
ReDim Preserve dominio_slu.mry(1 To NMaxDom)
ReDim Preserve dominio_slu.ang(1 To NMaxDom)
ReDim Preserve dominio_slu.nrc(1 To NMaxDom)
ReDim Preserve dominio_slu.nrt(1 To NMaxDom)
ReDim Preserve dominio_slu.xrc(1 To NMaxDom)
ReDim Preserve dominio_slu.yrc(1 To NMaxDom)
ReDim Preserve dominio_slu.xrt(1 To NMaxDom)
ReDim Preserve dominio_slu.yrt(1 To NMaxDom)
ReDim Preserve dominio_slu.epsc(1 To NMaxDom)
ReDim Preserve dominio_slu.epss(1 To NMaxDom)
ReDim Preserve dominio_slu.yn(1 To NMaxDom)
ReDim Preserve dominio_slu.curv(1 To NMaxDom)
' sposto i valori da index+1 in avanti in modo da lasciare lo spazio per
' l'inserimento dei nuovi valori di infittimento
k = NMaxDom \ 2
For i = index + 1 To k
dominio_slu.mrx(i + k) = dominio_slu.mrx(i)
dominio_slu.mry(i + k) = dominio_slu.mry(i)
dominio_slu.ang(i + k) = dominio_slu.ang(i)
dominio_slu.nrc(i + k) = dominio_slu.nrc(i)
dominio_slu.nrt(i + k) = dominio_slu.nrt(i)
dominio_slu.xrc(i + k) = dominio_slu.xrc(i)
dominio_slu.yrc(i + k) = dominio_slu.yrc(i)
dominio_slu.xrt(i + k) = dominio_slu.xrt(i)
dominio_slu.yrt(i + k) = dominio_slu.yrt(i)
dominio_slu.epsc(i + k) = dominio_slu.epsc(i)
dominio_slu.epss(i + k) = dominio_slu.epss(i)
dominio_slu.yn(i + k) = dominio_slu.yn(i)
dominio_slu.curv(i + k) = dominio_slu.curv(i)
Next i
'PiGreco
PiGreco = 4# * Atn(1#)
'prelevo gli angoli dei due punti estremi del segmento di dominio da considerare
Dim ang1 As Double, ang2 As Double
ang1 = dominio_slu.ang(index)
If index = NMaxDom Then
ang2 = dominio_slu.ang(1)
Else
ang2 = dominio_slu.ang(index + 1)
End If
'arco individuato dai due angoli di cui sopra
Dim arco As Double
arco = ang2 - ang1
If arco < 0# Then arco = arco + 2# * PiGreco
Delta_alfa = arco / (k + 1) ' divido per k+1 per tener conto che i punti estremi sono già calcolati
Dim alfa As Double
alfa = ang1 + Delta_alfa
'calcolo i valori di infittimento
For i = index + 1 To index + k
If alfa >= 2# * PiGreco Then alfa = alfa - 2# * PiGreco
Call calcola_dominio_alfa(dominio_slu, alfa, i)
alfa = alfa + Delta_alfa
Next i
End Sub
'-----------------------------------------------------------------
' Infittimento_Dominio_globale
'
' Infittimento punti del dominio con calcolo solo punti mancanti
'-----------------------------------------------------------------
Private Sub Infittimento_Dominio_globale(ByRef dominio_slu As Dominio_Rottura, ByRef NMaxDom As Integer)
Dim i As Integer
Dim k As Integer
' infittiamo i punti del dominio
NMaxDom = NMaxDom + NMaxDom
' ingrandisco campo dati mantenendo i vecchi valori calcolati
ReDim Preserve dominio_slu.mrx(1 To NMaxDom)
ReDim Preserve dominio_slu.mry(1 To NMaxDom)
ReDim Preserve dominio_slu.ang(1 To NMaxDom)
ReDim Preserve dominio_slu.nrc(1 To NMaxDom)
ReDim Preserve dominio_slu.nrt(1 To NMaxDom)
ReDim Preserve dominio_slu.xrc(1 To NMaxDom)
ReDim Preserve dominio_slu.yrc(1 To NMaxDom)
ReDim Preserve dominio_slu.xrt(1 To NMaxDom)
ReDim Preserve dominio_slu.yrt(1 To NMaxDom)
ReDim Preserve dominio_slu.epsc(1 To NMaxDom)
ReDim Preserve dominio_slu.epss(1 To NMaxDom)
ReDim Preserve dominio_slu.yn(1 To NMaxDom)
ReDim Preserve dominio_slu.curv(1 To NMaxDom)
' sposto i valori opportunamente in modo da lasciare lo spazio per
' l'inserimento dei nuovi valori di infittimento
' il primo valore rimane sul posto poi spazio poi secondo valore
' poi spazio poi terzo valore poi spazio poi quarto valore ecc...
k = NMaxDom \ 2 - 1
For i = NMaxDom - 1 To 3 Step -2
dominio_slu.mrx(i) = dominio_slu.mrx(i - k)
dominio_slu.mry(i) = dominio_slu.mry(i - k)
dominio_slu.ang(i) = dominio_slu.ang(i - k)
dominio_slu.nrc(i) = dominio_slu.nrc(i - k)
dominio_slu.nrt(i) = dominio_slu.nrt(i - k)
dominio_slu.xrc(i) = dominio_slu.xrc(i - k)
dominio_slu.yrc(i) = dominio_slu.yrc(i - k)
dominio_slu.xrt(i) = dominio_slu.xrt(i - k)
dominio_slu.yrt(i) = dominio_slu.yrt(i - k)
dominio_slu.epsc(i) = dominio_slu.epsc(i - k)
dominio_slu.epss(i) = dominio_slu.epss(i - k)
dominio_slu.yn(i) = dominio_slu.yn(i - k)
dominio_slu.curv(i) = dominio_slu.curv(i - k)
k = k - 1
Next i
PiGreco = 4# * Atn(1#)
Delta_alfa = 2# * PiGreco / NMaxDom
Dim alfa As Double
alfa = Delta_alfa
'calcolo solo i valori di infittimento
For i = 2 To NMaxDom Step 2
Call calcola_dominio_alfa(dominio_slu, alfa, i)
alfa = alfa + Delta_alfa + Delta_alfa
Next i
End Sub
' --------------------------------------------------------------------------
' Nome sub calcola_dominio_alfa(
' Scopo funzione : Facendo ruotare di alfa la sezione determina le
' coppie di punti mrx,mry di rottura per dato valore
' di sforzo normale.
' Parametri formali: Nd=sforzo normale di sollecitazione.
' Valore restituito: Struttura dati con varie informazioni: risultanti di
' compressione e trazione, posizioni risultanti, posizio-
' ne asse neutro, deformazioni limite a rottura sezione
' Implementazione : Luglio 2011
' Autore : Zax2010
' --------------------------------------------------------------------------
Public Sub calcola_dominio_alfa(ByRef dom As Dominio_Rottura, alfa As Double, index As Integer)
Dim k As Integer
Dim Np As Integer
Dim polic() As poligono_sezione
ReDim polic(N_POLI)
Dim armco As armo_sezione
Dim armcp As armp_sezione
Dim Nfin As risultante_n_finale
Dim Xc As Double
Dim Yc As Double
Dim xt As Double
Dim yt As Double
Dim c As Double
Dim s As Double
'---------------------------------------------------------------------------------
PiGreco = 4# * Atn(1#)
'hack per risolvere problema di stallo a 90° con poligoni rettangolari sovrapposti
If alfa = PiGreco / 2# Then alfa = alfa + 0.000001
'---------------------------------------------------------------------------------
' Calcola una sola volta cos(alfa) e sin(alfa) per evitare elaborazione ogni volta
c = Cos(alfa)
s = Sin(alfa)
' Prima copia la sezione in altra struttura dati e poi la ruota di alfa
For Np = 1 To N_POLI
polic(Np) = poli(Np)
For k = 1 To polic(Np).numv
polic(Np).X(k) = poli(Np).X(k) * c + poli(Np).Y(k) * s
polic(Np).Y(k) = -poli(Np).X(k) * s + poli(Np).Y(k) * c
Next
Next
' Copia le armature in altra struttura dati e poi le ruota di alfa
armco = arm
For k = 1 To arm.numarm
armco.X(k) = arm.X(k) * c + arm.Y(k) * s
armco.Y(k) = -arm.X(k) * s + arm.Y(k) * c
Next
armcp = armp
For k = 1 To armp.numarm
armcp.X(k) = armp.X(k) * c + armp.Y(k) * s
armcp.Y(k) = -armp.X(k) * s + armp.Y(k) * c
Next
' Chiama la funzione per definire l'asse neutro della sezione (ruotata di alfa)
Nfin = asse_neutro_SLU(polic, armco, armcp, dom.nd)
' Ripristina il sistema di riferimento delle risultanti
Xc = Nfin.ncf.X * c - Nfin.ncf.Y * s
Yc = Nfin.ncf.X * s + Nfin.ncf.Y * c
xt = Nfin.ntf.X * c - Nfin.ntf.Y * s
yt = Nfin.ntf.X * s + Nfin.ntf.Y * c
' Calcola i momenti resistenti per ciascuna configurazione ruotata
dom.mrx(index) = Nfin.ncf.n * (Yc - ygO) + Nfin.ntf.n * (yt - ygO)
dom.mry(index) = Nfin.ncf.n * (Xc - xgO) + Nfin.ntf.n * (xt - xgO)
dom.ang(index) = alfa
dom.nrc(index) = Nfin.ncf.n
dom.nrt(index) = Nfin.ntf.n
dom.xrc(index) = Xc
dom.yrc(index) = Yc
dom.xrt(index) = xt
dom.yrt(index) = yt
dom.epsc(index) = Nfin.epsc
dom.epss(index) = Nfin.epss
dom.yn(index) = Nfin.yn
dom.curv(index) = Nfin.curv
End Sub |
|
.
.
