OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
airbagb1.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "scr17_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ airbagb1()

subroutine airbagb1 ( integer, dimension(*) ivolu,
integer, dimension(nicbag,*) icbag,
integer njet,
integer, dimension(nibjet,*) ibagjet,
integer nvent,
integer, dimension(nibhol,*) ibaghol,
rvolu,
rvoluv,
rcbag,
rbagjet,
rbaghol,
fsav,
normal,
integer nn,
type (surf_), dimension(nsurf) igrsurf,
poro,
integer, dimension(nimv,*) ivoluv,
rbagvjet,
integer, dimension(*) fr_mv,
integer, dimension(nparg,*) iparg,
integer, dimension(lipart1,*) ipart,
integer, dimension(numelc) ipartc,
integer, dimension(numeltg) iparttg,
integer, dimension(npropmi,*) ipm,
pm,
type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(*) igroupc,
integer, dimension(*) igrouptg,
integer, dimension(npropgi,*) igeo,
geo )

Definition at line 38 of file airbagb1.F.

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 IF(idef==1 .AND. 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 IF(idef==0.AND.dtpdefc>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 IF(idef==0 .AND. 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 IF(idef==1 .AND. 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 IF (mtn/=19.AND.mtn/=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 ELSEIF(ileakage==2.OR.ileakage==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 IF(ipora/=0.AND.ipvent/=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 IF(ipora1/=0.AND.ipvent/=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 ELSEIF(ifvent==2.OR.ifvent==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 IF(ittf==0.OR.ittf==11.OR.ittf==12.OR.ittf==13)THEN
752 IF(idef==0.AND.p>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 IF(idef==0 .AND. 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 IF(idef==1 .AND. 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
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
porfor4
subroutine porfor4(svtfac, im, ipm, pm, strain, p, pext, iel, nel)
Definition porfor4.F:31
porfor5
subroutine porfor5(svtfac, im, ipm, pm, elbuf_str, p, pext, iel, nel)
Definition porfor5.F:33
porfor6
subroutine porfor6(svtfac, im, ipm, pm, strain, p, pext, iel, nel)
Definition porfor6.F:29
poro
subroutine poro(geo, nodpor, ms, x, v, w, af, am, skew, weight, nporgeo)
Definition poro.F:40
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:51