OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_monvol_type5.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_type5_mod ../starter/source/airbag/hm_read_monvol_type5.F
25!||--- called by ------------------------------------------------------
26!|| read_monvol ../starter/source/airbag/read_monvol.F
27!||====================================================================
28 MODULE hm_read_monvol_type5_mod
29 CONTAINS
30!||====================================================================
31!|| hm_read_monvol_type5 ../starter/source/airbag/hm_read_monvol_type5.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!|| usr2sys ../starter/source/system/sysfus.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_type5(T_MONVOLN, T_MONVOL_METADATA, ITABM1,
54 . SENSORS, NPT, PLD,
55 . UNITAB, LUID, 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) :: LUID, ITABM1(*), 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(monvol_metadata_), INTENT(INOUT) :: T_MONVOL_METADATA
92 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
93 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER :: II, JJ
98 INTEGER :: SURFID
99 my_real :: FAC_M, FAC_L, FAC_T, FAC_C, FAC_GEN
100 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
101 LOGICAL :: FOUND, DECREASE
102 my_real :: sa, rot, vol, vmin, veps, amu, sv,
103 . pext, ti, pini
104 INTEGER :: IEQUI, ITTF, NP, IP, IS, NJET, NVENT
105 my_real :: gamai, cpai, cpbi, cpci, cpi, cvi, rmwi, cpg, rmwg, rhoi, especi, ti2, mi,
106 . ttfire, shol
107 my_real, DIMENSION(:), ALLOCATABLE :: gama, cpa, cpb, cpc, fmass, ftemp, fpt, fpa, fpz,
108 . tvent, dpdef, dtpdef, fvdp, avent, bvent, tstope, fport, fporp, fpora,
109 . fport1, fporp1,fpora1
110 INTEGER, DIMENSION(:), ALLOCATABLE :: IMASS, IFLU, ITEMP, ISENS, IJET, NJ1, NJ2, NJ3,
111 . IPT, IPA, IPZ, IVDP, IDTPDEF, IPVENT, IFVENT, IPORT, IPORP, IPORA, IPORT1, IPORP1, IPORA1
112 CHARACTER(LEN = 40) :: MESS
113 INTEGER :: NCA, LCA, CHKSURF
114 INTEGER, DIMENSION(:), ALLOCATABLE :: COMM_ID, COMM_IPVENT
115 my_real, DIMENSION(:), ALLOCATABLE :: comm_dpdef, comm_avent, comm_tvent, comm_dtpdef
116 INTEGER :: NN, EXT_SURFID, JI, ITY, NN1, J1, JI1, ITY1, NEL
117 LOGICAL :: IS_AVAILABLE
118C-----------------------------------------------
119C E x t e r n a l F u n c t i o n s
120C-----------------------------------------------
121 INTEGER USR2SYS
122 EXTERNAL USR2SYS
123C-----------------------------------------------
124C B e g i n n i n g o f s o u r c e
125C-----------------------------------------------
126 mess = 'MONITORED VOLUME DEFINITION '
127C =======
128C Reading
129C =======
130! Line 1
131 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
132! Line 2
133 CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
134 CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
135 CALL hm_get_floatv('AscaleS', scal_s, is_available, lsubmodel, unitab)
136 CALL hm_get_floatv('AscaleA', scal_a, is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('AscaleD', scal_d, is_available, lsubmodel, unitab)
138! Line 3
139 CALL hm_get_floatv('Mu', amu, is_available, lsubmodel, unitab)
140 CALL hm_get_floatv('Pext', pext, is_available, lsubmodel, unitab)
141 CALL hm_get_floatv('T0', ti, is_available, lsubmodel, unitab)
142 CALL hm_get_intv('Iequi', iequi, is_available, lsubmodel)
143 CALL hm_get_intv('Ittf', ittf, is_available, lsubmodel)
144! Line 4
145 CALL hm_get_floatv('Gammai', gamai, is_available, lsubmodel, unitab)
146 CALL hm_get_floatv('cpai', cpai, is_available, lsubmodel, unitab)
147 CALL hm_get_floatv('cpbi', cpbi, is_available, lsubmodel, unitab)
148 CALL hm_get_floatv('cpci', cpci, is_available, lsubmodel, unitab)
149! Injectors
150 CALL hm_get_intv('Njet', njet, is_available, lsubmodel)
151 t_monvoln%NJET = njet
152 t_monvoln%IVOLU(8) = njet
153 IF (njet > 0) THEN
154 ALLOCATE(t_monvoln%IBAGJET(nibjet, njet))
155 t_monvoln%IBAGJET(1:nibjet, 1:njet) = 0
156 ALLOCATE(t_monvoln%RBAGJET(nrbjet, njet))
157 t_monvoln%RBAGJET(1:nrbjet, 1:njet) = zero
158 ENDIF
159 IF (njet > 0) THEN
160 ALLOCATE(gama(njet), cpa(njet), cpb(njet), cpc(njet))
161 ALLOCATE(imass(njet), iflu(njet), fmass(njet), itemp(njet), ftemp(njet), isens(njet))
162 ALLOCATE(ijet(njet), nj1(njet), nj2(njet), nj3(njet))
163 ALLOCATE(ipt(njet), ipa(njet), ipz(njet), fpt(njet), fpa(njet), fpz(njet))
164 DO ii = 1, njet
165 CALL hm_get_float_array_index('Gamma', gama(ii), ii, is_available, lsubmodel, unitab)
166 CALL hm_get_float_array_index('cpa', cpa(ii), ii, is_available, lsubmodel, unitab)
167 CALL hm_get_float_array_index('cpb', cpb(ii), ii, is_available, lsubmodel, unitab)
168 CALL hm_get_float_array_index('cpc', cpc(ii), ii, is_available, lsubmodel, unitab)
169
170 CALL hm_get_int_array_index('fct_IDmas', imass(ii), ii,is_available, lsubmodel)
171 CALL hm_get_int_array_index('Iflow', iflu(ii), ii,is_available, lsubmodel)
172 CALL hm_get_float_array_index('Fscalemas', fmass(ii), ii, is_available, lsubmodel, unitab)
173 CALL hm_get_int_array_index('fct_IDT', itemp(ii), ii,is_available, lsubmodel)
174 CALL hm_get_float_array_index('FscaleT', ftemp(ii), ii, is_available, lsubmodel, unitab)
175 CALL hm_get_int_array_index('sens_ID', isens(ii), ii,is_available, lsubmodel)
176
177 CALL hm_get_int_array_index('Ijet', ijet(ii), ii,is_available, lsubmodel)
178 CALL hm_get_int_array_index('ABG_N1', nj1(ii), ii,is_available, lsubmodel)
179 CALL hm_get_int_array_index('node_ID2', nj2(ii), ii,is_available, lsubmodel)
180 CALL hm_get_int_array_index('node_ID3', nj3(ii), ii,is_available, lsubmodel)
181
182 fpt(ii) = zero
183 fpa(ii) = zero
184 fpz(ii) = zero
185 IF (ijet(ii) > 0) THEN
186 CALL hm_get_int_array_index('fct_IDPt', ipt(ii), ii,is_available, lsubmodel)
187 CALL hm_get_int_array_index('fctIDPThet', ipa(ii), ii,is_available, lsubmodel)
188 CALL hm_get_int_array_index('fctIDPDelt', ipz(ii), ii,is_available, lsubmodel)
189 CALL hm_get_float_array_index('FscalePt', fpt(ii), ii, is_available, lsubmodel, unitab)
190 CALL hm_get_float_array_index('FscalePTheta', fpa(ii), ii, is_available, lsubmodel, unitab)
191 CALL hm_get_float_array_index('FscalePDelta', fpz(ii), ii, is_available, lsubmodel, unitab)
192 ENDIF
193 ENDDO
194 ENDIF
195! Ventholes
196 CALL hm_get_intv('Nvent', nvent, is_available, lsubmodel)
197 t_monvoln%IVOLU(11) = nvent
198 t_monvoln%NVENT = nvent
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 IF (nvent > 0) THEN
206 ALLOCATE(tvent(nvent), dpdef(nvent), dtpdef(nvent), fvdp(nvent), avent(nvent),
207 . bvent(nvent), tstope(nvent))
208 ALLOCATE(ipvent(nvent), ivdp(nvent), idtpdef(nvent), ifvent(nvent))
209 ALLOCATE(iport(nvent), iporp(nvent), ipora(nvent), iport1(nvent),
210 . iporp1(nvent), ipora1(nvent))
211 ALLOCATE(fport(nvent), fporp(nvent), fpora(nvent), fport1(nvent),
212 . fporp1(nvent), fpora1(nvent))
213 DO ii = 1, nvent
214 ifvent(ii) = 0
215 CALL hm_get_int_array_index('surf_IDv', ipvent(ii), ii, is_available, lsubmodel)
216 CALL hm_get_float_array_index('Avent', avent(ii), ii, is_available, lsubmodel, unitab)
217 CALL hm_get_float_array_index('Bvent', bvent(ii), ii, is_available, lsubmodel, unitab)
218 CALL hm_get_float_array_index('Tstop', tstope(ii), ii, is_available, lsubmodel, unitab)
219
220 CALL hm_get_float_array_index('Tvent', tvent(ii), ii, is_available, lsubmodel, unitab)
221 CALL hm_get_float_array_index('DeltaPdef', dpdef(ii), ii, is_available, lsubmodel, unitab)
222 CALL hm_get_float_array_index('deltatpdef', DTPDEF(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
223 CALL HM_GET_INT_ARRAY_INDEX('fct_idv', IVDP(II), II,IS_AVAILABLE, LSUBMODEL)
224 CALL HM_GET_FLOAT_ARRAY_INDEX('fscalev', FVDP(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
225 CALL HM_GET_INT_ARRAY_INDEX('idtpdef', IDTPDEF(II), II,IS_AVAILABLE, LSUBMODEL)
226
227 CALL HM_GET_INT_ARRAY_INDEX('fct_idt', IPORT(II), II,IS_AVAILABLE, LSUBMODEL)
228 CALL HM_GET_INT_ARRAY_INDEX('fct_idp', IPORP(II), II,IS_AVAILABLE, LSUBMODEL)
229 CALL HM_GET_INT_ARRAY_INDEX('fct_ida', IPORA(II), II,IS_AVAILABLE, LSUBMODEL)
230 CALL HM_GET_FLOAT_ARRAY_INDEX('fscalet', FPORT(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
231 CALL HM_GET_FLOAT_ARRAY_INDEX('fscalep', FPORP(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
232 CALL HM_GET_FLOAT_ARRAY_INDEX('fscalea', FPORA(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
233
234 CALL HM_GET_INT_ARRAY_INDEX("fct_IDt'", IPORT1(II), II,IS_AVAILABLE, LSUBMODEL)
235 CALL HM_GET_INT_ARRAY_INDEX("fct_idp'", IPORP1(II), II,IS_AVAILABLE, LSUBMODEL)
236 CALL HM_GET_INT_ARRAY_INDEX("fct_IDA'", IPORA1(II), II,IS_AVAILABLE, LSUBMODEL)
237 CALL HM_GET_FLOAT_ARRAY_INDEX("fscalet'", FPORT1(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
238 CALL HM_GET_FLOAT_ARRAY_INDEX("FscaleP'", FPORP1(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
239 CALL HM_GET_FLOAT_ARRAY_INDEX("fscalea'", FPORA1(II), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
240 ENDDO
241 ENDIF
242! Specific cards communicating airbags
243 CALL HM_GET_INTV('nbag', NCA, IS_AVAILABLE, LSUBMODEL)
244
245 T_MONVOLN%NCA = NCA
246 T_MONVOLN%IVOLU(3) = NCA
247 IF (NCA > 0) THEN
248 ALLOCATE(COMM_ID(NCA), COMM_IPVENT(NCA))
249 ALLOCATE(COMM_DPDEF(NCA), COMM_AVENT(NCA), COMM_TVENT(NCA), COMM_DTPDEF(NCA))
250 IF (NCA >= 1) THEN
251 CALL HM_GET_INT_ARRAY_INDEX('bag_id1', COMM_ID(1), II,IS_AVAILABLE, LSUBMODEL)
252 CALL HM_GET_INT_ARRAY_INDEX('surf_id1', COMM_IPVENT(1), II,IS_AVAILABLE, LSUBMODEL)
253 CALL HM_GET_FLOAT_ARRAY_INDEX('dpdiff1', COMM_DPDEF(1), II, IS_AVAILABLE, LSUBMODEL, UNITAB)
254 CALL HM_GET_FLOAT_ARRAY_INDEX('acom1', comm_avent(1), ii, is_available, lsubmodel, unitab)
255 CALL hm_get_float_array_index('TCOM1', comm_tvent(1), ii, is_available, lsubmodel, unitab)
256 CALL hm_get_float_array_index('dTPdefCommu1', comm_dtpdef(1), ii, is_available, lsubmodel, unitab)
257 ENDIF
258 IF (nca >= 2) THEN
259 CALL hm_get_int_array_index('BAG_ID2', comm_id(2), ii,is_available, lsubmodel)
260 CALL hm_get_int_array_index('SURF_ID2', comm_ipvent(2), ii,is_available, lsubmodel)
261 CALL hm_get_float_array_index('DPDIFF2', comm_dpdef(2), ii, is_available, lsubmodel, unitab)
262 CALL hm_get_float_array_index('ACOM2', comm_avent(2), ii, is_available, lsubmodel, unitab)
263 CALL hm_get_float_array_index('TCOM2', comm_tvent(2), ii, is_available, lsubmodel, unitab)
264 CALL hm_get_float_array_index('dTPdefCommu2', comm_dtpdef(2), ii, is_available, lsubmodel, unitab)
265 ENDIF
266 IF (nca >= 3) THEN
267 CALL hm_get_int_array_index('BAG_ID3', comm_id(3), ii,is_available, lsubmodel)
268 CALL hm_get_int_array_index('SURF_ID3', comm_ipvent(3), ii,is_available, lsubmodel)
269 CALL hm_get_float_array_index('DPDIFF3', comm_dpdef(3), ii, is_available, lsubmodel, unitab)
270 CALL hm_get_float_array_index('ACOM3', comm_avent(3), ii, is_available, lsubmodel, unitab)
271 CALL hm_get_float_array_index('TCOM3', comm_tvent(3), ii, is_available, lsubmodel, unitab)
272 CALL hm_get_float_array_index('dTPdefCommu3', comm_dtpdef(3), ii, is_available, lsubmodel, unitab)
273 ENDIF
274 IF (nca >= 4) THEN
275 CALL hm_get_int_array_index('BAG_ID4', comm_id(4), ii,is_available, lsubmodel)
276 CALL hm_get_int_array_index('SURF_ID4', comm_ipvent(4), ii,is_available, lsubmodel)
277 CALL hm_get_float_array_index('DPDIFF4', comm_dpdef(4), ii, is_available, lsubmodel, unitab)
278 CALL hm_get_float_array_index('ACOM4', comm_avent(4), ii, is_available, lsubmodel, unitab)
279 CALL hm_get_float_array_index('TCOM4', comm_tvent(4), ii, is_available, lsubmodel, unitab)
280 CALL hm_get_float_array_index('dTPdefCommu4', comm_dtpdef(4), ii, is_available, lsubmodel, unitab)
281 ENDIF
282 IF (nca >= 5) THEN
283 CALL hm_get_int_array_index('BAG_ID5', comm_id(5), ii,is_available, lsubmodel)
284 CALL hm_get_int_array_index('SURF_ID5', comm_ipvent(5), ii,is_available, lsubmodel)
285 CALL hm_get_float_array_index('DPDIFF5', comm_dpdef(5), ii, is_available, lsubmodel, unitab)
286 CALL hm_get_float_array_index('ACOM5', comm_avent(5), ii, is_available, lsubmodel, unitab)
287 CALL hm_get_float_array_index('TCOM5', comm_tvent(5), ii, is_available, lsubmodel, unitab)
288 CALL hm_get_float_array_index('dTPdefCommu5', comm_dtpdef(5), ii, is_available, lsubmodel, unitab)
289 ENDIF
290 ENDIF
291C ================
292C Check operations
293C ================
294C External surface check
295 t_monvoln%IVOLU(4) = 0
296 found = .false.
297 DO ii = 1, nsurf
298 IF (surfid == igrsurf(ii)%ID) THEN
299 t_monvoln%IVOLU(4) = ii
300 t_monvoln%EXT_SURFID = ii
301 found = .true.
302 EXIT
303 ENDIF
304 ENDDO
305 IF (.NOT. found) THEN
306 CALL freerr(3)
307 ELSEIF (igrsurf(t_monvoln%IVOLU(4))%ISH4N3N == 0) THEN
308 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
309 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
310 CALL freerr(3)
311 ENDIF
312
313C Check surface closure
314 CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
315C Set all normal on same side
316 CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
317 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 10)
318C Compute Monvon volume
319 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
320 . itab, x, pm, geo, ixc, ixtg,
321 . sa, rot, vol, vmin, veps, sv)
322C Reverse all normals to ensure positive volume
323 CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
324 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 10)
325
326
327 IF (ittf < 0 .OR. ittf > 3) THEN
328 CALL ancmsg(msgid = 773, anmode = aninfo, msgtype = msgerror,
329 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
330 ENDIF
331C =====
332C Units
333C =====
334 fac_m = unitab%FAC_M(luid)
335 fac_l = unitab%FAC_L(luid)
336 fac_t = unitab%FAC_T(luid)
337 fac_c = fac_m / (fac_l * fac_t * fac_t)
338
339C ==============
340C Default values
341C ==============
342 IF (scal_t == zero) THEN
343 CALL hm_get_floatv_dim('Ascalet', fac_gen, is_available, lsubmodel, unitab)
344 scal_t = one * fac_gen
345 ENDIF
346 IF (scal_p == zero) THEN
347 CALL hm_get_floatv_dim('AscaleP', fac_gen, is_available, lsubmodel, unitab)
348 scal_p = one * fac_gen
349 ENDIF
350 IF (scal_s == zero) THEN
351 CALL hm_get_floatv_dim('AscaleS', fac_gen, is_available, lsubmodel, unitab)
352 scal_s = one * fac_gen
353 ENDIF
354 IF (scal_a == zero) THEN
355 CALL hm_get_floatv_dim('AscaleA', fac_gen, is_available, lsubmodel, unitab)
356 scal_a = one * fac_gen
357 ENDIF
358 IF (scal_d == zero) THEN
359 CALL hm_get_floatv_dim('AscaleD', fac_gen, is_available, lsubmodel, unitab)
360 scal_d = one * fac_gen
361 ENDIF
362 IF (amu == zero) amu = em02
363 IF(pext == zero) THEN
364 pext = 101325.d0 * (unitab%FAC_L_WORK * unitab%FAC_T_WORK * unitab%FAC_T_WORK) / unitab%FAC_M_WORK
365 ENDIF
366 pini = pext
367 IF (ti == zero) ti = twohundred95
368
369 DO ii = 1, njet
370 IF (imass(ii) /= 0 .AND. fmass(ii) == zero) THEN
371 CALL hm_get_floatv_dim('Fscalemas', fac_gen, is_available, lsubmodel, unitab)
372 fmass(ii) = one * fac_gen
373 ENDIF
374 IF (itemp(ii) /= 0 .AND. ftemp(ii) == zero) THEN
375 CALL hm_get_floatv_dim('FscaleT', fac_gen, is_available, lsubmodel, unitab)
376 ftemp(ii) = one * fac_gen
377 ENDIF
378 IF (fpt(ii) == zero) THEN
379 CALL hm_get_floatv_dim('FscalePt', fac_gen, is_available, lsubmodel, unitab)
380 fpt(ii) = one * fac_gen
381 ENDIF
382 IF (fpa(ii) == zero) THEN
383 CALL hm_get_floatv_dim('FscalePTheta', fac_gen, is_available, lsubmodel, unitab)
384 fpa(ii) = one * fac_gen
385 ENDIF
386 IF (fpz(ii) == zero) THEN
387 CALL hm_get_floatv_dim('FscalePDelta', fac_gen, is_available, lsubmodel, unitab)
388 fpz(ii) = one * fac_gen
389 ENDIF
390 ENDDO
391 DO ii = 1, nvent
392 IF (ivdp(ii) > 0) ifvent(ii) = 2
393 IF (ipvent(ii) == 0) THEN
394 bvent(ii) = zero
395 ENDIF
396 IF (fport(ii) == zero) fport(ii) = one
397 IF (fporp(ii) == zero) fporp(ii) = one
398 IF (fpora(ii) == zero) fpora(ii) = one
399 IF (fport1(ii) == zero) fport1(ii) = one
400 IF (fporp1(ii) == zero) fporp1(ii) = one
401 IF (fpora1(ii) == zero) fpora1(ii) = one
402 ENDDO
403
404 cpi = cpai + ti * (cpbi + cpci * ti)
405 cvi = cpi / gamai
406 rmwi = cvi * (gamai - one)
407 mi = pini * (vol + veps) / (rmwi * ti)
408 ttfire = infinity
409 DO ii = 1, njet
410 IF (isens(ii) > 0) THEN
411 found = .false.
412 DO is = 1, sensors%NSENSOR
413 IF (isens(ii) == sensors%SENSOR_TAB(is)%SENS_ID) THEN
414 t_monvoln%IBAGJET(4, ii) = is
415 IF (sensors%SENSOR_TAB(is)%TCRIT < ttfire) ttfire = sensors%SENSOR_TAB(is)%TCRIT
416 found = .true.
417 EXIT
418 ENDIF
419 ENDDO
420 IF (.NOT. found) THEN
421 CALL ancmsg(msgid = 17, anmode = aninfo, msgtype = msgerror,
422 . i2 = isens(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
423 ENDIF
424 ENDIF
425 ENDDO
426 IF (ttfire == infinity) THEN
427 ttfire = zero
428 ENDIF
429
430C =====
431C Store
432C =====
433 t_monvoln%RVOLU(26) = one / scal_t
434 t_monvoln%RVOLU(27) = one / scal_p
435 t_monvoln%RVOLU(28) = one / scal_s
436 t_monvoln%RVOLU(29) = one / scal_a
437 t_monvoln%RVOLU(30) = one / scal_d
438C
439 IF (iequi > 0) iequi = 1
440 t_monvoln%IVOLU(15) = iequi
441 t_monvoln%IVOLU(17) = ittf
442 t_monvoln%IVOLU(8) = njet
443C
444 t_monvoln%RVOLU(31) = pini
445 t_monvoln%RVOLU(7) = cpai
446 t_monvoln%RVOLU(8) = cpbi
447 t_monvoln%RVOLU(9) = cpci
448 t_monvoln%RVOLU(10) = rmwi
449 t_monvoln%RVOLU(49) = ttfire
450C
451 t_monvoln%RVOLU(1) = gamai
452 t_monvoln%RVOLU(3) = pext
453 t_monvoln%RVOLU(4) = vol+veps
454 t_monvoln%RVOLU(11) = mi
455 t_monvoln%RVOLU(12) = pini
456 t_monvoln%RVOLU(13) = ti
457 t_monvoln%RVOLU(14) = rmwi*mi
458 t_monvoln%RVOLU(17) = veps
459 t_monvoln%RVOLU(20) = mi
460 t_monvoln%RVOLU(25) = ti
461 t_monvoln%RVOLU(61) = gamai
462 rhoi = pini / (ti * rmwi)
463 t_monvoln%RVOLU(62) = rhoi
464 ti2 = ti * ti
465 especi = ti * (cpai + half * cpbi * ti + third * cpci * ti2 - rmwi)
466
467 t_monvoln%RVOLU(63) = especi + rmwi * ti
468 t_monvoln%RVOLU(64) = zero
469 t_monvoln%RVOLU(65) = zero
470 t_monvoln%RVOLU(66) = especi
471 DO ii = 1, njet
472 t_monvoln%IBAGJET(13, ii) = 0
473 t_monvoln%RBAGJET(1, ii) = gama(ii)
474 t_monvoln%RBAGJET(2, ii) = cpa(ii)
475 t_monvoln%RBAGJET(3, ii) = cpb(ii)
476 t_monvoln%RBAGJET(4, ii) = cpc(ii)
477 t_monvoln%RBAGJET(5, ii) = fmass(ii)
478 t_monvoln%RBAGJET(6, ii) = ftemp(ii)
479 t_monvoln%RBAGJET(12, ii) = fpt(ii)
480 t_monvoln%RBAGJET(13, ii) = fpa(ii)
481 t_monvoln%RBAGJET(14, ii) = fpz(ii)
482 IF (imass(ii) == 0)THEN
483 t_monvoln%IBAGJET(1, ii) = 0
484 ELSE
485 found = .false.
486 DO jj = 1, nfunct
487 IF (imass(ii) == npc(jj)) THEN
488 t_monvoln%IBAGJET(1, ii) = jj
489 decrease = .false.
490 np = (npt(jj + 1) - npt(jj)) / 2
491 IF (iflu(ii) == 0) THEN
492 DO ip = (npt(jj) - 1) / 2 + 1, (npt(jj + 1) - 1) / 2 - 1
493 IF (pld(2, ip + 1) < pld(2, ip)) decrease = .true.
494 ENDDO
495 IF (decrease) THEN
496 CALL ancmsg(msgid=540, msgtype = msgwarning, anmode = aninfo_blind_1,
497 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = imass(ii), i3 = ii)
498 ENDIF
499 ELSE
500 DO ip = (npt(jj) - 1) / 2 + 1, (npt(jj + 1) - 1) / 2
501 IF (pld(2, ip) < zero) decrease = .true.
502 ENDDO
503 IF (decrease) THEN
504 CALL ancmsg(msgid = 541, msgtype = msgwarning, anmode = aninfo_blind_1,
505 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = imass(ii), i3 = ii)
506 ENDIF
507 ENDIF
508 found = .true.
509 EXIT
510 ENDIF
511 ENDDO
512 IF (.NOT. found) THEN
513 CALL ancmsg(msgid = 10, anmode = aninfo, msgtype = msgerror,
514 . i2 = imass(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
515 ENDIF
516 ENDIF
517 t_monvoln%IBAGJET(2, ii) = iflu(ii)
518 IF (itemp(ii) == 0) THEN
519 t_monvoln%IBAGJET(3, ii) = 0
520 ELSE
521 found = .false.
522 DO jj = 1, nfunct
523 IF (itemp(ii) == npc(jj)) THEN
524 t_monvoln%IBAGJET(3, ii) = jj
525 found = .true.
526 EXIT
527 ENDIF
528 ENDDO
529 IF (.NOT. found) THEN
530 CALL ancmsg(msgid = 11, anmode = aninfo, msgtype = msgerror,
531 . i2 = itemp(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
532 ENDIF
533 ENDIF
534! Jetting
535 IF (ijet(ii) > 0) THEN
536 t_monvoln%IBAGJET(5, ii) = usr2sys(nj1(ii), itabm1, mess, t_monvoln%ID)
537 t_monvoln%IBAGJET(6, ii) = usr2sys(nj2(ii), itabm1, mess, t_monvoln%ID)
538 IF(nj3(ii) /= 0) THEN
539 t_monvoln%IBAGJET(7, ii) = usr2sys(nj3(ii), itabm1, mess, t_monvoln%ID)
540 ENDIF
541 found = .false.
542 DO jj= 1, nfunct
543 IF (ipt(ii) == npc(jj)) THEN
544 t_monvoln%IBAGJET(8, ii) = jj
545 found = .true.
546 EXIT
547 ENDIF
548 ENDDO
549 IF (.NOT. found) THEN
550 CALL ancmsg(msgid = 12, anmode = aninfo, msgtype = msgerror,
551 . i2 = ipt(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
552 ENDIF
553 found = .false.
554 DO jj = 1, nfunct
555 IF (ipa(ii) == npc(jj)) THEN
556 t_monvoln%IBAGJET(9, ii) = jj
557 found = .true.
558 EXIT
559 ENDIF
560 ENDDO
561 IF (.NOT. found) THEN
562 CALL ancmsg(msgid = 13, anmode = aninfo, msgtype = msgerror,
563 . i2 = ipa(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
564 ENDIF
565 found = .false.
566 DO jj = 1, nfunct
567 IF (ipz(ii) == npc(jj)) THEN
568 t_monvoln%IBAGJET(10, ii) = jj
569 found = .true.
570 EXIT
571 ENDIF
572 ENDDO
573 IF (.NOT. found) THEN
574 CALL ancmsg(msgid = 14, anmode = aninfo, msgtype = msgerror,
575 . i2 = ipz(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
576 ENDIF
577 ENDIF
578 cpg = cpa(ii) + ti * (cpb(ii) + cpc(ii) * ti)
579 rmwg = cpg * (gama(ii) - one) / gama(ii)
580 t_monvoln%RBAGJET(1, ii) = rmwg
581 IF (nj1(ii) == 0) THEN
582 ijet(ii) = 0
583 ELSE
584 ijet(ii) = 1
585 ENDIF
586 IF (nj3(ii) == 0) THEN
587 t_monvoln%IBAGJET(7, ii) = t_monvoln%IBAGJET(5, ii)
588 ENDIF
589 ENDDO ! NJET loop
590! Ventholes
591 DO ii = 1, nvent
592 t_monvoln%IBAGHOL(13, ii) = 0
593 t_monvoln%RBAGHOL(7, ii) = fport(ii)
594 t_monvoln%RBAGHOL(8, ii) = fporp(ii)
595 t_monvoln%RBAGHOL(9, ii) = fpora(ii)
596 t_monvoln%RBAGHOL(10, ii) = fport1(ii)
597 t_monvoln%RBAGHOL(11, ii) = fporp1(ii)
598 t_monvoln%RBAGHOL(12, ii) = fpora1(ii)
599 t_monvoln%IBAGHOL(1, ii) = 0
600 t_monvoln%IBAGHOL(10, ii) = ifvent(ii)
601 t_monvoln%IBAGHOL(11, ii) = idtpdef(ii)
602 t_monvoln%IBAGHOL(12, ii) = 0
603 IF (ipvent(ii) == 0) THEN
604 t_monvoln%IBAGHOL(2, ii) = 0
605 ELSE
606 t_monvoln%IBAGHOL(2, ii) = 0
607 found = .false.
608 DO jj = 1, nsurf
609 IF (ipvent(ii) == igrsurf(jj)%ID) THEN
610 t_monvoln%IBAGHOL(2, ii) = jj
611 found = .true.
612 EXIT
613 ENDIF
614 ENDDO
615 IF(.NOT. found)THEN
616 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
617 . i2 = ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
618 ELSEIF(igrsurf(t_monvoln%IBAGHOL(2, ii))%ISH4N3N == 0) THEN
619 CALL ancmsg(msgid = 330, anmode = aninfo, msgtype = msgerror,
620 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
621 ENDIF
622 IF (avent(ii) == zero) avent(ii) = one
623 ENDIF
624 IF (avent(ii) == zero) dpdef(ii) = infinity
625 IF (avent(ii) == zero) tvent(ii) = infinity
626 IF (dpdef(ii) == zero .AND. dtpdef(ii) == zero .AND. tvent(ii) == zero) THEN
627 t_monvoln%IBAGHOL(1, ii) = 1
628 ENDIF
629 t_monvoln%RBAGHOL(1, ii) = dpdef(ii)
630 t_monvoln%RBAGHOL(2, ii) = avent(ii)
631 t_monvoln%RBAGHOL(3, ii) = tvent(ii)
632 t_monvoln%RBAGHOL(4, ii) = dtpdef(ii)
633 t_monvoln%RBAGHOL(6, ii) = bvent(ii)
634 IF (ivdp(ii) /= 0 .AND. fvdp(ii) == zero) fvdp(ii) = one
635 t_monvoln%RBAGHOL(13, ii) = fvdp(ii)
636 IF (tstope(ii) == zero) tstope(ii) = infinity
637 t_monvoln%RBAGHOL(14, ii) = tstope(ii)
638C
639 t_monvoln%IBAGHOL(3, ii) = -1
640 t_monvoln%IBAGHOL(4, ii) = -1
641 t_monvoln%IBAGHOL(5, ii) = -1
642 t_monvoln%IBAGHOL(6, ii) = -1
643 t_monvoln%IBAGHOL(7, ii) = -1
644 t_monvoln%IBAGHOL(8, ii) = -1
645 t_monvoln%IBAGHOL(9, ii) = -1
646 DO jj = 1, nfunct
647 IF (iport(ii) == npc(jj)) t_monvoln%IBAGHOL(3, ii) = jj
648 IF (iporp(ii) == npc(jj)) t_monvoln%IBAGHOL(4, ii) = jj
649 IF (ipora(ii) == npc(jj)) t_monvoln%IBAGHOL(5, ii) = jj
650 IF (iport1(ii) == npc(jj)) t_monvoln%IBAGHOL(6, ii) = jj
651 IF (iporp1(ii) == npc(jj)) t_monvoln%IBAGHOL(7, ii) = jj
652 IF (ipora1(ii) == npc(jj)) t_monvoln%IBAGHOL(8, ii) = jj
653 IF (ivdp(ii) == npc(jj)) t_monvoln%IBAGHOL(9, ii) = jj
654 ENDDO
655 IF (iport(ii) == 0) t_monvoln%IBAGHOL(3, ii) = 0
656 IF (iporp(ii) == 0) t_monvoln%IBAGHOL(4, ii) = 0
657 IF (ipora(ii) == 0) t_monvoln%IBAGHOL(5, ii) = 0
658 IF (iport1(ii) == 0) t_monvoln%IBAGHOL(6, ii) = 0
659 IF (iporp1(ii) == 0) t_monvoln%IBAGHOL(7, ii) = 0
660 IF (ipora1(ii) == 0) t_monvoln%IBAGHOL(8, ii) = 0
661 IF (ivdp(ii) == 0) t_monvoln%IBAGHOL(9, ii) = 0
662 IF (t_monvoln%IBAGHOL(3, ii) == -1) THEN
663 t_monvoln%IBAGHOL(3, ii) = 0
664 CALL ancmsg(msgid = 331, anmode = aninfo, msgtype = msgerror,
665 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport(ii))
666 ENDIF
667 IF (t_monvoln%IBAGHOL(4, ii) == -1) THEN
668 t_monvoln%IBAGHOL(4, ii) = 0
669 CALL ancmsg(msgid = 332, anmode = aninfo, msgtype = msgerror,
670 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp(ii))
671 ENDIF
672 IF (t_monvoln%IBAGHOL(5, ii) == -1) THEN
673 t_monvoln%IBAGHOL(5, ii)=0
674 CALL ancmsg(msgid = 333, anmode = aninfo, msgtype = msgerror,
675 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora(ii))
676 ENDIF
677 IF (t_monvoln%IBAGHOL(6, ii) == -1) THEN
678 t_monvoln%IBAGHOL(6, ii) = 0
679 CALL ancmsg(msgid=331, anmode=aninfo, msgtype=msgerror,
680 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iport1(ii))
681 ENDIF
682 IF (t_monvoln%IBAGHOL(7, ii) == -1) THEN
683 t_monvoln%IBAGHOL(7, ii)=0
684 CALL ancmsg(msgid=332, anmode=aninfo, msgtype=msgerror,
685 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = iporp1(ii))
686 ENDIF
687 IF (t_monvoln%IBAGHOL(8, ii) == -1) THEN
688 t_monvoln%IBAGHOL(8, ii) = 0
689 CALL ancmsg(msgid=333, anmode=aninfo, msgtype=msgerror,
690 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ipora1(ii))
691 ENDIF
692 IF (t_monvoln%IBAGHOL(9, ii) == -1) THEN
693 t_monvoln%IBAGHOL(9, ii) = 0
694 CALL ancmsg(msgid = 518, anmode = aninfo, msgtype = msgerror,
695 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = ivdp(ii))
696 ENDIF
697 ENDDO
698 lca = 0
699 IF (nca > 0) THEN
700 lca = t_monvol_metadata%LCA
701 DO ii = 1, nca
702 chksurf = 0
703 t_monvol_metadata%ICBAG(1, ii + lca) = comm_id(ii)
704 t_monvol_metadata%ICBAG(2, ii + lca) = 0
705 t_monvol_metadata%ICBAG(3, ii + lca) = 0
706 t_monvol_metadata%ICBAG(4, ii + lca) = 0
707 IF (comm_avent(ii) < zero) THEN
708 CALL ancmsg(msgid = 1002, anmode = aninfo, msgtype = msgerror,
709 . i1 = t_monvoln%ID, i2 = comm_id(ii), r1 = comm_avent(ii))
710 ENDIF
711 IF (comm_ipvent(ii) /= 0) THEN
712 IF (comm_avent(ii) == zero) comm_avent(ii) = one
713 DO jj = 1, nsurf
714 IF (comm_ipvent(ii) == igrsurf(jj)%ID) THEN
715 t_monvol_metadata%ICBAG(2, ii + lca) = jj
716 ENDIF
717 ENDDO
718 IF (t_monvol_metadata%ICBAG(2, ii + lca) == 0) THEN
719 CALL ancmsg(msgid = 532, anmode = aninfo, msgtype = msgerror,
720 . i2 = comm_ipvent(ii), i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
721 ELSEIF (igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ISH4N3N == 0) THEN
722 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
723 . i2 = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ID, i1 = t_monvoln%ID,
724 . c1 = t_monvoln%TITLE)
725 ENDIF
726C----------------------------------------------
727C Ajout condition Scom incluse dans Surf airbag
728C----------------------------------------------
729 nn = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%NSEG
730 ext_surfid = t_monvoln%EXT_SURFID
731 DO jj = 1, nn
732 ji = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ELEM(jj)
733 ity = igrsurf(t_monvol_metadata%ICBAG(2 ,ii + lca))%ELTYP(jj)
734 IF (ity == 7) THEN
735 ji = ji + numelc
736 ELSEIF (ity /= 3) THEN
737 ji = jj + numelc + numeltg
738 ENDIF
739 nn1 = igrsurf(ext_surfid)%NSEG
740 found = .false.
741 DO j1 = 1, nn1
742 ji1 = igrsurf(ext_surfid)%ELEM(j1)
743 ity1 = igrsurf(ext_surfid)%ELTYP(j1)
744 IF (ity1 == 7) THEN
745 ji1 = ji1 + numelc
746 ELSEIF (ity1 /= 3) THEN
747 ji1 = j1 + numelc + numeltg
748 ENDIF
749 IF (ji == ji1) THEN
750 found = .true.
751 EXIT
752 END IF
753 ENDDO
754 IF (.NOT. found) chksurf = 1
755 IF (ipri >= 5 .AND. .NOT. found) THEN
756 IF(ity == 3)THEN
757 nel = ixc(nixc, ji)
758 WRITE(iout,'(A,I10,A,I10,A,I10)')
759 . ' ERROR : SHELL ELEMENT ID=',nel,
760 . ' OF COMMUNICATING SURFACE ID=',
761 . igrsurf(t_monvol_metadata%ICBAG(2,ii + lca))%ID,
762 . ' IS NOT INCLUDED INTO AIRBAG SURFACE ID=',
763 . igrsurf(ext_surfid)%ID
764 ELSEIF(ity == 7)THEN
765 nel=ixtg(nixtg,ji-numelc)
766 WRITE(iout,'(A,I10,A,I10,A,I10)')
767 . ' ERROR : SH3N ELEMENT ID=',nel,
768 . ' OF COMMUNICATING SURFACE ID=',
769 . igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ID,
770 . ' IS NOT INCLUDED INTO AIRBAG SURFACE ID=',
771 . igrsurf(ext_surfid)%ID
772 ENDIF
773 ENDIF
774 ENDDO
775C Fin ajout condition Scom incluse dans Surf airbag
776 ENDIF
777 t_monvol_metadata%ICBAG(3, ii + lca) = 0
778 IF((comm_dpdef(ii) == zero .AND. comm_dtpdef(ii) == zero) .OR. comm_tvent(ii) == zero)
779 . t_monvol_metadata%ICBAG(3, ii + lca) = 1
780 t_monvol_metadata%RCBAG(1, ii + lca) = comm_dpdef(ii)
781 t_monvol_metadata%RCBAG(2, ii + lca) = comm_avent(ii)
782 t_monvol_metadata%RCBAG(3, ii + lca) = comm_tvent(ii)
783 t_monvol_metadata%RCBAG(4, ii + lca) = comm_dtpdef(ii)
784 IF (chksurf == 1) THEN
785 CALL ancmsg(msgid = 902, anmode = aninfo, msgtype = msgerror,
786 . i2 = igrsurf(t_monvol_metadata%ICBAG(2, ii + lca))%ID, i3 = igrsurf(ext_surfid)%ID,
787 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
788 ENDIF
789 ENDDO !DO II = 1, NCA
790 lca = lca + nca
791 ENDIF !IF (NCA > 0)
792! Store LCA
793 t_monvol_metadata%LCA = lca
794C
795 t_monvoln%RVOLU(2) = amu
796 t_monvoln%RVOLU(16) = vol + veps
797 t_monvoln%RVOLU(18) = sa
798 t_monvoln%RVOLU(21) = rot
799 t_monvoln%RVOLU(22:24) = zero
800
801C =========
802C Print out
803C =========
804 WRITE(iout, 1005) surfid
805 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
806 WRITE(iout, 1002) sa, sv, vol
807 WRITE(iout, 1400) amu, ti, pext, pini
808 IF (iequi == 0) THEN
809 WRITE(iout, 1401)
810 ELSE
811 WRITE(iout, 1402)
812 ENDIF
813 WRITE(iout, 1410) gamai, cpai, cpbi, cpci
814 WRITE(iout,1420)
815 WRITE(iout,1421)njet
816 DO ii = 1, njet
817 WRITE(iout,1430) ii,
818 . imass(ii), iflu(ii), fmass(ii), itemp(ii), ftemp(ii), isens(ii)
819 WRITE(iout, 1440) gama(ii), cpa(ii), cpb(ii), cpc(ii)
820 WRITE(iout, 1450) ijet(ii)
821 IF (ijet(ii) > 0) THEN
822 IF (nj3(ii) == 0) THEN
823 WRITE(iout, 1460) nj1(ii), nj2(ii), ipt(ii), ipa(ii), ipz(ii),
824 . fpt(ii), fpa(ii), fpz(ii)
825 ELSE
826 WRITE(iout, 1461) nj1(ii), nj2(ii), nj3(ii), ipt(ii), ipa(ii), ipz(ii),
827 . fpt(ii), fpa(ii), fpz(ii)
828 ENDIF
829 ENDIF
830 ENDDO
831 WRITE(iout, 1470) nvent,ttfire
832 IF(nvent > 0) THEN
833 WRITE(iout, 1471) ittf
834 ENDIF
835 DO ii = 1, nvent
836 WRITE(iout,1472) ii, ipvent(ii)
837 IF (ipvent(ii) == 0 .AND. avent(ii) == zero) THEN
838 CALL ancmsg(msgid = 1019, msgtype = msgwarning, anmode = aninfo,
839 . i1 = t_monvoln%ID, i2 = ii, c1 = t_monvoln%TITLE, c2 = 'VENT HOLE SURFACE')
840 ENDIF
841 IF (ifvent(ii) <= 1) WRITE(iout, 1481)
842 IF (ifvent(ii) == 2) THEN
843 WRITE(iout, 1482) ivdp(ii), fvdp(ii)
844 ENDIF
845 IF (ifvent(ii) == 3) WRITE(iout, 1484)
846 IF (ifvent(ii) == 4) WRITE(iout, 1485)
847 IF (ipvent(ii) /= 0) THEN
848 CALL monvol_check_venthole_surf(ipri, t_monvoln, igrsurf, ii, shol, x, ixc, ixtg)
849 t_monvoln%RBAGHOL(15, ii) = shol
850 WRITE(iout,1479)
851 . shol,avent(ii),bvent(ii),
852 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
853 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
854 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
855 ELSE
856 WRITE(iout,1489)
857 . avent(ii),bvent(ii),
858 . iport(ii),iporp(ii),ipora(ii),fport(ii),fporp(ii),fpora(ii),
859 . iport1(ii),iporp1(ii),ipora1(ii),fport1(ii),fporp1(ii),fpora1(ii)
860 WRITE(iout,1480) tvent(ii),dpdef(ii),dtpdef(ii),idtpdef(ii),tstope(ii)
861 ENDIF
862 ENDDO
863 WRITE(iout, 1500) nca
864 DO ii = 1, nca
865 WRITE(iout, 1510) comm_id(ii), comm_ipvent(ii), comm_dpdef(ii), comm_dtpdef(ii), comm_avent(ii),
866 . comm_tvent(ii), 0, 0, zero, zero
867 ENDDO
868C ===========
869C Memory free
870C ===========
871 IF (njet > 0) THEN
872 DEALLOCATE(gama, cpa, cpb, cpc)
873 DEALLOCATE(imass, iflu, fmass, itemp, ftemp, isens)
874 DEALLOCATE(ijet, nj1, nj2, nj3)
875 DEALLOCATE(ipt, ipa, ipz, fpt, fpa, fpz)
876 ENDIF
877 IF (nvent > 0) THEN
878 DEALLOCATE(tvent, dpdef, dtpdef, fvdp, avent, bvent, tstope)
879 DEALLOCATE(ipvent, ivdp, idtpdef, ifvent)
880 DEALLOCATE(iport, iporp, ipora, iport1, iporp1, ipora1)
881 DEALLOCATE(fport, fporp, fpora, fport1, fporp1, fpora1)
882 ENDIF
883 IF (nca > 0) THEN
884 DEALLOCATE(comm_id, comm_ipvent)
885 DEALLOCATE(comm_dpdef, comm_avent, comm_tvent, comm_dtpdef)
886 ENDIF
887C-----------------------------------------------
888C E n d o f s o u r c e
889C-----------------------------------------------
890
891 RETURN
892 1002 FORMAT(
893 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
894 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
895 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
896 1003 FORMAT(
897 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
898 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
899 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
900 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
901 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
902 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
903 1400 FORMAT(
904 . 5x,'VOLUMIC VISCOSITY . . . . . . . . . . .=',1pg20.13,
905 . /5x,'initial temperature . . . . . . . . . .=',1PG20.13,
906 . /5X,'EXTERNAL pressure . . . . . . . . . . .=',1PG20.13,
907 . /5X,'initial pressure. . . . . . . . . . . .=',1PG20.13/)
908 1401 FORMAT(
909 . 5X,'initial thermodynamic equilibrium is set at time 0'
910 . /5X,'--------------------------------------------------'/)
911 1402 FORMAT(
912 . 5X,'initial thermodynamic equilibrium is set at injection time'
913 . /5X,'----------------------------------------------------------'/)
914 1410 FORMAT(
915 . 5X,'characteristics of initial gaz ',
916 . /5X,'------------------------------ ',
917 . /5X,'gamma at initial temperature. . . . . .=',1PG20.13,
918 . /5X,'coefficient cpa . . . . . . . . . . . .=',1PG20.13,
919 . /5X,'coefficient cpb . . . . . . . . . . . .=',1PG20.13,
920 . /5X,'coefficient cpc . . . . . . . . . . . .=',1PG20.13/)
921 1420 FORMAT(
922 . 5X,'inflators ',
923 . /5X,'--------- ')
924 1421 FORMAT(
925 . 5X,'number of inflators . . . . . . . . . .=',I10/)
926 1430 FORMAT(
927 . 5X,'inflator number . . . . . . . . . . . .=',I10,
928 . /15X,'time FUNCTION for incoming total mass .=',I10,
929 . /15X,' or mass flux if iflu=1 . . . . iflu =',I10,
930 . /15X,'scale factor for incoming total mass .=',1PG20.13,
931 . /15X,'time function for incomimg gas temp . .=',I10,
932 . /15X,'scale factor for incomimg gas temp . .=',1PG20.13,
933 . /15X,'sensor number . . . . . . . . . . . . .=',I10)
934 1440 FORMAT(
935 . /15X,'gaz characteristics ',
936 . /15X,'------------------- ',
937 . /15X,'gamma at initial temperature. . . . . .=',1PG20.13,
938 . /15X,'coefficient cpa . . . . . . . . . . . .=',1PG20.13,
939 . /15X,'coefficient cpb . . . . . . . . . . . .=',1PG20.13,
940 . /15X,'coefficient cpc . . . . . . . . . . . .=',1PG20.13)
941 1450 FORMAT(
942 . /15X,'jetting option. . . . . . . . . . . . .=',I10,
943 . /15X,'----------------------------------------')
944 1460 FORMAT(
945 . 15X,'conical jet . . . . . . . . . . . . . .',
946 . /15X,'node number defining injection center .=',I10,
947 . /15X,'node number defining injection axis . .=',i10,
948 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
949 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
950 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
951 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
952 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
953 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13/)
954 1461 FORMAT(
955 . 15x,'DIHEDRAL JET. . . . . . . . . . . . . .',
956 . /15x,'NODE NUMBER DEFINING INJECTION CENTER .=',i10,
957 . /15x,'NODE NUMBER DEFINING INJECTION AXIS . .=',i10,
958 . /15x,'NODE NUMBER DEFINING BASE LINE. . . . .=',i10,
959 . /15x,'JETTING PRESSURE TIME CURVE NUMBER. . .=',i10,
960 . /15x,'JETTING PRESSURE THETA CURVE NUMBER . .=',i10,
961 . /15x,'JETTING PRESSURE DIST. CURVE NUMBER . .=',i10,
962 . /15x,'TIME FUNCTION SCALE FACTOR . .=',1pg20.13,
963 . /15x,'THETA FUNCTION SCALE FACTOR . .=',1pg20.13,
964 . /15x,'DIST FUNCTION SCALE FACTOR . .=',1pg20.13)
965 1470 FORMAT(
966 . /5x,'VENT HOLES AND POROUS FABRIC SURFACES ',
967 . /5x,'------------------------------------- ',
968 . /5x,'NUMBER OF VENT HOLES AND POROUS SURFACES . .=',i10,
969 . /5x,'INJECTION TIME TINJ. . . . . . . . . . . . .=',1pg20.13)
970 1471 FORMAT(
971 . 5x,'VENTING START TIME SHIFT . . . . . . . . . .=',i10,
972 . /5x,' 0 : NO SHIFT',
973 . /5x,' 1 : JETTING FUNCTIONS ARE SHIFTED BY INJECTION TIME',
974 . /5x,' 2 : JETTING AND VENTING FUNCTIONS ARE SHIFTED BY',
975 . /5x,' INJECTION TIME TINJ',
976 . /5x,' 3 : JETTING AND VENTING FUNCTIONS ARE SHIFTED',
977 . /5x,' BY TINJ FOR JETTING FUNCTIONS',
978 . /5x,' BY TINJ+TSTART FOR VENTING FUNCTIONS')
979 1472 FORMAT(
980 . / 5x,'VENT HOLE NUMBER. . . . . . . . . . . .=',i10,
981 . /15x,'VENT HOLE SURFACE ID. . . . . . . . . .=',i10)
982 1481 FORMAT(15x,'ISENTHALPIC VENTING MODEL ')
983 1482 FORMAT(15x,'CHEMKIN MODEL FOR POROSITY : ',
984 . /15x,'VELOCITY VS RELATIVE PRESSURE FUNCTION =',i10,
985 . /15x,' SCALE FACTOR. . . . . . .=',1pg20.13)
986 1484 FORMAT(15x,'GRAEFE POROSITY FORMULATION')
987 1485 FORMAT(15x,'ISENTHALPIC VENTING MODEL WITH POSSIBLE FLOW IN')
988 1479 FORMAT(
989 . 15x,'INITIAL SURFACE . . . . . . . . . . . .=',1pg20.13,
990 . /15x,'AVENT:VENT HOLE SCALE FACTOR. . . . . .=',1pg20.13,
991 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
992 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
993 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
994 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
995 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
996 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
997 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
998 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
999 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1000 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1001 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1002 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1003 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1004 1480 FORMAT(
1005 . 15x,'START TIME FOR VENTING TSTART . . . . .=',1pg20.13,
1006 . /15x,'RELATIVE PRES. FOR MEMBRANE DEFLATION .=',1pg20.13,
1007 . /15x,' (DPDEF = PDEF - PEXT) ',
1008 . /15x,'TIME DELAY BEFORE MEMBRANE DEFLATION .=',1pg20.13,
1009 . /15x,'TIME DELAY FLAG . . . . . . . . . . . .=',i10,
1010 . /15x,' IF IDTPDEF : 0',
1011 . /15x,' PRESSURE SHOULD BE OVER PDEF DURING',
1012 . /15x,' A CUMULATED DTPDEF TIME'
1013 . /15x,' BEFORE ACTIVATING DEFLATION'
1014 . /15x,' IF IDTPDEF : 1',
1015 . /15x,' DEFLATION START DTPDEF AFTER',
1016 . /15x,' DPDEF HAS BEEN REACHED',
1017 . /15x,'END TIME FOR VENTING TSTOP. . . . . . .=',1pg20.13)
1018 1489 FORMAT(
1019 . 15x,'AVENT:VENT HOLE AREA. . . . . . . . . .=',1pg20.13,
1020 . /15x,'BVENT:VENT HOLE SCALE FACTOR IF CONTACT=',1pg20.13,
1021 . /15x,'POROSITY FUNCTION / TIME. . . . . . . .=',i10,
1022 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1023 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1024 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1025 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1026 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13,
1027 . /15x,'POROSITY FUNCTION / TIME(after contact)=',i10,
1028 . /15x,'POROSITY FUNCTION / PRESSURE. . . . . .=',i10,
1029 . /15x,'POROSITY FUNCTION / AREA. . . . . . . .=',i10,
1030 . /15x,'POROSITY TIME FUNCTION SCALE FACTOR =',1pg20.13,
1031 . /15x,'POROSITY PRESSURE FUNCTION SCALE FACTOR=',1pg20.13,
1032 . /15x,'POROSITY AREA FUNCTION SCALE FACTOR . .=',1pg20.13)
1033 1500 FORMAT(/5x,'NUMBER OF COMMUNICATING VOLUMES . . . .=',i10,
1034 . /5x,'VOLUME_ID ',' VENT_SURF',8x,'DELTA_PDEF',11x,'DTPDEF',15x,
1035 . 'AVENT',16x,'TVENT',9x,' FCT/TIME ','FCT/PRES. ',
1036 . 'FCT/TIME SCALE FAC. ','FCT/PRES.SCALE FAC. ')
1037 1510 FORMAT(5x,2i10,4(1x,1pg20.13),2i10,2(1x,1pg20.13))
1038 END SUBROUTINE hm_read_monvol_type5
1039 END MODULE hm_read_monvol_type5_mod
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
groupdef_mod
Definition groupdef_mod.F:662
hm_read_monvol_type5_mod
Definition hm_read_monvol_type5.F:28
hm_read_monvol_type5_mod::hm_read_monvol_type5
subroutine hm_read_monvol_type5(t_monvoln, t_monvol_metadata, itabm1, sensors, npt, pld, unitab, luid, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)
Definition hm_read_monvol_type5.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
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_metadata_
Definition monvol_struct_mod.F:76
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