OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
porfor5.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| porfor5 ../engine/source/airbag/porfor5.F
25!||--- called by ------------------------------------------------------
26!|| airbagb1 ../engine/source/airbag/airbagb1.F
27!||--- calls -----------------------------------------------------
28!|| roto ../engine/source/airbag/roto.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!||====================================================================
32 SUBROUTINE porfor5(SVTFAC,IM,IPM,PM,ELBUF_STR,P,PEXT,IEL,NEL)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE elbufdef_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "param_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER IPM(NPROPMI,*),IM,IEL,NEL
49 my_real
50 . svtfac,pm(npropm,*),p,pext
51 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55C INTEGER I,J,MTN,NEL,NFT,IAD,NPT,ISTRA,JHBE,IEXPAN,IPT,MIDPT(5)
56C DATA MIDPT/1,1,2,2,3/
57 INTEGER I,J,MTN
58 my_real
59 . lr1,fthk,c1,c2,c3,lbd1,lbd2,epsxx,epsyy,deltap,cos_phi,tan_phi,
60 . apor0,apor1,rs,deltaa,eps(5,1),dir(1,2)
61 my_real,
62 . DIMENSION(:), POINTER :: uvar
63C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
64C COMPUTE EFFECTIVE LEAKAGE AREA ACCORDING TO AUTOLIV FORMULATION
65C----------------------------------------------------------------
66 svtfac= zero
67 tan_phi=zero !PHI=SHEAR ANGLE - FIBER ANGLE=PI/2-PHI
68 DO i=1,5
69 eps(i,1) = zero
70 ENDDO
71 mtn=ipm(2,im)
72C
73 IF(mtn==19) THEN
74 j = (iel-1)*8
75 DO i=1,5
76 eps(i,1) = elbuf_str%GBUF%STRA(j+i)
77 ENDDO
78 dir(1,1) = elbuf_str%BUFLY(1)%DIRA(iel)
79 dir(1,2) = elbuf_str%BUFLY(1)%DIRA(iel+nel)
80 CALL roto(1,1,eps,dir,1)
81 ELSEIF (mtn == 58) THEN
82c IPT= MIDPT(NPT)
83c J = (IPT-1)*NEL*NUVAR+K-NFT-1
84c EPS(1,1) = ELBUF(J+3*NEL)
85c EPS(2,1) = ELBUF(J+4*NEL)
86c TAN_PHI = ELBUF(J+5*NEL)
87c J = (IPT-1)*NEL*NUVAR+K-NFT-1
88 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
89 eps(1,1) = uvar(3*nel+iel) ! uvar(iel,4)
90 eps(2,1) = uvar(4*nel+iel) ! uvar(iel,5)
91 tan_phi = uvar(5*nel+iel) ! uvar(iel,6)
92 ENDIF
93C
94 lbd1 = one+eps(1,1)
95 lbd2 = one+eps(2,1)
96 rs = lbd1*lbd2
97 IF(rs > one) THEN
98 lr1 = pm(164,im)
99 fthk = pm(166,im)
100 c1 = pm(167,im)
101 c2 = pm(168,im)
102 c3 = pm(169,im)
103 deltap= max(p/pext-one,zero)
104 apor0 = (lr1-fthk)*(lr1-fthk)
105 apor1 = (lr1*lbd1-fthk/sqrt(lbd2))*(lr1*lbd2-fthk/sqrt(lbd1))
106 deltaa= max(apor1-apor0,zero)
107 cos_phi = one / sqrt(one + tan_phi*tan_phi)
108 svtfac= c1*apor0*exp(c2*log(deltap)) + c3*deltaa
109 svtfac= svtfac*cos_phi/(rs*lr1*lr1)
110 ENDIF
111 RETURN
112 END
113!||====================================================================
114!|| porform5 ../engine/source/airbag/porfor5.F
115!||--- called by ------------------------------------------------------
116!|| fvvent0 ../engine/source/airbag/fvvent0.F
117!||--- calls -----------------------------------------------------
118!|| roto ../engine/source/airbag/roto.F
119!||--- uses -----------------------------------------------------
120!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
121!||====================================================================
122 SUBROUTINE porform5(SVTFAC,IM,IPM,PM,ELBUF_STR,P,PEXT,IEL,NEL)
123C-----------------------------------------------
124C M o d u l e s
125C-----------------------------------------------
126 USE elbufdef_mod
127C-----------------------------------------------
128C I m p l i c i t T y p e s
129C-----------------------------------------------
130#include "implicit_f.inc"
131C-----------------------------------------------
132C C o m m o n B l o c k s
133C-----------------------------------------------
134#include "param_c.inc"
135C-----------------------------------------------
136C D u m m y A r g u m e n t s
137C-----------------------------------------------
138 INTEGER IPM(NPROPMI,*),IM,IEL,NEL
139 my_real
140 . svtfac,pm(npropm,*),p,pext
141 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
142C-----------------------------------------------
143C L o c a l V a r i a b l e s
144C-----------------------------------------------
145 INTEGER I,J,MTN
146 my_real
147 . lr1,fthk,c1,c2,c3,lbd1,lbd2,epsxx,epsyy,deltap,cos_phi,tan_phi,
148 . apor0,apor1,rs,deltaa,eps(5,1),dir(1,2)
149 my_real,
150 . DIMENSION(:), POINTER :: uvar
151C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
152C COMPUTE EFFECTIVE LEAKAGE AREA ACCORDING TO AUTOLIV FORMULATION
153C----------------------------------------------------------------
154 svtfac= zero
155 tan_phi=zero !PHI=SHEAR ANGLE - FIBER ANGLE=PI/2-PHI
156 DO i=1,5
157 eps(i,1) = zero
158 ENDDO
159 mtn=ipm(2,im)
160C
161 IF(mtn==19) THEN
162 j = (iel-1)*8
163 DO i=1,5
164 eps(i,1) = elbuf_str%GBUF%STRA(j+i)
165 ENDDO
166 dir(1,1) = elbuf_str%BUFLY(1)%DIRA(iel)
167 dir(1,2) = elbuf_str%BUFLY(1)%DIRA(iel+nel)
168 CALL roto(1,1,eps,dir,1)
169 ELSEIF (mtn == 58) THEN
170 uvar => elbuf_str%BUFLY(1)%MAT(1,1,1)%VAR
171 eps(1,1) = uvar(3*nel+iel) ! uvar(iel,4)
172 eps(2,1) = uvar(4*nel+iel) ! uvar(iel,5)
173 tan_phi = uvar(5*nel+iel) ! uvar(iel,6)
174 ENDIF
175C
176 lbd1 = one+eps(1,1)
177 lbd2 = one+eps(2,1)
178 rs = lbd1*lbd2
179 IF(rs > one) THEN
180 lr1 = pm(164,im)
181 fthk = pm(166,im)
182 c1 = pm(167,im)
183 c2 = pm(168,im)
184 c3 = pm(169,im)
185 deltap= max(p/pext-one,zero)
186 apor0 = (lr1-fthk)*(lr1-fthk)
187 apor1 = (lr1*lbd1-fthk/sqrt(lbd2))*(lr1*lbd2-fthk/sqrt(lbd1))
188 deltaa= max(apor1-apor0,zero)
189 cos_phi = one / sqrt(one + tan_phi*tan_phi)
190 svtfac= c1*apor0*exp(c2*log(deltap)) + c3*deltaa
191 svtfac= svtfac*cos_phi/(lr1*lr1)
192 ENDIF
193C
194 RETURN
195 END
roto
subroutine roto(jft, jlt, tab, ltab, dir, nel)
Definition cepsini.F:724
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
porform5
subroutine porform5(svtfac, im, ipm, pm, elbuf_str, p, pext, iel, nel)
Definition porfor5.F:123
porfor5
subroutine porfor5(svtfac, im, ipm, pm, elbuf_str, p, pext, iel, nel)
Definition porfor5.F:33