OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
porfor5.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine porfor5 (svtfac, im, ipm, pm, elbuf_str, p, pext, iel, nel)
subroutine porform5 (svtfac, im, ipm, pm, elbuf_str, p, pext, iel, nel)

Function/Subroutine Documentation

◆ porfor5()

subroutine porfor5 ( svtfac,
integer im,
integer, dimension(npropmi,*) ipm,
pm,
type(elbuf_struct_), target elbuf_str,
p,
pext,
integer iel,
integer nel )

Definition at line 32 of file porfor5.F.

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
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,
integer im,
integer, dimension(npropmi,*) ipm,
pm,
type(elbuf_struct_), target elbuf_str,
p,
pext,
integer iel,
integer nel )

Definition at line 122 of file porfor5.F.

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