OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_monvol_type7_mod Module Reference

Functions/Subroutines

subroutine hm_read_monvol_type7 (t_monvoln, ipm, igeo, itabm1, sensors, unitab, luid, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_monvol_type7()

subroutine hm_read_monvol_type7_mod::hm_read_monvol_type7 ( type(monvol_struct_), intent(inout) t_monvoln,
integer, dimension(npropmi, *), intent(in) ipm,
integer, dimension(npropgi, *), intent(in) igeo,
integer, dimension(*), intent(in) itabm1,
type (sensors_), intent(in) sensors,
type(unit_type_), intent(in) unitab,
integer, intent(in) luid,
integer, dimension(*), intent(in) npc,
type (surf_), dimension(nsurf), intent(inout) igrsurf,
integer, dimension(*), intent(in) itab,
dimension(3, *), intent(in) x,
dimension(npropm, *), intent(in) pm,
dimension(npropg, *), intent(in) geo,
integer, dimension(nixc, *), intent(in) ixc,
integer, dimension(nixtg, *), intent(in) ixtg,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 55 of file hm_read_monvol_type7.F.

59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE unitab_mod
63 USE groupdef_mod
64 USE message_mod
66 USE submodel_mod
67 USE sensor_mod
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75C NSURF
76#include "com04_c.inc"
77C NIMV, NRVOLU
78#include "param_c.inc"
79C IIN
80#include "units_c.inc"
81C IPRI
82#include "scr03_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 TYPE(UNIT_TYPE_), INTENT(IN) :: UNITAB
87 INTEGER, INTENT(IN) :: LUID, IPM(NPROPMI, *), IGEO(NPROPGI, *), ITABM1(*)
88 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
89 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *)
90 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
91 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
92 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
93 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER :: II, JJ
98 INTEGER :: SURFID
99 my_real :: fac_m, fac_l, fac_t, fac_c, fac_gen
100 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
101 LOGICAL :: FOUND
102 my_real :: sa, rot, vol, vmin, veps, amu, sv
103 INTEGER :: MID_INI, IEQUI, ITTF, MID_INISYS
104 my_real :: hconv, pext, ti, pini
105 my_real :: mwi, cpai, cpbi, cpci, cpdi, cpei, cpfi, r_igc1, cpi, rmwi, cvi, gamai
106 INTEGER :: NJET
107 INTEGER, DIMENSION(:), ALLOCATABLE :: I_INJ, ISENS, IJET, NJ1, NJ2, NJ3, IPT, IPA, IPZ, I_INJSYS
108 my_real, DIMENSION(:), ALLOCATABLE :: fpt, fpa, fpz
109 INTEGER :: NVENTHOLES, NPORSURF, NVENT
110 CHARACTER(LEN = 40) :: MESS
111 CHARACTER(LEN = 20) :: VENTTITLE
112 INTEGER :: TITREVENT(20)
113 INTEGER, DIMENSION(:), ALLOCATABLE :: IPVENT, IFVENT, IDTPDEF, IPORT, IPORP, IPORA
114 INTEGER, DIMENSION(:), ALLOCATABLE :: IPORT1, IPORP1, IPORA1, IVDP, IBLOCKAGE
115 my_real, DIMENSION(:), ALLOCATABLE :: avent, bvent, tvent, tstope, dpdef, dtpdef
116 my_real, DIMENSION(:), ALLOCATABLE :: fport, fporp, fpora, fport1, fporp1, fpora1, fvdp, cleak
117 my_real :: ttfire
118 CHARACTER(LEN = nchartitle) :: TITR1
119 my_real :: mi, rhoi, ti2, especi, cpa, cpb, cpc, cpd, cpe, cpf, mw_tmp, rmwg, cpg, cvg, gama, shol
120 LOGICAL :: IS_AVAILABLE
121C-----------------------------------------------
122C E x t e r n a l F u n c t i o n s
123C-----------------------------------------------
124 INTEGER USR2SYS
125 EXTERNAL usr2sys
126C-----------------------------------------------
127C B e g i n n i n g o f s o u r c e
128C-----------------------------------------------
129 mess = 'MONITORED VOLUME DEFINITION '
130 rmwi = 0
131C =======
132C Reading
133C =======
134! Line 1
135 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
136 CALL hm_get_floatv('hconv',hconv, is_available, lsubmodel, unitab)
137! Line 2
138 CALL hm_get_floatv('scale_t', scal_t, is_available, lsubmodel, unitab)
139 CALL hm_get_floatv('scale_p', scal_p, is_available, lsubmodel, unitab)
140 CALL hm_get_floatv('scale_s', scal_s, is_available, lsubmodel, unitab)
141 CALL hm_get_floatv('scale_a', scal_a, is_available, lsubmodel, unitab)
142 CALL hm_get_floatv('scale_d', scal_d, is_available, lsubmodel, unitab)
143! Line 3
144 CALL hm_get_intv('matid', mid_ini, is_available, lsubmodel)
145 CALL hm_get_floatv('mu', amu, is_available, lsubmodel, unitab)
146 CALL hm_get_floatv('pext', pext, is_available, lsubmodel, unitab)
147 CALL hm_get_floatv('t_initial', ti, is_available, lsubmodel, unitab)
148 CALL hm_get_intv('iequil', iequi, is_available, lsubmodel)
149 CALL hm_get_intv('ittf', ittf, is_available, lsubmodel)
150! Injectors
151 CALL hm_get_intv('nb_jet', njet, is_available, lsubmodel)
152 t_monvoln%NJET = njet
153 t_monvoln%IVOLU(8) = njet
154 IF (njet > 0) THEN
155 ALLOCATE(t_monvoln%IBAGJET(nibjet, njet))
156 t_monvoln%IBAGJET(1:nibjet, 1:njet) = 0
157 ALLOCATE(t_monvoln%RBAGJET(nrbjet, njet))
158 t_monvoln%RBAGJET(1:nrbjet, 1:njet) = zero
159 ENDIF
160 IF (njet > 0) THEN
161 ALLOCATE(i_inj(njet), isens(njet), ijet(njet), nj1(njet), nj2(njet), nj3(njet),
162 . ipt(njet), ipa(njet), ipz(njet), fpt(njet), fpa(njet), fpz(njet))
163 DO ii = 1, njet
164 CALL hm_get_int_array_index('inject_ID', i_inj(ii), ii, is_available, lsubmodel)
165 CALL hm_get_int_array_index('sensor', isens(ii), ii, is_available, lsubmodel)
166 CALL hm_get_int_array_index('ijet', ijet(ii), ii, is_available, lsubmodel)
167 CALL hm_get_int_array_index('node1', nj1(ii), ii, is_available, lsubmodel)
168 CALL hm_get_int_array_index('node2', nj2(ii), ii, is_available, lsubmodel)
169 CALL hm_get_int_array_index('node3', nj3(ii), ii, is_available, lsubmodel)
170 IF (ijet(ii) > 0) THEN
171 CALL hm_get_int_array_index('fct_pt', ipt(ii), ii, is_available, lsubmodel)
172 CALL hm_get_int_array_index('fct_theta', ipa(ii), ii, is_available, lsubmodel)
173 CALL hm_get_int_array_index('fct_delta', ipz(ii), ii, is_available, lsubmodel)
174 CALL hm_get_float_array_index('fscale_pt', fpt(ii), ii, is_available, lsubmodel, unitab)
175 CALL hm_get_float_array_index('fscale_ptheta', fpa(ii), ii, is_available, lsubmodel, unitab)
176 CALL hm_get_float_array_index('fscale_pdelta', fpz(ii), ii, is_available, lsubmodel, unitab)
177 ENDIF
178 ENDDO
179 ENDIF
180! Ventholes and porous surfaces
181 CALL hm_get_intv('nb_vent', nventholes, is_available, lsubmodel)
182 CALL hm_get_intv('nb_porous', nporsurf, is_available, lsubmodel)
183 nvent = nventholes + nporsurf
184 t_monvoln%IVOLU(11) = nvent
185 t_monvoln%NVENT = nvent
186 t_monvoln%NPORSURF = nporsurf
187 IF (nvent > 0) THEN
188 ALLOCATE(t_monvoln%IBAGHOL(nibhol, nvent))
189 t_monvoln%IBAGHOL(1:nibhol, 1:nvent) = 0
190 ALLOCATE(t_monvoln%RBAGHOL(nrbhol, nvent))
191 t_monvoln%RBAGHOL(1:nrbhol, 1:nvent) = zero
192 ENDIF
193 ALLOCATE(ipvent(nvent), ifvent(nvent), avent(nvent), bvent(nvent))
194 ALLOCATE(tvent(nvent), tstope(nvent), dpdef(nvent), dtpdef(nvent),
195 . idtpdef(nvent))
196 ALLOCATE(iport(nvent), iporp(nvent), ipora(nvent), fport(nvent),
197 . fporp(nvent), fpora(nvent))
198 ALLOCATE(iport1(nvent), iporp1(nvent), ipora1(nvent), fport1(nvent),
199 . fporp1(nvent), fpora1(nvent))
200 ALLOCATE(iblockage(nvent), cleak(nvent))
201 ALLOCATE(ivdp(nvent), fvdp(nvent))
202 IF (nventholes > 0) THEN
203 DO ii = 1, nventholes
204 venttitle = ''
205 CALL hm_get_int_array_index('surf_IDv', ipvent(ii), ii, is_available, lsubmodel)
206 CALL hm_get_int_array_index('Iform', ifvent(ii), ii, is_available, lsubmodel)
207 CALL hm_get_float_array_index('Avent', avent(ii), ii, is_available, lsubmodel, unitab)
208 CALL hm_get_float_array_index('Bvent', bvent(ii), ii, is_available, lsubmodel, unitab)
209 CALL hm_get_string_index('vent_title', venttitle, ii, 20, is_available)
210 DO jj = 1, 20
211 titrevent(jj) = iachar(venttitle(jj:jj))
212 t_monvoln%IBAGHOL(jj + 14, ii) = titrevent(jj)
213 ENDDO
214!
215 CALL hm_get_float_array_index('tstart', tvent(ii), ii, is_available, lsubmodel, unitab)
216 CALL hm_get_float_array_index('tstop', tstope(ii), ii, is_available, lsubmodel, unitab)
217 CALL hm_get_float_array_index('dpdef', dpdef(ii), ii, is_available, lsubmodel, unitab)
218 CALL hm_get_float_array_index('dtpdef', dtpdef(ii), ii, is_available, lsubmodel, unitab)
219 CALL hm_get_int_array_index('idtpdef', idtpdef(ii), ii, is_available, lsubmodel)
220!
221 CALL hm_get_int_array_index('fct_IDt', iport(ii), ii, is_available, lsubmodel)
222 CALL hm_get_int_array_index('fct_IDP', iporp(ii), ii, is_available, lsubmodel)
223 CALL hm_get_int_array_index('fct_IDA', ipora(ii), ii, is_available, lsubmodel)
224 CALL hm_get_float_array_index('Fscalet', fport(ii), ii, is_available, lsubmodel, unitab)
225 CALL hm_get_float_array_index('FscaleP', fporp(ii), ii, is_available, lsubmodel, unitab)
226 CALL hm_get_float_array_index('FscaleA', fpora(ii), ii, is_available, lsubmodel, unitab)
227!
228 CALL hm_get_int_array_index("fct_IDt'", iport1(ii), ii, is_available, lsubmodel)
229 CALL hm_get_int_array_index("fct_IDP'", iporp1(ii), ii, is_available, lsubmodel)
230 CALL hm_get_int_array_index("fct_IDA'", ipora1(ii), ii, is_available, lsubmodel)
231 CALL hm_get_float_array_index("Fscalet'", fport1(ii), ii, is_available, lsubmodel, unitab)
232 CALL hm_get_float_array_index("FscaleP'", fporp1(ii), ii, is_available, lsubmodel, unitab)
233 CALL hm_get_float_array_index("FscaleA'", fpora1(ii), ii, is_available, lsubmodel, unitab)
234
235 IF (ifvent(ii) == 2) THEN
236 CALL hm_get_int_array_index('fct_IDvvh', ivdp(ii), ii, is_available, lsubmodel)
237 CALL hm_get_float_array_index('Fscalevvh', fvdp(ii), ii, is_available, lsubmodel, unitab)
238 ELSE
239 ivdp(ii) = 0
240 fvdp(ii) = zero
241 ENDIF
242 ENDDO
243 ENDIF
244 IF (nporsurf > 0) THEN
245CALL HM_GET_INT_ARRAY_INDEX('', , II, IS_AVAILABLE, LSUBMODEL)
246CALL HM_GET_FLOAT_ARRAY_INDEX('', , II, IS_AVAILABLE, LSUBMODEL, UNITAB)
247 DO ii = 1, nporsurf
248 venttitle = ''
249 CALL hm_get_int_array_index('surf_ps', ipvent(nventholes + ii), ii, is_available, lsubmodel)
250 CALL hm_get_int_array_index('iform_ps', ifvent(nventholes + ii), ii, is_available, lsubmodel)
251 CALL hm_get_int_array_index('iblockage_ps', iblockage(nventholes + ii), ii, is_available, lsubmodel)
252 CALL hm_get_string_index('title_ps', venttitle, ii, 20, is_available)
253 DO jj = 1, 20
254 titrevent(jj) = iachar(venttitle(jj:jj))
255 t_monvoln%IBAGHOL(jj + 14, nventholes + ii) = titrevent(jj)
256 ENDDO
257!
258 CALL hm_get_float_array_index('tstart_ps', tvent(nventholes + ii), ii, is_available, lsubmodel, unitab)
259 CALL hm_get_float_array_index('tstop_ps', tstope(nventholes + ii), ii, is_available, lsubmodel, unitab)
260 CALL hm_get_float_array_index('dpdef_ps', dpdef(nventholes + ii), ii, is_available, lsubmodel, unitab)
261 CALL hm_get_float_array_index('dtpdef_ps', dtpdef(nventholes + ii), ii, is_available, lsubmodel, unitab)
262 CALL hm_get_int_array_index('idtpdef_ps', idtpdef(nventholes + ii), ii, is_available, lsubmodel)
263
264 cleak(nventholes + ii) = zero
265 avent(nventholes + ii) = zero
266 iport(nventholes + ii) = 0
267 ipora(nventholes + ii) = 0
268 fport(nventholes + ii) = zero
269 fpora(nventholes + ii) = zero
270 IF (ifvent(nventholes + ii) == 0) THEN
271 CALL hm_get_float_array_index('cps', cleak(nventholes + ii), ii, is_available, lsubmodel, unitab)
272 CALL hm_get_float_array_index('area_ps', avent(nventholes + ii), ii, is_available, lsubmodel, unitab)
273 CALL hm_get_int_array_index('fct_cps', iport(nventholes + ii), ii, is_available, lsubmodel)
274 CALL hm_get_int_array_index('fct_aps', ipora(nventholes + ii), ii, is_available, lsubmodel)
275 CALL hm_get_float_array_index('fscale_cps', fport(nventholes + ii), ii, is_available, lsubmodel, unitab)
276 CALL hm_get_float_array_index('fscale_aps', fpora(nventholes + ii), ii, is_available, lsubmodel, unitab)
277 ENDIF
278 ivdp(nventholes + ii) = 0
279 fvdp(nventholes + ii) = zero
280 IF (ifvent(nventholes + ii) == 2) THEN
281 CALL hm_get_int_array_index('fct_IDvps', ivdp(nventholes + ii), ii, is_available, lsubmodel)
282 CALL hm_get_float_array_index('Fscalevps', fvdp(nventholes + ii), ii, is_available, lsubmodel, unitab)
283 ENDIF
284 ENDDO
285 ENDIF
286C =====
287C Units
288C =====
289 fac_m = unitab%FAC_M(luid)
290 fac_l = unitab%FAC_L(luid)
291 fac_t = unitab%FAC_T(luid)
292 fac_c = fac_m / (fac_l * fac_t * fac_t)
293
294C ================
295C Check operations
296C ================
297C External surface check
298 t_monvoln%IVOLU(4) = 0
299 found = .false.
300 DO ii = 1, nsurf
301 IF (surfid == igrsurf(ii)%ID) THEN
302 t_monvoln%IVOLU(4) = ii
303 t_monvoln%EXT_SURFID = ii
304 found = .true.
305 EXIT
306 ENDIF
307 ENDDO
308 IF (.NOT. found) THEN
309 CALL freerr(3)
310 ELSEIF (igrsurf(t_monvoln%IVOLU(4))%ISH4N3N == 0) THEN
311 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
312 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
313 CALL freerr(3)
314 ENDIF
315
316C Check surface closure
317 CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
318C Set all normal on same side
319 CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
320 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 7)
321C Compute Monvon volume
322 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
323 . itab, x, pm, geo, ixc, ixtg,
324 . sa, rot, vol, vmin, veps, sv)
325C Reverse all normals to ensure positive volume
326 CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
327 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 7)
328
329 IF (ittf < 0 .OR. ittf > 3) THEN
330 CALL ancmsg(msgid = 773, anmode = aninfo, msgtype = msgerror,
331 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
332 END IF
333 IF (ti == zero) THEN
334 ti = twohundred95
335 ENDIF
336! Find material
337 t_monvoln%IVOLU(66) = 0
338 found = .false.
339 DO ii = 1, nummat
340 IF (ipm(1, ii) == mid_ini .AND. ipm(2, ii) == 999) THEN
341 mwi = pm(20, ii) * fac_m
342 cpai = pm(21, ii) * fac_l * fac_l / (fac_t * fac_t)
343 cpbi = pm(22, ii) * fac_l * fac_l / (fac_t * fac_t)
344 cpci = pm(23, ii) * fac_l * fac_l / (fac_t * fac_t)
345 cpdi = pm(24, ii) * fac_l * fac_l / (fac_t * fac_t)
346 cpei = pm(25, ii) * fac_l * fac_l / (fac_t * fac_t)
347 cpfi = pm(26, ii) * fac_l * fac_l / (fac_t * fac_t)
348 r_igc1 = pm(27, ii)
349 cpi = cpai + cpbi * ti + cpci * ti * ti + cpdi * ti * ti * ti +
350 . cpei / (ti * ti) + cpfi * ti * ti * ti * ti
351 rmwi = r_igc1 / mwi
352 cvi = cpi - rmwi
353 t_monvoln%IVOLU(66) = ii
354 IF (cvi == zero) THEN
355 CALL ancmsg(msgid = 709, msgtype = msgerror, anmode = aninfo,
356 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
357 gamai = zero
358 ELSE
359 gamai = cpi / cvi
360 END IF
361 found = .true.
362 EXIT
363 ENDIF
364 ENDDO
365 IF (.NOT. found) THEN
366 CALL ancmsg(msgid = 699, anmode = aninfo, msgtype = msgerror,
367 . i2 = mid_ini, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
368 ENDIF
369! Injectors
370 IF (njet > 0) THEN
371 ALLOCATE(i_injsys(njet))
372 DO ii = 1, njet
373! Check injector property
374 i_injsys(ii) = 0
375 found = .false.
376 DO jj = 1, numgeo
377 IF (igeo(1, jj) == i_inj(ii)) THEN
378 i_injsys(ii) = jj
379 found = .true.
380 EXIT
381 ENDIF
382 ENDDO
383 IF (.NOT. found) THEN
384 CALL ancmsg(msgid = 723, anmode = aninfo, msgtype = msgerror,
385 . i2 = i_inj(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
386 ENDIF
387 ENDDO
388 ENDIF
389
390
391C ==============
392C Default values
393C ==============
394 IF (scal_t == zero) THEN
395 CALL hm_get_floatv_dim('scale_t', fac_gen, is_available, lsubmodel, unitab)
396 scal_t = one * fac_gen
397 ENDIF
398 IF (scal_p == zero) THEN
399 CALL hm_get_floatv_dim('scale_p', fac_gen, is_available, lsubmodel, unitab)
400 scal_p = one * fac_gen
401 ENDIF
402 IF (scal_s == zero) THEN
403 CALL hm_get_floatv_dim('scale_s', fac_gen, is_available, lsubmodel, unitab)
404 scal_s = one * fac_gen
405 ENDIF
406 IF (scal_a == zero) THEN
407 CALL hm_get_floatv_dim('scale_a', fac_gen, is_available, lsubmodel, unitab)
408 scal_a = one * fac_gen
409 ENDIF
410 IF (scal_d == zero) THEN
411 CALL hm_get_floatv_dim('scale_d', fac_gen, is_available, lsubmodel, unitab)
412 scal_d = one * fac_gen
413 ENDIF
414
415 IF (amu == zero) amu = em02
416 IF (pext == zero) THEN
417 pext = 101325.d0 * (unitab%FAC_L_WORK * unitab%FAC_T_WORK * unitab%FAC_T_WORK) / unitab%FAC_M_WORK
418 ENDIF
419
420 pini = pext
421! Injectors
422 IF (njet > 0) THEN
423 DO ii = 1, njet
424 IF (ijet(ii) > 0) THEN
425 IF (fpt(ii) == zero) THEN
426 CALL hm_get_float_array_index_dim('fscale_pt', fac_gen, ii, is_available, lsubmodel, unitab)
427 fpt(ii) = one * fac_gen
428 ENDIF
429 IF (fpa(ii) == zero) THEN
430 CALL hm_get_float_array_index_dim('fscale_ptheta', fac_gen, ii, is_available, lsubmodel, unitab)
431 fpa(ii) = one * fac_gen
432 ENDIF
433 IF (fpz(ii) == zero) THEN
434 CALL hm_get_float_array_index_dim('fscale_pdelta', fac_gen, ii, is_available, lsubmodel, unitab)
435 fpz(ii) = one
436 ENDIF
437 ELSE
438 CALL hm_get_float_array_index_dim('fscale_pt', fac_gen, ii, is_available, lsubmodel, unitab)
439 fpt(ii) = one * fac_gen
440 CALL hm_get_float_array_index_dim('fscale_ptheta', fac_gen, ii, is_available, lsubmodel, unitab)
441 fpa(ii) = one * fac_gen
442 CALL hm_get_float_array_index_dim('fscale_pdelta', fac_gen, ii, is_available, lsubmodel, unitab)
443 fpz(ii) = one * fac_gen
444 ENDIF
445 ENDDO
446 ENDIF
447! Ventholes
448 IF (nventholes > 0) THEN
449 DO ii = 1, nventholes
450 IF (ifvent(ii) == 0) ifvent(ii) = 1
451 IF (ipvent(ii) == 0) THEN
452 bvent(ii) = zero
453 ENDIF
454 IF (fport(ii) == zero) THEN
455 CALL hm_get_float_array_index_dim('Fscalet', fac_gen, ii, is_available, lsubmodel, unitab)
456 fport(ii) = one * fac_gen
457 ENDIF
458 IF (fporp(ii) == zero) THEN
459 CALL hm_get_float_array_index_dim('FscaleP', fac_gen, ii, is_available, lsubmodel, unitab)
460 fporp(ii) = one * fac_gen
461 ENDIF
462 IF (fpora(ii) == zero) THEN
463 CALL hm_get_float_array_index_dim('fscale_aps', fac_gen, ii, is_available, lsubmodel, unitab)
464 fpora(ii) = one * fac_gen
465 ENDIF
466 IF (fport1(ii) == zero) THEN
467 CALL hm_get_float_array_index_dim("Fscalet'", fac_gen, ii, is_available, lsubmodel, unitab)
468 fport1(ii) = one * fac_gen
469 ENDIF
470 IF (fporp1(ii) == zero) THEN
471 CALL hm_get_float_array_index_dim("FscaleP'", fac_gen, ii, is_available, lsubmodel, unitab)
472 fporp1(ii) = one * fac_gen
473 ENDIF
474 IF (fpora1(ii) == zero) THEN
475 CALL hm_get_float_array_index_dim("FscaleA'", fac_gen, ii, is_available, lsubmodel, unitab)
476 fpora1(ii) = one * fac_gen
477 ENDIF
478 ENDDO
479 ENDIF
480C =====
481C Store
482C =====
483 t_monvoln%IVOLU(8) = njet
484 IF (iequi > 0 .AND. iequi /= 1) iequi = 1
485 t_monvoln%IVOLU(15) = iequi
486 t_monvoln%IVOLU(17) = ittf
487
488 t_monvoln%RVOLU(19) = hconv
489 t_monvoln%RVOLU(26) = one / scal_t
490 t_monvoln%RVOLU(27) = one / scal_p
491 t_monvoln%RVOLU(28) = one / scal_s
492 t_monvoln%RVOLU(29) = one / scal_a
493 t_monvoln%RVOLU(30) = one / scal_d
494
495 t_monvoln%RVOLU(31) = pini
496
497 mid_inisys = t_monvoln%IVOLU(66)
498 IF (mid_inisys /= 0) THEN
499 mwi = pm(20, mid_inisys)
500 cpai = pm(21, mid_inisys)
501 cpbi = pm(22, mid_inisys)
502 cpci = pm(23, mid_inisys)
503 cpdi = pm(24, mid_inisys)
504 cpei = pm(25, mid_inisys)
505 cpfi = pm(26, mid_inisys)
506 r_igc1 = pm(27, mid_inisys)
507 ELSE
508 mwi = zero
509 cpai = zero
510 cpbi = zero
511 cpci = zero
512 cpdi = zero
513 cpei = zero
514 cpfi = zero
515 r_igc1 = zero
516 CALL ancmsg(msgid= 7 18, anmode = aninfo, msgtype = msgerror,
517 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
518 ENDIF
519 t_monvoln%RVOLU(7)=cpai
520 t_monvoln%RVOLU(8)=cpbi
521 t_monvoln%RVOLU(9)=cpci
522 t_monvoln%RVOLU(56)=cpdi
523 t_monvoln%RVOLU(57)=cpei
524 t_monvoln%RVOLU(58)=cpfi
525 t_monvoln%RVOLU(59)=mwi
526 cpi = cpai + cpbi * ti + cpci * ti * ti + cpdi * ti * ti * ti +
527 . cpei / (ti * ti) + cpfi * ti * ti * ti * ti
528 IF (mwi == zero) THEN
529 gamai = zero
530 ELSE
531 rmwi = r_igc1 / mwi
532 cvi = cpi - rmwi
533 gamai = cpi / cvi
534 ENDIF
535 mi = pini * (vol + veps) / (rmwi * ti)
536 t_monvoln%RVOLU(1) = gamai
537 t_monvoln%RVOLU(3) = pext
538 t_monvoln%RVOLU(4) = vol + veps
539 t_monvoln%RVOLU(11) = mi
540 t_monvoln%RVOLU(12) = pini
541 t_monvoln%RVOLU(13) = ti
542 t_monvoln%RVOLU(14) = rmwi * mi
543 t_monvoln%RVOLU(17) = veps
544 t_monvoln%RVOLU(20) = mi
545 t_monvoln%RVOLU(25) = ti
546 t_monvoln%RVOLU(61) = gamai
547 rhoi = pini / (ti * rmwi)
548 t_monvoln%RVOLU(62) = rhoi
549 t_monvoln%RVOLU(10) = rmwi
550 ti2=ti*ti
551 especi=ti*(cpai+half*cpbi*ti+third*cpci*ti2-rmwi)
552 especi=especi+fourth*cpdi*ti2*ti2-cpei/ti+one_fifth*cpfi*ti2*ti2*ti
553 t_monvoln%RVOLU(63)= especi+rmwi*ti
554 t_monvoln%RVOLU(64)= zero
555 t_monvoln%RVOLU(65)= zero
556 t_monvoln%RVOLU(66)= especi
557! Injectors
558 ttfire = infinity
559 DO ii = 1, njet
560 t_monvoln%IBAGJET(13, ii) = i_injsys(ii)
561 t_monvoln%RBAGJET(1, ii) = zero
562 t_monvoln%RBAGJET(2, ii) = geo(203, i_injsys(ii))
563 t_monvoln%RBAGJET(3, ii) = geo(204, i_injsys(ii))
564 t_monvoln%RBAGJET(4, ii) = geo(205, i_injsys(ii))
565 t_monvoln%RBAGJET(16, ii) = geo(206, i_injsys(ii))
566 t_monvoln%RBAGJET(17, ii) = geo(207, i_injsys(ii))
567 t_monvoln%RBAGJET(18, ii) = geo(208, i_injsys(ii))
568 t_monvoln%RBAGJET(19, ii) = geo(202, i_injsys(ii))
569 t_monvoln%RBAGJET(5, ii) = zero !FMASS
570 t_monvoln%RBAGJET(6, ii) = zero !FTEMP
571 t_monvoln%RBAGJET(12, ii) = fpt(ii)
572 t_monvoln%RBAGJET(13, ii) = fpa(ii)
573 t_monvoln%RBAGJET(14, ii) = fpz(ii)
574 t_monvoln%IBAGJET(2, ii) = 0 !IFLU
575 t_monvoln%IBAGJET(3, ii) = 0 !ITEMP
576 t_monvoln%IBAGJET(4, ii) = isens(ii)
577! Jetting
578 IF (ijet(ii) > 0) THEN
579 t_monvoln%IBAGJET(5, ii) = usr2sys(nj1(ii), itabm1, mess, t_monvoln%ID)
580 t_monvoln%IBAGJET(6, ii) = usr2sys(nj2(ii), itabm1, mess, t_monvoln%ID)
581 IF(nj3(ii) /= 0) THEN
582 t_monvoln%IBAGJET(7, ii) = usr2sys(nj3(ii), itabm1, mess, t_monvoln%ID)
583 ENDIF
584 found = .false.
585 DO jj= 1, nfunct
586 IF (ipt(ii) == npc(jj)) THEN
587 t_monvoln%IBAGJET(8, ii) = jj
588 found = .true.
589 EXIT
590 ENDIF
591 ENDDO
592 IF (.NOT. found) THEN
593 CALL ancmsg(msgid = 12, anmode = aninfo, msgtype = msgerror,
594 . i2 = ipt(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
595 ENDIF
596 found = .false.
597 DO jj = 1, nfunct
598 IF (ipa(ii) == npc(jj)) THEN
599 t_monvoln%IBAGJET(9, ii) = jj
600 found = .true.
601 EXIT
602 ENDIF
603 ENDDO
604 IF (.NOT. found) THEN
605 CALL ancmsg(msgid = 13, anmode = aninfo, msgtype = msgerror,
606 . i2 = ipa(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
607 ENDIF
608 found = .false.
609 DO jj = 1, nfunct
610 IF (ipz(ii) == npc(jj)) THEN
611 t_monvoln%IBAGJET(10, ii) = jj
612 found = .true.
613 EXIT
614 ENDIF
615 ENDDO
616 IF (.NOT. found) THEN
617 CALL ancmsg(msgid = 14, anmode = aninfo, msgtype = msgerror,
618 . i2 = ipz(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
619 ENDIF
620 ENDIF
621 IF (isens(ii) > 0) THEN
622 found = .false.
623 DO jj = 1, sensors%NSENSOR
624 IF (isens(ii) == sensors%SENSOR_TAB(jj)%SENS_ID) THEN
625 t_monvoln%IBAGJET(4, ii) = jj
626 IF (sensors%SENSOR_TAB(jj)%TCRIT < ttfire) ttfire = sensors%SENSOR_TAB(jj)%TCRIT
627 found = .true.
628 EXIT
629 ENDIF
630 ENDDO
631 IF (.NOT. found) THEN
632 CALL ancmsg(msgid = 17, anmode =aninfo, msgtype = msgerror,
633 . i2 = isens(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
634 ENDIF
635 ENDIF
636 cpa = t_monvoln%RBAGJET(2, ii)
637 cpb = t_monvoln%RBAGJET(3, ii)
638 cpc = t_monvoln%RBAGJET(4, ii)
639 cpd = t_monvoln%RBAGJET(16, ii)
640 cpe = t_monvoln%RBAGJET(17, ii)
641 cpf = t_monvoln%RBAGJET(18, ii)
642 mw_tmp = t_monvoln%RBAGJET(19, ii)
643 rmwg = r_igc1 / mw_tmp
644 cpg = cpa + cpb*ti+cpc*ti*ti+cpd*ti*ti*ti+
645 . cpe/(ti*ti)+cpf*ti*ti*ti*ti
646 cvg = cpg - rmwg
647 gama = cpg / cvg
648 t_monvoln%RBAGJET(1, ii) = rmwg
649 ENDDO
650 IF (ttfire == infinity) ttfire = zero
651 t_monvoln%RVOLU(49) = ttfire
652! Ventholes
653 DO ii = 1, nventholes
654 t_monvoln%RBAGHOL(7, ii) = fport(ii)
655 t_monvoln%RBAGHOL(8, ii) = fporp(ii)
656 t_monvoln%RBAGHOL(9, ii) = fpora(ii)
657 t_monvoln%RBAGHOL(10, ii) = fport1(ii)
658 t_monvoln%RBAGHOL(11, ii) = fporp1(ii)
659 t_monvoln%RBAGHOL(12, ii) = fpora1(ii)
660
661 t_monvoln%IBAGHOL(1, ii) = 0
662 t_monvoln%IBAGHOL(10, ii) = ifvent(ii)
663 t_monvoln%IBAGHOL(11, ii) = idtpdef(ii)
664
665 t_monvoln%IBAGHOL(12, ii) = 0
666
667 IF (ipvent(ii) == 0) THEN
668 t_monvoln%IBAGHOL(2, ii) = 0
669 ELSE
670 t_monvoln%IBAGHOL(2, ii) = 0
671 found = .false.
672 DO jj = 1, nsurf
673 IF (ipvent(ii) == igrsurf(jj)%ID) THEN
674 t_monvoln%IBAGHOL(2, ii) = jj
675 found = .true.
676 EXIT
677 ENDIF
678 ENDDO
679 IF(.NOT. found)THEN
680 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
681 . i2 = ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
682 ELSEIF(igrsurf(t_monvoln%IBAGHOL(2, ii))%ISH4N3N == 0) THEN
683 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
684 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
685 ENDIF
686 IF (avent(ii) == zero) THEN
687 CALL hm_get_float_array_index_dim('avent', fac_gen, ii, is_available, lsubmodel, unitab)
688 avent(ii) = one * fac_gen
689 ENDIF
690 ENDIF
691 IF (avent(ii) == zero) dpdef(ii) = infinity
692 IF (avent(ii) == zero) tvent(ii) = infinity
693 IF (dpdef(ii) == zero .AND. dtpdef(ii) == zero .AND. tvent(ii) == zero) THEN
694 t_monvoln%IBAGHOL(1, ii) = 1
695 ENDIF
696 t_monvoln%RBAGHOL(1, ii) = dpdef(ii)
697 t_monvoln%RBAGHOL(2, ii) = avent(ii)
698 t_monvoln%RBAGHOL(3, ii) = tvent(ii)
699 t_monvoln%RBAGHOL(4, ii) = dtpdef(ii)
700 t_monvoln%RBAGHOL(6, ii) = bvent(ii)
701 IF (ivdp(ii) /= 0 .AND. fvdp(ii) == zero) THEN
702 CALL hm_get_float_array_index_dim('fscale_v', fac_gen, ii, is_available, lsubmodel, unitab)
703 fvdp(ii) = one * fac_gen
704 ENDIF
705 t_monvoln%RBAGHOL(13, ii) = fvdp(ii)
706 IF (tstope(ii) == zero) tstope(ii) = infinity
707 t_monvoln%RBAGHOL(14, ii) = tstope(ii)
708C
709 t_monvoln%IBAGHOL(3, ii) = -1
710 t_monvoln%IBAGHOL(4, ii) = -1
711 t_monvoln%IBAGHOL(5, ii) = -1
712 t_monvoln%IBAGHOL(6, ii) = -1
713 t_monvoln%IBAGHOL(7, ii) = -1
714 t_monvoln%IBAGHOL(8, ii) = -1
715 t_monvoln%IBAGHOL(9, ii) = -1
716 DO jj = 1, nfunct
717 IF (iport(ii) == npc(jj)) t_monvoln%IBAGHOL(3, ii) = jj
718 IF (iporp(ii) == npc(jj)) t_monvoln%IBAGHOL(4, ii) = jj
719 IF (ipora(ii) == npc(jj)) t_monvoln%IBAGHOL(5, ii) = jj
720 IF (iport1(ii) == npc(jj)) t_monvoln%IBAGHOL(6, ii) = jj
721 IF (iporp1(ii) == npc(jj)) t_monvoln%IBAGHOL(7, ii) = jj
722 IF (ipora1(ii) == npc(jj)) t_monvoln%IBAGHOL(8, ii) = jj
723 IF (ivdp(ii) == npc(jj)) t_monvoln%IBAGHOL(9, ii) = jj
724 ENDDO
725 IF (iport(ii) == 0) t_monvoln%IBAGHOL(3, ii) = 0
726 IF (iporp(ii) == 0) t_monvoln%IBAGHOL(4, ii) = 0
727 IF (ipora(ii) == 0) t_monvoln%IBAGHOL(5, ii) = 0
728 IF (iport1(ii) == 0) t_monvoln%IBAGHOL(6, ii) = 0
729 IF (iporp1(ii) == 0) t_monvoln%IBAGHOL(7, ii) = 0
730 IF (ipora1(ii) == 0) t_monvoln%IBAGHOL(8, ii) = 0
731 IF (ivdp(ii) == 0 .AND. ifvent(ii) /= 2) t_monvoln%IBAGHOL(9, ii) = 0
732 IF (t_monvoln%IBAGHOL(3, ii) == -1) THEN
733 t_monvoln%IBAGHOL(3, ii) = 0
734 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
735 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(ii))
736 ENDIF
737 IF (t_monvoln%IBAGHOL(4, ii) == -1) THEN
738 t_monvoln%IBAGHOL(4, ii) = 0
739 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
740 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp(ii))
741 ENDIF
742 IF (t_monvoln%IBAGHOL(5, ii) == -1) THEN
743 t_monvoln%IBAGHOL(5, ii)=0
744 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
745 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(ii))
746 ENDIF
747 IF (t_monvoln%IBAGHOL(6, ii) == -1) THEN
748 t_monvoln%IBAGHOL(6, ii) = 0
749 CALL ancmsg(msgid=331, anmode=aninfo, msgtype=msgerror,
750 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport1(ii))
751 ENDIF
752 IF (t_monvoln%IBAGHOL(7, ii) == -1) THEN
753 t_monvoln%IBAGHOL(7, ii)=0
754 CALL ancmsg(msgid=332, anmode=aninfo, msgtype=msgerror,
755 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp1(ii))
756 ENDIF
757 IF (t_monvoln%IBAGHOL(8, ii) == -1) THEN
758 t_monvoln%IBAGHOL(8, ii) = 0
759 CALL ancmsg(msgid=333, anmode=aninfo, msgtype=msgerror,
760 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora1(ii))
761 ENDIF
762 IF (t_monvoln%IBAGHOL(9, ii) == -1) THEN
763 t_monvoln%IBAGHOL(9, ii) = 0
764 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
765 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(ii))
766 ENDIF
767 ENDDO
768
769 DO ii = 1, nporsurf
770 t_monvoln%IBAGHOL(13, nventholes + ii) = 1
771 IF (ifvent(nventholes + ii) == 0) THEN
772 IF (cleak(nventholes + ii) > zero) iport(nventholes + ii) = 0
773 IF (avent(nventholes + ii) > zero) ipora(nventholes + ii) = 0
774 ipvent(nventholes + ii) = 0
775 iblockage(nventholes + ii) = 0
776 ENDIF
777 IF (fport(nventholes + ii) == zero) THEN
778 CALL hm_get_float_array_index_dim('fscale_cps', fac_gen, ii, is_available, lsubmodel, unitab)
779 fport(nventholes + ii) = one * fac_gen
780 ENDIF
781 IF (fpora(nventholes + ii) == zero) THEN
782 CALL hm_get_float_array_index_dim('fscale_aps', fac_gen, ii, is_available, lsubmodel, unitab)
783 fpora(nventholes + ii) = one * fac_gen
784 ENDIF
785 t_monvoln%RBAGHOL(7, nventholes + ii) = fport(nventholes + ii)
786 t_monvoln%RBAGHOL(9, nventholes + ii) = fpora(nventholes + ii)
787C
788 t_monvoln%IBAGHOL(1, nventholes + ii) = 0
789 t_monvoln%IBAGHOL(10, nventholes + ii) = ifvent(nventholes + ii)
790 t_monvoln%IBAGHOL(11, nventholes + ii) = idtpdef(nventholes + ii)
791 t_monvoln%IBAGHOL(12, nventholes + ii) = 0
792 t_monvoln%IBAGHOL(14, nventholes + ii) = iblockage(nventholes + ii)
793C
794 IF (ipvent(nventholes + ii) == 0) THEN
795 t_monvoln%IBAGHOL(2, nventholes + ii) = 0
796 ELSE
797 t_monvoln%IBAGHOL(2, nventholes + ii) = 0
798 DO jj = 1, nsurf
799 IF (ipvent(nventholes + ii) == igrsurf(jj)%ID) THEN
800 t_monvoln%IBAGHOL(2, nventholes + ii) = jj
801 ENDIF
802 ENDDO
803 IF (t_monvoln%IBAGHOL(2, nventholes + ii) == 0) THEN
804 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
805 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipvent(nventholes + ii))
806 ELSEIF (igrsurf(t_monvoln%IBAGHOL(2, nventholes + ii))%ISH4N3N == 0) THEN
807 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
808 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
809 ENDIF
810 ENDIF
811C
812 IF (dpdef(nventholes + ii) == zero .AND. dtpdef(nventholes + ii) == zero .AND.
813 . tvent(nventholes + ii) == zero) THEN
814 t_monvoln%IBAGHOL(1, nventholes + ii) = 1
815 ENDIF
816 t_monvoln%RBAGHOL(1, nventholes + ii) = dpdef(nventholes + ii)
817 t_monvoln%RBAGHOL(2, nventholes + ii) = avent(nventholes + ii)
818 t_monvoln%RBAGHOL(3, nventholes + ii) = tvent(nventholes + ii)
819 t_monvoln%RBAGHOL(4, nventholes + ii) = dtpdef(nventholes + ii)
820 t_monvoln%RBAGHOL(6, nventholes + ii) = cleak(nventholes + ii)
821 IF (ivdp(nventholes + ii) /= 0 .AND. fvdp(nventholes + ii) == zero) THEN
822 CALL hm_get_float_array_index_dim('fscale_v', fac_gen, ii, is_available, lsubmodel, unitab)
823 fvdp = one * fac_gen
824 ENDIF
825 t_monvoln%RBAGHOL(13, nventholes + ii)=fvdp(nventholes + ii)
826 IF (tstope(nventholes + ii) == zero) tstope(nventholes + ii) = infinity
827 t_monvoln%RBAGHOL(14, nventholes + ii) = tstope(nventholes + ii)
828C
829 t_monvoln%IBAGHOL(3, nventholes + ii) = -1
830 t_monvoln%IBAGHOL(5, nventholes + ii) = -1
831 t_monvoln%IBAGHOL(9, nventholes + ii) = -1
832C
833 DO jj = 1, nfunct
834 IF (iport(nventholes + ii) == npc(jj)) THEN
835 t_monvoln%IBAGHOL(3, nventholes + ii) = jj
836 ENDIF
837 IF (ipora(nventholes + ii) == npc(jj)) THEN
838 t_monvoln%IBAGHOL(5, nventholes + ii) = jj
839 ENDIF
840 IF (ivdp(nventholes + ii) == npc(jj)) THEN
841 t_monvoln%IBAGHOL(9, nventholes + ii) = jj
842 ENDIF
843 ENDDO
844 IF (iport(nventholes + ii) == 0) t_monvoln%IBAGHOL(3, nventholes + ii) = 0
845 IF (ipora(nventholes + ii) == 0) t_monvoln%IBAGHOL(5, nventholes + ii) = 0
846 IF (ivdp(nventholes + ii) == 0 .AND. ifvent(nventholes + ii) /= 2) THEN
847 t_monvoln%IBAGHOL(9, nventholes + ii) = 0
848 ENDIF
849
850 IF (t_monvoln%IBAGHOL(3, nventholes + ii) == -1) THEN
851 t_monvoln%IBAGHOL(3, nventholes + ii) =0
852 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
853 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(nventholes + ii))
854 ENDIF
855 IF (t_monvoln%IBAGHOL(5, nventholes + ii) == -1) THEN
856 t_monvoln%IBAGHOL(5, nventholes + ii) = 0
857 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
858 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(nventholes + ii))
859 ENDIF
860 IF (t_monvoln%IBAGHOL(9, nventholes + ii) == -1) THEN
861 t_monvoln%IBAGHOL(9, nventholes + ii) = 0
862 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
863 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(nventholes + ii))
864 ENDIF
865 ENDDO
866
867C
868 t_monvoln%RVOLU(2) = amu
869 t_monvoln%RVOLU(16) = vol + veps
870 t_monvoln%RVOLU(18) = sa
871 t_monvoln%RVOLU(21) = rot
872 t_monvoln%RVOLU(22:24) = zero
873
874C =========
875C Print out
876C =========
877 WRITE(iout, 1005) surfid
878 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
879 WRITE(iout, 1006) hconv
880 WRITE(iout, 1002) sa, sv, vol
881 WRITE(iout,1395) mid_ini
882 WRITE(iout,1400) amu, ti, pext, pini
883 IF (iequi == 0) THEN
884 WRITE(iout,1401)
885 ENDIF
886 IF (iequi > 0) THEN
887 WRITE(iout,1402)
888 ENDIF
889 WRITE(iout,1415) mwi, gamai, cpai, cpbi, cpci, cpdi, cpei, cpfi
890 WRITE(iout,1425)
891 WRITE(iout,1426) njet
892 DO ii = 1, njet
893 WRITE(iout,1432) ii,
894 . igeo(1, i_injsys(ii)), isens(ii)
895 cpa = t_monvoln%RBAGJET(2, ii)
896 cpb = t_monvoln%RBAGJET(3, ii)
897 cpc = t_monvoln%RBAGJET(4, ii)
898 cpd = t_monvoln%RBAGJET(16, ii)
899 cpe = t_monvoln%RBAGJET(17, ii)
900 cpf = t_monvoln%RBAGJET(18, ii)
901 mw_tmp = t_monvoln%RBAGJET(19, ii)
902 rmwg = r_igc1 / mw_tmp
903 cpg = cpa + cpb*ti+cpc*ti*ti+cpd*ti*ti*ti+
904 . cpe/(ti*ti)+cpf*ti*ti*ti*ti
905 cvg = cpg - rmwg
906 gama = cpg / cvg
907 WRITE(iout,1442) gama, mw_tmp, cpa, cpb, cpc,
908 . cpd, cpe, cpf
909 IF (nj1(ii) == 0) THEN
910 WRITE(iout, 1455) 0
911 ELSE
912 WRITE(iout, 1455) 1
913 IF (nj3(ii) == 0) THEN
914 WRITE(iout, 1460) nj1(ii), nj2(ii),
915 . ipt(ii), ipa(ii), ipz(ii), fpt(ii), fpa(ii), fpz(ii)
916 t_monvoln%IBAGJET(7, ii) = t_monvoln%IBAGJET(5, ii)
917 ELSE
918 WRITE(iout, 1461) nj1(ii), nj2(ii), nj3(ii),
919 . ipt(ii), ipa(ii), ipz(ii),
920 . fpt(ii), fpa(ii) ,fpz(ii)
921 ENDIF
922 ENDIF
923 ENDDO
924 WRITE(iout,1470) nvent, ttfire
925 IF (nvent > 0) THEN
926 WRITE(iout,1471) ittf
927 ENDIF
928 DO ii = 1, nvent
929 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
930 titr1='VENT HOLE SURFACE'
931 WRITE(iout,1472) ii,ipvent(ii)
932 ELSE
933 titr1='POROUS SURFACE'
934 WRITE(iout,1473) ii,ipvent(ii)
935 ENDIF
936 DO jj = 1, 20
937 titrevent(jj) = t_monvoln%IBAGHOL(jj + 14, ii)
938 ENDDO
939 WRITE(iout,1476) venttitle
940 IF (ipvent(ii) == 0 .AND. avent(ii) == zero) THEN
941 CALL ancmsg(msgid=1019, msgtype=msgwarning, anmode=aninfo,
942 . i1=t_monvoln%ID,i2=ii, c1=t_monvoln%TITLE,c2=titr1)
943 ENDIF
944 IF(ifvent(ii) <= 1)WRITE(iout,1481)
945 IF(ifvent(ii)==2) THEN
946 WRITE(iout,1482)ivdp(ii),fvdp(ii)
947 ENDIF
948 IF(ifvent(ii)==3) WRITE(iout,1484)
949 IF(ifvent(ii)==4) WRITE(iout,1485)
950 shol = zero
951 IF (ipvent(ii) /= 0) THEN
952 CALL monvol_check_venthole_surf(ipri, t_monvoln, igrsurf, ii, shol, x, ixc, ixtg)
953 t_monvoln%RBAGHOL(15, ii) = shol
954 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
955 WRITE(iout,1479)
956 . shol,avent(ii),bvent(ii),
957 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
958 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
959 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
960 ELSE
961 WRITE(iout,1579) shol,iblockage(ii)
962 WRITE(iout,1580) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
963 ENDIF
964 ELSE
965 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
966 WRITE(iout,1489)
967 . avent(ii),bvent(ii),
968 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
969 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
970 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
971 ELSE
972 cleak =t_monvoln%RBAGHOL(6, ii)
973 WRITE(iout,1585) cleak(ii),avent(ii),iport(ii),fport(ii),ipora(ii),fpora(ii)
974 WRITE(iout,1580) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
975 ENDIF
976 ENDIF
977 ENDDO
978C ===================
979C Memory deallocation
980C ===================
981 IF (ALLOCATED(i_inj)) DEALLOCATE(i_inj)
982 IF (ALLOCATED(isens)) DEALLOCATE(isens)
983 IF (ALLOCATED(ijet)) DEALLOCATE(ijet)
984 IF (ALLOCATED(nj1)) DEALLOCATE(nj1)
985 IF (ALLOCATED(nj2)) DEALLOCATE(nj2)
986 IF (ALLOCATED(nj3)) DEALLOCATE(nj3)
987 IF (ALLOCATED(ipt)) DEALLOCATE(ipt)
988 IF (ALLOCATED(ipa)) DEALLOCATE(ipa)
989 IF (ALLOCATED(ipz)) DEALLOCATE(ipz)
990 IF (ALLOCATED(fpt)) DEALLOCATE(fpt)
991 IF (ALLOCATED(fpa)) DEALLOCATE(fpa)
992 IF (ALLOCATED(fpz)) DEALLOCATE(fpz)
993 IF (ALLOCATED(i_injsys)) DEALLOCATE(i_injsys)
994 IF (nvent > 0) THEN
995 DEALLOCATE(ipvent, ifvent, avent, bvent)
996 DEALLOCATE(tvent, tstope, dpdef, dtpdef,
997 . idtpdef)
998 DEALLOCATE(iport, iporp, ipora, fport,
999 . fporp, fpora)
1000 DEALLOCATE(iport1, iporp1, ipora1, fport1,
1001 . fporp1, fpora1)
1002 DEALLOCATE(iblockage, cleak)
1003 DEALLOCATE(ivdp, fvdp)
1004 ENDIF
1005C-----------------------------------------------
1006C E n d o f s o u r c e
1007C-----------------------------------------------
1008
1009 RETURN
1010 1002 FORMAT(
1011 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
1012 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
1013 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
1014 1003 FORMAT(
1015 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
1016 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
1017 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
1018 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
1019 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
1020 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
1021 1006 FORMAT( 5x,'GLOBAL HEAT TRANSFER COEFFICIENT. . . .=',1pg20.13)
1022 1395 FORMAT(
1023 . /5x,'INITIAL GAS . . . . . . . . . . . . . .=',i10)
1024 1400 FORMAT(
1025 . 5x,'VOLUMIC VISCOSITY . . . . . . . . . . .=',1pg20.13,
1026 . /5x,'INITIAL TEMPERATURE . . . . . . . . . .=',1pg20.13,
1027 . /5x,'EXTERNAL PRESSURE . . . . . . . . . . .=',1pg20.13,
1028 . /5x,'INITIAL PRESSURE. . . . . . . . . . . .=',1pg20.13/)
1029 1401 FORMAT(
1030 . 5x,'INITIAL THERMODYNAMIC EQUILIBRIUM IS SET AT TIME 0'
1031 . /5x,'--------------------------------------------------'/)
1032 1402 FORMAT(
1033 . 5x,'INITIAL THERMODYNAMIC EQUILIBRIUM IS SET AT INJECTION TIME'
1034 . /5x,'----------------------------------------------------------'/)
1035 1415 FORMAT(
1036 . 5x,'CHARACTERISTICS OF INITIAL GAZ ',
1037 . /5x,'------------------------------ ',
1038 . /5x,'MOLECULAR WEIGHT',
1039 . /5x,' AT INITIAL TEMPERATURE . . . . .=',1pg20.13,
1040 . /5x,'GAMMA AT INITIAL TEMPERATURE . . . . .=',1pg20.13,
1041 . /5x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1042 . /5x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1043 . /5x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,
1044 . /5x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,
1045 . /5x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,
1046 . /5x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13/)
1047 1425 FORMAT(
1048 . /5x,'INJECTORS ',
1049 . /5x,'--------- ')
1050 1426 FORMAT(
1051 . 5x,'NUMBER OF INJECTORS . . . . . . . . . .=',i10/)
1052 1432 FORMAT(
1053 . 5x,'INJECTOR. . . . . . . . . . . . . . . .=',i10,
1054 . /10x,'INJECTOR NUMBER . . . . . . . . . . . .=',i10,
1055 . /10x,'SENSOR NUMBER . . . . . . . . . . . . .=',i10)
1056 1442 FORMAT(
1057 . /15x,'MIXTURE CHARACTERISTICS ',
1058 . /15x,'AT BEGINNING OF INJECTION ',
1059 . /15x,'------------------------- ',
1060 . /15x,'GAMMA . . . . . . . . . . . . . . . . .=',1pg20.13,
1061 . /15x,'MOLECULAR WEIGHT. . . . . . . . . . . .=',1pg20.13,
1062 . /15x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1063 . /15x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1064 . /15x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,
1065 . /15x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,
1066 . /15x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,
1067 . /15x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13)
1068 1455 FORMAT(
1069 . /10x,'JETTING OPTION. . . . . . . . . . . . .=',i10,
1070 . /10x,'----------------------------------------')
1071 1460 FORMAT(
1072 . 15x,'CONICAL JET . . . . . . . . . . . . . .',
1073 . /15x,'NODE NUMBER DEFINING INJECTION CENTER .=',i10,
1074 . /15x,'NODE NUMBER DEFINING INJECTION AXIS . .=',i10,
1075 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
1076 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
1077 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
1078 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
1079 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
1080 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13/)
1081 1461 FORMAT(
1082 . 15x,'DIHEDRAL JET. . . . . . . . . . . . . .',
1083 . /15x,'NODE NUMBER DEFINING INJECTION CENTER .=',i10,
1084 . /15x,'NODE NUMBER DEFINING INJECTION AXIS . .=',i10,
1085 . /15x,'NODE NUMBER DEFINING BASE LINE. . . . .=',i10,
1086 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
1087 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
1088 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
1089 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
1090 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
1091 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13)
1092 1470 FORMAT(
1093 . /5x,'VENT HOLES AND POROUS FABRIC SURFACES ',
1094 . /5x,'------------------------------------- ',
1095 . /5x,'NUMBER OF VENT HOLES AND POROUS SURFACES . .=',i10,
1096 . /5x,'INJECTION TIME TINJ. . . . . . . . . . . . .=',1pg20.13)
1097 1471 FORMAT(
1098 . 5x,'VENTING START TIME SHIFT . . . . . . . . . .=',i10,
1099 . /5x,' 0 : NO SHIFT',
1100 . /5x,' 1 : JETTING FUNCTIONS ARE SHIFTED BY INJECTION TIME',
1101 . /5x,' 2 : JETTING AND VENTING FUNCTIONS ARE SHIFTED BY',
1102 . /5x,' INJECTION TIME TINJ',
1103 . /5x,' 3 : JETTING AND VENTING FUNCTIONS ARE SHIFTED',
1104 . /5x,' BY TINJ FOR JETTING FUNCTIONS',
1105 . /5x,' BY TINJ+TSTART FOR VENTING FUNCTIONS')
1106 1472 FORMAT(
1107 . / 5x,'VENT HOLE NUMBER. . . . . . . . . . . .=',i10,
1108 . /15x,'VENT HOLE SURFACE ID. . . . . . . . . .=',i10)
1109 1473 FORMAT(
1110 . / 5x,'POROUS SURFACE NUMBER . . . . . . . . .=',i10,
1111 . /15x,'POROUS SURFACE ID . . . . . . . . . . .=',i10)
1112 1476 FORMAT(
1113 . 15x,'TITLE . . . . . . . . . . . . . . . . .=',1x,a20)
1114 1481 FORMAT(15x,'ISENTHALPIC VENTING MODEL ')
1115 1482 FORMAT(15x,'CHEMKIN MODEL FOR POROSITY : ',
1116 . /15x,'VELOCITY VS RELATIVE PRESSURE FUNCTION =',i10,
1117 . /15x,' SCALE FACTOR. . . . . . .=',1pg20.13)
1118 1484 FORMAT(15x,'GRAEFE POROSITY FORMULATION')
1119 1485 FORMAT(15x,'ISENTHALPIC VENTING MODEL WITH POSSIBLE FLOW IN')
1120 1479 FORMAT(
1121 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
1122 . /15x,'AVENT:VENT HOLE SCALE FACTOR. . . . . .=',1pg20.13,
1123 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1124 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1125 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1126 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1127 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1128 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1129 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1130 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1131 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1132 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1133 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1134 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1135 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1136 1480 FORMAT(
1137 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1138 . /15x,'RELATIVE PRES. FOR MEMBRANE DEFLATION .=',1pg20.13,
1139 . /15x,' (DPDEF = PDEF - PEXT) ',
1140 . /15x,'TIME DELAY BEFORE MEMBRANE DEFLATION .=',1pg20.13,
1141 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1142 . /15x,' IF IDTPDEF : 0',
1143 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1144 . /15x,' A CUMULATED DTPDEF TIME'
1145 . /15x,' BEFORE ACTIVATING DEFLATION'
1146 . /15x,' IF IDTPDEF : 1',
1147 . /15x,' DEFLATION START DTPDEF AFTER',
1148 . /15x,' DPDEF HAS BEEN REACHED',
1149 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1150 1489 FORMAT(
1151 . 15x,'AVENT:VENT HOLE AREA. . . . . . . . . .=',1pg20.13,
1152 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1153 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1154 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1155 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1156 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1157 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1158 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1159 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1160 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1161 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1162 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1163 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1164 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1165 1579 FORMAT(
1166 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
1167 . /15x,'BLOCKAGE IF CONTACT . . . . . . . . . .=',i10,
1168 . /15x,' =0 NO =1 YES')
1169 1580 FORMAT(
1170 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1171 . /15x,'RELATIVE PRESSURE TO INITIATE LEAKAGE .=',1pg20.13,
1172 . /15x,' (DPDEF = PDEF - PEXT) ',
1173 . /15x,'TIME DELAY BEFORE LEAKAGE . . . . . . .=',1pg20.13,
1174 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1175 . /15x,' IF IDTPDEF = 0',
1176 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1177 . /15x,' A CUMULATED DTPDEF TIME '
1178 . /15x,' BEFORE INITIATING LEAKAGE'
1179 . /15x,' IF IDTPDEF = 1',
1180 . /15x,' DEFLATION STARTS DTPDEF AFTER',
1181 . /15x,' DPDEF HAS BEEN REACHED',
1182 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1183 1585 FORMAT(
1184 . 15x,'LEAKAGE COEFFICIENT . . . . . . . . . .=',1pg20.13,
1185 . /15x,'LEAKAGE AREA. . . . . . . . . . . . . .=',1pg20.13,
1186 . /15x,'LEAKAGE COEFFICIENT TIME FUNCTION . . .=',i10,
1187 . /15x,' SCALE FACTOR. . . . . . . . . .=',1pg20.13,
1188 . /15x,'LEAKAGE AREA TIME FUNCTION. . . . . . .=',i10,
1189 . /15x,' SCALE FACTOR. . . . . . . . . .=',1pg20.13)
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, 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)
Definition message.F:889
subroutine freerr(it)
Definition freform.F:506
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160