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

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ hm_read_monvol_type5()

subroutine hm_read_monvol_type5_mod::hm_read_monvol_type5 ( type(monvol_struct_), intent(inout) t_monvoln,
type(monvol_metadata_), intent(inout) t_monvol_metadata,
integer, dimension(*), intent(in) itabm1,
type (sensors_), intent(in) sensors,
integer, dimension(*), intent(in) npt,
dimension(2, *), intent(in) pld,
type(unit_type_), intent(in) unitab,
integer, intent(in) luid,
integer, dimension(*), intent(in) npc,
type (surf_), dimension(nsurf), intent(inout) igrsurf,
integer, dimension(*), intent(in) itab,
dimension(3, *), intent(in) x,
dimension(npropm, *), intent(in) pm,
dimension(npropg, *), intent(in) geo,
integer, dimension(nixc, *), intent(in) ixc,
integer, dimension(nixtg, *), intent(in) ixtg,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 53 of file hm_read_monvol_type5.F.

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