57
58
59
60
61
62
63
69 USE sensor_mod
70 use element_mod , only : nixc,nixtg
71
72
73
74#include "implicit_f.inc"
75
76
77
78
79#include "com04_c.inc"
80
81#include "param_c.inc"
82
83#include "units_c.inc"
84
85#include "scr03_c.inc"
86
87
88
89 TYPE(UNIT_TYPE_), INTENT(IN) :: UNITAB
90 INTEGER, INTENT(IN) :: LUID, IPM(NPROPMI, NUMMAT), IGEO(NPROPGI, NUMGEO), ITABM1(NUMNOD)
91 INTEGER, INTENT(IN) :: NPC(*), ITAB(NUMNOD), IXC(NIXC, NUMELC), IXTG(NIXTG, NUMELTG)
92 my_real,
INTENT(IN) :: x(3, numnod), geo(npropg, numgeo), pm(npropm, nummat),
93 . xframe(nxframe, numfram+1)
94 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
95 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
96 TYPE (GROUP_) , DIMENSION(NGRBRIC), INTENT(IN) :: IGRBRIC
97 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
98 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
99
100
101
102 INTEGER :: II, JJ
103 INTEGER :: SURFID, SURFID_INT,SURFID_INJ
104 my_real :: fac_m, fac_l, fac_t, fac_c
105 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
106 LOGICAL :: FOUND
107 my_real :: sa, rot, vol, vmin, veps, amu, sv
108 INTEGER :: MID_INI, IEQUI, ITTF, MID_INISYS
109 my_real :: hconv, pext, ti, pini
110 my_real :: mwi, cpai, cpbi, cpci, cpdi, cpei, cpfi, r_igc1, cpi, rmwi, cvi, gamai
111 INTEGER :: NJET
112 INTEGER, DIMENSION(:), ALLOCATABLE :: I_INJ, ISENS, IJET, NJ1, NJ2, NJ3,
113 . IPT, IPA, IPZ, I_INJSYS,IVEL
114 my_real,
DIMENSION(:),
ALLOCATABLE :: fpt, fpa, fpz,fvel
115 INTEGER :: NVENTHOLES, NPORSURF, NVENT
116 CHARACTER(LEN = 40) :: MESS
117 CHARACTER(LEN = 20) :: VENTTITLE
118 INTEGER :: TITREVENT(20)
119 INTEGER, DIMENSION(:), ALLOCATABLE :: IPVENT, IFVENT, IDTPDEF, IPORT, IPORP, IPORA,
120 . IPORT1, IPORP1, IPORA1, IVDP, IBLOCKAGE
121 my_real,
DIMENSION(:),
ALLOCATABLE :: avent, bvent, tvent, tstope, dpdef, dtpdef,
122 . fport, fporp, fpora, fport1, fporp1, fpora1, fvdp, cleak
124 CHARACTER(LEN = nchartitle) :: TITR1
125 my_real :: mi, rhoi, ti2, especi, cpa, cpb, cpc, cpd, cpe, cpf, mw_tmp, rmwg,
126 . cpg, cvg, gama, shol
127 LOGICAL lFOUND
128 INTEGER IMESH_ALL, NSWITCH, ISWITCH, NBX, NBY, NBZ, IBRIC
129 INTEGER IREF, IGMERG, ILVOUT, NLAYER, NFACMAX, NPPMAX, IFVANI
130 INTEGER I1,I2,I3, I4, NBRIC, NN, ISH34
131 my_real tswitch, pswitch, lx, ly, lz, cnmerg, qa, qb, ptole,hmin, cfl_coef, dtmin, sjet, cgmerg
132 my_real nx, ny, nz, xx, yy, zz, x13, y13, z13, x24, y24, z24
133 my_real origx, origy, origz, dir2x, dir2y, dir2z, dir, ds, dirx, diry, dirz
134 INTEGER :: KMESH,ID_DT_OPTION, IH3D_FLAG
135 LOGICAL :: IS_AVAILABLE
136
137
138
139 INTEGER USR2SYS
141
142
143
144 mess = 'MONITORED VOLUME DEFINITION '
145 lfound=.false.
146 id_dt_option=2
147 rmwi = zero
148
149
150
151
152
153 CALL hm_get_intv(
'surf_IDex', surfid, is_available, lsubmodel)
154 CALL hm_get_intv(
'surf_IDin', surfid_int, is_available, lsubmodel)
155 CALL hm_get_floatv(
'HEAT_T0',hconv, is_available, lsubmodel, unitab)
156 CALL hm_get_intv(
'IH3D', ih3d_flag, is_available, lsubmodel)
157
158
159 CALL hm_get_intv(
'mat_ID', mid_ini, is_available, lsubmodel)
160 CALL hm_get_floatv(
'Pext', pext, is_available, lsubmodel, unitab)
161 CALL hm_get_floatv(
'T0', ti, is_available, lsubmodel, unitab)
162 CALL hm_get_intv(
'Ittf', ittf, is_available, lsubmodel)
163
164 CALL hm_get_intv(
'Njet', njet, is_available, lsubmodel)
165
166 t_monvoln%NJET = njet
167 t_monvoln%IVOLU(8) = njet
168 IF (njet > 0) THEN
169 ALLOCATE(t_monvoln%IBAGJET(nibjet, njet))
170 t_monvoln%IBAGJET(1:nibjet, 1:njet) = 0
171 ALLOCATE(t_monvoln%RBAGJET(nrbjet, njet))
172 t_monvoln%RBAGJET(1:nrbjet, 1:njet) = zero
173 ENDIF
174 IF (njet > 0) THEN
175 ALLOCATE(i_inj(njet), isens(njet), ijet(njet), nj1(njet), nj2(njet), nj3(njet))
176 ALLOCATE(ipt(njet), ipa(njet), ipz(njet), fpt(njet), fpa(njet), fpz(njet))
177 ALLOCATE(ivel(njet),fvel(njet))
178
179 i_inj(1:njet) = 0
180 isens(1:njet) = 0
181 ijet(1:njet) = 0
182 nj1(1:njet) = 0
183 nj2(1:njet) = 0
184 nj3(1:njet) = 0
185 ipt(1:njet) = 0
186 ipa(1:njet) = 0
187 ipz(1:njet) = 0
188 fpt(1:njet) = zero
189 fpa(1:njet) = zero
190 fpz(1:njet) = zero
191 ivel(1:njet) = 0
192 fvel(1:njet) = zero
193 DO ii = 1, njet
197 ENDDO
198 ENDIF
199
200 CALL hm_get_intv(
'Nvent', nventholes, is_available, lsubmodel)
201 CALL hm_get_intv(
'Nporsurf', nporsurf, is_available, lsubmodel)
202
203 nvent = nventholes + nporsurf
204 t_monvoln%IVOLU(11) = nvent
205 t_monvoln%NVENT = nvent
206 t_monvoln%NPORSURF = nporsurf
207 IF (nvent > 0) THEN
208 ALLOCATE(t_monvoln%IBAGHOL(nibhol, nvent))
209 t_monvoln%IBAGHOL(1:nibhol, 1:nvent) = 0
210 ALLOCATE(t_monvoln%RBAGHOL(nrbhol, nvent))
211 t_monvoln%RBAGHOL(1:nrbhol, 1:nvent) = zero
212 ENDIF
213
214 ALLOCATE(ipvent(nvent), ifvent(nvent), avent(nvent), bvent(nvent))
215 ALLOCATE(tvent(nvent), tstope(nvent), dpdef(nvent), dtpdef(nvent),
216 . idtpdef(nvent))
217 ALLOCATE(iport(nvent), iporp(nvent), ipora(nvent), fport(nvent),
218 . fporp(nvent), fpora(nvent))
219 ALLOCATE(iport1(nvent), iporp1(nvent), ipora1(nvent), fport1(nvent),
220 . fporp1(nvent), fpora1(nvent))
221 ALLOCATE(iblockage(nvent), cleak(nvent))
222 ALLOCATE(ivdp(nvent), fvdp(nvent))
223
224 IF (nventholes > 0) THEN
225 DO ii = 1, nventholes
226 venttitle = ''
232 IF (ifvent(ii) == 0) ifvent(ii) = 1
238 DO jj = 1, 20
239 titrevent(jj) = iachar(venttitle(jj:jj))
240 t_monvoln%IBAGHOL(jj + 14, ii) = titrevent(jj)
241 ENDDO
248
255
256 IF (ifvent(ii) == 2) THEN
259 ELSE
260 ivdp(ii) = 0
261 fvdp(ii) = zero
262 ENDIF
263 ENDDO
264 ENDIF
265 IF (nporsurf > 0) THEN
266 DO ii = 1, nporsurf
267 venttitle = ''
272 DO jj = 1, 20
273 titrevent(jj) = iachar(venttitle(jj:jj))
274 t_monvoln%IBAGHOL(jj + 14, nventholes + ii) = titrevent(jj)
275 ENDDO
276
282 cleak(nventholes + ii) = zero
283 avent(nventholes + ii) = zero
284 iport(nventholes + ii) = 0
285 ipora(nventholes + ii) = 0
286 fport(nventholes + ii) = zero
287 fpora(nventholes + ii) = zero
288 IF (ifvent(nventholes + ii) == 0) ifvent(nventholes + ii) = 1
289 IF (ifvent(nventholes + ii) == 3) ifvent(nventholes + ii) = 5
290 ivdp(nventholes + ii) = 0
291 fvdp(nventholes + ii) = zero
292 IF (ifvent(nventholes + ii) == 2) THEN
295 ENDIF
296 ENDDO
297 ENDIF
298
299 kmesh = 14
300 imesh_all = 0
301 CALL hm_get_floatv(
'Cgmerg', cgmerg, is_available, lsubmodel, unitab)
302 CALL hm_get_floatv(
'Tswitch', tswitch, is_available, lsubmodel, unitab)
303 CALL hm_get_intv(
'Iswitch', iswitch, is_available, lsubmodel)
304 CALL hm_get_floatv(
'Pswitch', pswitch, is_available, lsubmodel, unitab)
305
306 CALL hm_get_floatv(
'Dtsca', cfl_coef, is_available, lsubmodel, unitab)
307 CALL hm_get_floatv(
'Dtmin', dtmin, is_available, lsubmodel, unitab)
308
309 jj = 1
310
311 dirx = xframe(7, jj)
312 diry = xframe(8, jj)
313 dirz = xframe(9, jj)
314 dir2x = xframe(1, jj)
315 dir2y = xframe(2, jj)
316 dir2z = xframe(3, jj)
317 origx = xframe(10, jj)
318 origy = xframe(11, jj)
319 origz = xframe(12, jj)
320
321
322
323
324 fac_m = unitab%FAC_M(luid)
325 fac_l = unitab%FAC_L(luid)
326 fac_t = unitab%FAC_T(luid)
327 fac_c = fac_m / (fac_l * fac_t * fac_t)
328
329
330
331
332
333 t_monvoln%IVOLU(4) = 0
334 t_monvoln%EXT_SURFID = 0
335 found = .false.
336 DO ii = 1, nsurf
337 IF (surfid == igrsurf(ii)%ID) THEN
338 t_monvoln%IVOLU(4) = ii
339 t_monvoln%EXT_SURFID = ii
340 found = .true.
341 EXIT
342 ENDIF
343 ENDDO
344 IF (.NOT. found) THEN
346 ELSEIF (igrsurf(t_monvoln%IVOLU(4))%ISH4N3N == 0) THEN
347 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
348 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
350 ENDIF
351
352
354
356 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 11)
357
358 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
359 . itab, x, pm, geo, ixc, ixtg,
360 . sa, rot, vol, vmin, veps, sv)
361
363 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 11)
364
365 IF (ittf < 0 .OR. ittf > 3) THEN
366 CALL ancmsg(msgid = 773, anmode = aninfo, msgtype = msgerror,
367 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
368 ENDIF
369 IF (ti == zero) THEN
370 ti = twohundred95
371 ENDIF
372
373 t_monvoln%IVOLU(66) = 0
374 found = .false.
375 DO ii = 1, nummat
376 IF (ipm(1, ii) == mid_ini .AND. ipm(2, ii) == 999) THEN
377 mwi = pm(20, ii) * fac_m
378 cpai = pm(21, ii) * fac_l * fac_l / (fac_t * fac_t)
379 cpbi = pm(22, ii) * fac_l * fac_l / (fac_t * fac_t)
380 cpci = pm(23, ii) * fac_l * fac_l / (fac_t * fac_t)
381 cpdi = pm(24, ii) * fac_l * fac_l / (fac_t * fac_t)
382 cpei = pm(25, ii) * fac_l * fac_l / (fac_t * fac_t)
383 cpfi = pm(26, ii) * fac_l * fac_l / (fac_t * fac_t)
384 r_igc1 = pm(27, ii)
385 cpi = cpai + cpbi * ti + cpci * ti * ti + cpdi * ti * ti * ti +
386 . cpei / (ti * ti) + cpfi * ti * ti * ti * ti
387 rmwi = r_igc1 / mwi
388 cvi = cpi - rmwi
389 t_monvoln%IVOLU(66) = ii
390 IF (cvi == zero) THEN
391 CALL ancmsg(msgid = 709, msgtype = msgerror, anmode = aninfo,
392 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
393 gamai = zero
394 ELSE
395 gamai = cpi / cvi
396 END IF
397 found = .true.
398 EXIT
399 ENDIF
400 ENDDO
401 IF (.NOT. found) THEN
402 CALL ancmsg(msgid = 699, anmode = aninfo, msgtype = msgerror,
403 . i2 = mid_ini, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
404 ENDIF
405
406 IF (njet > 0) THEN
407 ALLOCATE(i_injsys(njet))
408 DO ii = 1, njet
409
410 i_injsys(ii) = 0
411 found = .false.
412 DO jj = 1, numgeo
413 IF (igeo(1, jj) == i_inj(ii)) THEN
414 i_injsys(ii) = jj
415 found = .true.
416 EXIT
417 ENDIF
418 ENDDO
419 IF (.NOT. found) THEN
420 CALL ancmsg(msgid = 723, anmode = aninfo, msgtype = msgerror,
421 . i2 = i_inj(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
422 ENDIF
423 ENDDO
424 ENDIF
425
426
427 t_monvoln%IVOLU(61)=0
428
429
430 t_monvoln%IVOLU(67)=0
431 t_monvoln%INT_SURFID = 0
432 IF(surfid_int>0) THEN
433 DO ii=1,nsurf
434 IF (surfid_int==igrsurf(ii)%ID) THEN
435 t_monvoln%IVOLU(67) = ii
436 t_monvoln%INT_SURFID = ii
437 EXIT
438 ENDIF
439 ENDDO
440 ENDIF
441
442 nbric=0
443 IF(t_monvoln%IVOLU(61)/=0) nbric=igrbric(t_monvoln%IVOLU(61))%ID
444 surfid_int=0
445 IF(t_monvoln%INT_SURFID/=0) surfid_int=igrsurf(t_monvoln%INT_SURFID)%ID
446
447
448
449
450 IF(ih3d_flag /= 0)THEN
451 IF(ih3d_flag /= -1 .AND. ih3d_flag /= 1)THEN
452 ih3d_flag = -1
453 ENDIF
454 ENDIF
455
456
457
458
459 scal_t = one
460 scal_p = one
461 scal_s = one
462 scal_a = one
463 scal_d = one
464 amu = em02
465 IF (pext == zero) THEN
466 pext = 101325.d0 * (unitab%FAC_L_WORK * unitab%FAC_T_WORK * unitab%FAC_T_WORK) / unitab%FAC_M_WORK
467 ENDIF
468 pini = pext
469 lx = zero
470 ly = zero
471 lz = zero
472 ibric = 0
473 nbx = 0
474 nby = 0
475 nbz = 0
476 iref = 0
477 igmerg = 1
478 cnmerg = em04
479 ptole = zero
480 qa = zero
481 qb = zero
482 hmin = zero
483 ilvout = 0
484 nlayer = 0
485 nfacmax = 0
486 nppmax = 0
487 ifvani = 0
488 nswitch = 0
489
490 IF (njet > 0) THEN
491 DO ii = 1, njet
492 IF (ijet(ii) > 0) THEN
493 IF (fpt(ii) == zero) fpt(ii) = one
494 IF (fpa(ii) == zero) fpa(ii) = one
495 IF (fpz(ii) == zero) fpz(ii) = one
496 ELSE
497 fpt(ii) = one
498 fpa(ii) = one
499 fpz(ii) = one
500 ENDIF
501 ivel(ii) = 0
502 fvel(ii) = three100 * unitab%FAC_T_WORK / unitab%FAC_L_WORK
503 ENDDO
504 ENDIF
505
506 IF (nventholes > 0) THEN
507 DO ii = 1, nventholes
508 IF (ipvent(ii) == 0) THEN
509 bvent(ii) = zero
510 ENDIF
511 IF (fport(ii) == zero) fport(ii) = one
512 IF (fporp(ii) == zero) fporp(ii) = one
513 IF (fpora(ii) == zero) fpora(ii) = one
514 IF (fport1(ii) == zero) fport1(ii) = one
515 IF (fporp1(ii) == zero) fporp1(ii) = one
516 IF (fpora1(ii) == zero) fpora1(ii) = one
517 ENDDO
518 ENDIF
519
520
521 DO ii=1,njet
522 t_monvoln%IBAGJET(14,ii) = 0
523 lfound=.false.
524 DO jj=1,nsurf
525 IF (ijet(ii)==igrsurf(jj)%ID) THEN
526 t_monvoln%IBAGJET(14, ii) = jj
527 lfound=.true.
528 EXIT
529 ENDIF
530 ENDDO
531 ijet(ii) = 0
532 IF(.NOT.lfound)
CALL ancmsg(msgid=847,anmode=aninfo,msgtype=msgerror,i2=ijet(ii),i1=t_monvoln%ID,c1=t_monvoln%TITLE)
533 DO jj=1,nfunct
534 IF (ivel(ii)==npc(jj)) t_monvoln%IBAGJET(11, ii)=jj
535 ENDDO
536 IF (fvel(ii) == zero) fvel(ii) = one
537 ENDDO
538
539 IF(tswitch == zero) tswitch=ep20
540
541 IF (nbx==0) nbx=1
542 IF (nby==0) nby=1
543 IF (nbz==0) nbz=1
544
545
546 IF (igmerg==0) igmerg=1
547 IF (cgmerg == zero) cgmerg = em01
548 IF (ptole==zero) ptole=em5
549 IF (nlayer ==0) nlayer =10
550 IF (nfacmax==0) nfacmax=20
551 IF (nppmax ==0) nppmax =20
552
553 IF(cfl_coef/=zero .AND. dtmin/=zero)id_dt_option=1
554 IF(cfl_coef==zero)cfl_coef=zep9
555 IF(dtmin==zero)dtmin=em20
556
557
558
559
560
561 t_monvoln%IMESH_ALL = imesh_all
562 t_monvoln%IVOLU(8) = njet
563 iequi = 1
564 t_monvoln%IVOLU(15) = iequi
565 t_monvoln%IVOLU(17) = ittf
566 t_monvoln%IVOLU(27) = id_dt_option
567 t_monvoln%IVOLU(30) = kmesh
568 t_monvoln%IVOLU(35)=nbx*nby
569 t_monvoln%IVOLU(37) = nswitch
570 t_monvoln%IVOLU(40)=nlayer
571 t_monvoln%IVOLU(41)=nfacmax
572 t_monvoln%IVOLU(42)=nppmax
573 t_monvoln%IVOLU(44)=ilvout
574 t_monvoln%IVOLU(54)=nbx
575 t_monvoln%IVOLU(55)=nby
576 t_monvoln%IVOLU(59)=iref
577 t_monvoln%IVOLU(60)=igmerg
578 t_monvoln%IVOLU(65)=nbz
579 t_monvoln%IVOLU(74) = iswitch
580 t_monvoln%IVOLU(75) = ih3d_flag
581
582 t_monvoln%RVOLU(19) = hconv
583 t_monvoln%RVOLU(26) = one / scal_t
584 t_monvoln%RVOLU(27) = one / scal_p
585 t_monvoln%RVOLU(28) = one / scal_s
586 t_monvoln%RVOLU(29) = one / scal_a
587 t_monvoln%RVOLU(30) = one / scal_d
588 t_monvoln%RVOLU(31)=cgmerg
589 t_monvoln%RVOLU(34)=cnmerg
590 t_monvoln%RVOLU(35)=dirx
591 t_monvoln%RVOLU(36)=diry
592 t_monvoln%RVOLU(37)=dirz
593 t_monvoln%RVOLU(38)=dir2x
594 t_monvoln%RVOLU(39)=dir2y
595 t_monvoln%RVOLU(40)=dir2z
596 t_monvoln%RVOLU(41)=origx
597 t_monvoln%RVOLU(42)=origy
598 t_monvoln%RVOLU(43)=origz
599 t_monvoln%RVOLU(44)=lx
600 t_monvoln%RVOLU(45)=ly
601 t_monvoln%RVOLU(46)=qa
602 t_monvoln%RVOLU(47)=qb
603 t_monvoln%RVOLU(50)=ptole
604 t_monvoln%RVOLU(51)=hmin
605 t_monvoln%RVOLU(53)=lz
606 t_monvoln%RVOLU(70) = tswitch
607 t_monvoln%RVOLU(71) = cfl_coef
608 t_monvoln%RVOLU(72) = dtmin
609 t_monvoln%RVOLU(73) = pswitch
610
611
612 mid_inisys = t_monvoln%IVOLU(66)
613 IF (mid_inisys /= 0) THEN
614 mwi = pm(20, mid_inisys)
615 cpai = pm(21, mid_inisys)
616 cpbi = pm(22, mid_inisys)
617 cpci = pm(23, mid_inisys)
618 cpdi = pm(24, mid_inisys)
619 cpei = pm(25, mid_inisys)
620 cpfi = pm(26, mid_inisys)
621 r_igc1 = pm(27, mid_inisys)
622 ELSE
623 mwi = zero
624 cpai = zero
625 cpbi = zero
626 cpci = zero
627 cpdi = zero
628 cpei = zero
629 cpfi = zero
630 r_igc1 = zero
631 CALL ancmsg(msgid= 7 18, anmode = aninfo, msgtype = msgerror,
632 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
633 ENDIF
634 t_monvoln%RVOLU(7)=cpai
635 t_monvoln%RVOLU(8)=cpbi
636 t_monvoln%RVOLU(9)=cpci
637 t_monvoln%RVOLU(56)=cpdi
638 t_monvoln%RVOLU(57)=cpei
639 t_monvoln%RVOLU(58)=cpfi
640 t_monvoln%RVOLU(59)=mwi
641 cpi = cpai + cpbi * ti + cpci * ti * ti + cpdi * ti * ti * ti +
642 . cpei / (ti * ti) + cpfi * ti * ti * ti * ti
643 IF (mwi == zero) THEN
644 gamai = zero
645 ELSE
646 rmwi = r_igc1 / mwi
647 cvi = cpi - rmwi
648 gamai = cpi / cvi
649 ENDIF
650 mi = pini * (vol + veps) / (rmwi * ti)
651 t_monvoln%RVOLU(1) = gamai
652 t_monvoln%RVOLU(3) = pext
653 t_monvoln%RVOLU(4) = vol + veps
654 t_monvoln%RVOLU(11) = mi
655 t_monvoln%RVOLU(12) = pini
656 t_monvoln%RVOLU(13) = ti
657 t_monvoln%RVOLU(14) = rmwi * mi
658 t_monvoln%RVOLU(17) = veps
659 t_monvoln%RVOLU(20) = mi
660 t_monvoln%RVOLU(25) = ti
661 t_monvoln%RVOLU(61) = gamai
662 rhoi = pini / (ti * rmwi)
663 t_monvoln%RVOLU(62) = rhoi
664 t_monvoln%RVOLU(10) = rmwi
665 ti2=ti*ti
666 especi=ti*(cpai+half*cpbi*ti+third*cpci*ti2-rmwi)
667 especi=especi+fourth*cpdi*ti2*ti2-cpei/ti+one_fifth*cpfi*ti2*ti2*ti
668 t_monvoln%RVOLU(63)= especi+rmwi*ti
669 t_monvoln%RVOLU(64)= zero
670 t_monvoln%RVOLU(65)= zero
671 t_monvoln%RVOLU(66)= especi
672
673 ttfire = infinity
674 DO ii = 1, njet
675
676 t_monvoln%RBAGJET(15,ii)=fvel(ii)
677
678 t_monvoln%IBAGJET(13, ii) = i_injsys(ii)
679 t_monvoln%RBAGJET(1, ii) = zero
680 t_monvoln%RBAGJET(2, ii) = geo(203, i_injsys(ii))
681 t_monvoln%RBAGJET(3, ii) = geo(204, i_injsys(ii))
682 t_monvoln%RBAGJET(4, ii) = geo(205, i_injsys(ii))
683 t_monvoln%RBAGJET(16, ii) = geo(206, i_injsys(ii))
684 t_monvoln%RBAGJET(17, ii) = geo(207, i_injsys(ii))
685 t_monvoln%RBAGJET(18, ii) = geo(208, i_injsys(ii))
686 t_monvoln%RBAGJET(19, ii) = geo(202, i_injsys(ii))
687 t_monvoln%RBAGJET(5, ii) = zero
688 t_monvoln%RBAGJET(6, ii) = zero
689 t_monvoln%RBAGJET(12, ii) = fpt(ii)
690 t_monvoln%RBAGJET(13, ii) = fpa(ii)
691 t_monvoln%RBAGJET(14, ii) = fpz(ii)
692 t_monvoln%IBAGJET(2, ii) = 0
693 t_monvoln%IBAGJET(3, ii) = 0
694 t_monvoln%IBAGJET(4, ii) = isens(ii)
695
696 IF (ijet(ii) > 0) THEN
697 t_monvoln%IBAGJET(5, ii) =
usr2sys(nj1(ii), itabm1, mess, t_monvoln%ID)
698 t_monvoln%IBAGJET(6, ii) =
usr2sys(nj2(ii), itabm1, mess, t_monvoln%ID)
699 IF(nj3(ii) /= 0) THEN
700 t_monvoln%IBAGJET(7, ii) =
usr2sys(nj3(ii), itabm1, mess, t_monvoln%ID)
701 ENDIF
702 found = .false.
703 DO jj= 1, nfunct
704 IF (ipt(ii) == npc(jj)) THEN
705 t_monvoln%IBAGJET(8, ii) = jj
706 found = .true.
707 EXIT
708 ENDIF
709 ENDDO
710 IF (.NOT. found) THEN
711 CALL ancmsg(msgid = 12, anmode = aninfo, msgtype = msgerror,
712 . i2 = ipt(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
713 ENDIF
714 found = .false.
715 DO jj = 1, nfunct
716 IF (ipa(ii) == npc(jj)) THEN
717 t_monvoln%IBAGJET(9, ii) = jj
718 found = .true.
719 EXIT
720 ENDIF
721 ENDDO
722 IF (.NOT. found) THEN
723 CALL ancmsg(msgid = 13, anmode = aninfo, msgtype = msgerror,
724 . i2 = ipa(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
725 ENDIF
726 found = .false.
727 DO jj = 1, nfunct
728 IF (ipz(ii) == npc(jj)) THEN
729 t_monvoln%IBAGJET(10, ii) = jj
730 found = .true.
731 EXIT
732 ENDIF
733 ENDDO
734 IF (.NOT. found) THEN
735 CALL ancmsg(msgid = 14, anmode = aninfo, msgtype = msgerror,
736 . i2 = ipz(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
737 ENDIF
738 ENDIF
739 IF (isens(ii) > 0) THEN
740 found = .false.
741 DO jj = 1, sensors%NSENSOR
742 IF (isens(ii) == sensors%SENSOR_TAB(jj)%SENS_ID) THEN
743 t_monvoln%IBAGJET(4, ii) = jj
744 IF (sensors%SENSOR_TAB(jj)%TCRIT < ttfire) ttfire = sensors%SENSOR_TAB(jj)%TCRIT
745 found = .true.
746 EXIT
747 ENDIF
748 ENDDO
749 IF (.NOT. found) THEN
750 CALL ancmsg(msgid = 17, anmode =aninfo, msgtype = msgerror,
751 . i2 = isens(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
752 ENDIF
753 ENDIF
754 cpa = t_monvoln%RBAGJET(2, ii)
755 cpb = t_monvoln%RBAGJET(3, ii)
756 cpc = t_monvoln%RBAGJET(4, ii)
757 cpd = t_monvoln%RBAGJET(16, ii)
758 cpe = t_monvoln%RBAGJET(17, ii)
759 cpf = t_monvoln%RBAGJET(18, ii)
760 mw_tmp = t_monvoln%RBAGJET(19, ii)
761 rmwg = r_igc1 / mw_tmp
762 cpg = cpa + cpb*ti+cpc*ti*ti+cpd*ti*ti*ti+
763 . cpe/(ti*ti)+cpf*ti*ti*ti*ti
764 cvg = cpg - rmwg
765 gama = cpg / cvg
766 t_monvoln%RBAGJET(1, ii) = rmwg
767 ENDDO
768 IF (ttfire == infinity) ttfire = zero
769 t_monvoln%RVOLU(49) = ttfire
770
771 DO ii = 1, nventholes
772 t_monvoln%RBAGHOL(7, ii) = fport(ii)
773 t_monvoln%RBAGHOL(8, ii) = fporp(ii)
774 t_monvoln%RBAGHOL(9, ii) = fpora(ii)
775 t_monvoln%RBAGHOL(10, ii) = fport1(ii)
776 t_monvoln%RBAGHOL(11, ii) = fporp1(ii)
777 t_monvoln%RBAGHOL(12, ii) = fpora1(ii)
778
779 t_monvoln%IBAGHOL(1, ii) = 0
780 IF (ifvent(ii) == 1) t_monvoln%IBAGHOL(10, ii) = 2
781 IF (ifvent(ii) == 2) t_monvoln%IBAGHOL(10, ii) = 3
782 IF (ifvent(ii) == 3) t_monvoln%IBAGHOL(10, ii) = 1
783
784 t_monvoln%IBAGHOL(11, ii) = idtpdef(ii)
785
786 t_monvoln%IBAGHOL(12, ii) = 0
787
788 IF (ipvent(ii) == 0) THEN
789 t_monvoln%IBAGHOL(2, ii) = 0
790 ELSE
791 t_monvoln%IBAGHOL(2, ii) = 0
792 found = .false.
793 DO jj = 1, nsurf
794 IF (ipvent(ii) == igrsurf(jj)%ID) THEN
795 t_monvoln%IBAGHOL(2, ii) = jj
796 found = .true.
797 EXIT
798 ENDIF
799 ENDDO
800 IF(.NOT. found)THEN
801 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
802 . i2 = ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
803 ELSEIF(igrsurf(t_monvoln%IBAGHOL(2, ii))%ISH4N3N == 0) THEN
804 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
805 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
806 ENDIF
807 IF (avent(ii) == zero) avent(ii) = one
808 ENDIF
809 IF (avent(ii) == zero) dpdef(ii) = infinity
810 IF (avent(ii) == zero) tvent(ii) = infinity
811 IF (dpdef(ii) == zero .AND. dtpdef(ii) == zero .AND. tvent(ii) == zero) THEN
812 t_monvoln%IBAGHOL(1, ii) = 1
813 ENDIF
814 t_monvoln%RBAGHOL(1, ii) = dpdef(ii)
815 t_monvoln%RBAGHOL(2, ii) = avent(ii)
816 t_monvoln%RBAGHOL(3, ii) = tvent(ii)
817 t_monvoln%RBAGHOL(4, ii) = dtpdef(ii)
818 t_monvoln%RBAGHOL(6, ii) = bvent(ii)
819 IF (ivdp(ii) /= 0 .AND. fvdp(ii) == zero) fvdp(ii) = one
820 t_monvoln%RBAGHOL(13, ii) = fvdp(ii)
821 IF (tstope(ii) == zero) tstope(ii) = infinity
822 t_monvoln%RBAGHOL(14, ii) = tstope(ii)
823
824 t_monvoln%IBAGHOL(3, ii) = -1
825 t_monvoln%IBAGHOL(4, ii) = -1
826 t_monvoln%IBAGHOL(5, ii) = -1
827 t_monvoln%IBAGHOL(6, ii) = -1
828 t_monvoln%IBAGHOL(7, ii) = -1
829 t_monvoln%IBAGHOL(8, ii) = -1
830 t_monvoln%IBAGHOL(9, ii) = -1
831 DO jj = 1, nfunct
832 IF (iport(ii) == npc(jj)) t_monvoln%IBAGHOL(3, ii) = jj
833 IF (iporp(ii) == npc(jj)) t_monvoln%IBAGHOL(4, ii) = jj
834 IF (ipora(ii) == npc(jj)) t_monvoln%IBAGHOL(5, ii) = jj
835 IF (iport1(ii) == npc(jj)) t_monvoln%IBAGHOL(6, ii) = jj
836 IF (iporp1(ii) == npc(jj)) t_monvoln%IBAGHOL(7, ii) = jj
837 IF (ipora1(ii) == npc(jj)) t_monvoln%IBAGHOL(8, ii) = jj
838 IF (ivdp(ii) == npc(jj)) t_monvoln%IBAGHOL(9, ii) = jj
839 ENDDO
840 IF (iport(ii) == 0) t_monvoln%IBAGHOL(3, ii) = 0
841 IF (iporp(ii) == 0) t_monvoln%IBAGHOL(4, ii) = 0
842 IF (ipora(ii) == 0) t_monvoln%IBAGHOL(5, ii) = 0
843 IF (iport1(ii) == 0) t_monvoln%IBAGHOL(6, ii) = 0
844 IF (iporp1(ii) == 0) t_monvoln%IBAGHOL(7, ii) = 0
845 IF (ipora1(ii) == 0) t_monvoln%IBAGHOL(8, ii) = 0
846 IF (ivdp(ii) == 0 .AND. ifvent(ii) /= 3) t_monvoln%IBAGHOL(9, ii) = 0
847 IF (t_monvoln%IBAGHOL(3, ii) == -1) THEN
848 t_monvoln%IBAGHOL(3, ii) = 0
849 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
850 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(ii))
851 ENDIF
852 IF (t_monvoln%IBAGHOL(4, ii) == -1) THEN
853 t_monvoln%IBAGHOL(4, ii) = 0
854 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
855 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp(ii))
856 ENDIF
857 IF (t_monvoln%IBAGHOL(5, ii) == -1) THEN
858 t_monvoln%IBAGHOL(5, ii)=0
859 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
860 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(ii))
861 ENDIF
862 IF (t_monvoln%IBAGHOL(6, ii) == -1) THEN
863 t_monvoln%IBAGHOL(6, ii) = 0
864 CALL ancmsg(msgid=331, anmode=aninfo, msgtype=msgerror,
865 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport1(ii))
866 ENDIF
867 IF (t_monvoln%IBAGHOL(7, ii) == -1) THEN
868 t_monvoln%IBAGHOL(7, ii)=0
869 CALL ancmsg(msgid=332, anmode=aninfo, msgtype=msgerror,
870 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp1(ii))
871 ENDIF
872 IF (t_monvoln%IBAGHOL(8, ii) == -1) THEN
873 t_monvoln%IBAGHOL(8, ii) = 0
874 CALL ancmsg(msgid=333, anmode=aninfo, msgtype=msgerror,
875 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora1(ii))
876 ENDIF
877 IF (t_monvoln%IBAGHOL(9, ii) == -1) THEN
878 t_monvoln%IBAGHOL(9, ii) = 0
879 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
880 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(ii))
881 ENDIF
882 ENDDO
883
884 DO ii = 1, nporsurf
885 t_monvoln%IBAGHOL(13, nventholes + ii) = 1
886 IF (ifvent(nventholes + ii) == 1) t_monvoln%IBAGHOL(10, nventholes + ii) = 2
887 IF (ifvent(nventholes + ii) == 2) t_monvoln%IBAGHOL(10, nventholes + ii) = 3
888 IF (fport(nventholes + ii) == zero) fport(nventholes + ii) = one
889 IF (fpora(nventholes + ii) == zero) fpora(nventholes + ii) = one
890 t_monvoln%RBAGHOL(7, nventholes + ii) = fport(nventholes + ii)
891 t_monvoln%RBAGHOL(9, nventholes + ii) = fpora(nventholes + ii)
892
893 t_monvoln%IBAGHOL(1, nventholes + ii) = 0
894 t_monvoln%IBAGHOL(11, nventholes + ii) = idtpdef(nventholes + ii)
895 t_monvoln%IBAGHOL(12, nventholes + ii) = 0
896 t_monvoln%IBAGHOL(14, nventholes + ii) = iblockage(nventholes + ii)
897
898 IF (ipvent(nventholes + ii) == 0) THEN
899 t_monvoln%IBAGHOL(2, nventholes + ii) = 0
900 ELSE
901 t_monvoln%IBAGHOL(2, nventholes + ii) = 0
902 DO jj = 1, nsurf
903 IF (ipvent(nventholes + ii) == igrsurf(jj)%ID) THEN
904 t_monvoln%IBAGHOL(2, nventholes + ii) = jj
905 ENDIF
906 ENDDO
907 IF (t_monvoln%IBAGHOL(2, nventholes + ii) == 0) THEN
908 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
909 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipvent(nventholes + ii))
910 ELSEIF (igrsurf(t_monvoln%IBAGHOL(2, nventholes + ii))%ISH4N3N == 0) THEN
911 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
912 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
913 ENDIF
914 ENDIF
915
916 IF (dpdef(nventholes + ii) == zero .AND. dtpdef(nventholes + ii) == zero .AND.
917 . tvent(nventholes + ii) == zero) THEN
918 t_monvoln%IBAGHOL(1, nventholes + ii) = 1
919 ENDIF
920 t_monvoln%RBAGHOL(1, nventholes + ii) = dpdef(nventholes + ii)
921 t_monvoln%RBAGHOL(2, nventholes + ii) = avent(nventholes + ii)
922 t_monvoln%RBAGHOL(3, nventholes + ii) = tvent(nventholes + ii)
923 t_monvoln%RBAGHOL(4, nventholes + ii) = dtpdef(nventholes + ii)
924 t_monvoln%RBAGHOL(6, nventholes + ii) = cleak(nventholes + ii)
925 IF (ivdp(nventholes + ii) /= 0 .AND. fvdp(nventholes + ii) == zero) fvdp=one
926 t_monvoln%RBAGHOL(13, nventholes + ii)=fvdp(nventholes + ii)
927 IF (tstope(nventholes + ii) == zero) tstope(nventholes + ii) = infinity
928 t_monvoln%RBAGHOL(14, nventholes + ii) = tstope(nventholes + ii)
929
930 t_monvoln%IBAGHOL(3, nventholes + ii) = -1
931 t_monvoln%IBAGHOL(5, nventholes + ii) = -1
932 t_monvoln%IBAGHOL(9, nventholes + ii) = -1
933
934 DO jj = 1, nfunct
935 IF (iport(nventholes + ii) == npc(jj)) THEN
936 t_monvoln%IBAGHOL(3, nventholes + ii) = jj
937 ENDIF
938 IF (ipora(nventholes + ii) == npc(jj)) THEN
939 t_monvoln%IBAGHOL(5, nventholes + ii) = jj
940 ENDIF
941 IF (ivdp(nventholes + ii) == npc(jj)) THEN
942 t_monvoln%IBAGHOL(9, nventholes + ii) = jj
943 ENDIF
944 ENDDO
945 IF (iport(nventholes + ii) == 0) t_monvoln%IBAGHOL(3, nventholes + ii) = 0
946 IF (ipora(nventholes + ii) == 0) t_monvoln%IBAGHOL(5, nventholes + ii) = 0
947 IF (ivdp(nventholes + ii) == 0 .AND. ifvent(nventholes + ii) /= 2) THEN
948 t_monvoln%IBAGHOL(9, nventholes + ii) = 0
949 ENDIF
950
951 IF (t_monvoln%IBAGHOL(3, nventholes + ii) == -1) THEN
952 t_monvoln%IBAGHOL(3, nventholes + ii) =0
953 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
954 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(nventholes + ii))
955 ENDIF
956 IF (t_monvoln%IBAGHOL(4, ii) == -1) THEN
957 t_monvoln%IBAGHOL(4, ii) = 0
958 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
959 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp(ii))
960 ENDIF
961 IF (t_monvoln%IBAGHOL(5, nventholes + ii) == -1) THEN
962 t_monvoln%IBAGHOL(5, nventholes + ii) = 0
963 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
964 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(nventholes + ii))
965 ENDIF
966 IF (t_monvoln%IBAGHOL(9, nventholes + ii) == -1) THEN
967 t_monvoln%IBAGHOL(9, nventholes + ii) = 0
968 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
969 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(nventholes + ii))
970 ENDIF
971 ENDDO
972
973
974 t_monvoln%RVOLU(2) = amu
975 t_monvoln%RVOLU(16) = vol + veps
976 t_monvoln%RVOLU(18) = sa
977 t_monvoln%RVOLU(21) = rot
978 t_monvoln%RVOLU(22:24) = zero
979
980
981
982
983 WRITE(iout, 1005) surfid
984 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
985 WRITE(iout, 1006) hconv
986 WRITE(iout, 1002) sa, sv, vol
987 WRITE(iout,1395) mid_ini
988 WRITE(iout,1400) amu, ti, pext, pini
989 IF (iequi == 0) THEN
990 WRITE(iout,1401)
991 ELSEIF(iequi == 1) THEN
992 WRITE(iout,1404)
993 ELSE
994 WRITE(iout,1405) iequi
995 ENDIF
996 WRITE(iout,1415) mwi, gamai, cpai, cpbi, cpci, cpdi, cpei, cpfi
997 WRITE(iout,1700)
998
999 IF(iswitch /= 0 .OR. tswitch /= zero .OR. pswitch /= zero)THEN
1000 WRITE(iout,1789) iswitch
1001 WRITE(iout,1790)
1002 WRITE(iout,1791)
1003 WRITE(iout,2703) tswitch
1004 WRITE(iout,2704) pswitch
1005 ENDIF
1006
1007 IF (t_monvoln%IMESH_ALL > 0) THEN
1008 WRITE(iout, 1706) t_monvoln%IMESH_ALL
1009 ENDIF
1010 WRITE(iout, 1711) t_monvoln%INT_SURFID, t_monvoln%IVOLU(60),
1011 . t_monvoln%RVOLU(31), t_monvoln%RVOLU(34),
1012 . t_monvoln%RVOLU(71), t_monvoln%RVOLU(72)
1013
1014
1015 WRITE(iout,1425)
1016 WRITE(iout,1426) njet
1017 DO ii = 1, njet
1018 WRITE(iout,1432) ii, igeo(1, i_injsys(ii)), isens(ii)
1019 WRITE(iout, 2435) fvel(ii)
1020 cpa = t_monvoln%RBAGJET(2, ii)
1021 cpb = t_monvoln%RBAGJET(3, ii)
1022 cpc = t_monvoln%RBAGJET(4, ii)
1023 cpd = t_monvoln%RBAGJET(16, ii)
1024 cpe = t_monvoln%RBAGJET(17, ii)
1025 cpf = t_monvoln%RBAGJET(18, ii)
1026 mw_tmp = t_monvoln%RBAGJET(19, ii)
1027 rmwg = r_igc1 / mw_tmp
1028 cpg = cpa + cpb*ti+cpc*ti*ti+cpd*ti*ti*ti+
1029 . cpe/(ti*ti)+cpf*ti*ti*ti*ti
1030 cvg = cpg - rmwg
1031 gama = cpg / cvg
1032 WRITE(iout,1442) gama, mw_tmp, cpa, cpb, cpc,
1033 . cpd, cpe, cpf
1034 surfid_inj = t_monvoln%IBAGJET(14, ii)
1035 sjet = zero
1036 IF (surfid_inj/=0) THEN
1037 IF (igrsurf(surfid_inj)%ISH4N3N == 0) THEN
1038 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
1039 . i2 = igrsurf(surfid_inj)%ID, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
1040 ELSE
1041 nn = igrsurf(surfid_inj)%NSEG
1042 DO jj = 1, nn
1043 dir = half
1044 i1 = igrsurf(surfid_inj)%NODES(jj,1)
1045 i2 = igrsurf(surfid_inj)%NODES(jj,2)
1046 i3 = igrsurf(surfid_inj)%NODES(jj,3)
1047 i4 = igrsurf(surfid_inj)%NODES(jj,4)
1048 ish34 = igrsurf(surfid_inj)%ELTYP(jj)
1049 IF (ish34 == 7)i4 = i3
1050 xx = half * (x(1, i1) + x(1, i2))
1051 yy = half * (x(2, i1) + x(2, i2))
1052 zz = half * (x(3, i1) + x(3, i2))
1053 x13 = x(1, i3) - x(1, i1)
1054 y13 = x(2, i3) - x(2, i1)
1055 z13 = x(3, i3) - x(3, i1)
1056 x24 = x(1, i4) - x(1, i2)
1057 y24 = x(2, i4) - x(2, i2)
1058 z24 = x(3, i4) - x(3, i2)
1059 nx = dir * (y13 * z24 - y24 * z13)
1060 ny = dir * (z13 * x24 - z24 * x13)
1061 nz = dir * (x13 * y24 - x24 * y13)
1062 ds = sqrt(nx * nx + ny * ny + nz * nz)
1063 sjet = sjet + ds
1064 ENDDO
1065 ENDIF
1066 WRITE(iout,1445) igrsurf(surfid_inj)%ID, sjet
1067 ENDIF
1068 ENDDO
1069 WRITE(iout,1470) nvent, ttfire
1070 WRITE(iout,1475)ittf
1071 DO ii = 1, nvent
1072 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
1073 titr1='VENT HOLE SURFACE'
1074 WRITE(iout,1472) ii, ipvent(ii)
1075 ELSE
1076 titr1='POROUS SURFACE'
1077 WRITE(iout,1473) ii, ipvent(ii)
1078 ENDIF
1079 DO jj = 1, 20
1080 titrevent(jj) = t_monvoln%IBAGHOL(jj + 14, ii)
1081 venttitle(jj:jj) = achar(titrevent(jj))
1082 ENDDO
1083 WRITE(iout,1476) venttitle
1084 IF (ipvent(ii)==0) THEN
1085 CALL ancmsg(msgid = 1050, msgtype = msgerror, anmode = aninfo,
1086 . i1 = t_monvoln%ID, i2 = ii, c1 = t_monvoln%TITLE, c2 = titr1)
1087 ENDIF
1088 IF (ifvent(ii) == 1) WRITE(iout, 1483)
1089 IF (ifvent(ii) == 2) WRITE(iout, 1481)
1090 IF (ifvent(ii) == 3) WRITE(iout, 1482) ivdp(ii), fvdp(ii)
1091 IF (ifvent(ii) == 5) WRITE(iout, 1484)
1092 IF (ifvent(ii) == 4) WRITE(iout, 1485)
1093 shol = zero
1094 IF (ipvent(ii) /= 0) THEN
1096 t_monvoln%RBAGHOL(15, ii) = shol
1097 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
1098 WRITE(iout,1479)
1099 . shol,avent(ii),bvent(ii),
1100 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
1101 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
1102 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1103 ELSE
1104 WRITE(iout,1579) shol,iblockage(ii)
1105 WRITE(iout,1580) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1106 ENDIF
1107 ELSE
1108 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
1109 WRITE(iout,1489)
1110 . avent(ii),bvent(ii),
1111 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
1112 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
1113 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1114 ELSE
1115 cleak =t_monvoln%RBAGHOL(6, ii)
1116 WRITE(iout,1585) cleak(ii),avent(ii),iport(ii),fport(ii),ipora(ii),fpora(ii)
1117 WRITE(iout,1580) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1118 ENDIF
1119 ENDIF
1120 ENDDO
1121
1122 IF(t_monvoln%IVOLU(75) == 1)THEN
1123 WRITE(iout,3001)1
1124 ENDIF
1125
1126
1127
1128
1129
1130 IF (ALLOCATED(i_inj)) DEALLOCATE(i_inj)
1131 IF (ALLOCATED(isens)) DEALLOCATE(isens)
1132 IF (ALLOCATED(ijet)) DEALLOCATE(ijet)
1133 IF (ALLOCATED(nj1)) DEALLOCATE(nj1)
1134 IF (ALLOCATED(nj2)) DEALLOCATE(nj2)
1135 IF (ALLOCATED(nj3)) DEALLOCATE(nj3)
1136 IF (ALLOCATED(ipt)) DEALLOCATE(ipt)
1137 IF (ALLOCATED(ipa)) DEALLOCATE(ipa)
1138 IF (ALLOCATED(ipz)) DEALLOCATE(ipz)
1139 IF (ALLOCATED(fpt)) DEALLOCATE(fpt)
1140 IF (ALLOCATED(fpa)) DEALLOCATE(fpa)
1141 IF (ALLOCATED(fpz)) DEALLOCATE(fpz)
1142 IF (ALLOCATED(i_injsys)) DEALLOCATE(i_injsys)
1143 DEALLOCATE(ipvent, ifvent, avent, bvent)
1144 DEALLOCATE(tvent, tstope, dpdef, dtpdef,
1145 . idtpdef)
1146 DEALLOCATE(iport, iporp, ipora, fport,
1147 . fporp, fpora)
1148 DEALLOCATE(iport1, iporp1, ipora1, fport1,
1149 . fporp1, fpora1)
1150 DEALLOCATE(iblockage, cleak)
1151 DEALLOCATE(ivdp, fvdp)
1152
1153
1154
1155
1156 RETURN
1157 1002 FORMAT(
1158 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
1159 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
1160 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
1161 1003 FORMAT(
1162 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
1163 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
1164 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
1165 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
1166 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
1167 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
1168 1006 FORMAT( 5x,'GLOBAL HEAT TRANSFER COEFFICIENT. . . .=',1pg20.13)
1169 1395 FORMAT(
1170 . /5x,'INITIAL GAS . . . . . . . . . . . . . .=',i10)
1171 1400 FORMAT(
1172 . 5x,'VOLUMIC VISCOSITY . . . . . . . . . . .=',1pg20.13,
1173 . /5x,'INITIAL TEMPERATURE . . . . . . . . . .=',1pg20.13,
1174 . /5x,'EXTERNAL PRESSURE . . . . . . . . . . .=',1pg20.13,
1175 . /5x,'INITIAL PRESSURE. . . . . . . . . . . .=',1pg20.13/)
1176 1401 FORMAT(
1177 . 5x,'INITIAL THERMODYNAMIC EQUILIBRIUM IS SET AT TIME 0'
1178 . /5x,'--------------------------------------------------'/)
1179 1404 FORMAT(
1180 . 5x,'THERMODYNAMIC EQUILIBRIUM IS SET EVERY CYCLE UP TO INJECTION TIME'/)
1181 1405 FORMAT(
1182 . 5x,'THERMODYNAMIC EQUILIBRIUM IS SET EVERY',i10,' CYCLES UP TO INJECTION TIME'/)
1183 1415 FORMAT(
1184 . 5x,'CHARACTERISTICS OF INITIAL GAZ ',
1185 . /5x,'------------------------------ ',
1186 . /5x,'MOLECULAR WEIGHT',
1187 . /5x,' AT INITIAL TEMPERATURE . . . . .=',1pg20.13,
1188 . /5x,'GAMMA AT INITIAL TEMPERATURE . . . . .=',1pg20.13,
1189 . /5x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1190 . /5x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1191 . /5x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,
1192 . /5x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,
1193 . /5x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,
1194 . /5x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13/)
1195 1425 FORMAT(
1196 . /5x,'INJECTORS ',
1197 . /5x,'--------- ')
1198 1426 FORMAT(
1199 . 5x,'NUMBER OF INJECTORS . . . . . . . . . .=',i10/)
1200 1432 FORMAT(
1201 . 5x,'INJECTOR. . . . . . . . . . . . . . . .=',i10,
1202 . /10x,'INJECTOR NUMBER . . . . . . . . . . . .=',i10,
1203 . /10x,'SENSOR NUMBER . . . . . . . . . . . . .=',i10)
1204 1442 FORMAT(
1205 . /15x,'MIXTURE CHARACTERISTICS ',
1206 . /15x,'AT BEGINNING OF INJECTION ',
1207 . /15x,'------------------------- ',
1208 . /15x,'GAMMA . . . . . . . . . . . . . . . . .=',1pg20.13,
1209 . /15x,'MOLECULAR WEIGHT. . . . . . . . . . . .=',1pg20.13,
1210 . /15x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1211 . /15x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1212 . /15x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,
1213 . /15x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,
1214 . /15x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,
1215 . /15x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13)
1216 1445 FORMAT(
1217 . 15x,'INFLATOR SURFACE ID . . . . . . . . . .=',i10,
1218 . /15x,'INITIAL SURFACE OF INFLATOR . . . . . .=',1pg20.13)
1219 1470 FORMAT(
1220 . /5x,'VENT HOLES AND POROUS FABRIC SURFACES ',
1221 . /5x,'------------------------------------- ',
1222 . /5x,'NUMBER OF VENT HOLES AND POROUS SURFACES . .=',i10,
1223 . /5x,'INJECTION TIME TINJ. . . . . . . . . . . . .=',1pg20.13)
1224 1472 FORMAT(
1225 . / 5x,'VENT HOLE NUMBER. . . . . . . . . . . .=',i10,
1226 . /15x,'VENT HOLE SURFACE ID. . . . . . . . . .=',i10)
1227 1473 FORMAT(
1228 . / 5x,'POROUS SURFACE NUMBER . . . . . . . . .=',i10,
1229 . /15x,'POROUS SURFACE ID . . . . . . . . . . .=',i10)
1230 1475 FORMAT(
1231 . 5x,'VENTING START TIME SHIFT . . . . . . . . . .=',i10,
1232 . /5x,' 0 : NO SHIFT',
1233 . /5x,' 1,2: VENTING FUNCTIONS ARE SHIFTED BY TINJ',
1234 . /5x,' 3 : VENTING FUNCTIONS ARE SHIFTED BY TINJ+TSTART')
1235 1476 FORMAT(
1236 . 15x,'TITLE . . . . . . . . . . . . . . . . .=',1x,a20)
1237 1481 FORMAT(15x,'ISENTHALPIC VENTING MODEL ')
1238 1482 FORMAT(15x,'CHEMKIN MODEL FOR POROSITY : ',
1239 . /15x,'VELOCITY VS RELATIVE PRESSURE FUNCTION =',i10,
1240 . /15x,' SCALE FACTOR. . . . . . .=',1pg20.13)
1241 1484 FORMAT(15x,'GRAEFE POROSITY FORMULATION')
1242 1485 FORMAT(15x,'ISENTHALPIC VENTING MODEL WITH POSSIBLE FLOW IN')
1243 1479 FORMAT(
1244 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
1245 . /15x,'AVENT:VENT HOLE SCALE FACTOR. . . . . .=',1pg20.13,
1246 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1247 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1248 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1249 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1250 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1251 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1252 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1253 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1254 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1255 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1256 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1257 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1258 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1259 1480 FORMAT(
1260 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1261 . /15x,'RELATIVE PRES. FOR MEMBRANE DEFLATION .=',1pg20.13,
1262 . /15x,' (DPDEF = PDEF - PEXT) ',
1263 . /15x,'TIME DELAY BEFORE MEMBRANE DEFLATION .=',1pg20.13,
1264 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1265 . /15x,' IF IDTPDEF : 0',
1266 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1267 . /15x,' A CUMULATED DTPDEF TIME'
1268 . /15x,' BEFORE ACTIVATING DEFLATION'
1269 . /15x,' IF IDTPDEF : 1',
1270 . /15x,' DEFLATION START DTPDEF AFTER',
1271 . /15x,' DPDEF HAS BEEN REACHED',
1272 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1273 1483 FORMAT(15x,'LOCAL VELOCITY VENTING FORMULATION')
1274 1489 FORMAT(
1275 . 15x,'AVENT:VENT HOLE AREA. . . . . . . . . .=',1pg20.13,
1276 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1277 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1278 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1279 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1280 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1281 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1282 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1283 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1284 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1285 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1286 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1287 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1288 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1289 1579 FORMAT(
1290 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
1291 . /15x,'BLOCKAGE IF CONTACT . . . . . . . . . .=',i10,
1292 . /15x,' =0 NO =1 YES')
1293 1580 FORMAT(
1294 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1295 . /15x,'RELATIVE PRESSURE TO INITIATE LEAKAGE .=',1pg20.13,
1296 . /15x,' (DPDEF = PDEF - PEXT) ',
1297 . /15x,'TIME DELAY BEFORE LEAKAGE . . . . . . .=',1pg20.13,
1298 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1299 . /15x,' IF IDTPDEF = 0',
1300 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1301 . /15x,' A CUMULATED DTPDEF TIME '
1302 . /15x,' BEFORE INITIATING LEAKAGE'
1303 . /15x,' IF IDTPDEF = 1',
1304 . /15x,' DEFLATION STARTS DTPDEF AFTER',
1305 . /15x,' DPDEF HAS BEEN REACHED',
1306 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1307 1585 FORMAT(
1308 . 15x,'LEAKAGE COEFFICIENT . . . . . . . . . .=',1pg20.13,
1309 . /15x,'LEAKAGE AREA. . . . . . . . . . . . . .=',1pg20.13,
1310 . /15x,'LEAKAGE COEFFICIENT TIME FUNCTION . . .=',i10,
1311 . /15x,' SCALE FACTOR. . . . . . . . . .=',1pg20.13,
1312 . /15x,'LEAKAGE AREA TIME FUNCTION. . . . . . .=',i10,
1313 . /15x,' SCALE FACTOR. . . . . . . . . .=',1pg20.13)
1314 1700 FORMAT(5x,'FVMBAG PARAMETERS ',
1315 . /5x,'----------------- ')
1316 1706 FORMAT(15x,'MESH HOLES. . . . . . . . . . . . . . .=',i10)
1317 1789 FORMAT(15x, 'SWITCH OPTION (ISWITCH). . . . . . . . =',i10)
1318 1790 FORMAT(15x, ' = 1 SWITCH TO UNIFORM PRESSURE')
1319 1791 FORMAT(15x, ' = 2 MERGE TO SINGLE FV INSIDE EACH CHAMBER')
1320 2703 FORMAT(15x, ' TIME (TSWITCH) . . . . . . . . . . =',1pg20.13)
1321 2704 FORMAT(15x, ' PRESSURE DEVIATION RATIO (PSWITCH) =',1pg20.13)
1322 1711 FORMAT(/15x,'INTERNAL SURFACE ID . . . . . . . . =',i10,
1323 . /15x,'CELL MERGING STRATEGY: ',
1324 . /15x,' GLOBAL MERGING TYPE. . . . . . . . .=',i10,
1325 . /15x,' GLOBAL MERGING COEFFICIENT . . . . .=',1pg20.13,
1326 . /15x,' NEIGHBORHOOD MERGING COEFFICIENT . .=',1pg20.13,
1327 . /15x,'DT SCALE FACTOR . . . . . . . . . . . .=',1pg20.13,
1328 . /15x,'MINIMUM TIMESTEP. . . . . . . . . . . .=',1pg20.13)
1329 2435 FORMAT(15x,'INCOMING GAS VELOCITY. . . . . . . . .=',1pg20.13)
1330 3001 FORMAT(
1331 . /5x,'DEBUG OPTIONS',
1332 . /5x,'-------------',
1333 . /5x,' IH3D_FLAG (H3D OUTPUT). . . . . . . .=', i10)
1334
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_get_string_index(name, sval, index, size, is_available)
subroutine monvol_check_venthole_surf(ipri, t_monvoln, igrsurf, ihol, shol, x, ixc, ixtg)
subroutine monvol_compute_volume(t_monvoln, title, ivolu, surf, itab, node_coord, pm, geo, ixc, ixtg, sa, rot, vol, vmin, veps, sv)
subroutine monvol_check_surfclose(t_monvoln, itab, surf, x)
subroutine monvol_orient_surf(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, x, itype)
subroutine monvol_reverse_normals(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, vol, x, itype)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
integer function usr2sys(iu, itabm1, mess, id)