OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
airbagb1.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!|| airbagb1 ../engine/source/airbag/airbagb1.F
25!||--- called by ------------------------------------------------------
26!|| monvol0 ../engine/source/airbag/monvol0.F
27!||--- calls -----------------------------------------------------
28!|| get_u_func ../engine/source/user_interface/ufunc.F
29!|| porfor4 ../engine/source/airbag/porfor4.F
30!|| porfor5 ../engine/source/airbag/porfor5.F
31!|| porfor6 ../engine/source/airbag/porfor6.F
32!|| spmd_exch_fr6 ../engine/source/mpi/kinematic_conditions/spmd_exch_fr6.F
33!|| sum_6_float ../engine/source/system/parit.F
34!||--- uses -----------------------------------------------------
35!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
36!|| groupdef_mod ../common_source/modules/groupdef_mod.F
37!||====================================================================
38 SUBROUTINE airbagb1(
39 1 IVOLU ,ICBAG ,NJET ,IBAGJET ,NVENT ,
40 2 IBAGHOL ,RVOLU ,RVOLUV ,RCBAG ,RBAGJET ,
41 3 RBAGHOL ,FSAV ,NORMAL ,NN ,
42 4 IGRSURF ,PORO ,IVOLUV ,RBAGVJET,
43 5 FR_MV ,IPARG ,IPART ,IPARTC ,IPARTTG ,
44 6 IPM ,PM ,ELBUF_TAB,IGROUPC ,IGROUPTG,
45 7 IGEO ,GEO )
46C-----------------------------------------------
47C STRUCTURES AIRBAG
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
52 USE groupdef_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "param_c.inc"
61#include "units_c.inc"
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com08_c.inc"
65#include "scr17_c.inc"
66#include "task_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER IVOLU(*),ICBAG(NICBAG,*),NJET,IBAGJET(NIBJET,*),
71 . NVENT,IBAGHOL(NIBHOL,*),
72 . NN,IVOLUV(NIMV,*),FR_MV(*),IPARG(NPARG,*),
73 . IPART(LIPART1,*),IPM(NPROPMI,*),
74 . IPARTC(NUMELC) ,IPARTTG(NUMELTG),
75 . IGROUPC(*),IGROUPTG(*)
76 INTEGER IGEO(NPROPGI,*)
77C REAL
78 my_real
79 . rvolu(*), rvoluv(nrvolu,*),rcbag(nrcbag,*),poro(*),
80 . rbagjet(nrbjet,*),rbaghol(nrbhol,*),fsav(*),normal(3,*),rbagvjet(*),
81 . geo(npropg,*), pm(npropm,*)
82C
83 TYPE(elbuf_struct_), DIMENSION(NGROUP) :: ELBUF_TAB
84 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I,II, NAV, K,NFT,IEL, IDEF, KK, IPVENT, NNC,
89 . IPORT,IPORP,IPORA,IPORT1,IPORP1,IPORA1,IVDP,
90 . ij ,iv, radvois,pmain,
91 . in1,in2,in3,in4,ittf,idtpdef,
92 . ioff,ng,im,ifvent,nfunc,ity,iad,mtn,
93 . iventyp,ileakage,iblockage
94 INTEGER NEL,TITREVENT(20)
95 INTEGER IK, I_INJ, I_TYPINJ, I_GAS, NGASES
96C REAL
97 my_real
98 . GAMA, CV, CP, PEXT, PDEF, DTPDEFI, DTPDEFC, TVENT, TSTOPE,
99 . APVENT, AVENT, BVENT,
100 . AMTOT, P, RO, VOL, HSPEC,
101 . gmtot, cpa, cpb, cpc, gmi, cpai, cpbi, cpci, tbag,
102 . cpd, cpe, cpf, cpdi, cpei, cpfi,
103 . u, deout, dmout, area, pcrit, pvois, tvois, aa, veps,
104 . aout, aout1, aoutot, flout, de, vvois,
105 . dgeout, dgmout, rnm, rmwi, rnmi, rmwg, rnmg,
106 . deri, temp, aisent, achemk, fchemk, vmax,
107 . fport,fporp,fpora,fport1,fporp1,fpora1,scalt,scalp,scals,
108 . fvdp, roex, uisent, tt1,
109 . f1(nn), f2(nn), ttf, svtfac, flc, fac, facp,
110 . aisent1, dgmin, dgein, gamai, rhoi, rho2, p2, eta,
111 . pcrit1, hspec1
112 my_real
113 . mw, r_igc1, tout
114 my_real get_u_func
115 EXTERNAL get_u_func
116 CHARACTER*20 VENTTITLE
117 DOUBLE PRECISION
118 . FRMV6(2,6), FRMV6B(6)
119C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
120C
121 pmain = fr_mv(nspmd+2)
122 nav = ivolu(3)
123 ittf = ivolu(17)
124 ttf =rvolu(60)
125 gama =rvolu(1)
126 pext =rvolu(3)
127 vol =rvolu(16)
128 veps =rvolu(17)
129 tbag =rvolu(13)
130 amtot =rvolu(20)
131 p =rvolu(12)
132 area =rvolu(18)
133C
134 scalt =rvolu(26)
135 scalp =rvolu(27)
136 scals =rvolu(28)
137C
138 r_igc1= pm(27,ivolu(66))
139 ro = amtot/vol
140 pcrit = p*(two/(gama+one))**(gama/(gama-one))
141C---------------------------------
142C contribution du gaz a l'initial.
143C---------------------------------
144 cpai=rvolu(7)
145 cpbi=rvolu(8)
146 cpci=rvolu(9)
147 cpdi=rvolu(56)
148 cpei=rvolu(57)
149 cpfi=rvolu(58)
150 gmi =rvolu(11)
151 hspec=gmi*tbag*(
152 . cpai+half*cpbi*tbag+third*cpci*tbag*tbag
153 . +fourth*cpdi*tbag*tbag*tbag
154 . -cpei/(tbag*tbag)
155 . +one_fifth*cpfi*tbag*tbag*tbag*tbag)
156C
157 DO ij=1,njet
158 i_inj = iabs(ibagjet(13,ij))
159 i_typinj = igeo(22,i_inj)
160 ngases = igeo(23,i_inj)
161 DO ik=1,ngases
162 IF (i_typinj==1) THEN
163 i_gas = igeo(100+(ik-1)*3+1,i_inj)
164 ELSE IF (i_typinj==2) THEN
165 i_gas = igeo(100+(ik-1)*2+1,i_inj)
166 END IF
167 cpa =pm(21,i_gas)
168 cpb =pm(22,i_gas)
169 cpc =pm(23,i_gas)
170 cpd =pm(24,i_gas)
171 cpe =pm(25,i_gas)
172 cpf =pm(26,i_gas)
173 gmtot= rbagjet(20+(ik-1)*4+1,ij)
174 hspec= hspec+gmtot*tbag*
175 . (cpa+half*cpb*tbag+third*cpc*tbag*tbag
176 . +fourth*cpd*tbag*tbag*tbag
177 . -cpe/(tbag*tbag)
178 . +one_fifth*cpf*tbag*tbag*tbag*tbag)
179 ENDDO
180 ENDDO
181 hspec=hspec/max(em20,amtot)
182C--------------------------------
183C FLUX SORTANT PAR LES TROUS
184C--------------------------------
185 aisent =zero
186 aisent1=zero
187 achemk=zero
188 fchemk=zero
189 DO iv=1,nvent
190 idef = ibaghol(1,iv)
191 ipvent = ibaghol(2,iv)
192 ifvent = ibaghol(10,iv)
193 idtpdef= ibaghol(11,iv)
194 iventyp= ibaghol(13,iv)
195 iblockage= ibaghol(14,iv)
196C
197 pdef = rbaghol(1,iv)
198 dtpdefi= rbaghol(4,iv)
199 dtpdefc= rbaghol(5,iv)
200 avent = rbaghol(2,iv)
201 tvent = rbaghol(3,iv)
202 bvent = rbaghol(6,iv)
203 tstope = rbaghol(14,iv)
204C
205 rbaghol(16,iv)=zero
206 rbaghol(17,iv)=zero
207 rbaghol(18,iv)=zero
208 rbaghol(21,iv)=zero
209 rbaghol(22,iv)=zero
210C
211 DO k=1,20
212 titrevent(k)=ibaghol(14+k,iv)
213 venttitle(k:k) = achar(titrevent(k))
214 ENDDO
215C
216 IF(ittf==11.OR.ittf==12.OR.ittf==13) THEN
217 IF(idef==0.AND.p>pdef+pext
218 . .AND.dtpdefc>dtpdefi
219 . .AND.vol>em3*area**three_half
220 . .AND.tt<tstope+ttf
221 . .AND.idtpdef==0) THEN
222 idef=1
223 IF(ispmd+1==pmain) THEN
224 WRITE(iout,'(A)')
225 . ' ** AIRBAG VENT HOLE MEMBRANE IS DEFLATED **'
226 WRITE(iout,'(3X,2(A,I10),2A)')' MONITORED VOLUME ',ivolu(1),
227 . ' VENT HOLE NUMBER',iv ,' ',venttitle
228 WRITE(istdo,'(2A)')
229 . ' ** VENT HOLE MEMBRANE IS DEFLATED ',venttitle
230 ENDIF
231 ENDIF
232 IF(idef==0.AND.dtpdefc>dtpdefi
233 . .AND.tt<tstope+ttf
234 . .AND.idtpdef==1) THEN
235 idef=1
236 WRITE(iout,'(A)')
237 . ' ** AIRBAG VENT HOLE MEMBRANE IS DEFLATED **'
238 WRITE(iout,'(3X,2(A,I10),2A)')' MONITORED VOLUME ',ivolu(1),
239 . ' VENT HOLE NUMBER',iv ,' ',venttitle
240 WRITE(istdo,'(2A)')
241 . ' ** VENT HOLE MEMBRANE IS DEFLATED ',venttitle
242 ENDIF
243 IF(idef==0 .AND. tt>tvent+ttf
244 . .AND. tt<tstope+ttf) THEN
245 idef=1
246 IF(ispmd+1==pmain) THEN
247 WRITE(iout,'(A)') ' ** AIRBAG VENTING STARTS **'
248 WRITE(iout,'(3X,2(A,I10),2A)')' MONITORED VOLUME ',ivolu(1),
249 . ' VENT HOLE NUMBER',iv ,' ',venttitle
250 WRITE(istdo,'(2A)') ' ** venting starts ',VENTTITLE
251 ENDIF
252 ENDIF
253.AND. IF(IDEF==1 TT>=TSTOPE+TTF) THEN
254 IDEF=0
255 IF(ISPMD+1==PMAIN) THEN
256 WRITE(IOUT,'(a)') ' ** airbag venting stops **'
257 WRITE(iout,'(3X,2(A,I10),2A)')' MONITORED VOLUME ',ivolu(1),
258 . ' VENT HOLE NUMBER',iv ,' ',venttitle
259 WRITE(istdo,'(2A)') ' ** VENTING STOPS ',venttitle
260 END IF
261 END IF
262C
263 ELSE IF(ittf==0) THEN
264 IF(idef==0.AND.p>pdef+pext.
265 . and.dtpdefc>dtpdefi.
266 . and.vol>em3*area**three_half.
267 . and.tt<tstope
268 . .AND.idtpdef==0) THEN
269 idef=1
270 IF(ispmd+1==pmain) THEN
271 WRITE(iout,'(A)')
272 . ' ** AIRBAG VENT HOLE MEMBRANE IS DEFLATED **'
273 WRITE(iout,'(3x,2(a,i10),2a)')' monitored volume ',IVOLU(1),
274 . ' vent hole number',IV ,' ',VENTTITLE
275 WRITE(ISTDO,'(2a)')
276 . ' ** vent hole membrane is deflated ',VENTTITLE
277 ENDIF
278 ENDIF
279.AND. IF(IDEF==0DTPDEFC>DTPDEFI.
280 . AND.TT<TSTOPE
281.AND. . IDTPDEF==1) THEN
282 IDEF=1
283 WRITE(IOUT,'(a)')
284 . ' ** airbag vent hole membrane is deflated **'
285 WRITE(IOUT,'(3x,2(a,i10),2a)')' monitored volume ',IVOLU(1),
286 . ' vent hole number',IV ,' ',VENTTITLE
287 WRITE(ISTDO,'(2a)')
288 . ' ** vent hole membrane is deflated ',VENTTITLE
289 ENDIF
290.AND. IF(IDEF==0 TT>TVENT
291.AND. . TT<TSTOPE) THEN
292 IDEF=1
293 IF(ISPMD+1==PMAIN) THEN
294 WRITE(IOUT,'(a)') ' ** airbag venting starts **'
295 WRITE(IOUT,'(3x,2(a,i10),2a)')' monitored volume ',IVOLU(1),
296 . ' vent hole number',IV ,' ',VENTTITLE
297 WRITE(ISTDO,'(2a)') ' ** venting starts ',VENTTITLE
298 ENDIF
299 ENDIF
300.AND. IF(IDEF==1 TT>=TSTOPE) THEN
301 IDEF=0
302 IF(ISPMD+1==PMAIN) THEN
303 WRITE(IOUT,'(a)') ' ** airbag venting stops **'
304 WRITE(IOUT,'(3x,2(a,i10),2a)')' monitored volume ',IVOLU(1),
305 . ' vent hole number',IV ,' ',VENTTITLE
306 WRITE(ISTDO,'(2a)') ' ** venting stops ',VENTTITLE
307 ENDIF
308 ENDIF
309 ENDIF
310 IBAGHOL(1,IV)=IDEF
311 IF(IDEF==0) CYCLE
312C-----------------------------------
313C COMPUTE EFFECTIVE VENTING SURFACE
314C-----------------------------------
315 TT1=TT-TTF
316 IF (ITTF==13) TT1=TT-TTF-TVENT
317C--------------------------------
318C VENTING AREA GIVEN BY A SURFACE
319C--------------------------------
320 IF(IPVENT/=0)THEN
321 IF(IVENTYP==0)THEN
322C-------------
323C VENT HOLES
324C-------------
325 NNC=IGRSURF(IPVENT)%NSEG
326 DO KK=1,NNC
327 IF(IGRSURF(IPVENT)%ELTYP(KK)==3)THEN
328 K=IGRSURF(IPVENT)%ELEM(KK)
329 ELSEIF(IGRSURF(IPVENT)%ELTYP(KK)==7)THEN
330 K=IGRSURF(IPVENT)%ELEM(KK) + NUMELC
331 ELSE
332 K=IGRSURF(IPVENT)%ELEM(KK) + NUMELC + NUMELTG
333 ENDIF
334 AA = SQRT(NORMAL(1,K)**2+NORMAL(2,K)**2+NORMAL(3,K)**2)
335 IF(INTBAG==0) THEN
336 F1(KK) = AA
337 F2(KK) = ZERO
338 ELSE
339 F1(KK) = (ONE - PORO(K))*AA
340 F2(KK) = PORO(K)*AA
341 ENDIF
342 ENDDO
343 ELSE
344C------------
345C POROSITY
346C------------
347 NNC=IGRSURF(IPVENT)%NSEG
348C
349 DO KK=1,NNC
350 ITY=IGRSURF(IPVENT)%ELTYP(KK)
351 K =IGRSURF(IPVENT)%ELEM(KK)
352 FACP=ZERO
353 SVTFAC=ZERO
354 IF(ITY==3)THEN
355 IM=IPART(1,IPARTC(K))
356 ELSEIF(ITY==7)THEN
357 IM=IPART(1,IPARTTG(K))
358 ELSE
359 GO TO 200
360 ENDIF
361 MTN = IPM(2,IM)
362.AND. IF (MTN/=19MTN/=58) GOTO 200
363C
364 ILEAKAGE = IPM(4,IM)
365 NFUNC = IPM(10,IM)+IPM(6,IM)
366 IF(ILEAKAGE==0) THEN
367 SVTFAC=ZERO
368 ELSEIF(ILEAKAGE==1) THEN
369 FLC=PM(164,IM)
370 FAC=PM(165,IM)
371 SVTFAC=FLC*FAC
372.OR. ELSEIF(ILEAKAGE==2ILEAKAGE==3) THEN
373 FLC=ZERO
374 IPORT=IPM(10+NFUNC-1,IM)
375 IF(IPORT > 0) THEN
376 SCALT=PM(160,IM)
377 FPORT=PM(164,IM)
378 FLC=FPORT*GET_U_FUNC(IPORT,TT1*SCALT,DERI)
379 ENDIF
380 FAC=ZERO
381 IPORP=IPM(10+NFUNC-2,IM)
382 IF(IPORP > 0) THEN
383 SCALP=PM(161,IM)
384 FPORP=PM(165,IM)
385 IF(ILEAKAGE==2) THEN
386 FAC=FPORP*GET_U_FUNC(IPORP,P*SCALP,DERI)
387 ELSE
388 FAC=FPORP*GET_U_FUNC(IPORP,(P-PEXT)*SCALP,DERI)
389 ENDIF
390 ENDIF
391 SVTFAC=FLC*FAC
392 ELSE ! ILEAKAGE >= 4
393 IF(ITY==3)NG=IGROUPC(K)
394 IF(ITY==7)NG=IGROUPTG(K)
395 NEL = IPARG(2,NG)
396 NFT = IPARG(3,NG)
397 IEL = K-NFT
398 IF(ILEAKAGE==4) THEN
399 CALL PORFOR4(SVTFAC,IM,IPM,PM,
400 . ELBUF_TAB(NG)%GBUF%STRA,P,PEXT,IEL,NEL)
401 ELSEIF(ILEAKAGE==5) THEN
402 CALL PORFOR5(SVTFAC,IM,IPM,PM,
403 . ELBUF_TAB(NG),P,PEXT,IEL,NEL)
404 ELSEIF(ILEAKAGE==6) THEN
405 CALL PORFOR6(SVTFAC,IM,IPM,PM,
406 . ELBUF_TAB(NG)%GBUF%STRA,P,PEXT,IEL,NEL)
407 ENDIF
408 ENDIF
409C
410 FACP=PM(162,IM)
411 IF(FACP == ZERO) THEN
412 IPORT=IPM(10+NFUNC,IM)
413 IF(IPORT > 0) THEN
414 SCALT=PM(160,IM)
415 FPORT=PM(163,IM)
416 FACP=FPORT*GET_U_FUNC(IPORT,TT1*SCALT,DERI)
417 ENDIF
418 ENDIF
419C
420
421 200 CONTINUE
422 IF (ITY==7) K=K+NUMELC
423 AA = SQRT( NORMAL(1,K)**2+NORMAL(2,K)**2+NORMAL(3,K)**2 )
424 IF(INTBAG==0) THEN
425 F1(KK) = AA*SVTFAC
426 F2(KK) = ZERO
427 ELSE
428 IF(IBLOCKAGE==1) THEN
429 F1(KK) = (ONE - PORO(K))*AA*SVTFAC
430 F2(KK) = ZERO
431 ELSE
432 F1(KK) = (ONE - PORO(K))*AA*SVTFAC
433 F2(KK) = FACP*PORO(K) *AA*SVTFAC
434 ENDIF
435 ENDIF
436 ENDDO
437 ENDIF
438C----------------
439C somme parith/on
440C----------------
441 DO K = 1, 6
442 FRMV6(1,K) = ZERO
443 FRMV6(2,K) = ZERO
444 END DO
445 CALL SUM_6_FLOAT(1, NNC, F1, FRMV6(1,1),2)
446 CALL SUM_6_FLOAT(1, NNC, F2, FRMV6(2,1),2)
447C comm si necessaire
448 IF(NSPMD > 1) THEN
449 CALL SPMD_EXCH_FR6(FR_MV,FRMV6,2*6)
450 ENDIF
451C
452 AOUT = FRMV6(1,1)+FRMV6(1,2)+FRMV6(1,3)+
453 . FRMV6(1,4)+FRMV6(1,5)+FRMV6(1,6)
454 AOUT1 = FRMV6(2,1)+FRMV6(2,2)+FRMV6(2,3)+
455 . FRMV6(2,4)+FRMV6(2,5)+FRMV6(2,6)
456 ELSE
457C---------------------------------
458C VENTING THROUGH A CONSTANT AREA
459C---------------------------------
460 AOUT1=ZERO
461 IF(IVENTYP==0) THEN
462 AOUT =AVENT
463 AVENT=ONE
464 ELSE
465 IF(AVENT==ZERO) THEN
466 IPORA = IBAGHOL(5,IV)
467 FPORA = RBAGHOL(9,IV)
468 AVENT=FPORA*GET_U_FUNC(IPORA,(P-PEXT)*SCALP,DERI)
469 ENDIF
470 IF(BVENT==ZERO) THEN
471 IPORT = IBAGHOL(3,IV)
472 FPORT = RBAGHOL(7,IV)
473 BVENT=FPORT*GET_U_FUNC(IPORT,TT1*SCALT,DERI)
474 ENDIF
475 AOUT=AVENT*BVENT
476 ENDIF
477 ENDIF
478C
479 IF(IVENTYP==0) THEN
480C-------------
481C VENT HOLES
482C-------------
483 IPORT =IBAGHOL(3,IV)
484 IPORP =IBAGHOL(4,IV)
485 IPORA =IBAGHOL(5,IV)
486 IPORT1=IBAGHOL(6,IV)
487 IPORP1=IBAGHOL(7,IV)
488 IPORA1=IBAGHOL(8,IV)
489 FPORT = RBAGHOL(7,IV)
490 FPORP = RBAGHOL(8,IV)
491 FPORA = RBAGHOL(9,IV)
492 FPORT1= RBAGHOL(10,IV)
493 FPORP1= RBAGHOL(11,IV)
494 FPORA1= RBAGHOL(12,IV)
495.AND. IF(IPORA/=0IPVENT/=0)THEN
496 AOUT=FPORA*AVENT*GET_U_FUNC(IPORA,AOUT*SCALS,DERI)
497 ELSE
498 AOUT=AVENT*AOUT
499 ENDIF
500 IF(IPORT/=0)
501 . AOUT=FPORT*AOUT*GET_U_FUNC(IPORT,TT1*SCALT,DERI)
502 IF(IPORP/=0)
503 . AOUT=FPORP*AOUT*GET_U_FUNC(IPORP,(P-PEXT)*SCALP,DERI)
504.AND. IF(IPORA1/=0IPVENT/=0)THEN
505 AOUT1=FPORA1*BVENT*GET_U_FUNC(IPORA1,AOUT1*SCALS,DERI)
506 ELSE
507 AOUT1=BVENT*AOUT1
508 ENDIF
509 IF(IPORT1/=0)
510 . AOUT1=FPORT1*AOUT1*GET_U_FUNC(IPORT1,TT1*SCALT,DERI)
511 IF(IPORP1/=0)
512 . AOUT1=FPORP1*AOUT1*GET_U_FUNC(IPORP1,(P-PEXT)*SCALP,DERI)
513C
514 IF(IFVENT==1)THEN
515 AISENT=AISENT+AOUT+AOUT1
516 ELSEIF(IFVENT==2) THEN
517 ACHEMK=ACHEMK+AOUT+AOUT1
518 IVDP=IBAGHOL(9,IV)
519 FVDP=RBAGHOL(13,IV)
520 U=FVDP*GET_U_FUNC(IVDP,(P-PEXT)*SCALP,DERI)
521 FCHEMK= FCHEMK+(AOUT+AOUT1)*U
522 IF(ISPMD+1==PMAIN) RBAGHOL(18,IV)=U
523 ELSEIF(IFVENT==4) THEN
524 AISENT1=AISENT1+AOUT+AOUT1
525 ENDIF
526 ELSE
527C------------
528C POROSITY
529C------------
530 IF(IFVENT <= 1) THEN
531 AISENT=AISENT+AOUT+AOUT1
532 ELSEIF(IFVENT==2) THEN
533 ACHEMK=ACHEMK+AOUT+AOUT1
534 IVDP=IBAGHOL(9,IV)
535 FVDP=RBAGHOL(13,IV)
536 U=FVDP*GET_U_FUNC(IVDP,(P-PEXT)*SCALP,DERI)
537 FCHEMK= FCHEMK+(AOUT+AOUT1)*U
538 IF(ISPMD+1==PMAIN) RBAGHOL(18,IV)=U
539 ELSEIF(IFVENT==3) THEN
540 ACHEMK=ACHEMK+AOUT+AOUT1
541 U=MAX(TWO*(P-PEXT)/RO,ZERO)
542 U=SQRT(U)
543 FCHEMK= FCHEMK+(AOUT+AOUT1)*U
544 IF(ISPMD+1==PMAIN) RBAGHOL(18,IV)=U
545 ENDIF
546 ENDIF
547C
548 IF(ISPMD+1==PMAIN) THEN
549 RBAGHOL(16,IV)=AOUT
550 RBAGHOL(17,IV)=AOUT1
551 ENDIF
552 ENDDO
553C-------------------
554C END LOOP ON NVENT
555C------------------------------------------------
556C COMPUTE MASS FLOW RATE OUT : ISENTROPIC MODEL
557C------------------------------------------------
558 AOUTOT=AISENT+AISENT1+ACHEMK
559 UISENT=ZERO
560 FLOUT =ZERO
561 DMOUT =ZERO
562 DGMIN =ZERO
563 TOUT =TBAG
564 IF(AOUTOT>ZERO)THEN
565 ROEX =RO*(PEXT/P)**(ONE/GAMA)
566 TEMP =ROEX*AISENT+RO*ACHEMK+ROEX*AISENT1
567 VMAX =HALF*(P-PEXT)*VOL/(GAMA-ONE)
568 . /MAX(EM20,HSPEC*TEMP*DT1)
569 VMAX =MIN(VMAX,HALF*VOL/MAX(EM20,AOUTOT*DT1))
570 VMAX =MAX(VMAX,ZERO)
571C
572 IF(AISENT>ZERO)THEN
573 PEXT = MAX(PEXT,PCRIT)
574 ROEX =RO*(PEXT/P)**(ONE/GAMA)
575 UISENT=TWO*GAMA/(GAMA-ONE)*P/RO*(ONE-(PEXT/P)**((GAMA-ONE)/GAMA))
576 UISENT=MAX(UISENT,ZERO)
577 UISENT=SQRT(UISENT)
578 UISENT=MIN(UISENT,VMAX)
579 FLOUT=AISENT*UISENT
580 DMOUT=FLOUT*ROEX
581 ENDIF
582C
583 IF(ACHEMK>ZERO)THEN
584 FCHEMK=MIN(FCHEMK,VMAX*ACHEMK)
585 FLOUT =FLOUT +FCHEMK
586 DMOUT =DMOUT +RO*FCHEMK
587 ENDIF
588C
589 IF(AISENT1>ZERO)THEN
590 IF(P < PEXT) THEN
591 GAMAI=RVOLU(1)
592 RHOI=RVOLU(62)
593 HSPEC1=RVOLU(63)
594 ETA=(GAMAI-ONE)/GAMAI
595 PCRIT1=PEXT*(TWO/(GAMAI+ONE))**(ONE/ETA)
596 P2 = MAX(P,PCRIT1)
597 RHO2 =RHOI*(P2/PEXT)**(ONE/GAMAI)
598 UISENT=TWO*PEXT*(ONE-(P2/PEXT)**ETA)/(RHOI*ETA)
599 UISENT=MAX(UISENT,ZERO)
600 UISENT=SQRT(UISENT)
601 VMAX =HALF*(PEXT-P)*VOL/(GAMA-ONE)
602 . /MAX(EM20,HSPEC1*RHOI*AISENT1*DT1)
603 UISENT=MIN(UISENT,VMAX)
604 FLOUT=FLOUT -AISENT1*UISENT
605 DGMIN=DGMIN +AISENT1*UISENT*RHO2
606 UISENT=-UISENT
607 ROEX=RHO2
608 ELSE
609 PEXT = MAX(PEXT,PCRIT)
610 ROEX =RO*(PEXT/P)**(ONE/GAMA)
611 ETA=(GAMA-ONE)/GAMA
612 UISENT=TWO*P*(ONE-(PEXT/P)**ETA)/(RO*ETA)
613 UISENT=MAX(UISENT,ZERO)
614 UISENT=SQRT(UISENT)
615 UISENT=MIN(UISENT,VMAX)
616 FLOUT=FLOUT +AISENT1*UISENT
617 DMOUT=DMOUT +AISENT1*UISENT*ROEX
618 HSPEC1=HSPEC
619 ENDIF
620 ENDIF
621C
622 IF(ISPMD+1==PMAIN)THEN
623 DO IV=1,NVENT
624 IDEF=IBAGHOL(1,IV)
625 IVDP=IBAGHOL(9,IV)
626 IF(IDEF==1)THEN
627 IFVENT = IBAGHOL(10,IV)
628 IF(IFVENT <= 1)THEN
629 RBAGHOL(18,IV)=UISENT
630 RBAGHOL(21,IV)= ROEX*UISENT
631 . *(RBAGHOL(16,IV)+RBAGHOL(17,IV))
632 RBAGHOL(22,IV)=RBAGHOL(21,IV)*HSPEC
633.OR. ELSEIF(IFVENT==2IFVENT==3) THEN
634 RBAGHOL(18,IV)=MIN(RBAGHOL(18,IV),VMAX)
635 RBAGHOL(21,IV)= RO*RBAGHOL(18,IV)
636 . *(RBAGHOL(16,IV)+RBAGHOL(17,IV))
637 RBAGHOL(22,IV)=RBAGHOL(21,IV)*HSPEC
638 ELSEIF(IFVENT==4)THEN
639 RBAGHOL(18,IV)=UISENT
640 RBAGHOL(21,IV)= ROEX*UISENT
641 . *(RBAGHOL(16,IV)+RBAGHOL(17,IV))
642 RBAGHOL(22,IV)=RBAGHOL(21,IV)*HSPEC1
643 END IF
644 END IF
645 END DO
646 END IF
647 ENDIF
648C--------------
649C SAVE FOR T.H.
650C--------------
651 RNM =RVOLU(14)
652 CV =RNM/AMTOT/(GAMA-ONE)
653 CP =GAMA*CV
654 IF(ISPMD+1==PMAIN) THEN
655 FSAV(1) =AMTOT
656 FSAV(2) =VOL
657 FSAV(3) =P
658 FSAV(4) =AREA
659 FSAV(5) =TBAG
660 FSAV(6) =AOUTOT
661 FSAV(7) =FLOUT/MAX(EM20,AOUTOT)
662 FSAV(8)=ZERO
663 FSAV(9)=ZERO
664 FSAV(10)=CP
665 FSAV(11)=CV
666 FSAV(12)=GAMA
667 FSAV(15)=ZERO
668 FSAV(16)=ZERO
669 DO IJ=1,NJET
670 I_INJ = IBAGJET(13,IJ)
671 IF(I_INJ <= 0) CYCLE
672 NGASES = IGEO(23,I_INJ)
673 DO IK=1,NGASES
674 FSAV(15)=FSAV(15)+RBAGJET(20+(IK-1)*4+2,IJ)
675 ENDDO
676 FSAV(16)=FSAV(16)+RBAGJET(11,IJ)
677 ENDDO
678 FSAV(17)=AMTOT*CV*TBAG
679 FSAV(18)=RVOLU(32)
680 ENDIF
681C---------------------------------------------
682C MASSE et TRAVAIL par GAZ
683C---------------------------------------------
684 RMWI=RVOLU(10)
685 RNMI=GMI*RMWI
686C
687C VOLG/VOL=fraction molaire=RNMG/RNM
688 DGMOUT=RNMI/MAX(EM20,RNM)*DMOUT
689 DGEOUT=DGMOUT*TOUT*(
690 . CPAI+HALF*CPBI*TOUT+THIRD*CPCI*TOUT*TOUT
691 . +FOURTH*CPDI*TOUT*TOUT*TOUT
692 . -CPEI/(TOUT*TOUT)
693 . +ONE_FIFTH*CPFI*TOUT*TOUT*TOUT*TOUT)
694 DGEIN =DGMIN*RVOLU(63)
695 RVOLU(22)=RVOLU(22)+DGEOUT
696 RVOLU(24)=RVOLU(24)+DGMOUT
697 RVOLU(64)=DGMIN
698 RVOLU(65)=DGEIN
699C
700 DO IJ=1,NJET
701 I_INJ = IABS(IBAGJET(13,IJ))
702 I_TYPINJ = IGEO(22,I_INJ)
703 NGASES = IGEO(23,I_INJ)
704 DO IK=1,NGASES
705 IF (I_TYPINJ==1) THEN
706 I_GAS = IGEO(100+(IK-1)*3+1,I_INJ)
707 ELSE IF (I_TYPINJ==2) THEN
708 I_GAS = IGEO(100+(IK-1)*2+1,I_INJ)
709 END IF
710 MW = PM(20,I_GAS)
711 RMWG = R_IGC1/MW
712 CPA =PM(21,I_GAS)
713 CPB =PM(22,I_GAS)
714 CPC =PM(23,I_GAS)
715 CPD =PM(24,I_GAS)
716 CPE =PM(25,I_GAS)
717 CPF =PM(26,I_GAS)
718 KK=20+(IK-1)*4
719 GMTOT= RBAGJET(KK+1,IJ)
720 RNMG =GMTOT*RMWG
721 DGMOUT=RNMG/MAX(EM20,RNM)*DMOUT
722 DGEOUT=DGMOUT*TOUT*(
723 . CPA+HALF*CPB*TOUT+THIRD*CPC*TOUT*TOUT
724 . +FOURTH*CPD*TOUT*TOUT*TOUT
725 . -CPE/(TOUT*TOUT)
726 . +ONE_FIFTH*CPF*TOUT*TOUT*TOUT*TOUT)
727 RBAGJET(KK+3,IJ)=RBAGJET(KK+3,IJ)+DGMOUT
728 RBAGJET(KK+4,IJ)=RBAGJET(KK+4,IJ)+DGEOUT
729 RBAGJET( 9,IJ)=RBAGJET(9 ,IJ)+DGMOUT
730 RBAGJET(10,IJ)=RBAGJET(10,IJ)+DGEOUT
731 ENDDO
732 ENDDO
733C---------------------------------------------
734C AIRBAG COMMUNIQUANTS
735C---------------------------------------------
736 DO I=1,NAV
737 II = ICBAG(1,I)
738 IPVENT = ICBAG(2,I)
739 IDEF = ICBAG(3,I)
740 IPORT = ICBAG(4,I)
741 IPORP = ICBAG(5,I)
742 PDEF = RCBAG(1,I)
743 AVENT = RCBAG(2,I)
744 TVENT = RCBAG(3,I)
745 DTPDEFI= RCBAG(4,I)
746 DTPDEFC= RCBAG(5,I)
747 FPORT = RCBAG(6,I)
748 FPORP = RCBAG(7,I)
749 PVOIS=RVOLUV(12,II)
750 VVOIS=RVOLUV(16,II)
751.OR..OR..OR. IF(ITTF==0ITTF==11ITTF==12ITTF==13)THEN
752.AND. IF(IDEF==0P>PDEF+PVOIS
753.AND. . DTPDEFC>DTPDEFI
754.AND. . VOL>EM3*AREA**THREE_HALF)THEN
755
756 IDEF=1
757 IF(ISPMD+1==PMAIN) THEN
758 WRITE(IOUT,*)
759 . ' ** chamber communication membrane is deflated **'
760 WRITE(IOUT,*)
761 . ' ** monitored volume ',IVOLU(1),' **'
762 WRITE(ISTDO,*)
763 . ' ** chamber communication membrane is deflated **'
764 ENDIF
765 ENDIF
766.AND. IF(IDEF==0 TT>TVENT+TTF) THEN
767 IDEF=1
768 IF(ISPMD+1==PMAIN) THEN
769 WRITE(IOUT,*) ' ** chamber communication starts **'
770 WRITE(IOUT,*) ' ** monitored volume ',IVOLU(1),' **'
771 WRITE(ISTDO,*)' ** communication starts **'
772 ENDIF
773 ENDIF
774 ENDIF
775C
776 IF(IPVENT/=0)THEN
777 NNC=IGRSURF(IPVENT)%NSEG
778 DO KK=1,NNC
779 IF(IGRSURF(IPVENT)%ELTYP(KK)==3)THEN
780 K=IGRSURF(IPVENT)%ELEM(KK)
781 ELSEIF(IGRSURF(IPVENT)%ELTYP(KK)==7)THEN
782 K=IGRSURF(IPVENT)%ELEM(KK) + NUMELC
783 ELSE
784 K=IGRSURF(IPVENT)%ELEM(KK) + NUMELC + NUMELTG
785 ENDIF
786 F1(KK) = SQRT( NORMAL(1,K)**2+NORMAL(2,K)**2+NORMAL(3,K)**2 )
787 ENDDO
788C
789C Sommation p/on
790C
791 DO K = 1, 6
792 FRMV6B(K) = ZERO
793 ENDDO
794 CALL SUM_6_FLOAT(1, NNC, F1, FRMV6B,1)
795C comm si necessaire
796 IF(NSPMD > 1) THEN
797 CALL SPMD_EXCH_FR6(FR_MV,FRMV6B,6)
798 ENDIF
799 APVENT = FRMV6B(1)+FRMV6B(2)+FRMV6B(3)+
800 . FRMV6B(4)+FRMV6B(5)+FRMV6B(6)
801 ELSE
802 APVENT = ONE
803 ENDIF
804C
805 AOUT=AVENT*APVENT
806 IF(IPORT > 0) THEN
807 TT1=TT-TTF
808 IF(ITTF==13) TT1=TT-TTF-TVENT
809 SCALT=RVOLU(26)
810 AOUT =AOUT*FPORT*GET_U_FUNC(IPORT,TT1*SCALT,DERI)
811 ENDIF
812 IF(IPORP > 0) THEN
813 SCALP=RVOLU(27)
814 AOUT =AOUT*FPORP*GET_U_FUNC(IPORP,(P-PVOIS)*SCALP,DERI)
815 ENDIF
816C
817.AND. IF(IDEF==1 P>PVOIS.
818 . AND.VOL>EM3*AREA**THREE_HALF)THEN
819 PVOIS = MAX(PVOIS,PCRIT)
820 U=TWO*GAMA/(GAMA-ONE)*P/RO*(ONE-(PVOIS/P)**((GAMA-ONE)/GAMA))
821 U=SQRT(U)
822 U=MIN(U,HALF*VOL/MAX(EM20,AOUT*DT1))
823 DE=RO*(PVOIS/P)**(ONE/GAMA)*HSPEC
824 U=MIN(U,(P-PVOIS)*HALF*MIN(VOL,VVOIS)
825 . /(GAMA-ONE)/DE/MAX(EM20,AOUT*DT1))
826 FLOUT=AOUT*U
827 DMOUT=FLOUT*RO*(PVOIS/P)**(ONE/GAMA)
828 ELSE
829 DMOUT=ZERO
830 FLOUT=ZERO
831 U=ZERO
832 ENDIF
833 ICBAG(3,I) = IDEF
834 RCBAG(8,I) = RCBAG(8,I) + DMOUT*DT1
835 RCBAG(9,I) = U
836C---------------------------------------------
837C MASSE et TRAVAIL par GAZ
838C---------------------------------------------
839C VOLG/VOL=fraction molaire=RNMG/RNM
840 DGMOUT=RNMI/MAX(EM20,RNM)*DMOUT
841 DGEOUT=DGMOUT*TBAG*(
842 . CPAI+HALF*CPBI*TBAG+THIRD*CPCI*TBAG*TBAG
843 . +FOURTH*CPDI*TBAG*TBAG*TBAG
844 . -CPEI/(TBAG*TBAG)
845 . +ONE_FIFTH*CPFI*TBAG*TBAG*TBAG*TBAG)
846C OUT
847 RVOLU(22)=RVOLU(22) + DGEOUT
848 RVOLU(24)=RVOLU(24) + DGMOUT
849C IN
850 RVOLUV(22,II)=RVOLUV(22,II) - DGEOUT
851 RVOLUV(24,II)=RVOLUV(24,II) - DGMOUT
852C
853 RADVOIS= IVOLUV(10,II)
854 DO IJ=1,NJET
855 I_INJ = IABS(IBAGJET(13,IJ))
856 I_TYPINJ = IGEO(22,I_INJ)
857 NGASES = IGEO(23,I_INJ)
858 NFT=RADVOIS+NRBJET*(IJ-1)
859C
860 DO IK=1,NGASES
861 IF (I_TYPINJ==1) THEN
862 I_GAS = IGEO(100+(IK-1)*3+1,I_INJ)
863 ELSE IF (I_TYPINJ==2) THEN
864 I_GAS = IGEO(100+(IK-1)*2+1,I_INJ)
865 END IF
866 MW = PM(20,I_GAS)
867 RMWG = R_IGC1/MW
868 CPA =PM(21,I_GAS)
869 CPB =PM(22,I_GAS)
870 CPC =PM(23,I_GAS)
871 CPD =PM(24,I_GAS)
872 CPE =PM(25,I_GAS)
873 CPF =PM(26,I_GAS)
874 KK=20+(IK-1)*4
875 GMTOT= RBAGJET(KK+1,IJ)
876 RNMG =GMTOT*RMWG
877 DGMOUT=RNMG/MAX(EM20,RNM)*DMOUT
878 DGEOUT=DGMOUT*TBAG*(
879 . CPA+HALF*CPB*TBAG+THIRD*CPC*TBAG*TBAG
880 . +FOURTH*CPD*TBAG*TBAG*TBAG
881 . -CPE/(TBAG*TBAG)
882 . +ONE_FIFTH*CPF*TBAG*TBAG*TBAG*TBAG)
883C OUT
884 RBAGJET(KK+3,IJ) = RBAGJET(KK+3,IJ)+DGMOUT
885 RBAGJET(KK+4,IJ) = RBAGJET(KK+4,IJ)+DGEOUT
886 RBAGJET( 9,IJ) = RBAGJET( 9,IJ)+DGMOUT
887 RBAGJET(10,IJ) = RBAGJET(10,IJ)+DGEOUT
888C IN
889 RBAGVJET(NFT+KK+3) = RBAGVJET(NFT+KK+3)-DGMOUT
890 RBAGVJET(NFT+KK+4) = RBAGVJET(NFT+KK+4)-DGEOUT
891 RBAGVJET(NFT+ 9) = RBAGVJET(NFT+ 9)-DGMOUT
892 RBAGVJET(NFT+10) = RBAGVJET(NFT+10)-DGEOUT
893 ENDDO
894 ENDDO
895 IF(ISPMD+1==PMAIN) THEN
896 FSAV(8)=FSAV(8)+AOUT
897 FSAV(9)=FSAV(9)+FLOUT
898 ENDIF
899 ENDDO ! I=1,NAV
900
901 IF(ISPMD+1==PMAIN) THEN
902 FSAV(9)=FSAV(9)/MAX(EM20,FSAV(8))
903 ENDIF
904C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
905 RETURN
906 END
airbagb1
subroutine airbagb1(ivolu, icbag, njet, ibagjet, nvent, ibaghol, rvolu, rvoluv, rcbag, rbagjet, rbaghol, fsav, normal, nn, igrsurf, poro, ivoluv, rbagvjet, fr_mv, iparg, ipart, ipartc, iparttg, ipm, pm, elbuf_tab, igroupc, igrouptg, igeo, geo)
Definition airbagb1.F:46
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
poro
subroutine poro(geo, nodpor, ms, x, v, w, af, am, skew, weight, nporgeo)
Definition poro.F:40