OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_monvol_type9.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_monvol_type9_mod ../starter/source/airbag/hm_read_monvol_type9.F
25!||--- called by ------------------------------------------------------
26!|| read_monvol ../starter/source/airbag/read_monvol.F
27!||====================================================================
28 MODULE hm_read_monvol_type9_mod
29 CONTAINS
30!||====================================================================
31!|| hm_read_monvol_type9 ../starter/source/airbag/hm_read_monvol_type9.F
32!||--- called by ------------------------------------------------------
33!|| read_monvol ../starter/source/airbag/read_monvol.F
34!||--- calls -----------------------------------------------------
35!|| ancmsg ../starter/source/output/message/message.F
36!|| freerr ../starter/source/starter/freform.F
37!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
38!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
39!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
40!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
41!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
42!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.F
43!|| monvol_check_surfclose ../starter/share/modules1/monvol_struct_mod.F
44!|| monvol_check_venthole_surf ../starter/share/modules1/monvol_struct_mod.F
45!|| monvol_compute_volume ../starter/share/modules1/monvol_struct_mod.F
46!|| monvol_orient_surf ../starter/share/modules1/monvol_struct_mod.F
47!|| monvol_reverse_normals ../starter/share/modules1/monvol_struct_mod.F
48!|| usr2sys ../starter/source/system/sysfus.F
49!||--- uses -----------------------------------------------------
50!|| message_mod ../starter/share/message_module/message_mod.F
51!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
52!|| submodel_mod ../starter/share/modules1/submodel_mod.F
53!||====================================================================
54 SUBROUTINE hm_read_monvol_type9(T_MONVOLN, T_MONVOL_METADATA, IPM, IGEO, ITABM1,
55 . SENSORS,
56 . UNITAB, LUID, NPC, IGRSURF, ITAB, X, PM, GEO, IXC, IXTG,
57 . LSUBMODEL)
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE groupdef_mod
63 USE message_mod
64 USE monvol_struct_mod
65 USE submodel_mod
66 USE sensor_mod
67 use element_mod , only : nixc,nixtg
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 KMONVO, IREC
78#include "scr17_c.inc"
79C NIMV, NRVOLU
80#include "param_c.inc"
81C IIN
82#include "units_c.inc"
83C IPRI
84#include "scr03_c.inc"
85C-----------------------------------------------
86C D u m m y A r g u m e n t s
87C-----------------------------------------------
88 TYPE(unit_type_), INTENT(IN) :: UNITAB
89 INTEGER, INTENT(IN) :: LUID, IPM(NPROPMI, *), IGEO(NPROPGI, *), ITABM1(*)
90 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
91 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *)
92 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
93 TYPE(monvol_struct_), INTENT(INOUT) :: T_MONVOLN
94 TYPE(MONVOL_METADATA_), INTENT(INOUT) :: T_MONVOL_METADATA
95 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
96 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
97C-----------------------------------------------
98C L o c a l V a r i a b l e s
99C-----------------------------------------------
100 INTEGER :: II, JJ
101 INTEGER :: SURFID
102 my_real :: FAC_M, FAC_L, FAC_T, FAC_C, FAC_GEN
103 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
104 LOGICAL :: FOUND
105 my_real :: sa, rot, vol, vmin, veps, amu, sv
106 INTEGER :: MID_INI, IEQUI, ITTF, MID_INISYS
107 my_real :: hconv, pext, ti, pini
108 my_real :: mwi, cpai, cpbi, cpci, cpdi, cpei, cpfi, r_igc1, cpi, rmwi, cvi, gamai
109 INTEGER :: NJET
110 INTEGER, DIMENSION(:), ALLOCATABLE :: I_INJ, ISENS, IJET, NJ1, NJ2, NJ3,
111 . ipt, ipa, ipz, i_injsys
112 my_real, DIMENSION(:), ALLOCATABLE :: fpt, fpa, fpz
113 INTEGER :: NVENTHOLES, NPORSURF, NVENT
114 CHARACTER(LEN = 40) :: MESS
115 CHARACTER(LEN = 20) :: VENTTITLE
116 INTEGER :: TITREVENT(20)
117 INTEGER, DIMENSION(:), ALLOCATABLE :: IPVENT, IFVENT, IDTPDEF, IPORT, IPORP, IPORA,
118 . iport1, iporp1, ipora1, ivdp, iblockage
119 my_real, DIMENSION(:), ALLOCATABLE :: avent, bvent, tvent, tstope, dpdef, dtpdef,
120 . fport, fporp, fpora, fport1, fporp1, fpora1, fvdp, cleak
121 my_real :: ttfire
122 CHARACTER(LEN = nchartitle) :: TITR1
123 my_real :: MI, RHOI, TI2, ESPECI, CPA, CPB, CPC, CPD, CPE, CPF, MW_TMP, RMWG,
124 . cpg, cvg, gama, shol
125 INTEGER :: NCA
126 INTEGER, DIMENSION(:), ALLOCATABLE :: COMM_BAGID, COMM_IPVENT, COMM_IPORT, COMM_IPORP
127 my_real, DIMENSION(:), ALLOCATABLE :: COMM_DPDEF, COMM_AVENT, COMM_TVENT, COMM_DTPDEF,
128 . comm_fport, comm_fporp
129 INTEGER :: CHKSURF, EXT_SURFID, JI, ITY, NN1, J1, JI1, ITY1, NN, NEL, LCA
130 LOGICAL :: IS_AVAILABLE
131C-----------------------------------------------
132C E x t e r n a l F u n c t i o n s
133C-----------------------------------------------
134 INTEGER USR2SYS
135 EXTERNAL USR2SYS
136C-----------------------------------------------
137C B e g i n n i n g o f s o u r c e
138C-----------------------------------------------
139 mess = 'MONITORED VOLUME DEFINITION '
140 rmwi = 0
141C =======
142C Reading
143C =======
144! Line 1
145 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
146 CALL hm_get_floatv('Hconv', hconv, is_available, lsubmodel, unitab)
147! Line 2
148 CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
149 CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
150 CALL hm_get_floatv('AscaleS', scal_s, is_available, lsubmodel, unitab)
151 CALL hm_get_floatv('AscaleA', scal_a, is_available, lsubmodel, unitab)
152 CALL hm_get_floatv('AscaleD', scal_d, is_available, lsubmodel, unitab)
153! Line 3
154 CALL hm_get_intv('mat_ID', mid_ini, is_available, lsubmodel)
155 CALL hm_get_floatv('Mu', amu, is_available, lsubmodel, unitab)
156 CALL hm_get_floatv('Pext', pext, is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('T0', ti, is_available, lsubmodel, unitab)
158 CALL hm_get_intv('Iequi', iequi, is_available, lsubmodel)
159 CALL hm_get_intv('Ittf', ittf, is_available, lsubmodel)
160! Injectors
161 CALL hm_get_intv('Njet', njet, is_available, lsubmodel)
162 t_monvoln%NJET = njet
163 t_monvoln%IVOLU(8) = njet
164 IF (njet > 0) THEN
165 ALLOCATE(t_monvoln%IBAGJET(nibjet, njet))
166 t_monvoln%IBAGJET(1:nibjet, 1:njet) = 0
167 ALLOCATE(t_monvoln%RBAGJET(nrbjet, njet))
168 t_monvoln%RBAGJET(1:nrbjet, 1:njet) = zero
169 ENDIF
170 IF (njet > 0) THEN
171 ALLOCATE(i_inj(njet), isens(njet), ijet(njet), nj1(njet), nj2(njet), nj3(njet),
172 . ipt(njet), ipa(njet), ipz(njet), fpt(njet), fpa(njet), fpz(njet))
173 DO ii = 1, njet
174 CALL hm_get_int_array_index('inject_ID', i_inj(ii), ii,is_available, lsubmodel)
175 CALL hm_get_int_array_index('sens_ID', isens(ii), ii,is_available, lsubmodel)
176 CALL hm_get_int_array_index('Ijet', ijet(ii), ii,is_available, lsubmodel)
177 CALL hm_get_int_array_index('ABG_N1', nj1(ii), ii,is_available, lsubmodel)
178 CALL hm_get_int_array_index('ABG_N2', nj2(ii), ii,is_available, lsubmodel)
179 CALL hm_get_int_array_index('ABG_N3', nj3(ii), ii,is_available, lsubmodel)
180 IF (ijet(ii) > 0) THEN
181 CALL hm_get_int_array_index('fct_IDPt', ipt(ii), ii,is_available, lsubmodel)
182 CALL hm_get_int_array_index('fctIDPThet', ipa(ii), ii,is_available, lsubmodel)
183 CALL hm_get_int_array_index('fctIDPDelt', ipz(ii), ii,is_available, lsubmodel)
184 CALL hm_get_float_array_index('FscalePt', fpt(ii), ii, is_available, lsubmodel, unitab)
185 CALL hm_get_float_array_index('FscalePTheta', fpa(ii), ii, is_available, lsubmodel, unitab)
186 CALL hm_get_float_array_index('FscalePDelta', fpz(ii), ii, is_available, lsubmodel, unitab)
187 ENDIF
188 ENDDO
189 ENDIF
190
191! ventholes and porous surfaces
192 CALL hm_get_intv('Nvent', nventholes, is_available, lsubmodel)
193 CALL hm_get_intv('Nporsurf', nporsurf, is_available, lsubmodel)
194
195 nvent = nventholes + nporsurf
196 t_monvoln%IVOLU(11) = nvent
197 t_monvoln%NVENT = nvent
198 t_monvoln%NPORSURF = nporsurf
199 IF (nvent > 0) THEN
200 ALLOCATE(t_monvoln%IBAGHOL(nibhol, nvent))
201 t_monvoln%IBAGHOL(1:nibhol, 1:nvent) = 0
202 ALLOCATE(t_monvoln%RBAGHOL(nrbhol, nvent))
203 t_monvoln%RBAGHOL(1:nrbhol, 1:nvent) = zero
204 ENDIF
205 ALLOCATE(ipvent(nvent), ifvent(nvent), avent(nvent), bvent(nvent))
206 ALLOCATE(tvent(nvent), tstope(nvent), dpdef(nvent), dtpdef(nvent),
207 . idtpdef(nvent))
208 ALLOCATE(iport(nvent), iporp(nvent), ipora(nvent), fport(nvent),
209 . fporp(nvent), fpora(nvent))
210 ALLOCATE(iport1(nvent), iporp1(nvent), ipora1(nvent), fport1(nvent),
211 . fporp1(nvent), fpora1(nvent))
212 ALLOCATE(iblockage(nvent), cleak(nvent))
213 ALLOCATE(ivdp(nvent), fvdp(nvent))
214
215 IF (nventholes > 0) THEN
216 DO ii = 1, nventholes
217 venttitle = ''
218 CALL hm_get_int_array_index('surf_IDv', ipvent(ii), ii, is_available, lsubmodel)
219 CALL hm_get_int_array_index('Iform', ifvent(ii), ii, is_available, lsubmodel)
220 CALL hm_get_float_array_index('Avent', avent(ii), ii, is_available, lsubmodel, unitab)
221 CALL hm_get_float_array_index('Bvent', bvent(ii), ii, is_available, lsubmodel, unitab)
222 CALL hm_get_string_index('vent_title', venttitle, ii, 20, is_available)
223
224 CALL hm_get_float_array_index('Tstart_arr_X', tvent(ii), ii, is_available, lsubmodel, unitab)
225 CALL hm_get_float_array_index('Tstop_arr_X', tstope(ii), ii, is_available, lsubmodel, unitab)
226 CALL hm_get_float_array_index('ABG_dPdef', dpdef(ii), ii, is_available, lsubmodel, unitab)
227 CALL hm_get_float_array_index('ABG_dtPdef', dtpdef(ii), ii, is_available, lsubmodel, unitab)
228 CALL hm_get_int_array_index('I_dtPdef_arr', idtpdef(ii), ii,is_available, lsubmodel)
229 venttitle = venttitle(1:len_trim(venttitle))
230 DO jj = 1, 20
231 titrevent(jj) = iachar(venttitle(jj:jj))
232 t_monvoln%IBAGHOL(jj + 14, ii) = titrevent(jj)
233 ENDDO
234 CALL hm_get_int_array_index('fct_IDt', iport(ii), ii,is_available, lsubmodel)
235 CALL hm_get_int_array_index('fct_IDP', iporp(ii), ii,is_available, lsubmodel)
236 CALL hm_get_int_array_index('fct_IDA', ipora(ii), ii,is_available, lsubmodel)
237 CALL hm_get_float_array_index('Fscalet', fport(ii), ii, is_available, lsubmodel, unitab)
238 CALL hm_get_float_array_index('FscaleP', fporp(ii), ii, is_available, lsubmodel, unitab)
239 CALL hm_get_float_array_index('FscaleA', fpora(ii), ii, is_available, lsubmodel, unitab)
240
241 CALL hm_get_int_array_index("fct_IDt'", iport1(ii), ii,is_available, lsubmodel)
242 CALL hm_get_int_array_index("fct_IDP'", iporp1(ii), ii,is_available, lsubmodel)
243 CALL hm_get_int_array_index("fct_IDA'", ipora1(ii), ii,is_available, lsubmodel)
244 CALL hm_get_float_array_index("Fscalet'", fport1(ii), ii, is_available, lsubmodel, unitab)
245 CALL hm_get_float_array_index("FscaleP'", fporp1(ii), ii, is_available, lsubmodel, unitab)
246 CALL hm_get_float_array_index("FscaleA'", fpora1(ii), ii, is_available, lsubmodel, unitab)
247
248 IF (ifvent(ii) == 2) THEN
249 CALL hm_get_int_array_index('ABG_Iv', ivdp(ii), ii,is_available, lsubmodel)
250 CALL hm_get_float_array_index('BB1', fvdp(ii), ii, is_available, lsubmodel, unitab)
251 ELSE
252 ivdp(ii) = 0
253 fvdp(ii) = zero
254 ENDIF
255 ENDDO
256 ENDIF
257
258 IF (nporsurf > 0) THEN
259 DO ii = 1, nporsurf
260 venttitle = ''
261 CALL hm_get_int_array_index('surf_IDps', ipvent(nventholes + ii), ii,is_available, lsubmodel)
262 CALL hm_get_int_array_index('Iformps', ifvent(nventholes + ii), ii,is_available, lsubmodel)
263 CALL hm_get_int_array_index('Iblockage', iblockage(nventholes + ii), ii,is_available, lsubmodel)
264 CALL hm_get_string_index('surface_title', venttitle, ii, 20, is_available)
265
266 venttitle = venttitle(1:len_trim(venttitle))
267 DO jj = 1, 20
268 titrevent(jj) = iachar(venttitle(jj:jj))
269 t_monvoln%IBAGHOL(jj + 14, nventholes + ii) = titrevent(jj)
270 ENDDO
271 CALL hm_get_float_array_index('Tstart_arr_Y', tvent(nventholes + ii), ii, is_available, lsubmodel, unitab)
272 CALL hm_get_float_array_index('Tstop_arr_Y', tstope(nventholes + ii), ii, is_available, lsubmodel, unitab)
273 CALL hm_get_float_array_index('ABG_dPdef_ps', dpdef(nventholes + ii), ii, is_available, lsubmodel, unitab)
274 CALL hm_get_float_array_index('ABG_dtPdef_ps', dtpdef(nventholes + ii), ii, is_available, lsubmodel, unitab)
275 CALL hm_get_int_array_index('I_dtPdef_arr_ps', idtpdef(nventholes + ii), ii,is_available, lsubmodel)
276
277
278 cleak(nventholes + ii) = zero
279 avent(nventholes + ii) = zero
280 iport(nventholes + ii) = 0
281 ipora(nventholes + ii) = 0
282 fport(nventholes + ii) = zero
283 fpora(nventholes + ii) = zero
284 IF (ifvent(nventholes + ii) == 0) THEN
285 CALL hm_get_float_array_index('Cps', cleak(nventholes + ii), ii, is_available, lsubmodel, unitab)
286 CALL hm_get_float_array_index('Areaps', avent(nventholes + ii), ii, is_available, lsubmodel, unitab)
287 CALL hm_get_int_array_index('fct_IDcps', iport(nventholes + ii), ii,is_available, lsubmodel)
288 CALL hm_get_int_array_index('fct_IDaps', ipora(nventholes + ii), ii,is_available, lsubmodel)
289 CALL hm_get_float_array_index('Fscalecps', fport(nventholes + ii), ii, is_available, lsubmodel, unitab)
290 CALL hm_get_float_array_index('Fscaleaps', fpora(nventholes + ii), ii, is_available, lsubmodel, unitab)
291
292 ENDIF
293 ivdp(nventholes + ii) = 0
294 fvdp(nventholes + ii) = zero
295 IF (ifvent(nventholes + ii) == 2) THEN
296 CALL hm_get_int_array_index('ABG_fct_v', ivdp(nventholes + ii), ii,is_available, lsubmodel)
297 CALL hm_get_float_array_index('BB10', fvdp(nventholes + ii), ii, is_available, lsubmodel, unitab)
298 ENDIF
299 ENDDO
300 ENDIF
301! Specific cards communicating airbags
302 CALL hm_get_intv('Nbag', nca, is_available, lsubmodel)
303
304 t_monvoln%NCA = nca
305 t_monvoln%IVOLU(3) = nca
306
307 IF (nca > 0) THEN
308 ALLOCATE(comm_bagid(nca), comm_ipvent(nca), comm_iport(nca), comm_iporp(nca),
309 . comm_dpdef(nca), comm_avent(nca), comm_tvent(nca), comm_dtpdef(nca),
310 . comm_fport(nca), comm_fporp(nca))
311 DO ii = 1, nca
312 CALL hm_get_int_array_index('bag_ID', comm_bagid(ii), ii,is_available, lsubmodel)
313 CALL hm_get_int_array_index('surf_IDc', comm_ipvent(ii), ii,is_available, lsubmodel)
314 CALL hm_get_float_array_index('DeltaPCdef', comm_dpdef(ii), ii, is_available, lsubmodel, unitab)
315 CALL hm_get_float_array_index('Acom', comm_avent(ii), ii, is_available, lsubmodel, unitab)
316 CALL hm_get_float_array_index('Tcom', comm_tvent(ii), ii, is_available, lsubmodel, unitab)
317 CALL hm_get_float_array_index('DeltatPCdef', comm_dtpdef(ii), ii, is_available, lsubmodel, unitab)
318
319 CALL hm_get_int_array_index('fct_IDCt', comm_iport(ii), ii,is_available, lsubmodel)
320 CALL hm_get_int_array_index('fct_IDCP', comm_iporp(ii), ii,is_available, lsubmodel)
321 CALL hm_get_float_array_index('FscaleCt', comm_fport(ii), ii, is_available, lsubmodel, unitab)
322 CALL hm_get_float_array_index('FscaleCP', comm_fporp(ii), ii, is_available, lsubmodel, unitab)
323 ENDDO
324 ENDIF
325
326C =====
327C Units
328C =====
329 fac_m = unitab%FAC_M(luid)
330 fac_l = unitab%FAC_L(luid)
331 fac_t = unitab%FAC_T(luid)
332 fac_c = fac_m / (fac_l * fac_t * fac_t)
333
334C ================
335C Check operations
336C ================
337C External surface check
338 t_monvoln%IVOLU(4) = 0
339 found = .false.
340 DO ii = 1, nsurf
341 IF (surfid == igrsurf(ii)%ID) THEN
342 t_monvoln%IVOLU(4) = ii
343 t_monvoln%EXT_SURFID = ii
344 found = .true.
345 EXIT
346 ENDIF
347 ENDDO
348 IF (.NOT. found) THEN
349 CALL freerr(3)
350 ELSEIF (igrsurf(t_monvoln%IVOLU(4))%ISH4N3N == 0) THEN
351 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
352 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
353 CALL freerr(3)
354 ENDIF
355
356C Check surface closure
357 CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
358C Set all normal on same side
359 CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
360 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 9)
361C Compute Monvon volume
362 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
363 . itab, x, pm, geo, ixc, ixtg,
364 . sa, rot, vol, vmin, veps, sv)
365C Reverse all normals to ensure positive volume
366 CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
367 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 9)
368
369 IF (ittf < 0 .OR. ittf > 3) THEN
370 CALL ancmsg(msgid = 773, anmode = aninfo, msgtype = msgerror,
371 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
372 END IF
373 IF (ti == zero) THEN
374 ti = twohundred95
375 ENDIF
376! Find material
377 t_monvoln%IVOLU(66) = 0
378 found = .false.
379 DO ii = 1, nummat
380 IF (ipm(1, ii) == mid_ini .AND. ipm(2, ii) == 999) THEN
381 mwi = pm(20, ii) * fac_m
382 cpai = pm(21, ii) * fac_l * fac_l / (fac_t * fac_t)
383 cpbi = pm(22, ii) * fac_l * fac_l / (fac_t * fac_t)
384 cpci = pm(23, ii) * fac_l * fac_l / (fac_t * fac_t)
385 cpdi = pm(24, ii) * fac_l * fac_l / (fac_t * fac_t)
386 cpei = pm(25, ii) * fac_l * fac_l / (fac_t * fac_t)
387 cpfi = pm(26, ii) * fac_l * fac_l / (fac_t * fac_t)
388 r_igc1 = pm(27, ii)
389 cpi = cpai + cpbi * ti + cpci * ti * ti + cpdi * ti * ti * ti +
390 . cpei / (ti * ti) + cpfi * ti * ti * ti * ti
391 rmwi = r_igc1 / mwi
392 cvi = cpi - rmwi
393 t_monvoln%IVOLU(66) = ii
394 IF (cvi == zero) THEN
395 CALL ancmsg(msgid = 709, msgtype = msgerror, anmode = aninfo,
396 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
397 gamai = zero
398 ELSE
399 gamai = cpi / cvi
400 END IF
401 found = .true.
402 EXIT
403 ENDIF
404 ENDDO
405 IF (.NOT. found) THEN
406 CALL ancmsg(msgid = 699, anmode = aninfo, msgtype = msgerror,
407 . i2 = mid_ini, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
408 ENDIF
409! Injectors
410 IF (njet > 0) THEN
411 ALLOCATE(i_injsys(njet))
412 DO ii = 1, njet
413! check injector property
414 i_injsys(ii) = 0
415 found = .false.
416 DO jj = 1, numgeo
417 IF (igeo(1, jj) == i_inj(ii)) THEN
418 i_injsys(ii) = jj
419 found = .true.
420 EXIT
421 ENDIF
422 ENDDO
423 IF (.NOT. found) THEN
424 CALL ancmsg(msgid = 723, anmode = aninfo, msgtype = msgerror,
425 . i2 = i_inj(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
426 ENDIF
427 ENDDO
428 ENDIF
429
430C ==============
431C Default values
432C ==============
433 IF (scal_t == zero) THEN
434 CALL hm_get_floatv_dim('Ascalet', fac_gen, is_available, lsubmodel, unitab)
435 scal_t = one * fac_gen
436 ENDIF
437 IF (scal_p == zero) THEN
438 CALL hm_get_floatv_dim('AscaleP', fac_gen, is_available, lsubmodel, unitab)
439 scal_p = one * fac_gen
440 ENDIF
441 IF (scal_s == zero) THEN
442 CALL hm_get_floatv_dim('AscaleS', fac_gen, is_available, lsubmodel, unitab)
443 scal_s = one * fac_gen
444 ENDIF
445 IF (scal_a == zero) THEN
446 CALL hm_get_floatv_dim('AscaleA', fac_gen, is_available, lsubmodel, unitab)
447 scal_a = one * fac_gen
448 ENDIF
449 IF (scal_d == zero) THEN
450 CALL hm_get_floatv_dim('AscaleD', fac_gen, is_available, lsubmodel, unitab)
451 scal_d = one * fac_gen
452 ENDIF
453
454 IF (amu == zero) amu = em02
455 IF (pext == zero) THEN
456 pext = 101325.d0 * (unitab%FAC_L_WORK * unitab%FAC_T_WORK * unitab%FAC_T_WORK) / unitab%FAC_M_WORK
457 ENDIF
458
459 pini = pext
460! Injectors
461 IF (njet > 0) THEN
462 DO ii = 1, njet
463 IF (ijet(ii) > 0) THEN
464 IF (fpt(ii) == zero) fpt(ii) = one
465 IF (fpa(ii) == zero) fpa(ii) = one
466 IF (fpz(ii) == zero) fpz(ii) = one
467 ELSE
468 fpt(ii) = one
469 fpa(ii) = one
470 fpz(ii) = one
471 ENDIF
472 ENDDO
473 ENDIF
474! Ventholes
475 IF (nventholes > 0) THEN
476 DO ii = 1, nventholes
477 IF (ifvent(ii) == 0) ifvent(ii) = 1
478 IF (ipvent(ii) == 0) THEN
479 bvent(ii) = zero
480 ENDIF
481 IF (fport(ii) == zero) fport(ii) = one
482 IF (fporp(ii) == zero) fporp(ii) = one
483 IF (fpora(ii) == zero) fpora(ii) = one
484 IF (fport1(ii) == zero) fport1(ii) = one
485 IF (fporp1(ii) == zero) fporp1(ii) = one
486 IF (fpora1(ii) == zero) fpora1(ii) = one
487 ENDDO
488 ENDIF
489!
490 IF (nca > 0) THEN
491 DO ii = 1, nca
492 IF (comm_fport(ii) == zero) comm_fport(ii) = one
493 IF (comm_fporp(ii) == zero) comm_fporp(ii) = one
494 ENDDO
495 ENDIF
496C =====
497C Store
498C =====
499 t_monvoln%IVOLU(8) = njet
500 IF (iequi > 0 .AND. iequi /= 1) iequi = 1
501 t_monvoln%IVOLU(15) = iequi
502 t_monvoln%IVOLU(17) = ittf
503
504 t_monvoln%RVOLU(19) = hconv
505 t_monvoln%RVOLU(26) = one / scal_t
506 t_monvoln%RVOLU(27) = one / scal_p
507 t_monvoln%RVOLU(28) = one / scal_s
508 t_monvoln%RVOLU(29) = one / scal_a
509 t_monvoln%RVOLU(30) = one / scal_d
510
511 t_monvoln%RVOLU(31) = pini
512
513 mid_inisys = t_monvoln%IVOLU(66)
514 IF (mid_inisys /= 0) THEN
515 mwi = pm(20, mid_inisys)
516 cpai = pm(21, mid_inisys)
517 cpbi = pm(22, mid_inisys)
518 cpci = pm(23, mid_inisys)
519 cpdi = pm(24, mid_inisys)
520 cpei = pm(25, mid_inisys)
521 cpfi = pm(26, mid_inisys)
522 r_igc1 = pm(27, mid_inisys)
523 ELSE
524 mwi = zero
525 cpai = zero
526 cpbi = zero
527 cpci = zero
528 cpdi = zero
529 cpei = zero
530 cpfi = zero
531 r_igc1 = zero
532 CALL ancmsg(msgid= 7 18, anmode = aninfo, msgtype = msgerror,
533 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
534 ENDIF
535 t_monvoln%RVOLU(7)=cpai
536 t_monvoln%RVOLU(8)=cpbi
537 t_monvoln%RVOLU(9)=cpci
538 t_monvoln%RVOLU(56)=cpdi
539 t_monvoln%RVOLU(57)=cpei
540 t_monvoln%RVOLU(58)=cpfi
541 t_monvoln%RVOLU(59)=mwi
542 cpi = cpai + cpbi * ti + cpci * ti * ti + cpdi * ti * ti * ti +
543 . cpei / (ti * ti) + cpfi * ti * ti * ti * ti
544 IF (mwi == zero) THEN
545 gamai = zero
546 ELSE
547 rmwi = r_igc1 / mwi
548 cvi = cpi - rmwi
549 gamai = cpi / cvi
550 ENDIF
551 mi = pini * (vol + veps) / (rmwi * ti)
552 t_monvoln%RVOLU(1) = gamai
553 t_monvoln%RVOLU(3) = pext
554 t_monvoln%RVOLU(4) = vol + veps
555 t_monvoln%RVOLU(11) = mi
556 t_monvoln%RVOLU(12) = pini
557 t_monvoln%RVOLU(13) = ti
558 t_monvoln%RVOLU(14) = rmwi * mi
559 t_monvoln%RVOLU(17) = veps
560 t_monvoln%RVOLU(20) = mi
561 t_monvoln%RVOLU(25) = ti
562 t_monvoln%RVOLU(61) = gamai
563 rhoi = pini / (ti * rmwi)
564 t_monvoln%RVOLU(62) = rhoi
565 t_monvoln%RVOLU(10) = rmwi
566 ti2=ti*ti
567 especi=ti*(cpai+half*cpbi*ti+third*cpci*ti2-rmwi)
568 especi=especi+fourth*cpdi*ti2*ti2-cpei/ti+one_fifth*cpfi*ti2*ti2*ti
569 t_monvoln%RVOLU(63)= especi+rmwi*ti
570 t_monvoln%RVOLU(64)= zero
571 t_monvoln%RVOLU(65)= zero
572 t_monvoln%RVOLU(66)= especi
573! Injectors
574 ttfire = infinity
575 DO ii = 1, njet
576 t_monvoln%IBAGJET(13, ii) = i_injsys(ii)
577 t_monvoln%RBAGJET(1, ii) = zero
578 t_monvoln%RBAGJET(2, ii) = geo(203, i_injsys(ii))
579 t_monvoln%RBAGJET(3, ii) = geo(204, i_injsys(ii))
580 t_monvoln%RBAGJET(4, ii) = geo(205, i_injsys(ii))
581 t_monvoln%RBAGJET(16, ii) = geo(206, i_injsys(ii))
582 t_monvoln%RBAGJET(17, ii) = geo(207, i_injsys(ii))
583 t_monvoln%RBAGJET(18, ii) = geo(208, i_injsys(ii))
584 t_monvoln%RBAGJET(19, ii) = geo(202, i_injsys(ii))
585 t_monvoln%RBAGJET(5, ii) = zero !FMASS
586 t_monvoln%RBAGJET(6, ii) = zero !FTEMP
587 t_monvoln%RBAGJET(12, ii) = fpt(ii)
588 t_monvoln%RBAGJET(13, ii) = fpa(ii)
589 t_monvoln%RBAGJET(14, ii) = fpz(ii)
590 t_monvoln%IBAGJET(2, ii) = 0 !IFLU
591 t_monvoln%IBAGJET(3, ii) = 0 !ITEMP
592 t_monvoln%IBAGJET(4, ii) = isens(ii)
593! Jetting
594 IF (ijet(ii) > 0) THEN
595 t_monvoln%IBAGJET(5, ii) = usr2sys(nj1(ii), itabm1, mess, t_monvoln%ID)
596 t_monvoln%IBAGJET(6, ii) = usr2sys(nj2(ii), itabm1, mess, t_monvoln%ID)
597 IF(nj3(ii) /= 0) THEN
598 t_monvoln%IBAGJET(7, ii) = usr2sys(nj3(ii), itabm1, mess, t_monvoln%ID)
599 ENDIF
600 found = .false.
601 DO jj= 1, nfunct
602 IF (ipt(ii) == npc(jj)) THEN
603 t_monvoln%IBAGJET(8, ii) = jj
604 found = .true.
605 EXIT
606 ENDIF
607 ENDDO
608 IF (.NOT. found) THEN
609 CALL ancmsg(msgid = 12, anmode = aninfo, msgtype = msgerror,
610 . i2 = ipt(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
611 ENDIF
612 found = .false.
613 DO jj = 1, nfunct
614 IF (ipa(ii) == npc(jj)) THEN
615 t_monvoln%IBAGJET(9, ii) = jj
616 found = .true.
617 EXIT
618 ENDIF
619 ENDDO
620 IF (.NOT. found) THEN
621 CALL ancmsg(msgid = 13, anmode = aninfo, msgtype = msgerror,
622 . i2 = ipa(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
623 ENDIF
624 found = .false.
625 DO jj = 1, nfunct
626 IF (ipz(ii) == npc(jj)) THEN
627 t_monvoln%IBAGJET(10, ii) = jj
628 found = .true.
629 EXIT
630 ENDIF
631 ENDDO
632 IF (.NOT. found) THEN
633 CALL ancmsg(msgid = 14, anmode = aninfo, msgtype = msgerror,
634 . i2 = ipz(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
635 ENDIF
636 ENDIF
637 IF (isens(ii) > 0) THEN
638 found = .false.
639 DO jj = 1, sensors%NSENSOR
640 IF (isens(ii) == sensors%SENSOR_TAB(jj)%SENS_ID) THEN
641 t_monvoln%IBAGJET(4, ii) = jj
642 IF (sensors%SENSOR_TAB(jj)%TCRIT < ttfire) ttfire = sensors%SENSOR_TAB(jj)%TCRIT
643 found = .true.
644 EXIT
645 ENDIF
646 ENDDO
647 IF (.NOT. found) THEN
648 CALL ancmsg(msgid = 17, anmode =aninfo, msgtype = msgerror,
649 . i2 = isens(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
650 ENDIF
651 ENDIF
652 cpa = t_monvoln%RBAGJET(2, ii)
653 cpb = t_monvoln%RBAGJET(3, ii)
654 cpc = t_monvoln%RBAGJET(4, ii)
655 cpd = t_monvoln%RBAGJET(16, ii)
656 cpe = t_monvoln%RBAGJET(17, ii)
657 cpf = t_monvoln%RBAGJET(18, ii)
658 mw_tmp = t_monvoln%RBAGJET(19, ii)
659 rmwg = r_igc1 / mw_tmp
660 cpg = cpa + cpb*ti+cpc*ti*ti+cpd*ti*ti*ti+
661 . cpe/(ti*ti)+cpf*ti*ti*ti*ti
662 cvg = cpg - rmwg
663 gama = cpg / cvg
664 t_monvoln%RBAGJET(1, ii) = rmwg
665 ENDDO
666 IF (ttfire == infinity) ttfire = zero
667 t_monvoln%RVOLU(49) = ttfire
668! Ventholes
669 DO ii = 1, nventholes
670 t_monvoln%RBAGHOL(7, ii) = fport(ii)
671 t_monvoln%RBAGHOL(8, ii) = fporp(ii)
672 t_monvoln%RBAGHOL(9, ii) = fpora(ii)
673 t_monvoln%RBAGHOL(10, ii) = fport1(ii)
674 t_monvoln%RBAGHOL(11, ii) = fporp1(ii)
675 t_monvoln%RBAGHOL(12, ii) = fpora1(ii)
676
677 t_monvoln%IBAGHOL(1, ii) = 0
678 t_monvoln%IBAGHOL(10, ii) = ifvent(ii)
679 t_monvoln%IBAGHOL(11, ii) = idtpdef(ii)
680
681 t_monvoln%IBAGHOL(12, ii) = 0
682
683 IF (ipvent(ii) == 0) THEN
684 t_monvoln%IBAGHOL(2, ii) = 0
685 ELSE
686 t_monvoln%IBAGHOL(2, ii) = 0
687 found = .false.
688 DO jj = 1, nsurf
689 IF (ipvent(ii) == igrsurf(jj)%ID) THEN
690 t_monvoln%IBAGHOL(2, ii) = jj
691 found = .true.
692 EXIT
693 ENDIF
694 ENDDO
695 IF(.NOT. found)THEN
696 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
697 . i2 = ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
698 ELSEIF(igrsurf(t_monvoln%IBAGHOL(2, ii))%ISH4N3N == 0) THEN
699 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
700 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
701 ENDIF
702 IF (avent(ii) == zero) avent(ii) = one
703 ENDIF
704 IF (avent(ii) == zero) dpdef(ii) = infinity
705 IF (avent(ii) == zero) tvent(ii) = infinity
706 IF (dpdef(ii) == zero .AND. dtpdef(ii) == zero .AND. tvent(ii) == zero) THEN
707 t_monvoln%IBAGHOL(1, ii) = 1
708 ENDIF
709 t_monvoln%RBAGHOL(1, ii) = dpdef(ii)
710 t_monvoln%RBAGHOL(2, ii) = avent(ii)
711 t_monvoln%RBAGHOL(3, ii) = tvent(ii)
712 t_monvoln%RBAGHOL(4, ii) = dtpdef(ii)
713 t_monvoln%RBAGHOL(6, ii) = bvent(ii)
714 IF (ivdp(ii) /= 0 .AND. fvdp(ii) == zero) fvdp(ii) = one
715 t_monvoln%RBAGHOL(13, ii) = fvdp(ii)
716 IF (tstope(ii) == zero) tstope(ii) = infinity
717 t_monvoln%RBAGHOL(14, ii) = tstope(ii)
718C
719 t_monvoln%IBAGHOL(3, ii) = -1
720 t_monvoln%IBAGHOL(4, ii) = -1
721 t_monvoln%IBAGHOL(5, ii) = -1
722 t_monvoln%IBAGHOL(6, ii) = -1
723 t_monvoln%IBAGHOL(7, ii) = -1
724 t_monvoln%IBAGHOL(8, ii) = -1
725 t_monvoln%IBAGHOL(9, ii) = -1
726 DO jj = 1, nfunct
727 IF (iport(ii) == npc(jj)) t_monvoln%IBAGHOL(3, ii) = jj
728 IF (iporp(ii) == npc(jj)) t_monvoln%IBAGHOL(4, ii) = jj
729 IF (ipora(ii) == npc(jj)) t_monvoln%IBAGHOL(5, ii) = jj
730 IF (iport1(ii) == npc(jj)) t_monvoln%IBAGHOL(6, ii) = jj
731 IF (iporp1(ii) == npc(jj)) t_monvoln%IBAGHOL(7, ii) = jj
732 IF (ipora1(ii) == npc(jj)) t_monvoln%IBAGHOL(8, ii) = jj
733 IF (ivdp(ii) == npc(jj)) t_monvoln%IBAGHOL(9, ii) = jj
734 ENDDO
735 IF (iport(ii) == 0) t_monvoln%IBAGHOL(3, ii) = 0
736 IF (iporp(ii) == 0) t_monvoln%IBAGHOL(4, ii) = 0
737 IF (ipora(ii) == 0) t_monvoln%IBAGHOL(5, ii) = 0
738 IF (iport1(ii) == 0) t_monvoln%IBAGHOL(6, ii) = 0
739 IF (iporp1(ii) == 0) t_monvoln%IBAGHOL(7, ii) = 0
740 IF (ipora1(ii) == 0) t_monvoln%IBAGHOL(8, ii) = 0
741 IF (ivdp(ii) == 0 .AND. ifvent(ii) /= 2) t_monvoln%IBAGHOL(9, ii) = 0
742 IF (t_monvoln%IBAGHOL(3, ii) == -1) THEN
743 t_monvoln%IBAGHOL(3, ii) = 0
744 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
745 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(ii))
746 ENDIF
747 IF (t_monvoln%IBAGHOL(4, ii) == -1) THEN
748 t_monvoln%IBAGHOL(4, ii) = 0
749 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
750 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp(ii))
751 ENDIF
752 IF (t_monvoln%IBAGHOL(5, ii) == -1) THEN
753 t_monvoln%IBAGHOL(5, ii)=0
754 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
755 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(ii))
756 ENDIF
757 IF (t_monvoln%IBAGHOL(6, ii) == -1) THEN
758 t_monvoln%IBAGHOL(6, ii) = 0
759 CALL ancmsg(msgid=331, anmode=aninfo, msgtype=msgerror,
760 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport1(ii))
761 ENDIF
762 IF (t_monvoln%IBAGHOL(7, ii) == -1) THEN
763 t_monvoln%IBAGHOL(7, ii)=0
764 CALL ancmsg(msgid=332, anmode=aninfo, msgtype=msgerror,
765 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp1(ii))
766 ENDIF
767 IF (t_monvoln%IBAGHOL(8, ii) == -1) THEN
768 t_monvoln%IBAGHOL(8, ii) = 0
769 CALL ancmsg(msgid=333, anmode=aninfo, msgtype=msgerror,
770 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora1(ii))
771 ENDIF
772 IF (t_monvoln%IBAGHOL(9, ii) == -1) THEN
773 t_monvoln%IBAGHOL(9, ii) = 0
774 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
775 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(ii))
776 ENDIF
777 ENDDO
778
779 DO ii = 1, nporsurf
780 t_monvoln%IBAGHOL(13, nventholes + ii) = 1
781 IF (ifvent(nventholes + ii) == 0) THEN
782 IF (cleak(nventholes + ii) > zero) iport(nventholes + ii) = 0
783 IF (avent(nventholes + ii) > zero) ipora(nventholes + ii) = 0
784 ipvent(nventholes + ii) = 0
785 iblockage(nventholes + ii) = 0
786 ENDIF
787 IF (fport(nventholes + ii) == zero) fport(nventholes + ii) = one
788 IF (fpora(nventholes + ii) == zero) fpora(nventholes + ii) = one
789 t_monvoln%RBAGHOL(7, nventholes + ii) = fport(nventholes + ii)
790 t_monvoln%RBAGHOL(9, nventholes + ii) = fpora(nventholes + ii)
791C
792 t_monvoln%IBAGHOL(1, nventholes + ii) = 0
793 t_monvoln%IBAGHOL(10, nventholes + ii) = ifvent(nventholes + ii)
794 t_monvoln%IBAGHOL(11, nventholes + ii) = idtpdef(nventholes + ii)
795 t_monvoln%IBAGHOL(12, nventholes + ii) = 0
796 t_monvoln%IBAGHOL(14, nventholes + ii) = iblockage(nventholes + ii)
797C
798 IF (ipvent(nventholes + ii) == 0) THEN
799 t_monvoln%IBAGHOL(2, nventholes + ii) = 0
800 ELSE
801 t_monvoln%IBAGHOL(2, nventholes + ii) = 0
802 DO jj = 1, nsurf
803 IF (ipvent(nventholes + ii) == igrsurf(jj)%ID) THEN
804 t_monvoln%IBAGHOL(2, nventholes + ii) = jj
805 ENDIF
806 ENDDO
807 IF (t_monvoln%IBAGHOL(2, nventholes + ii) == 0) THEN
808 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
809 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipvent(nventholes + ii))
810 ELSEIF (igrsurf(t_monvoln%IBAGHOL(2, nventholes + ii))%ISH4N3N == 0) THEN
811 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
812 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
813 ENDIF
814 ENDIF
815C
816 IF (dpdef(nventholes + ii) == zero .AND. dtpdef(nventholes + ii) == zero .AND.
817 . tvent(nventholes + ii) == zero) THEN
818 t_monvoln%IBAGHOL(1, nventholes + ii) = 1
819 ENDIF
820 t_monvoln%RBAGHOL(1, nventholes + ii) = dpdef(nventholes + ii)
821 t_monvoln%RBAGHOL(2, nventholes + ii) = avent(nventholes + ii)
822 t_monvoln%RBAGHOL(3, nventholes + ii) = tvent(nventholes + ii)
823 t_monvoln%RBAGHOL(4, nventholes + ii) = dtpdef(nventholes + ii)
824 t_monvoln%RBAGHOL(6, nventholes + ii) = cleak(nventholes + ii)
825 IF (ivdp(nventholes + ii) /= 0 .AND. fvdp(nventholes + ii) == zero) fvdp=one
826 t_monvoln%RBAGHOL(13, nventholes + ii)=fvdp(nventholes + ii)
827 IF (tstope(nventholes + ii) == zero) tstope(nventholes + ii) = infinity
828 t_monvoln%RBAGHOL(14, nventholes + ii) = tstope(nventholes + ii)
829C
830 t_monvoln%IBAGHOL(3, nventholes + ii) = -1
831 t_monvoln%IBAGHOL(5, nventholes + ii) = -1
832 t_monvoln%IBAGHOL(9, nventholes + ii) = -1
833C
834 DO jj = 1, nfunct
835 IF (iport(nventholes + ii) == npc(jj)) THEN
836 t_monvoln%IBAGHOL(3, nventholes + ii) = jj
837 ENDIF
838 IF (ipora(nventholes + ii) == npc(jj)) THEN
839 t_monvoln%IBAGHOL(5, nventholes + ii) = jj
840 ENDIF
841 IF (ivdp(nventholes + ii) == npc(jj)) THEN
842 t_monvoln%IBAGHOL(9, nventholes + ii) = jj
843 ENDIF
844 ENDDO
845 IF (iport(nventholes + ii) == 0) t_monvoln%IBAGHOL(3, nventholes + ii) = 0
846 IF (ipora(nventholes + ii) == 0) t_monvoln%IBAGHOL(5, nventholes + ii) = 0
847 IF (ivdp(nventholes + ii) == 0 .AND. ifvent(nventholes + ii) /= 2) THEN
848 t_monvoln%IBAGHOL(9, nventholes + ii) = 0
849 ENDIF
850
851 IF (t_monvoln%IBAGHOL(3, nventholes + ii) == -1) THEN
852 t_monvoln%IBAGHOL(3, nventholes + ii) =0
853 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
854 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(nventholes + ii))
855 ENDIF
856 IF (t_monvoln%IBAGHOL(5, nventholes + ii) == -1) THEN
857 t_monvoln%IBAGHOL(5, nventholes + ii) = 0
858 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
859 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(nventholes + ii))
860 ENDIF
861 IF (t_monvoln%IBAGHOL(9, nventholes + ii) == -1) THEN
862 t_monvoln%IBAGHOL(9, nventholes + ii) = 0
863 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
864 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(nventholes + ii))
865 ENDIF
866 ENDDO
867 IF (nca > 0) THEN
868 lca = t_monvol_metadata%LCA
869 DO ii = 1, nca
870 chksurf = 0
871 t_monvol_metadata%ICBAG(1, ii + lca) = comm_bagid(ii)
872 t_monvol_metadata%ICBAG(2, ii + lca) = 0
873 t_monvol_metadata%ICBAG(3, ii + lca) = 0
874 t_monvol_metadata%ICBAG(4, ii + lca) = 0
875 IF (comm_avent(ii) < zero) THEN
876 CALL ancmsg(msgid = 1002, anmode = aninfo, msgtype = msgerror,
877 . i1 = t_monvoln%ID, i2 = comm_bagid(ii), r1 = comm_avent(ii))
878 ENDIF
879 t_monvol_metadata%ICBAG(4, ii + lca) = -1
880 t_monvol_metadata%ICBAG(5, ii + lca) = -1
881 DO jj = 1, nfunct
882 IF (comm_iport(ii) == npc(jj)) t_monvol_metadata%ICBAG(4, ii + lca) = jj
883 IF (comm_iporp(ii) == npc(jj)) t_monvol_metadata%ICBAG(5, ii + lca) = jj
884 ENDDO
885 IF (comm_iport(ii) == 0) t_monvol_metadata%ICBAG(4, ii + lca) = 0
886 IF (comm_iporp(ii) == 0) t_monvol_metadata%ICBAG(5, ii + lca) = 0
887 IF (t_monvol_metadata%ICBAG(4, ii + lca) == -1)THEN
888 t_monvol_metadata%ICBAG(4, ii + lca) = 0
889 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
890 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = comm_iport(ii))
891 ENDIF
892 IF (t_monvol_metadata%ICBAG(5, ii + lca) == -1) THEN
893 t_monvol_metadata%ICBAG(5, ii + lca) = 0
894 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
895 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = comm_iporp(ii))
896 ENDIF
897 IF (comm_ipvent(ii) /= 0) THEN
898 IF (comm_avent(ii) == zero) comm_avent(ii) = one
899 DO jj = 1, nsurf
900 IF (comm_ipvent(ii) == igrsurf(jj)%ID) THEN
901 t_monvol_metadata%ICBAG(2, ii + lca) = jj
902 ENDIF
903 ENDDO
904 IF (t_monvol_metadata%ICBAG(2, ii + lca) == 0) THEN
905 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
906 . i2 = comm_ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
907 ELSEIF (igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ISH4N3N == 0) THEN
908 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
909 . i2 = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ID, i1 = t_monvoln%ID,
910 . c1 = t_monvoln%TITLE)
911 ENDIF
912C----------------------------------------------
913C Adding SCOM Condition Include in Surf Airbag
914C----------------------------------------------
915 nn = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%NSEG
916 ext_surfid = t_monvoln%EXT_SURFID
917 DO jj = 1, nn
918 ji = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ELEM(jj)
919 ity = igrsurf(t_monvol_metadata%ICBAG(2 ,ii + lca))%ELTYP(jj)
920 IF (ity == 7) THEN
921 ji = ji + numelc
922 ELSEIF (ity /= 3) THEN
923 ji = jj + numelc + numeltg
924 ENDIF
925 nn1 = igrsurf(ext_surfid)%NSEG
926 found = .false.
927 DO j1 = 1, nn1
928 ji1 = igrsurf(ext_surfid)%ELEM(j1)
929 ity1 = igrsurf(ext_surfid)%ELTYP(j1)
930 IF (ity1 == 7) THEN
931 ji1 = ji1 + numelc
932 ELSEIF (ity1 /= 3) THEN
933 ji1 = j1 + numelc + numeltg
934 ENDIF
935 IF (ji == ji1) THEN
936 found = .true.
937 EXIT
938 END IF
939 ENDDO
940 IF (.NOT. found) chksurf = 1
941 IF (ipri >= 5 .AND. .NOT. found) THEN
942 IF(ity == 3)THEN
943 nel = ixc(nixc, ji)
944 WRITE(iout,'(A,I10,A,I10,A,I10)')
945 . ' ERROR : SHELL ELEMENT ID=',nel,
946 . ' OF COMMUNICATING SURFACE ID=',
947 . igrsurf(t_monvol_metadata%ICBAG(2,ii + lca))%ID,
948 . ' IS NOT INCLUDED INTO AIRBAG SURFACE ID=',
949 . igrsurf(ext_surfid)%ID
950 ELSEIF(ity == 7)THEN
951 nel=ixtg(nixtg,ji-numelc)
952 WRITE(iout,'(A,I10,A,I10,A,I10)')
953 . ' ERROR : SH3N ELEMENT ID=',nel,
954 . ' OF COMMUNICATING SURFACE ID=',
955 . igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ID,
956 . ' IS NOT INCLUDED INTO AIRBAG SURFACE ID=',
957 . igrsurf(ext_surfid)%ID
958 ENDIF
959 ENDIF
960 ENDDO
961C End Addition Condition SCOM Include in Surf Airbag
962 ENDIF
963 t_monvol_metadata%ICBAG(3, ii + lca) = 0
964 IF((comm_dpdef(ii) == zero .AND. comm_dtpdef(ii) == zero) .OR. comm_tvent(ii) == zero)
965 . t_monvol_metadata%ICBAG(3, ii + lca) = 1
966 t_monvol_metadata%RCBAG(1, ii + lca) = comm_dpdef(ii)
967 t_monvol_metadata%RCBAG(2, ii + lca) = comm_avent(ii)
968 t_monvol_metadata%RCBAG(3, ii + lca) = comm_tvent(ii)
969 t_monvol_metadata%RCBAG(4, ii + lca) = comm_dtpdef(ii)
970 t_monvol_metadata%RCBAG(6, ii + lca) = comm_fport(ii)
971 t_monvol_metadata%RCBAG(7, ii + lca) = comm_fporp(ii)
972 IF (chksurf == 1) THEN
973 CALL ancmsg(msgid = 902, anmode = aninfo, msgtype = msgerror,
974 . i2 = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ID, i3 = igrsurf(ext_surfid)%ID,
975 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
976 ENDIF
977 ENDDO !DO II = 1, NCA
978 lca = lca + nca
979! Store LCA
980 t_monvol_metadata%LCA = lca
981 ENDIF !IF (NCA > 0)
982
983
984C
985 t_monvoln%RVOLU(2) = amu
986 t_monvoln%RVOLU(16) = vol + veps
987 t_monvoln%RVOLU(18) = sa
988 t_monvoln%RVOLU(21) = rot
989 t_monvoln%RVOLU(22:24) = zero
990
991C =========
992C Print out
993C =========
994 WRITE(iout, 1005) surfid
995 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
996 WRITE(iout, 1006) hconv
997 WRITE(iout, 1002) sa, sv, vol
998 WRITE(iout,1395) mid_ini
999 WRITE(iout,1400) amu, ti, pext, pini
1000 IF (iequi == 0) THEN
1001 WRITE(iout,1401)
1002 ENDIF
1003 IF (iequi > 0) THEN
1004 WRITE(iout,1402)
1005 ENDIF
1006 WRITE(iout,1415) mwi, gamai, cpai, cpbi, cpci, cpdi, cpei, cpfi
1007 WRITE(iout,1425)
1008 WRITE(iout,1426) njet
1009 DO ii = 1, njet
1010 WRITE(iout,1432) ii,
1011 . igeo(1, i_injsys(ii)), isens(ii)
1012 cpa = t_monvoln%RBAGJET(2, ii)
1013 cpb = t_monvoln%RBAGJET(3, ii)
1014 cpc = t_monvoln%RBAGJET(4, ii)
1015 cpd = t_monvoln%RBAGJET(16, ii)
1016 cpe = t_monvoln%RBAGJET(17, ii)
1017 cpf = t_monvoln%RBAGJET(18, ii)
1018 mw_tmp = t_monvoln%RBAGJET(19, ii)
1019 rmwg = r_igc1 / mw_tmp
1020 cpg = cpa + cpb*ti+cpc*ti*ti+cpd*ti*ti*ti+
1021 . cpe/(ti*ti)+cpf*ti*ti*ti*ti
1022 cvg = cpg - rmwg
1023 gama = cpg / cvg
1024 WRITE(iout,1442) gama, mw_tmp, cpa, cpb, cpc,
1025 . cpd, cpe, cpf
1026 IF (nj1(ii) == 0) THEN
1027 WRITE(iout, 1455) 0
1028 ELSE
1029 WRITE(iout, 1455) 1
1030 IF (nj3(ii) == 0) THEN
1031 WRITE(iout, 1460) nj1(ii), nj2(ii),
1032 . ipt(ii), ipa(ii), ipz(ii), fpt(ii), fpa(ii), fpz(ii)
1033 t_monvoln%IBAGJET(7, ii) = t_monvoln%IBAGJET(5, ii)
1034 ELSE
1035 WRITE(iout, 1461) nj1(ii), nj2(ii), nj3(ii),
1036 . ipt(ii), ipa(ii), ipz(ii),
1037 . fpt(ii), fpa(ii) ,fpz(ii)
1038 ENDIF
1039 ENDIF
1040 ENDDO
1041 WRITE(iout,1470) nvent, ttfire
1042 IF (nvent > 0) THEN
1043 WRITE(iout,1471) ittf
1044 ENDIF
1045 DO ii = 1, nvent
1046 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
1047 titr1='VENT HOLE SURFACE'
1048 WRITE(iout,1472) ii,ipvent(ii)
1049 ELSE
1050 titr1='POROUS SURFACE'
1051 WRITE(iout,1473) ii,ipvent(ii)
1052 ENDIF
1053 DO jj = 1, 20
1054 titrevent(jj) = t_monvoln%IBAGHOL(jj + 14, ii)
1055 venttitle(jj:jj) = achar(titrevent(jj))
1056 ENDDO
1057 WRITE(iout,1476) venttitle
1058 IF (ipvent(ii) == 0 .AND. avent(ii) == zero) THEN
1059 CALL ancmsg(msgid=1019, msgtype=msgwarning, anmode=aninfo,
1060 . i1=t_monvoln%ID,i2=ii, c1=t_monvoln%TITLE,c2=titr1)
1061 ENDIF
1062 IF(ifvent(ii) <= 1)WRITE(iout,1481)
1063 IF(ifvent(ii)==2) THEN
1064 WRITE(iout,1482)ivdp(ii),fvdp(ii)
1065 ENDIF
1066 IF(ifvent(ii)==3) WRITE(iout,1484)
1067 IF(ifvent(ii)==4) WRITE(iout,1485)
1068 shol = zero
1069 IF (ipvent(ii) /= 0) THEN
1070 CALL monvol_check_venthole_surf(ipri, t_monvoln, igrsurf, ii, shol, x, ixc, ixtg)
1071 t_monvoln%RBAGHOL(15, ii) = shol
1072 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
1073 WRITE(iout,1479)
1074 . shol,avent(ii),bvent(ii),
1075 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
1076 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
1077 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1078 ELSE
1079 WRITE(iout,1579) shol,iblockage(ii)
1080 WRITE(iout,1580) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1081 ENDIF
1082 ELSE
1083 IF (t_monvoln%IBAGHOL(13, ii) == 0) THEN
1084 WRITE(iout,1489)
1085 . avent(ii),bvent(ii),
1086 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
1087 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
1088 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1089 ELSE
1090 cleak =t_monvoln%RBAGHOL(6, ii)
1091 WRITE(iout,1585) cleak(ii),avent(ii),iport(ii),fport(ii),ipora(ii),fpora(ii)
1092 WRITE(iout,1580) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
1093 ENDIF
1094 ENDIF
1095 ENDDO
1096 WRITE(iout, 1500) nca
1097 DO ii = 1, nca
1098 WRITE(iout, 1510) comm_bagid(ii), comm_ipvent(ii), comm_dpdef(ii), comm_dtpdef(ii), comm_avent(ii),
1099 . comm_tvent(ii), comm_iport(ii), comm_iporp(ii), comm_fport(ii), comm_fporp(ii)
1100 ENDDO
1101C ===================
1102C Memory deallocation
1103C ===================
1104 IF (ALLOCATED(i_inj)) DEALLOCATE(i_inj)
1105 IF (ALLOCATED(isens)) DEALLOCATE(isens)
1106 IF (ALLOCATED(ijet)) DEALLOCATE(ijet)
1107 IF (ALLOCATED(nj1)) DEALLOCATE(nj1)
1108 IF (ALLOCATED(nj2)) DEALLOCATE(nj2)
1109 IF (ALLOCATED(nj3)) DEALLOCATE(nj3)
1110 IF (ALLOCATED(ipt)) DEALLOCATE(ipt)
1111 IF (ALLOCATED(ipa)) DEALLOCATE(ipa)
1112 IF (ALLOCATED(ipz)) DEALLOCATE(ipz)
1113 IF (ALLOCATED(fpt)) DEALLOCATE(fpt)
1114 IF (ALLOCATED(fpa)) DEALLOCATE(fpa)
1115 IF (ALLOCATED(fpz)) DEALLOCATE(fpz)
1116 IF (ALLOCATED(i_injsys)) DEALLOCATE(i_injsys)
1117 DEALLOCATE(ipvent, ifvent, avent, bvent)
1118 DEALLOCATE(tvent, tstope, dpdef, dtpdef,
1119 . idtpdef)
1120 DEALLOCATE(iport, iporp, ipora, fport,
1121 . fporp, fpora)
1122 DEALLOCATE(iport1, iporp1, ipora1, fport1,
1123 . fporp1, fpora1)
1124 DEALLOCATE(iblockage, cleak)
1125 DEALLOCATE(ivdp, fvdp)
1126 IF (nca > 0) THEN
1127 DEALLOCATE(comm_bagid, comm_ipvent, comm_iport, comm_iporp,
1128 . comm_dpdef, comm_avent, comm_tvent, comm_dtpdef,
1129 . comm_fport, comm_fporp)
1130 ENDIF
1131C-----------------------------------------------
1132C E n d o f s o u r c e
1133C-----------------------------------------------
1134
1135 RETURN
1136 1002 FORMAT(
1137 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
1138 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
1139 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
1140 1003 FORMAT(
1141 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
1142 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
1143 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
1144 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
1145 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
1146 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
1147 1006 FORMAT( 5x,'GLOBAL HEAT TRANSFER COEFFICIENT. . . .=',1pg20.13)
1148 1395 FORMAT(
1149 . /5x,'INITIAL GAS . . . . . . . . . . . . . .=',i10)
1150 1400 FORMAT(
1151 . 5x,'VOLUMIC VISCOSITY . . . . . . . . . . .=',1pg20.13,
1152 . /5x,'INITIAL TEMPERATURE . . . . . . . . . .=',1pg20.13,
1153 . /5x,'EXTERNAL PRESSURE . . . . . . . . . . .=',1pg20.13,
1154 . /5x,'INITIAL PRESSURE. . . . . . . . . . . .=',1pg20.13/)
1155 1401 FORMAT(
1156 . 5x,'INITIAL THERMODYNAMIC EQUILIBRIUM IS SET AT TIME 0'
1157 . /5x,'--------------------------------------------------'/)
1158 1402 FORMAT(
1159 . 5x,'INITIAL THERMODYNAMIC EQUILIBRIUM IS SET AT INJECTION TIME'
1160 . /5x,'----------------------------------------------------------'/)
1161 1415 FORMAT(
1162 . 5x,'CHARACTERISTICS OF INITIAL GAZ ',
1163 . /5x,'------------------------------ ',
1164 . /5x,'MOLECULAR WEIGHT',
1165 . /5x,' AT INITIAL TEMPERATURE . . . . .=',1pg20.13,
1166 . /5x,'GAMMA AT INITIAL TEMPERATURE . . . . .=',1pg20.13,
1167 . /5x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1168 . /5x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1169 . /5x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,
1170 . /5x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,
1171 . /5x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,
1172 . /5x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13/)
1173 1425 FORMAT(
1174 . /5x,'INJECTORS ',
1175 . /5x,'--------- ')
1176 1426 FORMAT(
1177 . 5x,'NUMBER OF INJECTORS . . . . . . . . . .=',i10/)
1178 1432 FORMAT(
1179 . 5x,'INJECTOR. . . . . . . . . . . . . . . .=',i10,
1180 . /10x,'INJECTOR NUMBER . . . . . . . . . . . .=',i10,
1181 . /10x,'SENSOR NUMBER . . . . . . . . . . . . .=',i10)
1182 1442 FORMAT(
1183 . /15x,'MIXTURE CHARACTERISTICS ',
1184 . /15x,'AT BEGINNING OF INJECTION ',
1185 . /15x,'------------------------- ',
1186 . /15x,'GAMMA . . . . . . . . . . . . . . . . .=',1pg20.13,
1187 . /15x,'MOLECULAR WEIGHT. . . . . . . . . . . .=',1pg20.13,
1188 . /15x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
1189 . /15x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
1190 . /15x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,
1191 . /15x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,
1192 . /15x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,
1193 . /15x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13)
1194 1455 FORMAT(
1195 . /10x,'JETTING OPTION. . . . . . . . . . . . .=',i10,
1196 . /10x,'----------------------------------------')
1197 1460 FORMAT(
1198 . 15x,'CONICAL JET . . . . . . . . . . . . . .',
1199 . /15x,'NODE NUMBER DEFINING INJECTION CENTER .=',i10,
1200 . /15x,'NODE NUMBER DEFINING INJECTION AXIS . .=',i10,
1201 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
1202 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
1203 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
1204 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
1205 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
1206 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13/)
1207 1461 FORMAT(
1208 . 15x,'DIHEDRAL JET. . . . . . . . . . . . . .',
1209 . /15x,'NODE NUMBER DEFINING INJECTION CENTER .=',i10,
1210 . /15x,'NODE NUMBER DEFINING INJECTION AXIS . .=',i10,
1211 . /15x,'NODE NUMBER DEFINING BASE LINE. . . . .=',i10,
1212 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
1213 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
1214 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
1215 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
1216 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
1217 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13)
1218 1470 FORMAT(
1219 . /5x,'VENT HOLES AND POROUS FABRIC SURFACES ',
1220 . /5x,'------------------------------------- ',
1221 . /5x,'NUMBER OF VENT HOLES AND POROUS SURFACES . .=',i10,
1222 . /5x,'INJECTION TIME TINJ. . . . . . . . . . . . .=',1pg20.13)
1223 1471 FORMAT(
1224 . 5x,'VENTING START TIME SHIFT . . . . . . . . . .=',i10,
1225 . /5x,' 0 : NO SHIFT',
1226 . /5x,' 1 : JETTING FUNCTIONS ARE SHIFTED BY INJECTION TIME',
1227 . /5x,' 2 : JETTING AND VENTING FUNCTIONS ARE SHIFTED BY',
1228 . /5x,' INJECTION TIME TINJ',
1229 . /5x,' 3 : JETTING AND VENTING FUNCTIONS ARE SHIFTED',
1230 . /5x,' BY TINJ FOR JETTING FUNCTIONS',
1231 . /5x,' BY TINJ+TSTART FOR VENTING FUNCTIONS')
1232 1472 FORMAT(
1233 . / 5x,'VENT HOLE NUMBER. . . . . . . . . . . .=',i10,
1234 . /15x,'VENT HOLE SURFACE ID. . . . . . . . . .=',i10)
1235 1473 FORMAT(
1236 . / 5x,'POROUS SURFACE NUMBER . . . . . . . . .=',i10,
1237 . /15x,'POROUS SURFACE ID . . . . . . . . . . .=',i10)
1238 1476 FORMAT(
1239 . 15x,'TITLE . . . . . . . . . . . . . . . . .=',1x,a20)
1240 1481 FORMAT(15x,'ISENTHALPIC VENTING MODEL ')
1241 1482 FORMAT(15x,'CHEMKIN MODEL FOR POROSITY : ',
1242 . /15x,'VELOCITY VS RELATIVE PRESSURE FUNCTION =',i10,
1243 . /15x,' SCALE FACTOR. . . . . . .=',1pg20.13)
1244 1484 FORMAT(15x,'GRAEFE POROSITY FORMULATION')
1245 1485 FORMAT(15x,'ISENTHALPIC VENTING MODEL WITH POSSIBLE FLOW IN')
1246 1479 FORMAT(
1247 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
1248 . /15x,'AVENT:VENT HOLE SCALE FACTOR. . . . . .=',1pg20.13,
1249 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1250 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1251 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1252 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1253 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1254 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1255 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1256 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1257 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1258 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1259 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1260 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1261 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1262 1480 FORMAT(
1263 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1264 . /15x,'RELATIVE PRES. FOR MEMBRANE DEFLATION .=',1pg20.13,
1265 . /15x,' (DPDEF = PDEF - PEXT) ',
1266 . /15x,'TIME DELAY BEFORE MEMBRANE DEFLATION .=',1pg20.13,
1267 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1268 . /15x,' IF IDTPDEF : 0',
1269 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1270 . /15x,' A CUMULATED DTPDEF TIME'
1271 . /15x,' BEFORE ACTIVATING DEFLATION'
1272 . /15x,' IF IDTPDEF : 1',
1273 . /15x,' DEFLATION START DTPDEF AFTER',
1274 . /15x,' DPDEF HAS BEEN REACHED',
1275 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1276 1489 FORMAT(
1277 . 15x,'AVENT:VENT HOLE AREA. . . . . . . . . .=',1pg20.13,
1278 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1279 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1280 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1281 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1282 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1283 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1284 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1285 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1286 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1287 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1288 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1289 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1290 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1291 1510 FORMAT(5x,2i10,4(1x,1pg20.13),2i10,2(1x,1pg20.13))
1292 1579 FORMAT(
1293 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
1294 . /15x,'BLOCKAGE IF CONTACT . . . . . . . . . .=',i10,
1295 . /15x,' =0 NO =1 YES')
1296 1580 FORMAT(
1297 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1298 . /15x,'RELATIVE PRESSURE TO INITIATE LEAKAGE .=',1pg20.13,
1299 . /15x,' (DPDEF = PDEF - PEXT) ',
1300 . /15x,'TIME DELAY BEFORE LEAKAGE . . . . . . .=',1pg20.13,
1301 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1302 . /15x,' IF IDTPDEF = 0',
1303 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1304 . /15x,' A CUMULATED DTPDEF TIME '
1305 . /15x,' BEFORE INITIATING LEAKAGE'
1306 . /15x,' IF IDTPDEF = 1',
1307 . /15x,' DEFLATION STARTS DTPDEF AFTER',
1308 . /15x,' DPDEF HAS BEEN REACHED',
1309 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1310 1500 FORMAT(/5x,'NUMBER OF COMMUNICATING VOLUMES . . . .=',i10,
1311 . /5x,'VOLUME_ID ',' VENT_SURF',8x,'DELTA_PDEF',11x,'DTPDEF',15x,
1312 . 'AVENT',16x,'TVENT',9x,' FCT/TIME ','FCT/PRES. ',
1313 . 'FCT/TIME SCALE FAC. ','FCT/PRES.SCALE FAC. ')
1314 1585 FORMAT(
1315 . 15x,'LEAKAGE COEFFICIENT . . . . . . . . . .=',1pg20.13,
1316 . /15x,'LEAKAGE AREA. . . . . . . . . . . . . .=',1pg20.13,
1317 . /15x,'LEAKAGE COEFFICIENT TIME FUNCTION . . .=',i10,
1318 . /15x,' SCALE FACTOR. . . . . . . . . .=',1pg20.13,
1319 . /15x,'LEAKAGE AREA TIME FUNCTION. . . . . . .=',i10,
1320 . /15x,' SCALE FACTOR. . . . . . . . . .=',1pg20.13)
1321 END SUBROUTINE hm_read_monvol_type9
1322 END MODULE hm_read_monvol_type9_mod
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
groupdef_mod
Definition groupdef_mod.F:668
hm_read_monvol_type9_mod
Definition hm_read_monvol_type9.F:28
hm_read_monvol_type9_mod::hm_read_monvol_type9
subroutine hm_read_monvol_type9(t_monvoln, t_monvol_metadata, ipm, igeo, itabm1, sensors, unitab, luid, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)
Definition hm_read_monvol_type9.F:58
message_mod
Definition message_mod.F:1257
monvol_struct_mod
Definition monvol_struct_mod.F:66
monvol_struct_mod::monvol_check_venthole_surf
subroutine monvol_check_venthole_surf(ipri, t_monvoln, igrsurf, ihol, shol, x, ixc, ixtg)
Definition monvol_struct_mod.F:797
monvol_struct_mod::monvol_compute_volume
subroutine monvol_compute_volume(t_monvoln, title, ivolu, surf, itab, node_coord, pm, geo, ixc, ixtg, sa, rot, vol, vmin, veps, sv)
Definition monvol_struct_mod.F:656
monvol_struct_mod::monvol_check_surfclose
subroutine monvol_check_surfclose(t_monvoln, itab, surf, x)
Definition monvol_struct_mod.F:421
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
monvol_orient_surf
subroutine monvol_orient_surf(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, x, itype)
Definition monvol_struct_mod.F:1112
monvol_reverse_normals
subroutine monvol_reverse_normals(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, vol, x, itype)
Definition monvol_struct_mod.F:1783
ancmsg
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:895
freerr
subroutine freerr(it)
Definition freform.F:501
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84
submodel_mod::submodel_data
Definition submodel_mod.F:728
unitab_mod::unit_type_
Definition unitab_mod.F:524