OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_monvol_type6.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_type6_mod ../starter/source/airbag/hm_read_monvol_type6.F
25!||--- called by ------------------------------------------------------
26!|| read_monvol ../starter/source/airbag/read_monvol.F
27!||====================================================================
28 MODULE hm_read_monvol_type6_mod
29 CONTAINS
30!||====================================================================
31!|| hm_read_monvol_type6 ../starter/source/airbag/hm_read_monvol_type6.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!|| monvol_check_surfclose ../starter/share/modules1/monvol_struct_mod.F
43!|| monvol_check_venthole_surf ../starter/share/modules1/monvol_struct_mod.F
44!|| monvol_compute_volume ../starter/share/modules1/monvol_struct_mod.F
45!|| monvol_orient_surf ../starter/share/modules1/monvol_struct_mod.F
46!|| monvol_reverse_normals ../starter/share/modules1/monvol_struct_mod.F
47!|| origin ../starter/source/model/remesh/build_admesh.F
48!||--- uses -----------------------------------------------------
49!|| message_mod ../starter/share/message_module/message_mod.F
50!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
51!|| submodel_mod ../starter/share/modules1/submodel_mod.F
52!||====================================================================
53 SUBROUTINE hm_read_monvol_type6(T_MONVOLN,
54 . SENSORS, NPT, PLD, IGRBRIC,
55 . UNITAB, NPC, IGRSURF, ITAB, X, PM, GEO, IXC, IXTG,
56 . LSUBMODEL)
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE unitab_mod
61 USE groupdef_mod
62 USE message_mod
63 USE monvol_struct_mod
64 USE submodel_mod
65 USE sensor_mod
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73C NSURF
74#include "com04_c.inc"
75C KMONVO, IREC
76C NIMV, NRVOLU
77#include "param_c.inc"
78C IIN
79#include "units_c.inc"
80C IPRI
81#include "scr03_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 TYPE(unit_type_), INTENT(IN) :: UNITAB
86 INTEGER, INTENT(IN) :: NPT(*)
87 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
88 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *), pld(2, *)
89 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
90 TYPE(monvol_struct_), INTENT(INOUT) :: T_MONVOLN
91 TYPE (GROUP_), DIMENSION(NGRBRIC), INTENT(IN) :: IGRBRIC
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_GEN
100 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
101 LOGICAL :: FOUND, DECREASE
102 my_real :: sa, rot, vol, vmin, veps, amu, sv
103 my_real :: pext, ti, pini, gamai, cpai, cpbi, cpci
104 INTEGER :: IEQUI, ITTF, NJET, NVENT
105 my_real, DIMENSION(:), ALLOCATABLE :: gama, cpa, cpb, cpc, fmass, ftemp, fvel
106 INTEGER, DIMENSION(:), ALLOCATABLE :: IMASS, IFLU, ITEMP, ISENS, IJET, IVEL
107 INTEGER, DIMENSION(:), ALLOCATABLE :: IPVENT, ITVENT, IDTPDEF, IVDP
108 my_real, DIMENSION(:), ALLOCATABLE :: avent, bvent, tstope, tvent, dpdef, dtpdef, fvdp
109 INTEGER, DIMENSION(:), ALLOCATABLE :: IPORT, IPORP, IPORA, IPORT1, IPORP1, IPORA1
110 my_real, DIMENSION(:), ALLOCATABLE :: fport, fporp, fpora, fport1, fporp1, fpora1
111 my_real :: dirx, diry, dirz, dir2x, dir2y, dir2z, origx, origy, origz, lx, ly, lz
112 INTEGER :: NBX, NBY, NBZ, IBRIC, ISUR, IREF, IGMERG
113 my_real :: cgmerg, cnmerg, ptole, qa, qb, hmin
114 INTEGER :: ILVOUT, NLAYER, NFACMAX, NPPMAX, IFVANI
115 my_real :: cpi, cvi, rmwi, mi, cpg, rmwg
116 INTEGER :: NBRIC, NN, I1, I2, I3, I4, ISH34
117 my_real :: sjet, dir, xx, yy, zz, x13, y13, z13, x24, y24, z24, nx, ny, nz, ds,
118 . rhoi, ti2, especi, shol
119 INTEGER :: NP, IP, IFVENT
120 LOGICAL :: IS_AVAILABLE
121C-----------------------------------------------
122C B e g i n n i n g o f s o u r c e
123C-----------------------------------------------
124C =======
125C Reading
126C =======
127! Line 1
128 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
129! Line 2
130 CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
132 CALL hm_get_floatv('AscaleS', scal_s, is_available, lsubmodel, unitab)
133 CALL hm_get_floatv('AscaleA', scal_a, is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('AscaleD', scal_d, is_available, lsubmodel, unitab)
135! Line 3
136 CALL hm_get_floatv('Pext', pext, is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('T0', ti, is_available, lsubmodel, unitab)
138 CALL hm_get_intv('iequi', IEQUI, IS_AVAILABLE, LSUBMODEL)
139 CALL HM_GET_INTV('ittf', ITTF, IS_AVAILABLE, LSUBMODEL)
140! Line 4
141 CALL HM_GET_FLOATV('gammai', GAMAI, IS_AVAILABLE, LSUBMODEL, UNITAB)
142 CALL HM_GET_FLOATV('cpai', CPAI, IS_AVAILABLE, LSUBMODEL, UNITAB)
143 CALL HM_GET_FLOATV('cpbi', CPBI, IS_AVAILABLE, LSUBMODEL, UNITAB)
144 CALL HM_GET_FLOATV('cpci', CPCI, IS_AVAILABLE, LSUBMODEL, UNITAB)
145! Injectors
146 CALL HM_GET_INTV('njet', NJET, IS_AVAILABLE, LSUBMODEL)
147 T_MONVOLN%NJET = NJET
148 T_MONVOLN%IVOLU(8) = NJET
149 IF (NJET > 0) THEN
150 ALLOCATE(T_MONVOLN%IBAGJET(NIBJET, NJET))
151 T_MONVOLN%IBAGJET(1:NIBJET, 1:NJET) = 0
152 ALLOCATE(T_MONVOLN%RBAGJET(NRBJET, NJET))
153 T_MONVOLN%RBAGJET(1:NRBJET, 1:NJET) = ZERO
154 ENDIF
155 IF (NJET > 0) THEN
156 ALLOCATE(GAMA(NJET), CPA(NJET), CPB(NJET), CPC(NJET), FMASS(NJET), FTEMP(NJET))
157 ALLOCATE(IMASS(NJET), IFLU(NJET), ITEMP(NJET), ISENS(NJET))
158 ALLOCATE(IJET(NJET))
159 ALLOCATE(IVEL(NJET), FVEL(NJET))
160 DO II = 1, NJET
161 CALL HM_GET_FLOAT_ARRAY_INDEX('gamma', gama(ii), ii, is_available, lsubmodel, unitab)
162 CALL hm_get_float_array_index('cpa', cpa(ii), ii, is_available, lsubmodel, unitab)
163 CALL hm_get_float_array_index('cpb', cpb(ii), ii, is_available, lsubmodel, unitab)
164 CALL hm_get_float_array_index('cpc', cpc(ii), ii, is_available, lsubmodel, unitab)
165
166 CALL hm_get_int_array_index('fct_IDmas', imass(ii), ii,is_available, lsubmodel)
167 CALL hm_get_int_array_index('Iflow', iflu(ii), ii,is_available, lsubmodel)
168 CALL hm_get_float_array_index('Fscalemas', fmass(ii), ii, is_available, lsubmodel, unitab)
169 CALL hm_get_int_array_index('fct_IDT', itemp(ii), ii,is_available, lsubmodel)
170 CALL hm_get_float_array_index('FscaleT', ftemp(ii), ii, is_available, lsubmodel, unitab)
171 CALL hm_get_int_array_index('sens_ID', isens(ii), ii,is_available, lsubmodel)
172
173 CALL hm_get_int_array_index('Isjet', ijet(ii), ii,is_available, lsubmodel)
174
175 CALL hm_get_int_array_index('fct_IDvel', ivel(ii), ii,is_available, lsubmodel)
176 CALL hm_get_float_array_index('Fscalevel', fvel(ii), ii, is_available, lsubmodel, unitab)
177 ENDDO
178 ENDIF
179! Ventholes
180 CALL hm_get_intv('Nvent', nvent, is_available, lsubmodel)
181 t_monvoln%IVOLU(11) = nvent
182 t_monvoln%NVENT = nvent
183 IF (nvent > 0) THEN
184 ALLOCATE(t_monvoln%IBAGHOL(nibhol, nvent))
185 t_monvoln%IBAGHOL(1:nibhol, 1:nvent) = 0
186 ALLOCATE(t_monvoln%RBAGHOL(nrbhol, nvent))
187 t_monvoln%RBAGHOL(1:nrbhol, 1:nvent) = zero
188 ENDIF
189 IF (nvent > 0) THEN
190 ALLOCATE(ipvent(nvent), itvent(nvent), idtpdef(nvent), ivdp(nvent))
191 ALLOCATE(avent(nvent), bvent(nvent), tstope(nvent),
192 . tvent(nvent), dpdef(nvent), dtpdef(nvent), fvdp(nvent))
193 ALLOCATE(iport(nvent), iporp(nvent), ipora(nvent), iport1(nvent),
194 . iporp1(nvent), ipora1(nvent))
195 ALLOCATE(fport(nvent), fporp(nvent), fpora(nvent), fport1(nvent),
196 . fporp1(nvent), fpora1(nvent))
197 DO ii = 1, nvent
198 CALL hm_get_int_array_index('surf_IDv', ipvent(ii), ii, is_available, lsubmodel)
199 CALL hm_get_float_array_index('Avent', avent(ii), ii, is_available, lsubmodel, unitab)
200 CALL hm_get_float_array_index('Bvent', bvent(ii), ii, is_available, lsubmodel, unitab)
201 CALL hm_get_int_array_index('Itvent', itvent(ii), ii, is_available, lsubmodel)
202
203 CALL hm_get_float_array_index('Tvent', tvent(ii), ii, is_available, lsubmodel, unitab)
204 CALL hm_get_float_array_index('dPdef', dpdef(ii), ii, is_available, lsubmodel, unitab)
205 CALL hm_get_float_array_index('dtPdef', dtpdef(ii), ii, is_available, lsubmodel, unitab)
206 CALL hm_get_int_array_index('fct_IDV', ivdp(ii), ii,is_available, lsubmodel)
207 CALL hm_get_float_array_index('FscaleV', fvdp(ii), ii, is_available, lsubmodel, unitab)
208 CALL hm_get_int_array_index('IdtPdef', idtpdef(ii), ii,is_available, lsubmodel)
209
210 CALL hm_get_int_array_index('fct_IDt', iport(ii), ii,is_available, lsubmodel)
211 CALL hm_get_int_array_index('fct_IDP', iporp(ii), ii,is_available, lsubmodel)
212 CALL hm_get_int_array_index('fct_IDA', ipora(ii), ii,is_available, lsubmodel)
213 CALL hm_get_float_array_index('Fscalet', fport(ii), ii, is_available, lsubmodel, unitab)
214 CALL hm_get_float_array_index('FscaleP', fporp(ii), ii, is_available, lsubmodel, unitab)
215 CALL hm_get_float_array_index('FscaleA', fpora(ii), ii, is_available, lsubmodel, unitab)
216
217 CALL hm_get_int_array_index("fct_IDt'", iport1(ii), ii,is_available, lsubmodel)
218 CALL hm_get_int_array_index("fct_IDP'", iporp1(ii), ii,is_available, lsubmodel)
219 CALL hm_get_int_array_index("fct_IDA'", ipora1(ii), ii,is_available, lsubmodel)
220 CALL hm_get_float_array_index("Fscalet'", fport1(ii), ii, is_available, lsubmodel, unitab)
221 CALL hm_get_float_array_index("FscaleP'", fporp1(ii), ii, is_available, lsubmodel, unitab)
222 CALL hm_get_float_array_index("FscaleA'", fpora1(ii), ii, is_available, lsubmodel, unitab)
223 ENDDO
224 ENDIF
225 CALL hm_get_floatv('Vx3', dirx, is_available, lsubmodel, unitab)
226 CALL hm_get_floatv('Vy3', diry, is_available, lsubmodel, unitab)
227 CALL hm_get_floatv('Vz3', dirz, is_available, lsubmodel, unitab)
228
229 CALL hm_get_floatv('Vx1', dir2x, is_available, lsubmodel, unitab)
230 CALL hm_get_floatv('Vy1', dir2y, is_available, lsubmodel, unitab)
231 CALL hm_get_floatv('Vz1', dir2z, is_available, lsubmodel, unitab)
232
233 CALL hm_get_floatv('X0', origx, is_available, lsubmodel, unitab)
234 CALL hm_get_floatv('Y0', origy, is_available, lsubmodel, unitab)
235 CALL hm_get_floatv('Z0', origz, is_available, lsubmodel, unitab)
236
237 CALL hm_get_floatv('L1', lx, is_available, lsubmodel, unitab)
238 CALL hm_get_floatv('L2', ly, is_available, lsubmodel, unitab)
239 CALL hm_get_floatv('L3', lz, is_available, lsubmodel, unitab)
240
241 CALL hm_get_intv('Nb1', nbx, is_available, lsubmodel)
242 CALL hm_get_intv('Nb2', nby, is_available, lsubmodel)
243 CALL hm_get_intv('Nb3', nbz, is_available, lsubmodel)
244 CALL hm_get_intv('grbrc_ID', ibric, is_available, lsubmodel)
245 CALL hm_get_intv('surf_IDin', isur, is_available, lsubmodel)
246 CALL hm_get_intv('Iref', iref, is_available, lsubmodel)
247
248 CALL hm_get_intv('Igmerg', igmerg, is_available, lsubmodel)
249 CALL hm_get_floatv('Cgmerg', cgmerg, is_available, lsubmodel, unitab)
250 CALL hm_get_floatv('cnmerg', CNMERG, IS_AVAILABLE, LSUBMODEL, UNITAB)
251 CALL HM_GET_FLOATV('ptole', PTOLE, IS_AVAILABLE, LSUBMODEL, UNITAB)
252
253 CALL HM_GET_FLOATV('qa', QA, IS_AVAILABLE, LSUBMODEL, UNITAB)
254 CALL HM_GET_FLOATV('qb', qb, is_available, lsubmodel, unitab)
255 CALL hm_get_floatv('Hmin', hmin, is_available, lsubmodel, unitab)
256
257 CALL hm_get_intv('Ilvout', ilvout, is_available, lsubmodel)
258 CALL hm_get_intv('Nlayer', nlayer, is_available, lsubmodel)
259 CALL hm_get_intv('Nfacmax', nfacmax, is_available, lsubmodel)
260 CALL hm_get_intv('Nppmax', nppmax, is_available, lsubmodel)
261 CALL hm_get_intv('Ifvani', ifvani, is_available, lsubmodel)
262C ================
263C Check operations
264C ================
265C External surface check
266 t_monvoln%IVOLU(4) = 0
267 found = .false.
268 DO ii = 1, nsurf
269 IF (surfid == igrsurf(ii)%ID) THEN
270 t_monvoln%IVOLU(4) = ii
271 t_monvoln%EXT_SURFID = ii
272 found = .true.
273 EXIT
274 ENDIF
275 ENDDO
276 IF (.NOT. found) THEN
277 CALL freerr(3)
278 ELSEIF (igrsurf(t_monvoln%IVOLU(4))%ISH4N3N == 0) THEN
279 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
280 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
281 CALL freerr(3)
282 ENDIF
283
284C Check surface closure
285 CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
286C Set all normal on same side
287 CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
288 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 10)
289C Compute Monvon volume
290 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
291 . itab, x, pm, geo, ixc, ixtg,
292 . sa, rot, vol, vmin, veps, sv)
293C Reverse all normals to ensure positive volume
294 CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
295 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 10)
296
297 IF (ittf < 0 .OR. ittf > 3) THEN
298 CALL ancmsg(msgid = 773, anmode = aninfo, msgtype = msgerror,
299 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
300 END IF
301 IF (gamai == zero .OR. cpai == zero) THEN
302 CALL ancmsg(msgid = 473, msgtype = msgerror, anmode = aninfo,
303 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
304 ENDIF
305C ==============
306C Default values
307C ==============
308 IF (scal_t == zero) THEN
309 CALL hm_get_floatv_dim('Ascalet', fac_gen, is_available, lsubmodel, unitab)
310 scal_t = one * fac_gen
311 ENDIF
312 IF (scal_p == zero) THEN
313 CALL hm_get_floatv_dim('AscaleP', fac_gen, is_available, lsubmodel, unitab)
314 scal_p = one * fac_gen
315 ENDIF
316 IF (scal_s == zero) THEN
317 CALL hm_get_floatv_dim('AscaleS', fac_gen, is_available, lsubmodel, unitab)
318 scal_s = one * fac_gen
319 ENDIF
320 IF (scal_a == zero) THEN
321 CALL hm_get_floatv_dim('AscaleA', fac_gen, is_available, lsubmodel, unitab)
322 scal_a = one * fac_gen
323 ENDIF
324 IF (scal_d == zero) THEN
325 CALL hm_get_floatv_dim('AscaleD', fac_gen, is_available, lsubmodel, unitab)
326 scal_d = one * fac_gen
327 ENDIF
328
329 amu = em02
330 IF(pext == zero) THEN
331 pext = 101325.d0 * (unitab%FAC_L_WORK * unitab%FAC_T_WORK * unitab%FAC_T_WORK) / unitab%FAC_M_WORK
332 ENDIF
333 IF (ti == zero) ti = twohundred95
334 pini = pext
335
336 DO ii = 1, njet
337 IF (imass(ii) /=0 .AND. fmass(ii) == zero) THEN
338 CALL hm_get_floatv_dim('Fscalemas', fac_gen, is_available, lsubmodel, unitab)
339 fmass(ii) = one * fac_gen
340 ENDIF
341 IF (itemp(ii) /=0 .AND. ftemp(ii) == zero) THEN
342 CALL hm_get_floatv_dim('FscaleT', fac_gen, is_available, lsubmodel, unitab)
343 ftemp(ii) = one * fac_gen
344 ENDIF
345
346 IF (fvel(ii) == zero) THEN
347 CALL hm_get_floatv_dim('Fscalevel', fac_gen, is_available, lsubmodel, unitab)
348 fvel(ii) = one * fac_gen
349 ENDIF
350 ENDDO
351 DO ii = 1, nvent
352 IF (itvent(ii) == 0) itvent(ii) = 2
353 IF (ipvent(ii) == 0) THEN
354 avent(ii) = zero
355 bvent(ii) = zero
356 ENDIF
357 IF (fport(ii) == zero) fport(ii) = one
358 IF (fporp(ii) == zero) fporp(ii) = one
359 IF (fpora(ii) == zero) fpora(ii) = one
360 IF (fport1(ii) == zero) fport1(ii) = one
361 IF (fporp1(ii) == zero) fporp1(ii) = one
362 IF (fpora1(ii) == zero) fpora1(ii) = one
363 ENDDO
364 IF (nbx == 0) nbx = 1
365 IF (nby == 0) nby = 1
366 IF (nbz == 0) nbz = 1
367 IF (igmerg == 0) igmerg = 1
368 IF (cgmerg == zero) cgmerg = zep02
369 IF (ptole == zero) ptole = em5
370 IF (nlayer == 0) nlayer = 10
371 IF (nfacmax == 0) nfacmax = 20
372 IF (nppmax == 0) nppmax = 20
373 cpi = cpai + ti * (cpbi + cpci * ti)
374 cvi = cpi / gamai
375 rmwi = cvi * (gamai - one)
376 mi = pini * (vol + veps) / (rmwi * ti)
377C =====
378C Store
379C =====
380 t_monvoln%RVOLU(26) = one / scal_t
381 t_monvoln%RVOLU(27) = one / scal_p
382 t_monvoln%RVOLU(28) = one / scal_s
383 t_monvoln%RVOLU(29) = one / scal_a
384 t_monvoln%RVOLU(30) = one / scal_d
385
386 t_monvoln%IVOLU(17) = ittf
387 t_monvoln%IVOLU(8) = njet
388 DO ii = 1, njet
389 t_monvoln%IBAGJET(14, ii) = 0
390 found = .false.
391 DO jj = 1, nsurf
392 IF (ijet(ii) == igrsurf(jj)%ID) THEN
393 t_monvoln%IBAGJET(14, ii) = jj
394 found = .true.
395 EXIT
396 ENDIF
397 ENDDO
398 IF (.NOT. found) THEN
399 CALL ancmsg(msgid = 847, anmode = aninfo, msgtype = msgerror,
400 . i2 = ijet(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
401 ENDIF
402 ijet(ii) = 0
403 found = .false.
404 DO jj = 1, nfunct
405 IF (ivel(ii) == npc(jj)) THEN
406 t_monvoln%IBAGJET(11, ii) = jj
407 found = .true.
408 EXIT
409 ENDIF
410 ENDDO
411 IF (.NOT. found) THEN
412 CALL ancmsg(msgid = 6, anmode = aninfo, msgtype = msgerror,
413 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivel(ii))
414 ENDIF
415 t_monvoln%RBAGJET(15, ii) = fvel(ii)
416 t_monvoln%IBAGJET(13, ii) = 0
417 t_monvoln%RBAGJET(1, ii) = gama(ii)
418 t_monvoln%RBAGJET(2, ii) = cpa(ii)
419 t_monvoln%RBAGJET(3, ii) = cpb(ii)
420 t_monvoln%RBAGJET(4, ii) = cpc(ii)
421 t_monvoln%RBAGJET(5, ii) = fmass(ii)
422 t_monvoln%RBAGJET(6, ii) = ftemp(ii)
423 t_monvoln%RBAGJET(12, ii) = one
424 t_monvoln%RBAGJET(13, ii) = one
425 t_monvoln%RBAGJET(14, ii) = one
426 IF (imass(ii) == 0)THEN
427 t_monvoln%IBAGJET(1, ii) = 0
428 ELSE
429 found = .false.
430 DO jj = 1, nfunct
431 IF (imass(ii) == npc(jj)) THEN
432 t_monvoln%IBAGJET(1, ii) = jj
433 decrease = .false.
434 np = (npt(jj + 1) - npt(jj)) / 2
435 IF (iflu(ii) == 0) THEN
436 DO ip = (npt(jj) - 1) / 2 + 1, (npt(jj + 1) - 1) / 2 - 1
437 IF (pld(2, ip + 1) < pld(2, ip)) decrease = .true.
438 ENDDO
439 IF (decrease) THEN
440 CALL ancmsg(msgid=540, msgtype = msgwarning, anmode = aninfo_blind_1,
441 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = imass(ii), i3 = ii)
442 ENDIF
443 ELSE
444 DO ip = (npt(jj) - 1) / 2 + 1, (npt(jj + 1) - 1) / 2
445 IF (pld(2, ip) < zero) decrease = .true.
446 ENDDO
447 IF (decrease) THEN
448 CALL ancmsg(msgid = 541, msgtype = msgwarning, anmode = aninfo_blind_1,
449 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = imass(ii), i3 = ii)
450 ENDIF
451 ENDIF
452 found = .true.
453 EXIT
454 ENDIF
455 ENDDO
456 IF (.NOT. found) THEN
457 CALL ancmsg(msgid = 10, anmode = aninfo, msgtype = msgerror,
458 . i2 = imass(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
459 ENDIF
460 ENDIF
461 t_monvoln%IBAGJET(2, ii) = iflu(ii)
462 IF (itemp(ii) == 0) THEN
463 t_monvoln%IBAGJET(3, ii) = 0
464 ELSE
465 found = .false.
466 DO jj = 1, nfunct
467 IF (itemp(ii) == npc(jj)) THEN
468 t_monvoln%IBAGJET(3, ii) = jj
469 found = .true.
470 EXIT
471 ENDIF
472 ENDDO
473 IF (.NOT. found) THEN
474 CALL ancmsg(msgid = 11, anmode = aninfo, msgtype = msgerror,
475 . i2 = itemp(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
476 ENDIF
477 ENDIF
478 IF (isens(ii) > 0) THEN
479 found = .false.
480 DO jj = 1, sensors%NSENSOR
481 IF (isens(ii) == sensors%SENSOR_TAB(jj)%SENS_ID) THEN
482 t_monvoln%IBAGJET(4, ii) = jj
483 found = .true.
484 EXIT
485 ENDIF
486 ENDDO
487 IF (.NOT. found) THEN
488 CALL ancmsg(msgid = 17, anmode = aninfo, msgtype = msgerror,
489 . i2 = isens(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
490 ENDIF
491 ENDIF
492 cpg = cpa(ii) + ti * (cpb(ii) + cpc(ii) * ti)
493 rmwg = cpg * (gama(ii) - one) / gama(ii)
494 t_monvoln%RBAGJET(1, ii) = rmwg
495 ENDDO
496 DO ii = 1, nvent
497 t_monvoln%RBAGHOL(7, ii) = fport(ii)
498 t_monvoln%RBAGHOL(8, ii) = fporp(ii)
499 t_monvoln%RBAGHOL(9, ii) = fpora(ii)
500 t_monvoln%RBAGHOL(10, ii) = fport1(ii)
501 t_monvoln%RBAGHOL(11, ii) = fporp1(ii)
502 t_monvoln%RBAGHOL(12, ii) = fpora1(ii)
503 t_monvoln%IBAGHOL(1, ii) = 0
504 t_monvoln%IBAGHOL(10, ii) = 0
505 t_monvoln%IBAGHOL(11, ii) = idtpdef(ii)
506 t_monvoln%IBAGHOL(12, ii) = 0
507 IF (ipvent(ii) == 0) THEN
508 t_monvoln%IBAGHOL(2, ii) = 0
509 ELSE
510 t_monvoln%IBAGHOL(2, ii) = 0
511 found = .false.
512 DO jj = 1, nsurf
513 IF (ipvent(ii) == igrsurf(jj)%ID) THEN
514 t_monvoln%IBAGHOL(2, ii) = jj
515 found = .true.
516 EXIT
517 ENDIF
518 ENDDO
519 IF(.NOT. found)THEN
520 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
521 . i2 = ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
522 ELSEIF(igrsurf(t_monvoln%IBAGHOL(2, ii))%ISH4N3N == 0) THEN
523 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
524 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
525 ENDIF
526 IF (avent(ii) == zero) avent(ii) = one
527 ENDIF
528 IF (avent(ii) == zero) dpdef(ii) = infinity
529 IF (avent(ii) == zero) tvent(ii) = infinity
530 IF (dpdef(ii) == zero .AND. dtpdef(ii) == zero .AND. tvent(ii) == zero) THEN
531 t_monvoln%IBAGHOL(1, ii) = 1
532 ENDIF
533 t_monvoln%RBAGHOL(1, ii) = dpdef(ii)
534 t_monvoln%RBAGHOL(2, ii) = avent(ii)
535 t_monvoln%RBAGHOL(3, ii) = tvent(ii)
536 t_monvoln%RBAGHOL(4, ii) = dtpdef(ii)
537 t_monvoln%RBAGHOL(6, ii) = bvent(ii)
538 IF (ivdp(ii) /= 0 .AND. fvdp(ii) == zero) fvdp(ii) = one
539 t_monvoln%RBAGHOL(13, ii) = fvdp(ii)
540 tstope(ii) = infinity
541 t_monvoln%RBAGHOL(14, ii) = tstope(ii)
542C
543 t_monvoln%IBAGHOL(3, ii) = -1
544 t_monvoln%IBAGHOL(4, ii) = -1
545 t_monvoln%IBAGHOL(5, ii) = -1
546 t_monvoln%IBAGHOL(6, ii) = -1
547 t_monvoln%IBAGHOL(7, ii) = -1
548 t_monvoln%IBAGHOL(8, ii) = -1
549 t_monvoln%IBAGHOL(9, ii) = -1
550 DO jj = 1, nfunct
551 IF (iport(ii) == npc(jj)) t_monvoln%IBAGHOL(3, ii) = jj
552 IF (iporp(ii) == npc(jj)) t_monvoln%IBAGHOL(4, ii) = jj
553 IF (ipora(ii) == npc(jj)) t_monvoln%IBAGHOL(5, ii) = jj
554 IF (iport1(ii) == npc(jj)) t_monvoln%IBAGHOL(6, ii) = jj
555 IF (iporp1(ii) == npc(jj)) t_monvoln%IBAGHOL(7, ii) = jj
556 IF (ipora1(ii) == npc(jj)) t_monvoln%IBAGHOL(8, ii) = jj
557 IF (ivdp(ii) == npc(jj)) t_monvoln%IBAGHOL(9, ii) = jj
558 ENDDO
559 IF (iport(ii) == 0) t_monvoln%IBAGHOL(3, ii) = 0
560 IF (iporp(ii) == 0) t_monvoln%IBAGHOL(4, ii) = 0
561 IF (ipora(ii) == 0) t_monvoln%IBAGHOL(5, ii) = 0
562 IF (iport1(ii) == 0) t_monvoln%IBAGHOL(6, ii) = 0
563 IF (iporp1(ii) == 0) t_monvoln%IBAGHOL(7, ii) = 0
564 IF (ipora1(ii) == 0) t_monvoln%IBAGHOL(8, ii) = 0
565 IF (ivdp(ii) == 0) t_monvoln%IBAGHOL(9, ii) = 0
566 IF (t_monvoln%IBAGHOL(3, ii) == -1) THEN
567 t_monvoln%IBAGHOL(3, ii) = 0
568 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
569 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(ii))
570 ENDIF
571 IF (t_monvoln%IBAGHOL(4, ii) == -1) THEN
572 t_monvoln%IBAGHOL(4, ii) = 0
573 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
574 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp(ii))
575 ENDIF
576 IF (t_monvoln%IBAGHOL(5, ii) == -1) THEN
577 t_monvoln%IBAGHOL(5, ii)=0
578 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
579 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(ii))
580 ENDIF
581 IF (t_monvoln%IBAGHOL(6, ii) == -1) THEN
582 t_monvoln%IBAGHOL(6, ii) = 0
583 CALL ancmsg(msgid=331, anmode=aninfo, msgtype=msgerror,
584 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport1(ii))
585 ENDIF
586 IF (t_monvoln%IBAGHOL(7, ii) == -1) THEN
587 t_monvoln%IBAGHOL(7, ii)=0
588 CALL ancmsg(msgid=332, anmode=aninfo, msgtype=msgerror,
589 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp1(ii))
590 ENDIF
591 IF (t_monvoln%IBAGHOL(8, ii) == -1) THEN
592 t_monvoln%IBAGHOL(8, ii) = 0
593 CALL ancmsg(msgid=333, anmode=aninfo, msgtype=msgerror,
594 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora1(ii))
595 ENDIF
596 IF (t_monvoln%IBAGHOL(9, ii) == -1) THEN
597 t_monvoln%IBAGHOL(9, ii) = 0
598 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
599 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(ii))
600 ENDIF
601 t_monvoln%IBAGHOL(10, ii) = itvent(ii)
602 ENDDO
603 t_monvoln%RVOLU(35) = dirx
604 t_monvoln%RVOLU(36) = diry
605 t_monvoln%RVOLU(37) = dirz
606 t_monvoln%RVOLU(38) = dir2x
607 t_monvoln%RVOLU(39) = dir2y
608 t_monvoln%RVOLU(40) = dir2z
609 t_monvoln%RVOLU(41) = origx
610 t_monvoln%RVOLU(42) = origy
611 t_monvoln%RVOLU(43) = origz
612 t_monvoln%RVOLU(44) = lx
613 t_monvoln%RVOLU(45) = ly
614 t_monvoln%RVOLU(53) = lz
615 t_monvoln%IVOLU(54) = nbx
616 t_monvoln%IVOLU(55) = nby
617 t_monvoln%IVOLU(35) = nbx * nby
618 t_monvoln%IVOLU(65) = nbz
619 t_monvoln%IVOLU(59) = iref
620 t_monvoln%IVOLU(61) = 0
621 IF(ibric > 0) THEN
622 DO jj = 1, ngrbric
623 IF (ibric == igrbric(jj)%ID) t_monvoln%IVOLU(61) = jj
624 EXIT
625 ENDDO
626 ENDIF
627 t_monvoln%IVOLU(67)=0
628 t_monvoln%INT_SURFID = 0
629 IF (isur > 0) THEN
630 DO jj = 1, nsurf
631 IF (isur == igrsurf(jj)%ID) THEN
632 t_monvoln%IVOLU(67) = jj
633 t_monvoln%INT_SURFID = jj
634 EXIT
635 ENDIF
636 ENDDO
637 ENDIF
638 t_monvoln%IVOLU(60) = igmerg
639 t_monvoln%RVOLU(31) = cgmerg
640 t_monvoln%RVOLU(34) = cnmerg
641 t_monvoln%RVOLU(50) = ptole
642 t_monvoln%RVOLU(46) = qa
643 t_monvoln%RVOLU(47) = qb
644 t_monvoln%RVOLU(51) = hmin
645 t_monvoln%IVOLU(44) = ilvout
646 t_monvoln%IVOLU(40) = nlayer
647 t_monvoln%IVOLU(41) = nfacmax
648 t_monvoln%IVOLU(42) = nppmax
649 t_monvoln%IVOLU(15) = iequi
650 t_monvoln%IVOLU(27) = 1
651 t_monvoln%RVOLU(7) = cpai
652 t_monvoln%RVOLU(8) = cpbi
653 t_monvoln%RVOLU(9) = cpci
654 t_monvoln%RVOLU(10) = rmwi
655 t_monvoln%RVOLU(1) = gamai
656 t_monvoln%RVOLU(3) = pext
657 t_monvoln%RVOLU(4) = vol+veps
658 t_monvoln%RVOLU(11) = mi
659 t_monvoln%RVOLU(12) = pini
660 t_monvoln%RVOLU(13) = ti
661 t_monvoln%RVOLU(14) = rmwi * mi
662 t_monvoln%RVOLU(17) = veps
663 t_monvoln%RVOLU(20) = mi
664 t_monvoln%RVOLU(25) = ti
665 t_monvoln%RVOLU(61) = gamai
666 rhoi = pini / (ti * rmwi)
667 t_monvoln%RVOLU(62) = rhoi
668 ti2 = ti * ti
669 especi = ti * (cpai + half * cpbi * ti + third * cpci * ti2 - rmwi)
670 t_monvoln%RVOLU(63) = especi + rmwi * ti
671 t_monvoln%RVOLU(64) = zero
672 t_monvoln%RVOLU(65) = zero
673 t_monvoln%RVOLU(66) = especi
674C
675 t_monvoln%RVOLU(2) = amu
676 t_monvoln%RVOLU(16) = vol + veps
677 t_monvoln%RVOLU(18) = sa
678 t_monvoln%RVOLU(21) = rot
679 t_monvoln%RVOLU(22:24) = zero
680
681C =========
682C Print out
683C =========
684 WRITE(iout, 1005) surfid
685 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
686 WRITE(iout, 1002) sa, sv, vol
687 WRITE(iout, 1400) amu, ti, pext, pini
688 IF (iequi == 0) THEN
689 WRITE(iout, 1401)
690 ENDIF
691 IF (iequi > 0) THEN
692 IF (iequi == 1) THEN
693 WRITE(iout, 1404)
694 ELSE
695 WRITE(iout,1405) iequi
696 ENDIF
697 ENDIF
698 WRITE(iout, 1410) gamai, cpai, cpbi, cpci
699 nbric = 0
700 IF (t_monvoln%IVOLU(61) /= 0) nbric = igrbric(t_monvoln%IVOLU(61))%ID
701 WRITE(iout, 1700)
702 WRITE(iout, 1704)
703 WRITE(iout,1710) t_monvoln%RVOLU(41),t_monvoln%RVOLU(42),t_monvoln%RVOLU(43),
704 . t_monvoln%RVOLU(38),t_monvoln%RVOLU(39),t_monvoln%RVOLU(40),
705 . t_monvoln%RVOLU(35),t_monvoln%RVOLU(36),t_monvoln%RVOLU(37),
706 . t_monvoln%RVOLU(44),t_monvoln%RVOLU(45),t_monvoln%RVOLU(53),
707 . t_monvoln%IVOLU(54),t_monvoln%IVOLU(55),t_monvoln%IVOLU(65),
708 . nbric ,isur ,t_monvoln%IVOLU(59),
709 . t_monvoln%IVOLU(60),t_monvoln%RVOLU(31),t_monvoln%RVOLU(34),
710 . t_monvoln%RVOLU(50),
711 . t_monvoln%RVOLU(46),t_monvoln%RVOLU(47),t_monvoln%RVOLU(51),
712 . t_monvoln%RVOLU(71),t_monvoln%RVOLU(72),
713 . t_monvoln%IVOLU(44),t_monvoln%IVOLU(40),t_monvoln%IVOLU(41),
714 . t_monvoln%IVOLU(42),ifvani
715 WRITE(iout, 1420)
716 WRITE(iout, 1421) njet
717 DO ii = 1, njet
718 WRITE(iout, 1430) ii, imass(ii), iflu(ii), fmass(ii), itemp(ii), ftemp(ii), isens(ii)
719 IF (ivel(ii) > 0) THEN
720 WRITE(iout,1435) ivel(ii), fvel(ii)
721 ENDIF
722 WRITE(iout, 1440) gama(ii), cpa(ii), cpb(ii), cpc(ii)
723! Injector surface
724 isur = t_monvoln%IBAGJET(14, ii)
725 sjet = zero
726 IF (isur /= 0) THEN
727 IF (igrsurf(isur)%ISH4N3N == 0) THEN
728 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
729 . i2 = igrsurf(isur)%ID, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
730 ELSE
731 nn =igrsurf(isur)%NSEG
732 DO jj = 1, nn
733 dir = half
734 i1 = igrsurf(isur)%NODES(jj, 1)
735 i2 = igrsurf(isur)%NODES(jj, 2)
736 i3 = igrsurf(isur)%NODES(jj, 3)
737 i4 = igrsurf(isur)%NODES(jj, 4)
738 ish34 = igrsurf(isur)%ELTYP(jj)
739 IF (ish34 == 7) i4 = i3
740 xx = half * (x(1, i1) + x(1, i2))
741 yy = half * (x(2, i1) + x(2, i2))
742 zz = half * (x(3, i1) + x(3, i2))
743 x13 = x(1, i3) - x(1, i1)
744 y13 = x(2, i3) - x(2, i1)
745 z13 = x(3, i3) - x(3, i1)
746 x24 = x(1, i4) - x(1, i2)
747 y24 = x(2, i4) - x(2, i2)
748 z24 = x(3, i4) - x(3, i2)
749 nx = dir * (y13 * z24 - y24 * z13)
750 ny = dir * (z13 * x24 - z24 * x13)
751 nz = dir * (x13 * y24 - x24 * y13)
752 ds = sqrt(nx * nx + ny * ny + nz * nz)
753 sjet = sjet + ds
754 ENDDO
755 ENDIF
756 ENDIF
757 WRITE(iout,1445) igrsurf(isur)%ID, sjet
758 ENDDO
759 WRITE(iout, 1470) nvent, zero
760 IF (nvent > 0) THEN
761 WRITE(iout, 1475) ittf
762 DO ii = 1, nvent
763 WRITE(iout, 1472) ii, ipvent(ii)
764 IF (ipvent(ii) == 0) THEN
765 CALL ancmsg(msgid = 1050, msgtype = msgerror, anmode = aninfo,
766 . i1 = t_monvoln%ID, i2 = ii, c1 = t_monvoln%TITLE, c2 = 'VENT HOLE SURFACE')
767 ENDIF
768 ifvent = t_monvoln%IBAGHOL(10, ii)
769 IF (ifvent == 1) WRITE(iout, 1483)
770 IF (ifvent == 2) WRITE(iout, 1481)
771 IF (ifvent == 3) WRITE(iout, 1482) ivdp(ii), fvdp(ii)
772 IF (ifvent == 5) WRITE(iout, 1484)
773 IF (ipvent(ii) /= 0) THEN
774 CALL monvol_check_venthole_surf(ipri, t_monvoln, igrsurf, ii, shol, x, ixc, ixtg)
775 t_monvoln%RBAGHOL(15, ii) = shol
776 WRITE(iout,1479)
777 . shol,avent(ii),bvent(ii),
778 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
779 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
780 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
781 ELSE
782 WRITE(iout,1489)
783 . avent(ii),bvent(ii),
784 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
785 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
786 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
787 ENDIF
788 ENDDO
789 ENDIF
790C ===========
791C Memory free
792C ===========
793 IF (njet > 0) THEN
794 DEALLOCATE(gama, cpa, cpb, cpc, fmass, ftemp)
795 DEALLOCATE(imass, iflu, itemp, isens)
796 DEALLOCATE(ijet)
797 DEALLOCATE(ivel, fvel)
798 ENDIF
799 IF (nvent > 0) THEN
800 DEALLOCATE(ipvent, itvent, idtpdef, ivdp)
801 DEALLOCATE(avent, bvent, tstope, tvent, dpdef, dtpdef, fvdp)
802 DEALLOCATE(iport, iporp, ipora, iport1, iporp1, ipora1)
803 DEALLOCATE(fport, fporp, fpora, fport1, fporp1, fpora1)
804 ENDIF
805C-----------------------------------------------
806C E n d o f s o u r c e
807C-----------------------------------------------
808
809 RETURN
810 1002 FORMAT(
811 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
812 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
813 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
814 1003 FORMAT(
815 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
816 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
817 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
818 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
819 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
820 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
821 1400 FORMAT(
822 . 5x,'VOLUMIC VISCOSITY . . . . . . . . . . .=',1pg20.13,
823 . /5x,'INITIAL TEMPERATURE . . . . . . . . . .=',1pg20.13,
824 . /5x,'EXTERNAL PRESSURE . . . . . . . . . . .=',1pg20.13,
825 . /5x,'INITIAL PRESSURE. . . . . . . . . . . .=',1pg20.13/)
826 1401 FORMAT(
827 . 5x,'INITIAL THERMODYNAMIC EQUILIBRIUM IS SET AT TIME 0'
828 . /5x,'--------------------------------------------------'/)
829 1404 FORMAT(
830 . 5x,'THERMODYNAMIC EQUILIBRIUM IS SET EVERY CYCLE UP TO INJECTION TIME'/)
831 1405 FORMAT(
832 . 5x,'THERMODYNAMIC EQUILIBRIUM IS SET EVERY',i10,' CYCLES UP TO INJECTION TIME'/)
833 1410 FORMAT(
834 . 5x,'CHARACTERISTICS OF INITIAL GAZ ',
835 . /5x,'------------------------------ ',
836 . /5x,'GAMMA AT INITIAL TEMPERATURE. . . . . .=',1pg20.13,
837 . /5x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
838 . /5x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
839 . /5x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13/)
840 1700 FORMAT(5x,'FVMBAG PARAMETERS ',
841 . /5x,'----------------- ')
842 1704 FORMAT(15x,'AIRBAG CUTTING FRAME: ')
843 1710 FORMAT(15x,' ORIGIN X COORDINATE. . . . . . . . .=',1pg20.13,
844 . /15x,' ORIGIN Y COORDINATE. . . . . . . . .=',1pg20.13,
845 . /15x,' ORIGIN Z COORDINATE. . . . . . . . .=',1pg20.13,
846 . /15x,' DIRECTION 1 X COORDINATE . . . . . .=',1pg20.13,
847 . /15x,' DIRECTION 1 Y COORDINATE . . . . . .=',1pg20.13,
848 . /15x,' DIRECTION 1 Z COORDINATE . . . . . .=',1pg20.13,
849 . /15x,' DIRECTION 3 X COORDINATE . . . . . .=',1pg20.13,
850 . /15x,' DIRECTION 3 Y COORDINATE . . . . . .=',1pg20.13,
851 . /15x,' DIRECTION 3 Z COORDINATE . . . . . .=',1pg20.13,
852 . /15x,'CUTTING LENGTH IN LOCAL DIRECTION 1 . .=',1pg20.13,
853 . /15x,'CUTTING LENGTH IN LOCAL DIRECTION 2 . .=',1pg20.13,
854 . /15x,'CUTTING LENGTH IN LOCAL DIRECTION 3 . .=',1pg20.13,
855 . /15x,'NUMBER OF CELLS IN LOCAL DIRECTION 1. .=',i10,
856 . /15x,'NUMBER OF CELLS IN LOCAL DIRECTION 2. .=',i10,
857 . /15x,'NUMBER OF CELLS IN LOCAL DIRECTION 3. .=',i10,
858 . /15x,'ADDITIONAL BRICK GROUP NUMBER . . . . .=',i10,
859 . /15x,'INTERNAL SURFACE ID. . . . . . . . . .=',i10,
860 . /15x,'FLAG FOR MESH ON REFERENCE METRICS. . .=',i10,
861 . /15x,'CELL MERGING STRATEGY: ',
862 . /15x,' GLOBAL MERGING TYPE. . . . . . . . .=',i10,
863 . /15x,' GLOBAL MERGING COEFFICIENT . . . . .=',1pg20.13,
864 . /15x,' NEIGHBORHOOD MERGING COEFFICIENT . .=',1pg20.13,
865 . /15x,'TOLERANCE FOR SMALL SEGMENT REMOVAL . .=',1pg20.13,
866 . /15x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13,
867 . /15x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13,
868 . /15x,'MINIMUM HEIGHT. . . . . . . . . . . . .=',1pg20.13,
869 . /15x,'DT SCALE FACTOR . . . . . . . . . . . .=',1pg20.13,
870 . /15x,'MINIMUM TIMESTEP. . . . . . . . . . . .=',1pg20.13,
871 . /15x,'OUTPUT LEVEL. . . . . . . . . . . . . .=',i10,
872 . /15x,'MEMORY PARAMETERS: ',
873 . /15x,' ESTIMATED NUMBER OF AIRBAG LAYERS. .=',i10,
874 . /15x,' ESTIMATED MAXIMUM NUMBER OF AIRBAG ',
875 . /15x,' FACETS PER CUTTING CELL. . . . .=',i10,
876 . /15x,' ESTIMATED MAXIMUM NUMBER OF POINTS ',
877 . /15x,' PER POLYGON. . . . . . . . . . .=',i10,
878 . /15x,'FLAG FOR ANIMATION FILE A000. . . . . .=',i10)
879 1420 FORMAT(
880 . 5x,'INFLATORS ',
881 . /5x,'--------- ')
882 1421 FORMAT(
883 . 5x,'NUMBER OF INFLATORS . . . . . . . . . .=',i10/)
884 1430 FORMAT(
885 . 5x,'INFLATOR NUMBER . . . . . . . . . . . .=',i10,
886 . /15x,'TIME FUNCTION FOR INCOMING TOTAL MASS .=',i10,
887 . /15x,' or MASS FLUX if IFLU=1 . . . . IFLU =',i10,
888 . /15x,'SCALE FACTOR FOR INCOMING TOTAL MASS .=',1pg20.13,
889 . /15x,'TIME FUNCTION FOR INCOMIMG GAS TEMP . .=',i10,
890 . /15x,'SCALE FACTOR FOR INCOMIMG GAS TEMP . .=',1pg20.13,
891 . /15x,'SENSOR NUMBER . . . . . . . . . . . . .=',i10)
892 1435 FORMAT(15x,'TIME FUNCTION FOR INCOMING GAS VELOCITY=',i10,
893 . /15x,'SCALE FACTOR FOR INCOMING GAS VELOCITY.=',1pg20.13)
894 1440 FORMAT(
895 . /15x,'GAZ CHARACTERISTICS ',
896 . /15x,'------------------- ',
897 . /15x,'GAMMA AT INITIAL TEMPERATURE. . . . . .=',1pg20.13,
898 . /15x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
899 . /15x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
900 . /15x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13)
901 1445 FORMAT(
902 . 15x,'INFLATOR SURFACE ID . . . . . . . . . .=',i10,
903 . /15x,'INITIAL SURFACE OF INFLATOR . . . . . .=',1pg20.13)
904 1470 FORMAT(
905 . /5x,'VENT HOLES AND POROUS FABRIC SURFACES ',
906 . /5x,'------------------------------------- ',
907 . /5x,'NUMBER OF VENT HOLES AND POROUS SURFACES . .=',i10,
908 . /5x,'INJECTION TIME TINJ. . . . . . . . . . . . .=',1pg20.13)
909 1475 FORMAT(
910 . 5x,'VENTING START TIME SHIFT . . . . . . . . . .=',i10,
911 . /5x,' 0 : NO SHIFT',
912 . /5x,' 1,2: VENTING FUNCTIONS ARE SHIFTED BY TINJ',
913 . /5x,' 3 : VENTING FUNCTIONS ARE SHIFTED BY TINJ+TSTART')
914 1472 FORMAT(
915 . / 5x,'VENT HOLE NUMBER. . . . . . . . . . . .=',i10,
916 . /15x,'VENT HOLE SURFACE ID. . . . . . . . . .=',i10)
917 1481 FORMAT(15x,'ISENTHALPIC VENTING MODEL ')
918 1482 FORMAT(15x,'CHEMKIN MODEL FOR POROSITY : ',
919 . /15x,'VELOCITY VS RELATIVE PRESSURE FUNCTION =',i10,
920 . /15x,' SCALE FACTOR. . . . . . .=',1pg20.13)
921 1483 FORMAT(15x,'LOCAL VELOCITY VENTING FORMULATION')
922 1484 FORMAT(15x,'GRAEFE POROSITY FORMULATION')
923 1479 FORMAT(
924 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
925 . /15x,'AVENT:VENT HOLE SCALE FACTOR. . . . . .=',1pg20.13,
926 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
927 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
928 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
929 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
930 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
931 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
932 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
933 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
934 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
935 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
936 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
937 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
938 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
939 1480 FORMAT(
940 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
941 . /15x,'RELATIVE PRES. FOR MEMBRANE DEFLATION .=',1pg20.13,
942 . /15x,' (DPDEF = PDEF - PEXT) ',
943 . /15x,'TIME DELAY BEFORE MEMBRANE DEFLATION .=',1pg20.13,
944 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
945 . /15x,' IF IDTPDEF : 0',
946 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
947 . /15x,' A CUMULATED DTPDEF TIME'
948 . /15x,' BEFORE ACTIVATING DEFLATION'
949 . /15x,' IF IDTPDEF : 1',
950 . /15x,' DEFLATION START DTPDEF AFTER',
951 . /15x,' DPDEF HAS BEEN REACHED',
952 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
953 1489 FORMAT(
954 . 15x,'AVENT:VENT HOLE AREA. . . . . . . . . .=',1pg20.13,
955 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
956 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
957 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
958 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
959 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
960 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
961 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
962 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
963 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
964 . /15x,'porosity FUNCTION / area. . . . . . . .=',I10,
965 . /15X,'porosity time function scale factor =',1PG20.13,
966 . /15X,'porosity pressure function scale factor=',1PG20.13,
967 . /15X,'porosity area function scale factor . .=',1PG20.13)
968 END SUBROUTINE HM_READ_MONVOL_TYPE6
969 END MODULE HM_READ_MONVOL_TYPE6_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:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
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:523
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
groupdef_mod
Definition groupdef_mod.F:662
hm_read_monvol_type6_mod
Definition hm_read_monvol_type6.F:28
hm_read_monvol_type6_mod::hm_read_monvol_type6
subroutine hm_read_monvol_type6(t_monvoln, sensors, npt, pld, igrbric, unitab, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)
Definition hm_read_monvol_type6.F:57
message_mod
Definition message_mod.F:1249
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:796
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:712
unitab_mod
Definition unitab_mod.F:513
read_monvol
subroutine read_monvol(t_monvol, t_monvol_metadata, itab, itabm1, ipm, igeo, x, pm, geo, ixc, ixtg, sensors, unitab, npc, npt, pld, igrsurf, igrbric, nom_opt, iframe, xframe, lsubmodel)
Definition read_monvol.F:66
monvol_orient_surf
subroutine monvol_orient_surf(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, x, itype)
Definition monvol_struct_mod.F:1110
monvol_reverse_normals
subroutine monvol_reverse_normals(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, vol, x, itype)
Definition monvol_struct_mod.F:1780
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:889
freerr
subroutine freerr(it)
Definition freform.F:506
starter
program starter
Definition starter.F:39
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84
submodel_mod::submodel_data
Definition submodel_mod.F:723
unitab_mod::unit_type_
Definition unitab_mod.F:520