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
66 use element_mod , only : nixc,nixtg
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74C NSURF
75#include "com04_c.inc"
76C KMONVO, IREC
77C NIMV, NRVOLU
78#include "param_c.inc"
79C IIN
80#include "units_c.inc"
81C IPRI
82#include "scr03_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 TYPE(unit_type_), INTENT(IN) :: UNITAB
87 INTEGER, INTENT(IN) :: NPT(*)
88 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
89 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *), pld(2, *)
90 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
91 TYPE(monvol_struct_), INTENT(INOUT) :: T_MONVOLN
92 TYPE (GROUP_), DIMENSION(NGRBRIC), INTENT(IN) :: IGRBRIC
93 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
94 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER :: II, JJ
99 INTEGER :: SURFID
100 my_real :: FAC_GEN
101 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
102 LOGICAL :: FOUND, DECREASE
103 my_real :: sa, rot, vol, vmin, veps, amu, sv
104 my_real :: pext, ti, pini, gamai, cpai, cpbi, cpci
105 INTEGER :: IEQUI, ITTF, NJET, NVENT
106 my_real, DIMENSION(:), ALLOCATABLE :: gama, cpa, cpb, cpc, fmass, ftemp, fvel
107 INTEGER, DIMENSION(:), ALLOCATABLE :: IMASS, IFLU, ITEMP, ISENS, IJET, IVEL
108 INTEGER, DIMENSION(:), ALLOCATABLE :: IPVENT, ITVENT, IDTPDEF, IVDP
109 my_real, DIMENSION(:), ALLOCATABLE :: avent, bvent, tstope, tvent, dpdef, dtpdef, fvdp
110 INTEGER, DIMENSION(:), ALLOCATABLE :: IPORT, IPORP, IPORA, IPORT1, IPORP1, IPORA1
111 my_real, DIMENSION(:), ALLOCATABLE :: fport, fporp, fpora, fport1, fporp1, fpora1
112 my_real :: dirx, diry, dirz, dir2x, dir2y, dir2z, origx, origy, origz, lx, ly, lz
113 INTEGER :: NBX, NBY, NBZ, IBRIC, ISUR, IREF, IGMERG
114 my_real :: cgmerg, cnmerg, ptole, qa, qb, hmin
115 INTEGER :: ILVOUT, NLAYER, NFACMAX, NPPMAX, IFVANI
116 my_real :: cpi, cvi, rmwi, mi, cpg, rmwg
117 INTEGER :: NBRIC, NN, I1, I2, I3, I4, ISH34
118 my_real :: sjet, dir, xx, yy, zz, x13, y13, z13, x24, y24, z24, nx, ny, nz, ds,
119 . rhoi, ti2, especi, shol
120 INTEGER :: NP, IP, IFVENT
121 LOGICAL :: IS_AVAILABLE
122C-----------------------------------------------
123C B e g i n n i n g o f s o u r c e
124C-----------------------------------------------
125C =======
126C Reading
127C =======
128! line 1
129 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
130! Line 2
131 CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
132 CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
133 CALL hm_get_floatv('AscaleS', scal_s, is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('AscaleA', scal_a, is_available, lsubmodel, unitab)
135 CALL hm_get_floatv('AscaleD', scal_d, is_available, lsubmodel, unitab)
136! Line 3
137 CALL hm_get_floatv('Pext', pext, is_available, lsubmodel, unitab)
138 CALL hm_get_floatv('T0', ti, is_available, lsubmodel, unitab)
139 CALL hm_get_intv('Iequi', iequi, is_available, lsubmodel)
140 CALL hm_get_intv('Ittf', ittf, is_available, lsubmodel)
141! Line 4
142 CALL hm_get_floatv('Gammai', gamai, is_available, lsubmodel, unitab)
143 CALL hm_get_floatv('cpai', cpai, is_available, lsubmodel, unitab)
144 CALL hm_get_floatv('cpbi', cpbi, is_available, lsubmodel, unitab)
145 CALL hm_get_floatv('cpci', cpci, is_available, lsubmodel, unitab)
146! Injectors
147 CALL hm_get_intv('Njet', njet, is_available, lsubmodel)
148 t_monvoln%NJET = njet
149 t_monvoln%IVOLU(8) = njet
150 IF (njet > 0) THEN
151 ALLOCATE(t_monvoln%IBAGJET(nibjet, njet))
152 t_monvoln%IBAGJET(1:nibjet, 1:njet) = 0
153 ALLOCATE(t_monvoln%RBAGJET(nrbjet, njet))
154 t_monvoln%RBAGJET(1:nrbjet, 1:njet) = zero
155 ENDIF
156 IF (njet > 0) THEN
157 ALLOCATE(gama(njet), cpa(njet), cpb(njet), cpc(njet), fmass(njet), ftemp(njet))
158 ALLOCATE(imass(njet), iflu(njet), itemp(njet), isens(njet))
159 ALLOCATE(ijet(njet))
160 ALLOCATE(ivel(njet), fvel(njet))
161 DO ii = 1, njet
162 CALL hm_get_float_array_index('Gamma', gama(ii), ii, is_available, lsubmodel, unitab)
163 CALL hm_get_float_array_index('cpa', cpa(ii), ii, is_available, lsubmodel, unitab)
164 CALL hm_get_float_array_index('cpb', cpb(ii), ii, is_available, lsubmodel, unitab)
165 CALL hm_get_float_array_index('cpc', cpc(ii), ii, is_available, lsubmodel, unitab)
166
167 CALL hm_get_int_array_index('fct_IDmas', imass(ii), ii,is_available, lsubmodel)
168 CALL hm_get_int_array_index('Iflow', iflu(ii), ii,is_available, lsubmodel)
169 CALL hm_get_float_array_index('Fscalemas', fmass(ii), ii, is_available, lsubmodel, unitab)
170 CALL hm_get_int_array_index('fct_IDT', itemp(ii), ii,is_available, lsubmodel)
171 CALL hm_get_float_array_index('FscaleT', ftemp(ii), ii, is_available, lsubmodel, unitab)
172 CALL hm_get_int_array_index('sens_ID', isens(ii), ii,is_available, lsubmodel)
173
174 CALL hm_get_int_array_index('Isjet', ijet(ii), ii,is_available, lsubmodel)
175
176 CALL hm_get_int_array_index('fct_IDvel', ivel(ii), ii,is_available, lsubmodel)
177 CALL hm_get_float_array_index('Fscalevel', fvel(ii), ii, is_available, lsubmodel, unitab)
178 ENDDO
179 ENDIF
180! Ventholes
181 CALL hm_get_intv('Nvent', nvent, is_available, lsubmodel)
182 t_monvoln%IVOLU(11) = nvent
183 t_monvoln%NVENT = nvent
184 IF (nvent > 0) THEN
185 ALLOCATE(t_monvoln%IBAGHOL(nibhol, nvent))
186 t_monvoln%IBAGHOL(1:nibhol, 1:nvent) = 0
187 ALLOCATE(t_monvoln%RBAGHOL(nrbhol, nvent))
188 t_monvoln%RBAGHOL(1:nrbhol, 1:nvent) = zero
189 ENDIF
190 IF (nvent > 0) THEN
191 ALLOCATE(ipvent(nvent), itvent(nvent), idtpdef(nvent), ivdp(nvent))
192 ALLOCATE(avent(nvent), bvent(nvent), tstope(nvent),
193 . tvent(nvent), dpdef(nvent), dtpdef(nvent), fvdp(nvent))
194 ALLOCATE(iport(nvent), iporp(nvent), ipora(nvent), iport1(nvent),
195 . iporp1(nvent), ipora1(nvent))
196 ALLOCATE(fport(nvent), fporp(nvent), fpora(nvent), fport1(nvent),
197 . fporp1(nvent), fpora1(nvent))
198 DO ii = 1, nvent
199 CALL hm_get_int_array_index('surf_IDv', ipvent(ii), ii, is_available, lsubmodel)
200 CALL hm_get_float_array_index('Avent', avent(ii), ii, is_available, lsubmodel, unitab)
201 CALL hm_get_float_array_index('Bvent', bvent(ii), ii, is_available, lsubmodel, unitab)
202 CALL hm_get_int_array_index('Itvent', itvent(ii), ii, is_available, lsubmodel)
203
204 CALL hm_get_float_array_index('Tvent', tvent(ii), ii, is_available, lsubmodel, unitab)
205 CALL hm_get_float_array_index('dPdef', dpdef(ii), ii, is_available, lsubmodel, unitab)
206 CALL hm_get_float_array_index('dtPdef', dtpdef(ii), ii, is_available, lsubmodel, unitab)
207 CALL hm_get_int_array_index('fct_IDV', ivdp(ii), ii,is_available, lsubmodel)
208 CALL hm_get_float_array_index('FscaleV', fvdp(ii), ii, is_available, lsubmodel, unitab)
209 CALL hm_get_int_array_index('IdtPdef', idtpdef(ii), ii,is_available, lsubmodel)
210
211 CALL hm_get_int_array_index('fct_IDt', iport(ii), ii,is_available, lsubmodel)
212 CALL hm_get_int_array_index('fct_IDP', iporp(ii), ii,is_available, lsubmodel)
213 CALL hm_get_int_array_index('fct_IDA', ipora(ii), ii,is_available, lsubmodel)
214 CALL hm_get_float_array_index('Fscalet', fport(ii), ii, is_available, lsubmodel, unitab)
215 CALL hm_get_float_array_index('FscaleP', fporp(ii), ii, is_available, lsubmodel, unitab)
216 CALL hm_get_float_array_index('FscaleA', fpora(ii), ii, is_available, lsubmodel, unitab)
217
218 CALL hm_get_int_array_index("fct_IDt'", iport1(ii), ii,is_available, lsubmodel)
219 CALL hm_get_int_array_index("fct_idp'", IPORP1(II), II,IS_AVAILABLE, LSUBMODEL)
220 CALL HM_GET_INT_ARRAY_INDEX("fct_IDA'", IPORA1(II), II,IS_AVAILABLE, LSUBMODEL)
221 CALL HM_GET_FLOAT_ARRAY_INDEX("fscalet'", FPORT1(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
222 CALL HM_GET_FLOAT_ARRAY_INDEX("FscaleP'", FPORP1(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
223 CALL HM_GET_FLOAT_ARRAY_INDEX("fscalea'", FPORA1(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
224 ENDDO
225 ENDIF
226 CALL HM_GET_FLOATV('vx3', DIRX, IS_AVAILABLE, LSUBMODEL, UNITAB)
227 CALL HM_GET_FLOATV('vy3', DIRY, IS_AVAILABLE, LSUBMODEL, UNITAB)
228 CALL HM_GET_FLOATV('vz3', DIRZ, IS_AVAILABLE, LSUBMODEL, UNITAB)
229
230 CALL HM_GET_FLOATV('vx1', DIR2X, IS_AVAILABLE, LSUBMODEL, UNITAB)
231 CALL HM_GET_FLOATV('vy1', DIR2Y, IS_AVAILABLE, LSUBMODEL, UNITAB)
232 CALL HM_GET_FLOATV('vz1', DIR2Z, IS_AVAILABLE, LSUBMODEL, UNITAB)
233
234 CALL HM_GET_FLOATV('x0', ORIGX, IS_AVAILABLE, LSUBMODEL, UNITAB)
235 CALL HM_GET_FLOATV('y0', ORIGY, IS_AVAILABLE, LSUBMODEL, UNITAB)
236 CALL HM_GET_FLOATV('z0', ORIGZ, IS_AVAILABLE, LSUBMODEL, UNITAB)
237
238 CALL HM_GET_FLOATV('l1', LX, IS_AVAILABLE, LSUBMODEL, UNITAB)
239 CALL HM_GET_FLOATV('l2', LY, IS_AVAILABLE, LSUBMODEL, UNITAB)
240 CALL HM_GET_FLOATV('l3', LZ, IS_AVAILABLE, LSUBMODEL, UNITAB)
241
242 CALL HM_GET_INTV('nb1', NBX, IS_AVAILABLE, LSUBMODEL)
243 CALL HM_GET_INTV('nb2', NBY, IS_AVAILABLE, LSUBMODEL)
244 CALL HM_GET_INTV('nb3', NBZ, IS_AVAILABLE, LSUBMODEL)
245 CALL HM_GET_INTV('grbrc_id', IBRIC, IS_AVAILABLE, LSUBMODEL)
246 CALL HM_GET_INTV('surf_idin', ISUR, IS_AVAILABLE, LSUBMODEL)
247 CALL HM_GET_INTV('iref', IREF, IS_AVAILABLE, LSUBMODEL)
248
249 CALL HM_GET_INTV('igmerg', IGMERG, IS_AVAILABLE, LSUBMODEL)
250 CALL HM_GET_FLOATV('cgmerg', CGMERG, IS_AVAILABLE, LSUBMODEL, UNITAB)
251 CALL HM_GET_FLOATV('cnmerg', CNMERG, IS_AVAILABLE, LSUBMODEL, UNITAB)
252 CALL HM_GET_FLOATV('ptole', PTOLE, IS_AVAILABLE, LSUBMODEL, UNITAB)
253
254 CALL HM_GET_FLOATV('qa', QA, IS_AVAILABLE, LSUBMODEL, UNITAB)
255 CALL HM_GET_FLOATV('qb', QB, IS_AVAILABLE, LSUBMODEL, UNITAB)
256 CALL HM_GET_FLOATV('hmin', HMIN, IS_AVAILABLE, LSUBMODEL, UNITAB)
257
258 CALL HM_GET_INTV('ilvout', ILVOUT, IS_AVAILABLE, LSUBMODEL)
259 CALL HM_GET_INTV('nlayer', NLAYER, IS_AVAILABLE, LSUBMODEL)
260 CALL HM_GET_INTV('nfacmax', NFACMAX, IS_AVAILABLE, LSUBMODEL)
261 CALL HM_GET_INTV('nppmax', NPPMAX, IS_AVAILABLE, LSUBMODEL)
262 CALL HM_GET_INTV('ifvani', IFVANI, IS_AVAILABLE, LSUBMODEL)
263C ================
264C Check operations
265C ================
266C External surface check
267 T_MONVOLN%IVOLU(4) = 0
268 FOUND = .FALSE.
269 DO II = 1, NSURF
270 IF (SURFID == IGRSURF(II)%ID) THEN
271 T_MONVOLN%IVOLU(4) = II
272 T_MONVOLN%EXT_SURFID = II
273 FOUND = .TRUE.
274 EXIT
275 ENDIF
276 ENDDO
277.NOT. IF ( FOUND) THEN
278 CALL FREERR(3)
279 ELSEIF (IGRSURF(T_MONVOLN%IVOLU(4))%ISH4N3N == 0) THEN
280 CALL ANCMSG(MSGID = 18, ANMODE = ANINFO, MSGTYPE = MSGERROR,
281 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = SURFID)
282 CALL FREERR(3)
283 ENDIF
284
285C Check surface closure
286 CALL MONVOL_CHECK_SURFCLOSE(T_MONVOLN, ITAB, IGRSURF(T_MONVOLN%EXT_SURFID), X)
287C Set all normal on same side
288 CALL MONVOL_ORIENT_SURF(T_MONVOLN, T_MONVOLN%TITLE, T_MONVOLN%IVOLU, ITAB,
289 . IGRSURF(T_MONVOLN%EXT_SURFID),IXC, IXTG, X, 10)
290C Compute Monvon volume
291 CALL MONVOL_COMPUTE_VOLUME(T_MONVOLN, T_MONVOLN%TITLE, T_MONVOLN%IVOLU, IGRSURF(T_MONVOLN%EXT_SURFID),
292 . ITAB, X, PM, GEO, IXC, IXTG,
293 . SA, ROT, VOL, VMIN, VEPS, SV)
294C Reverse all normals to ensure positive volume
295 CALL MONVOL_REVERSE_NORMALS(T_MONVOLN, T_MONVOLN%TITLE, T_MONVOLN%IVOLU, ITAB,
296 . IGRSURF(T_MONVOLN%EXT_SURFID),IXC,IXTG,VOL, X, 10)
297
298.OR. IF (ITTF < 0 ITTF > 3) THEN
299 CALL ANCMSG(MSGID = 773, ANMODE = ANINFO, MSGTYPE = MSGERROR,
300 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
301 END IF
302.OR. IF (GAMAI == ZERO CPAI == ZERO) THEN
303 CALL ANCMSG(MSGID = 473, MSGTYPE = MSGERROR, ANMODE = ANINFO,
304 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
305 ENDIF
306C ==============
307C Default values
308C ==============
309 IF (SCAL_T == ZERO) THEN
310 CALL HM_GET_FLOATV_DIM('ascalet', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
311 SCAL_T = ONE * FAC_GEN
312 ENDIF
313 IF (SCAL_P == ZERO) THEN
314 CALL HM_GET_FLOATV_DIM('ascalep', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
315 SCAL_P = ONE * FAC_GEN
316 ENDIF
317 IF (SCAL_S == ZERO) THEN
318 CALL HM_GET_FLOATV_DIM('ascales', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
319 SCAL_S = ONE * FAC_GEN
320 ENDIF
321 IF (SCAL_A == ZERO) THEN
322 CALL HM_GET_FLOATV_DIM('ascalea', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
323 SCAL_A = ONE * FAC_GEN
324 ENDIF
325 IF (SCAL_D == ZERO) THEN
326 CALL HM_GET_FLOATV_DIM('ascaled', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
327 SCAL_D = ONE * FAC_GEN
328 ENDIF
329
330 AMU = EM02
331 IF(PEXT == ZERO) THEN
332 PEXT = 101325.D0 * (UNITAB%FAC_L_WORK * UNITAB%FAC_T_WORK * UNITAB%FAC_T_WORK) / UNITAB%FAC_M_WORK
333 ENDIF
334 IF (TI == ZERO) TI = TWOHUNDRED95
335 PINI = PEXT
336
337 DO II = 1, NJET
338.AND. IF (IMASS(II) /=0 FMASS(II) == ZERO) THEN
339 CALL HM_GET_FLOATV_DIM('fscalemas', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
340 FMASS(II) = ONE * FAC_GEN
341 ENDIF
342.AND. IF (ITEMP(II) /=0 FTEMP(II) == ZERO) THEN
343 CALL HM_GET_FLOATV_DIM('fscalet', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
344 FTEMP(II) = ONE * FAC_GEN
345 ENDIF
346
347 IF (FVEL(II) == ZERO) THEN
348 CALL HM_GET_FLOATV_DIM('fscalevel', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
349 FVEL(II) = ONE * FAC_GEN
350 ENDIF
351 ENDDO
352 DO II = 1, NVENT
353 IF (ITVENT(II) == 0) ITVENT(II) = 2
354 IF (IPVENT(II) == 0) THEN
355 AVENT(II) = ZERO
356 BVENT(II) = ZERO
357 ENDIF
358 IF (FPORT(II) == ZERO) FPORT(II) = ONE
359 IF (FPORP(II) == ZERO) FPORP(II) = ONE
360 IF (FPORA(II) == ZERO) FPORA(II) = ONE
361 IF (FPORT1(II) == ZERO) FPORT1(II) = ONE
362 IF (FPORP1(II) == ZERO) FPORP1(II) = ONE
363 IF (FPORA1(II) == ZERO) FPORA1(II) = ONE
364 ENDDO
365 IF (NBX == 0) NBX = 1
366 IF (NBY == 0) NBY = 1
367 IF (NBZ == 0) NBZ = 1
368 IF (IGMERG == 0) IGMERG = 1
369 IF (CGMERG == ZERO) CGMERG = ZEP02
370 IF (PTOLE == ZERO) PTOLE = EM5
371 IF (NLAYER == 0) NLAYER = 10
372 IF (NFACMAX == 0) NFACMAX = 20
373 IF (NPPMAX == 0) NPPMAX = 20
374 CPI = CPAI + TI * (CPBI + CPCI * TI)
375 CVI = CPI / GAMAI
376 RMWI = CVI * (GAMAI - ONE)
377 MI = PINI * (VOL + VEPS) / (RMWI * TI)
378C =====
379C Store
380C =====
381 T_MONVOLN%RVOLU(26) = ONE / SCAL_T
382 T_MONVOLN%RVOLU(27) = ONE / SCAL_P
383 T_MONVOLN%RVOLU(28) = ONE / SCAL_S
384 T_MONVOLN%RVOLU(29) = ONE / SCAL_A
385 T_MONVOLN%RVOLU(30) = ONE / SCAL_D
386
387 T_MONVOLN%IVOLU(17) = ITTF
388 T_MONVOLN%IVOLU(8) = NJET
389 DO II = 1, NJET
390 T_MONVOLN%IBAGJET(14, II) = 0
391 FOUND = .FALSE.
392 DO JJ = 1, NSURF
393 IF (IJET(II) == IGRSURF(JJ)%ID) THEN
394 T_MONVOLN%IBAGJET(14, II) = JJ
395 FOUND = .TRUE.
396 EXIT
397 ENDIF
398 ENDDO
399.NOT. IF ( FOUND) THEN
400 CALL ANCMSG(MSGID = 847, ANMODE = ANINFO, MSGTYPE = MSGERROR,
401 . I2 = IJET(II), I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
402 ENDIF
403 IJET(II) = 0
404 FOUND = .FALSE.
405 DO JJ = 1, NFUNCT
406 IF (IVEL(II) == NPC(JJ)) THEN
407 T_MONVOLN%IBAGJET(11, II) = JJ
408 FOUND = .TRUE.
409 EXIT
410 ENDIF
411 ENDDO
412.NOT. IF ( FOUND) THEN
413 CALL ANCMSG(MSGID = 6, ANMODE = ANINFO, MSGTYPE = MSGERROR,
414 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IVEL(II))
415 ENDIF
416 T_MONVOLN%RBAGJET(15, II) = FVEL(II)
417 T_MONVOLN%IBAGJET(13, II) = 0
418 T_MONVOLN%RBAGJET(1, II) = GAMA(II)
419 T_MONVOLN%RBAGJET(2, II) = CPA(II)
420 T_MONVOLN%RBAGJET(3, II) = CPB(II)
421 T_MONVOLN%RBAGJET(4, II) = CPC(II)
422 T_MONVOLN%RBAGJET(5, II) = FMASS(II)
423 T_MONVOLN%RBAGJET(6, II) = FTEMP(II)
424 T_MONVOLN%RBAGJET(12, II) = ONE
425 T_MONVOLN%RBAGJET(13, II) = ONE
426 T_MONVOLN%RBAGJET(14, II) = ONE
427 IF (IMASS(II) == 0)THEN
428 T_MONVOLN%IBAGJET(1, II) = 0
429 ELSE
430 FOUND = .FALSE.
431 DO JJ = 1, NFUNCT
432 IF (IMASS(II) == NPC(JJ)) THEN
433 T_MONVOLN%IBAGJET(1, II) = JJ
434 DECREASE = .FALSE.
435 NP = (NPT(JJ + 1) - NPT(JJ)) / 2
436 IF (IFLU(II) == 0) THEN
437 DO IP = (NPT(JJ) - 1) / 2 + 1, (NPT(JJ + 1) - 1) / 2 - 1
438 IF (PLD(2, IP + 1) < PLD(2, IP)) DECREASE = .TRUE.
439 ENDDO
440 IF (DECREASE) THEN
441 CALL ANCMSG(MSGID=540, MSGTYPE = MSGWARNING, ANMODE = ANINFO_BLIND_1,
442 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IMASS(II), I3 = II)
443 ENDIF
444 ELSE
445 DO IP = (NPT(JJ) - 1) / 2 + 1, (NPT(JJ + 1) - 1) / 2
446 IF (PLD(2, IP) < ZERO) DECREASE = .TRUE.
447 ENDDO
448 IF (DECREASE) THEN
449 CALL ANCMSG(MSGID = 541, MSGTYPE = MSGWARNING, ANMODE = ANINFO_BLIND_1,
450 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IMASS(II), I3 = II)
451 ENDIF
452 ENDIF
453 FOUND = .TRUE.
454 EXIT
455 ENDIF
456 ENDDO
457.NOT. IF ( FOUND) THEN
458 CALL ANCMSG(MSGID = 10, ANMODE = ANINFO, MSGTYPE = MSGERROR,
459 . I2 = IMASS(II), I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
460 ENDIF
461 ENDIF
462 T_MONVOLN%IBAGJET(2, II) = IFLU(II)
463 IF (ITEMP(II) == 0) THEN
464 T_MONVOLN%IBAGJET(3, II) = 0
465 ELSE
466 FOUND = .FALSE.
467 DO JJ = 1, NFUNCT
468 IF (ITEMP(II) == NPC(JJ)) THEN
469 T_MONVOLN%IBAGJET(3, II) = JJ
470 FOUND = .TRUE.
471 EXIT
472 ENDIF
473 ENDDO
474.NOT. IF ( FOUND) THEN
475 CALL ANCMSG(MSGID = 11, ANMODE = ANINFO, MSGTYPE = MSGERROR,
476 . I2 = ITEMP(II), I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
477 ENDIF
478 ENDIF
479 IF (ISENS(II) > 0) THEN
480 FOUND = .FALSE.
481 DO JJ = 1, SENSORS%NSENSOR
482 IF (ISENS(II) == SENSORS%SENSOR_TAB(JJ)%SENS_ID) THEN
483 T_MONVOLN%IBAGJET(4, II) = JJ
484 FOUND = .TRUE.
485 EXIT
486 ENDIF
487 ENDDO
488.NOT. IF ( FOUND) THEN
489 CALL ANCMSG(MSGID = 17, ANMODE = ANINFO, MSGTYPE = MSGERROR,
490 . I2 = ISENS(II), I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
491 ENDIF
492 ENDIF
493 CPG = CPA(II) + TI * (CPB(II) + CPC(II) * TI)
494 RMWG = CPG * (GAMA(II) - ONE) / GAMA(II)
495 T_MONVOLN%RBAGJET(1, II) = RMWG
496 ENDDO
497 DO II = 1, NVENT
498 T_MONVOLN%RBAGHOL(7, II) = FPORT(II)
499 T_MONVOLN%RBAGHOL(8, II) = FPORP(II)
500 T_MONVOLN%RBAGHOL(9, II) = FPORA(II)
501 T_MONVOLN%RBAGHOL(10, II) = FPORT1(II)
502 T_MONVOLN%RBAGHOL(11, II) = FPORP1(II)
503 T_MONVOLN%RBAGHOL(12, II) = FPORA1(II)
504 T_MONVOLN%IBAGHOL(1, II) = 0
505 T_MONVOLN%IBAGHOL(10, II) = 0
506 T_MONVOLN%IBAGHOL(11, II) = IDTPDEF(II)
507 T_MONVOLN%IBAGHOL(12, II) = 0
508 IF (IPVENT(II) == 0) THEN
509 T_MONVOLN%IBAGHOL(2, II) = 0
510 ELSE
511 T_MONVOLN%IBAGHOL(2, II) = 0
512 FOUND = .FALSE.
513 DO JJ = 1, NSURF
514 IF (IPVENT(II) == IGRSURF(JJ)%ID) THEN
515 T_MONVOLN%IBAGHOL(2, II) = JJ
516 FOUND = .TRUE.
517 EXIT
518 ENDIF
519 ENDDO
520.NOT. IF( FOUND)THEN
521 CALL ANCMSG(MSGID = 532, ANMODE = ANINFO, MSGTYPE = MSGERROR,
522 . I2 = IPVENT(II), I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
523 ELSEIF(IGRSURF(T_MONVOLN%IBAGHOL(2, II))%ISH4N3N == 0) THEN
524 CALL ANCMSG(MSGID = 330, ANMODE = ANINFO, MSGTYPE = MSGERROR,
525 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
526 ENDIF
527 IF (AVENT(II) == ZERO) AVENT(II) = ONE
528 ENDIF
529 IF (AVENT(II) == ZERO) DPDEF(II) = INFINITY
530 IF (AVENT(II) == ZERO) TVENT(II) = INFINITY
531.AND..AND. IF (DPDEF(II) == ZERO DTPDEF(II) == ZERO TVENT(II) == ZERO) THEN
532 T_MONVOLN%IBAGHOL(1, II) = 1
533 ENDIF
534 T_MONVOLN%RBAGHOL(1, II) = DPDEF(II)
535 T_MONVOLN%RBAGHOL(2, II) = AVENT(II)
536 T_MONVOLN%RBAGHOL(3, II) = TVENT(II)
537 T_MONVOLN%RBAGHOL(4, II) = DTPDEF(II)
538 T_MONVOLN%RBAGHOL(6, II) = BVENT(II)
539.AND. IF (IVDP(II) /= 0 FVDP(II) == ZERO) FVDP(II) = ONE
540 T_MONVOLN%RBAGHOL(13, II) = FVDP(II)
541 TSTOPE(II) = INFINITY
542 T_MONVOLN%RBAGHOL(14, II) = TSTOPE(II)
543C
544 T_MONVOLN%IBAGHOL(3, II) = -1
545 T_MONVOLN%IBAGHOL(4, II) = -1
546 T_MONVOLN%IBAGHOL(5, II) = -1
547 T_MONVOLN%IBAGHOL(6, II) = -1
548 T_MONVOLN%IBAGHOL(7, II) = -1
549 T_MONVOLN%IBAGHOL(8, II) = -1
550 T_MONVOLN%IBAGHOL(9, II) = -1
551 DO JJ = 1, NFUNCT
552 IF (IPORT(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(3, II) = JJ
553 IF (IPORP(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(4, II) = JJ
554 IF (IPORA(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(5, II) = JJ
555 IF (IPORT1(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(6, II) = JJ
556 IF (IPORP1(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(7, II) = JJ
557 IF (IPORA1(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(8, II) = JJ
558 IF (IVDP(II) == NPC(JJ)) T_MONVOLN%IBAGHOL(9, II) = JJ
559 ENDDO
560 IF (IPORT(II) == 0) T_MONVOLN%IBAGHOL(3, II) = 0
561 IF (IPORP(II) == 0) T_MONVOLN%IBAGHOL(4, II) = 0
562 IF (IPORA(II) == 0) T_MONVOLN%IBAGHOL(5, II) = 0
563 IF (IPORT1(II) == 0) T_MONVOLN%IBAGHOL(6, II) = 0
564 IF (IPORP1(II) == 0) T_MONVOLN%IBAGHOL(7, II) = 0
565 IF (IPORA1(II) == 0) T_MONVOLN%IBAGHOL(8, II) = 0
566 IF (IVDP(II) == 0) T_MONVOLN%IBAGHOL(9, II) = 0
567 IF (T_MONVOLN%IBAGHOL(3, II) == -1) THEN
568 T_MONVOLN%IBAGHOL(3, II) = 0
569 CALL ANCMSG(MSGID = 331, ANMODE = ANINFO, MSGTYPE = MSGERROR,
570 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IPORT(II))
571 ENDIF
572 IF (T_MONVOLN%IBAGHOL(4, II) == -1) THEN
573 T_MONVOLN%IBAGHOL(4, II) = 0
574 CALL ANCMSG(MSGID = 332, ANMODE = ANINFO, MSGTYPE = MSGERROR,
575 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IPORP(II))
576 ENDIF
577 IF (T_MONVOLN%IBAGHOL(5, II) == -1) THEN
578 T_MONVOLN%IBAGHOL(5, II)=0
579 CALL ANCMSG(MSGID = 333, ANMODE = ANINFO, MSGTYPE = MSGERROR,
580 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IPORA(II))
581 ENDIF
582 IF (T_MONVOLN%IBAGHOL(6, II) == -1) THEN
583 T_MONVOLN%IBAGHOL(6, II) = 0
584 CALL ANCMSG(MSGID=331, ANMODE=ANINFO, MSGTYPE=MSGERROR,
585 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IPORT1(II))
586 ENDIF
587 IF (T_MONVOLN%IBAGHOL(7, II) == -1) THEN
588 T_MONVOLN%IBAGHOL(7, II)=0
589 CALL ANCMSG(MSGID=332, ANMODE=ANINFO, MSGTYPE=MSGERROR,
590 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IPORP1(II))
591 ENDIF
592 IF (T_MONVOLN%IBAGHOL(8, II) == -1) THEN
593 T_MONVOLN%IBAGHOL(8, II) = 0
594 CALL ANCMSG(MSGID=333, ANMODE=ANINFO, MSGTYPE=MSGERROR,
595 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IPORA1(II))
596 ENDIF
597 IF (T_MONVOLN%IBAGHOL(9, II) == -1) THEN
598 T_MONVOLN%IBAGHOL(9, II) = 0
599 CALL ANCMSG(MSGID = 518, ANMODE = ANINFO, MSGTYPE = MSGERROR,
600 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = IVDP(II))
601 ENDIF
602 T_MONVOLN%IBAGHOL(10, II) = ITVENT(II)
603 ENDDO
604 T_MONVOLN%RVOLU(35) = DIRX
605 T_MONVOLN%RVOLU(36) = DIRY
606 T_MONVOLN%RVOLU(37) = DIRZ
607 T_MONVOLN%RVOLU(38) = DIR2X
608 T_MONVOLN%RVOLU(39) = DIR2Y
609 T_MONVOLN%RVOLU(40) = DIR2Z
610 T_MONVOLN%RVOLU(41) = ORIGX
611 T_MONVOLN%RVOLU(42) = ORIGY
612 T_MONVOLN%RVOLU(43) = ORIGZ
613 T_MONVOLN%RVOLU(44) = LX
614 T_MONVOLN%RVOLU(45) = LY
615 T_MONVOLN%RVOLU(53) = LZ
616 T_MONVOLN%IVOLU(54) = NBX
617 T_MONVOLN%IVOLU(55) = NBY
618 T_MONVOLN%IVOLU(35) = NBX * NBY
619 T_MONVOLN%IVOLU(65) = NBZ
620 T_MONVOLN%IVOLU(59) = IREF
621 T_MONVOLN%IVOLU(61) = 0
622 IF(IBRIC > 0) THEN
623 DO JJ = 1, NGRBRIC
624 IF (IBRIC == IGRBRIC(JJ)%ID) T_MONVOLN%IVOLU(61) = JJ
625 EXIT
626 ENDDO
627 ENDIF
628 T_MONVOLN%IVOLU(67)=0
629 T_MONVOLN%INT_SURFID = 0
630 IF (ISUR > 0) THEN
631 DO JJ = 1, NSURF
632 IF (ISUR == IGRSURF(JJ)%ID) THEN
633 T_MONVOLN%IVOLU(67) = JJ
634 T_MONVOLN%INT_SURFID = JJ
635 EXIT
636 ENDIF
637 ENDDO
638 ENDIF
639 T_MONVOLN%IVOLU(60) = IGMERG
640 T_MONVOLN%RVOLU(31) = CGMERG
641 T_MONVOLN%RVOLU(34) = CNMERG
642 T_MONVOLN%RVOLU(50) = PTOLE
643 T_MONVOLN%RVOLU(46) = QA
644 T_MONVOLN%RVOLU(47) = QB
645 T_MONVOLN%RVOLU(51) = HMIN
646 T_MONVOLN%IVOLU(44) = ILVOUT
647 T_MONVOLN%IVOLU(40) = NLAYER
648 T_MONVOLN%IVOLU(41) = NFACMAX
649 T_MONVOLN%IVOLU(42) = NPPMAX
650 T_MONVOLN%IVOLU(15) = IEQUI
651 T_MONVOLN%IVOLU(27) = 1
652 T_MONVOLN%RVOLU(7) = CPAI
653 T_MONVOLN%RVOLU(8) = CPBI
654 T_MONVOLN%RVOLU(9) = CPCI
655 T_MONVOLN%RVOLU(10) = RMWI
656 T_MONVOLN%RVOLU(1) = GAMAI
657 T_MONVOLN%RVOLU(3) = PEXT
658 T_MONVOLN%RVOLU(4) = VOL+VEPS
659 T_MONVOLN%RVOLU(11) = MI
660 T_MONVOLN%RVOLU(12) = PINI
661 T_MONVOLN%RVOLU(13) = TI
662 T_MONVOLN%RVOLU(14) = RMWI * MI
663 T_MONVOLN%RVOLU(17) = VEPS
664 T_MONVOLN%RVOLU(20) = MI
665 T_MONVOLN%RVOLU(25) = TI
666 T_MONVOLN%RVOLU(61) = GAMAI
667 RHOI = PINI / (TI * RMWI)
668 T_MONVOLN%RVOLU(62) = RHOI
669 TI2 = TI * TI
670 ESPECI = TI * (CPAI + HALF * CPBI * TI + THIRD * CPCI * TI2 - RMWI)
671 T_MONVOLN%RVOLU(63) = ESPECI + RMWI * TI
672 T_MONVOLN%RVOLU(64) = ZERO
673 T_MONVOLN%RVOLU(65) = ZERO
674 T_MONVOLN%RVOLU(66) = ESPECI
675C
676 T_MONVOLN%RVOLU(2) = AMU
677 T_MONVOLN%RVOLU(16) = VOL + VEPS
678 T_MONVOLN%RVOLU(18) = SA
679 T_MONVOLN%RVOLU(21) = ROT
680 T_MONVOLN%RVOLU(22:24) = ZERO
681
682C =========
683C Print out
684C =========
685 WRITE(IOUT, 1005) SURFID
686 WRITE(IOUT, 1003) SCAL_T, SCAL_P, SCAL_S, SCAL_A, SCAL_D
687 WRITE(IOUT, 1002) SA, SV, VOL
688 WRITE(IOUT, 1400) AMU, TI, PEXT, PINI
689 IF (IEQUI == 0) THEN
690 WRITE(IOUT, 1401)
691 ENDIF
692 IF (IEQUI > 0) THEN
693 IF (IEQUI == 1) THEN
694 WRITE(IOUT, 1404)
695 ELSE
696 WRITE(IOUT,1405) IEQUI
697 ENDIF
698 ENDIF
699 WRITE(IOUT, 1410) GAMAI, CPAI, CPBI, CPCI
700 NBRIC = 0
701 IF (T_MONVOLN%IVOLU(61) /= 0) NBRIC = IGRBRIC(T_MONVOLN%IVOLU(61))%ID
702 WRITE(IOUT, 1700)
703 WRITE(IOUT, 1704)
704 WRITE(IOUT,1710) T_MONVOLN%RVOLU(41),T_MONVOLN%RVOLU(42),T_MONVOLN%RVOLU(43),
705 . T_MONVOLN%RVOLU(38),T_MONVOLN%RVOLU(39),T_MONVOLN%RVOLU(40),
706 . T_MONVOLN%RVOLU(35),T_MONVOLN%RVOLU(36),T_MONVOLN%RVOLU(37),
707 . T_MONVOLN%RVOLU(44),T_MONVOLN%RVOLU(45),T_MONVOLN%RVOLU(53),
708 . T_MONVOLN%IVOLU(54),T_MONVOLN%IVOLU(55),T_MONVOLN%IVOLU(65),
709 . NBRIC ,ISUR ,T_MONVOLN%IVOLU(59),
710 . T_MONVOLN%IVOLU(60),T_MONVOLN%RVOLU(31),T_MONVOLN%RVOLU(34),
711 . T_MONVOLN%RVOLU(50),
712 . T_MONVOLN%RVOLU(46),T_MONVOLN%RVOLU(47),T_MONVOLN%RVOLU(51),
713 . T_MONVOLN%RVOLU(71),T_MONVOLN%RVOLU(72),
714 . T_MONVOLN%IVOLU(44),T_MONVOLN%IVOLU(40),T_MONVOLN%IVOLU(41),
715 . T_MONVOLN%IVOLU(42),IFVANI
716 WRITE(IOUT, 1420)
717 WRITE(IOUT, 1421) NJET
718 DO II = 1, NJET
719 WRITE(IOUT, 1430) II, IMASS(II), IFLU(II), FMASS(II), ITEMP(II), FTEMP(II), ISENS(II)
720 IF (IVEL(II) > 0) THEN
721 WRITE(IOUT,1435) IVEL(II), FVEL(II)
722 ENDIF
723 WRITE(IOUT, 1440) GAMA(II), CPA(II), CPB(II), CPC(II)
724! Injector surface
725 ISUR = T_MONVOLN%IBAGJET(14, II)
726 SJET = ZERO
727 IF (ISUR /= 0) THEN
728 IF (IGRSURF(ISUR)%ISH4N3N == 0) THEN
729 CALL ANCMSG(MSGID = 18, ANMODE = ANINFO, MSGTYPE = MSGERROR,
730 . I2 = IGRSURF(ISUR)%ID, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE)
731 ELSE
732 NN =IGRSURF(ISUR)%NSEG
733 DO JJ = 1, NN
734 DIR = HALF
735 I1 = IGRSURF(ISUR)%NODES(JJ, 1)
736 I2 = IGRSURF(ISUR)%NODES(JJ, 2)
737 I3 = IGRSURF(ISUR)%NODES(JJ, 3)
738 I4 = IGRSURF(ISUR)%NODES(JJ, 4)
739 ISH34 = IGRSURF(ISUR)%ELTYP(JJ)
740 IF (ISH34 == 7) I4 = I3
741 XX = HALF * (X(1, I1) + X(1, I2))
742 YY = HALF * (X(2, I1) + X(2, I2))
743 ZZ = HALF * (X(3, I1) + X(3, I2))
744 X13 = X(1, I3) - X(1, I1)
745 Y13 = X(2, I3) - X(2, I1)
746 Z13 = X(3, I3) - X(3, I1)
747 X24 = X(1, I4) - X(1, I2)
748 Y24 = X(2, I4) - X(2, I2)
749 Z24 = X(3, I4) - X(3, I2)
750 NX = DIR * (Y13 * Z24 - Y24 * Z13)
751 NY = DIR * (Z13 * X24 - Z24 * X13)
752 NZ = DIR * (X13 * Y24 - X24 * Y13)
753 DS = SQRT(NX * NX + NY * NY + NZ * NZ)
754 SJET = SJET + DS
755 ENDDO
756 ENDIF
757 ENDIF
758 WRITE(IOUT,1445) IGRSURF(ISUR)%ID, SJET
759 ENDDO
760 WRITE(IOUT, 1470) NVENT, ZERO
761 IF (NVENT > 0) THEN
762 WRITE(IOUT, 1475) ITTF
763 DO II = 1, NVENT
764 WRITE(IOUT, 1472) II, IPVENT(II)
765 IF (IPVENT(II) == 0) THEN
766 CALL ANCMSG(MSGID = 1050, MSGTYPE = MSGERROR, ANMODE = ANINFO,
767 . I1 = T_MONVOLN%ID, I2 = II, C1 = T_MONVOLN%TITLE, C2 = 'vent hole surface')
768 ENDIF
769 IFVENT = T_MONVOLN%IBAGHOL(10, II)
770 IF (IFVENT == 1) WRITE(IOUT, 1483)
771 IF (IFVENT == 2) WRITE(IOUT, 1481)
772 IF (IFVENT == 3) WRITE(IOUT, 1482) IVDP(II), FVDP(II)
773 IF (IFVENT == 5) WRITE(IOUT, 1484)
774 IF (IPVENT(II) /= 0) THEN
775 CALL MONVOL_CHECK_VENTHOLE_SURF(IPRI, T_MONVOLN, IGRSURF, II, SHOL, X, IXC, IXTG)
776 T_MONVOLN%RBAGHOL(15, II) = SHOL
777 WRITE(IOUT,1479)
778 . SHOL,AVENT(II),BVENT(II),
779 . IPORT(II),IPORP(II),IPORA(II),FPORT(II),FPORP(II),FPORA(II),
780 . IPORT1(II),IPORP1(II),IPORA1(II),FPORT1(II),FPORP1(II),FPORA1(II)
781 WRITE(IOUT,1480) TVENT(II),DPDEF(II),DTPDEF(II),IDTPDEF(II),TSTOPE(II)
782 ELSE
783 WRITE(IOUT,1489)
784 . AVENT(II),BVENT(II),
785 . IPORT(II),IPORP(II),IPORA(II),FPORT(II),FPORP(II),FPORA(II),
786 . IPORT1(II),IPORP1(II),IPORA1(II),FPORT1(II),FPORP1(II),FPORA1(II)
787 WRITE(IOUT,1480) TVENT(II),DPDEF(II),DTPDEF(II),IDTPDEF(II),TSTOPE(II)
788 ENDIF
789 ENDDO
790 ENDIF
791C ===========
792C Memory free
793C ===========
794 IF (NJET > 0) THEN
795 DEALLOCATE(GAMA, CPA, CPB, CPC, FMASS, FTEMP)
796 DEALLOCATE(IMASS, IFLU, ITEMP, ISENS)
797 DEALLOCATE(IJET)
798 DEALLOCATE(IVEL, FVEL)
799 ENDIF
800 IF (NVENT > 0) THEN
801 DEALLOCATE(IPVENT, ITVENT, IDTPDEF, IVDP)
802 DEALLOCATE(AVENT, BVENT, TSTOPE, TVENT, DPDEF, DTPDEF, FVDP)
803 DEALLOCATE(IPORT, IPORP, IPORA, IPORT1, IPORP1, IPORA1)
804 DEALLOCATE(FPORT, FPORP, FPORA, FPORT1, FPORP1, FPORA1)
805 ENDIF
806C-----------------------------------------------
807C E n d o f s o u r c e
808C-----------------------------------------------
809
810 RETURN
811 1002 FORMAT(
812 . /5X,'initial surface of monitored volume . .=',1PG20.13,
813 . /5X,'surface error(ne.0 for non closed surf)=',1PG20.13,
814 . /5X,'initial volume of monitored volume. . .=',1PG20.13)
815 1003 FORMAT(
816 . 5X,'unit scale for time functions =',1PG20.13,
817 . /5X,'unit scale for pressure functions =',1PG20.13,
818 . /5X,'unit scale for area functions =',1PG20.13,
819 . /5X,'unit scale for angle functions =',1PG20.13,
820 . /5X,'unit scale for distance functions =',1PG20.13)
821 1005 FORMAT( 5X,'EXTERNAL surface id . . . . . . . . . .=',I10)
822 1400 FORMAT(
823 . 5X,'volumic viscosity . . . . . . . . . . .=',1PG20.13,
824 . /5X,'initial temperature . . . . . . . . . .=',1PG20.13,
825 . /5X,'EXTERNAL pressure . . . . . . . . . . .=',1PG20.13,
826 . /5X,'initial pressure. . . . . . . . . . . .=',1PG20.13/)
827 1401 FORMAT(
828 . 5X,'initial thermodynamic equilibrium is set at time 0'
829 . /5X,'--------------------------------------------------'/)
830 1404 FORMAT(
831 . 5X,'thermodynamic equilibrium is set every cycle up to injection time'/)
832 1405 FORMAT(
833 . 5X,'thermodynamic equilibrium is set every',I10,' cycles up to injection time'/)
834 1410 FORMAT(
835 . 5X,'characteristics of initial gaz ',
836 . /5X,'------------------------------ ',
837 . /5X,'gamma at initial temperature. . . . . .=',1PG20.13,
838 . /5X,'coefficient cpa . . . . . . . . . . . .=',1PG20.13,
839 . /5X,'coefficient cpb . . . . . . . . . . . .=',1PG20.13,
840 . /5X,'coefficient cpc . . . . . . . . . . . .=',1PG20.13/)
841 1700 FORMAT(5X,'fvmbag parameters ',
842 . /5X,'----------------- ')
843 1704 FORMAT(15X,'airbag cutting frame: ')
844 1710 FORMAT(15X,' origin x coordinate. . . . . . . . .=',1PG20.13,
845 . /15X,' origin y coordinate. . . . . . . . .=',1PG20.13,
846 . /15X,' origin z coordinate. . . . . . . . .=',1PG20.13,
847 . /15X,' direction 1 x coordinate . . . . . .=',1PG20.13,
848 . /15X,' direction 1 y coordinate . . . . . .=',1PG20.13,
849 . /15X,' direction 1 z coordinate . . . . . .=',1PG20.13,
850 . /15X,' direction 3 x coordinate . . . . . .=',1PG20.13,
851 . /15X,' direction 3 y coordinate . . . . . .=',1PG20.13,
852 . /15X,' direction 3 z coordinate . . . . . .=',1PG20.13,
853 . /15X,'cutting length in local direction 1 . .=',1PG20.13,
854 . /15X,'cutting length in local direction 2 . .=',1PG20.13,
855 . /15X,'cutting length in local direction 3 . .=',1PG20.13,
856 . /15X,'number of cells in local direction 1. .=',I10,
857 . /15X,'number of cells in local direction 2. .=',I10,
858 . /15X,'number of cells in local direction 3. .=',I10,
859 . /15X,'additional brick group number . . . . .=',I10,
860 . /15X,'internal surface id. . . . . . . . . .=',I10,
861 . /15X,'flag for mesh on reference metrics. . .=',I10,
862 . /15X,'cell merging strategy: ',
863 . /15X,' global merging type. . . . . . . . .=',I10,
864 . /15X,' global merging coefficient . . . . .=',1PG20.13,
865 . /15X,' neighborhood merging coefficient . .=',1PG20.13,
866 . /15X,'tolerance for small segment removal . .=',1PG20.13,
867 . /15X,'quadratic bulk viscosity. . . . . . . .=',1PG20.13,
868 . /15X,'linear bulk viscosity . . . . . . . . .=',1PG20.13,
869 . /15X,'minimum height. . . . . . . . . . . . .=',1PG20.13,
870 . /15X,'dt scale factor . . . . . . . . . . . .=',1PG20.13,
871 . /15X,'minimum timestep. . . . . . . . . . . .=',1PG20.13,
872 . /15X,'output level. . . . . . . . . . . . . .=',I10,
873 . /15X,'memory parameters: ',
874 . /15X,' estimated number of airbag layers. .=',I10,
875 . /15X,' estimated maximum number of airbag ',
876 . /15X,' facets per cutting cell. . . . .=',I10,
877 . /15X,' estimated maximum number of points ',
878 . /15X,' per polygon. . . . . . . . . . .=',i10,
879 . /15x,'FLAG FOR ANIMATION FILE A000. . . . . .=',i10)
880 1420 FORMAT(
881 . 5x,'INFLATORS ',
882 . /5x,'--------- ')
883 1421 FORMAT(
884 . 5x,'NUMBER OF INFLATORS . . . . . . . . . .=',i10/)
885 1430 FORMAT(
886 . 5x,'INFLATOR NUMBER . . . . . . . . . . . .=',i10,
887 . /15x,'TIME FUNCTION FOR INCOMING TOTAL MASS .=',i10,
888 . /15x,' or MASS FLUX if IFLU=1 . . . . IFLU =',i10,
889 . /15x,'SCALE FACTOR FOR INCOMING TOTAL MASS .=',1pg20.13,
890 . /15x,'TIME FUNCTION FOR INCOMIMG GAS TEMP . .=',i10,
891 . /15x,'SCALE FACTOR FOR INCOMIMG GAS TEMP . .=',1pg20.13,
892 . /15x,'SENSOR NUMBER . . . . . . . . . . . . .=',i10)
893 1435 FORMAT(15x,'TIME FUNCTION FOR INCOMING GAS VELOCITY=',i10,
894 . /15x,'SCALE FACTOR FOR INCOMING GAS VELOCITY.=',1pg20.13)
895 1440 FORMAT(
896 . /15x,'GAZ CHARACTERISTICS ',
897 . /15x,'------------------- ',
898 . /15x,'GAMMA AT INITIAL TEMPERATURE. . . . . .=',1pg20.13,
899 . /15x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,
900 . /15x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,
901 . /15x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13)
902 1445 FORMAT(
903 . 15x,'INFLATOR SURFACE ID . . . . . . . . . .=',i10,
904 . /15x,'INITIAL SURFACE OF INFLATOR . . . . . .=',1pg20.13)
905 1470 FORMAT(
906 . /5x,'VENT HOLES AND POROUS FABRIC SURFACES ',
907 . /5x,'------------------------------------- ',
908 . /5x,'NUMBER OF VENT HOLES AND POROUS SURFACES . .=',i10,
909 . /5x,'INJECTION TIME TINJ. . . . . . . . . . . . .=',1pg20.13)
910 1475 FORMAT(
911 . 5x,'VENTING START TIME SHIFT . . . . . . . . . .=',i10,
912 . /5x,' 0 : NO SHIFT',
913 . /5x,' 1,2: VENTING FUNCTIONS ARE SHIFTED BY TINJ',
914 . /5x,' 3 : VENTING FUNCTIONS ARE SHIFTED BY TINJ+TSTART')
915 1472 FORMAT(
916 . / 5x,'VENT HOLE NUMBER. . . . . . . . . . . .=',i10,
917 . /15x,'VENT HOLE SURFACE ID. . . . . . . . . .=',i10)
918 1481 FORMAT(15x,'ISENTHALPIC VENTING MODEL ')
919 1482 FORMAT(15x,'CHEMKIN MODEL FOR POROSITY : ',
920 . /15x,'VELOCITY VS RELATIVE PRESSURE FUNCTION =',i10,
921 . /15x,' SCALE FACTOR. . . . . . .=',1pg20.13)
922 1483 FORMAT(15x,'LOCAL VELOCITY VENTING FORMULATION')
923 1484 FORMAT(15x,'GRAEFE POROSITY FORMULATION')
924 1479 FORMAT(
925 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
926 . /15x,'AVENT:VENT HOLE SCALE FACTOR. . . . . .=',1pg20.13,
927 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
928 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
929 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
930 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
931 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
932 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
933 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
934 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
935 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
936 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
937 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
938 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
939 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
940 1480 FORMAT(
941 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
942 . /15x,'RELATIVE PRES. FOR MEMBRANE DEFLATION .=',1pg20.13,
943 . /15x,' (DPDEF = PDEF - PEXT) ',
944 . /15x,'TIME DELAY BEFORE MEMBRANE DEFLATION .=',1pg20.13,
945 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
946 . /15x,' IF IDTPDEF : 0',
947 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
948 . /15x,' A CUMULATED DTPDEF TIME'
949 . /15x,' BEFORE ACTIVATING DEFLATION'
950 . /15x,' IF IDTPDEF : 1',
951 . /15x,' DEFLATION START DTPDEF AFTER',
952 . /15x,' DPDEF HAS BEEN REACHED',
953 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
954 1489 FORMAT(
955 . 15x,'AVENT:VENT HOLE AREA. . . . . . . . . .=',1pg20.13,
956 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
957 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
958 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
959 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
960 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
961 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
962 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
963 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
964 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
965 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
966 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
967 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
968 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
969 END SUBROUTINE hm_read_monvol_type6
970 END MODULE hm_read_monvol_type6_mod
origin
integer function origin(nn, ixc, ipartc, ipart)
Definition build_admesh.F:73
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_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
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
groupdef_mod
Definition groupdef_mod.F:668
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:1257
monvol_struct_mod
Definition monvol_struct_mod.F:66
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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:728
unitab_mod::unit_type_
Definition unitab_mod.F:524