OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_monvol_type10.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_type10_mod ../starter/source/airbag/hm_read_monvol_type10.F
25!||--- called by ------------------------------------------------------
26!|| read_monvol ../starter/source/airbag/read_monvol.F
27!||====================================================================
28 MODULE hm_read_monvol_type10_mod
29 CONTAINS
30!||====================================================================
31!|| hm_read_monvol_type10 ../starter/source/airbag/hm_read_monvol_type10.F
32!||--- called by ------------------------------------------------------
33!|| read_monvol ../starter/source/airbag/read_monvol.F
34!||--- calls -----------------------------------------------------
35!|| ancmsg ../starter/source/output/message/message.F
36!|| check_function_id ../starter/source/tools/curve/check_function.F
37!|| freerr ../starter/source/starter/freform.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_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
41!|| monvol_check_surfclose ../starter/share/modules1/monvol_struct_mod.F
42!|| monvol_compute_volume ../starter/share/modules1/monvol_struct_mod.F
43!|| monvol_orient_surf ../starter/share/modules1/monvol_struct_mod.f
44!|| monvol_reverse_normals ../starter/share/modules1/monvol_struct_mod.F
45!||--- uses -----------------------------------------------------
46!|| message_mod ../starter/share/message_module/message_mod.F
47!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
48!|| submodel_mod ../starter/share/modules1/submodel_mod.F
49!||====================================================================
50 SUBROUTINE hm_read_monvol_type10(T_MONVOLN, UNITAB, NPC, IGRSURF, ITAB, X, PM, GEO, IXC, IXTG, LSUBMODEL)
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE unitab_mod
55 USE groupdef_mod
56 USE message_mod
57 USE monvol_struct_mod
58 USE submodel_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66C NSURF, NFUNCT
67#include "com04_c.inc"
68C KMONVO, IREC
69C NIMV, NRVOLU
70#include "param_c.inc"
71C IIN
72#include "units_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 TYPE(unit_type_), INTENT(IN) :: UNITAB
77 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
78 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *)
79 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
80 TYPE(monvol_struct_), INTENT(INOUT) :: T_MONVOLN
81 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER :: II
86 INTEGER :: SURFID, IFUNCT_ID(6), IFBULK, IFMIN, IFMOUTT, IFMOUTP, IFP0, IFPMAX
87 my_real :: fac_gen
88 my_real :: scal_t, scal_p
89 my_real :: sa, rot, vol, vmin, veps, amu, sv
90 my_real :: rhoi, sfbulk, sfmin, sfmoutt, sfmoutp, sfp0, sfpmax
91 LOGICAL :: FOUND
92 LOGICAL :: IS_AVAILABLE
93C-----------------------------------------------
94C B e g i n n i n g o f s o u r c e
95C-----------------------------------------------
96C =======
97C Reading
98C =======
99C Line 1
100 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
101C Line 2
102 CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
103 CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
104C Line 3
105 CALL hm_get_floatv('Rho', rhoi, is_available, lsubmodel, unitab)
106C Line 4
107 CALL hm_get_intv('fct_K', ifbulk, is_available, lsubmodel)
108 CALL hm_get_intv('fct_Mtin', ifmin, is_available, lsubmodel)
109 CALL hm_get_floatv('Fscale_K', sfbulk, is_available, lsubmodel, unitab)
110 CALL hm_get_floatv('fscale_mtin', SFMIN, IS_AVAILABLE, LSUBMODEL, UNITAB)
111C Line 5
112 CALL HM_GET_INTV('fct_mtout', IFMOUTT, IS_AVAILABLE, LSUBMODEL)
113 CALL HM_GET_INTV('fct_mpout', IFMOUTP, IS_AVAILABLE, LSUBMODEL)
114 CALL HM_GET_FLOATV('fscale_mtout', SFMOUTT, IS_AVAILABLE, LSUBMODEL, UNITAB)
115 CALL HM_GET_FLOATV('fscale_mpout', SFMOUTP, IS_AVAILABLE, LSUBMODEL, UNITAB)
116C Line 6
117 CALL HM_GET_INTV('fct_padd', IFP0, IS_AVAILABLE, LSUBMODEL)
118 CALL HM_GET_INTV('fct_pmax', IFPMAX, IS_AVAILABLE, LSUBMODEL)
119 CALL HM_GET_FLOATV('fscale_padd', SFP0, IS_AVAILABLE, LSUBMODEL, UNITAB)
120 CALL HM_GET_FLOATV('fscale_pmax', SFPMAX, IS_AVAILABLE, LSUBMODEL, UNITAB)
121C ================
122C Check operations
123C ================
124C External surface check
125 T_MONVOLN%IVOLU(4) = 0
126 FOUND = .FALSE.
127 DO II = 1, NSURF
128 IF (SURFID == IGRSURF(II)%ID) THEN
129 T_MONVOLN%IVOLU(4) = II
130 T_MONVOLN%EXT_SURFID = II
131 FOUND = .TRUE.
132 EXIT
133 ENDIF
134 ENDDO
135.NOT. IF ( FOUND) THEN
136 CALL FREERR(3)
137 ELSEIF (IGRSURF(T_MONVOLN%EXT_SURFID)%ISH4N3N == 0) THEN
138 CALL ANCMSG(MSGID = 18, ANMODE = ANINFO, MSGTYPE = MSGERROR,
139 . I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, I2 = SURFID)
140 CALL FREERR(3)
141 ENDIF
142
143C Check surface closure
144 CALL MONVOL_CHECK_SURFCLOSE(T_MONVOLN, ITAB, IGRSURF(T_MONVOLN%EXT_SURFID), X)
145C Set all normal on same side
146 CALL MONVOL_ORIENT_SURF(T_MONVOLN, T_MONVOLN%TITLE, T_MONVOLN%IVOLU, ITAB,
147 . IGRSURF(T_MONVOLN%EXT_SURFID),IXC, IXTG, X, 10)
148C Compute Monvon volume
149 CALL MONVOL_COMPUTE_VOLUME(T_MONVOLN, T_MONVOLN%TITLE, T_MONVOLN%IVOLU, IGRSURF(T_MONVOLN%EXT_SURFID),
150 . ITAB, X, PM, GEO, IXC, IXTG,
151 . SA, ROT, VOL, VMIN, VEPS, SV)
152C Reverse all normals to ensure positive volume
153 CALL MONVOL_REVERSE_NORMALS(T_MONVOLN, T_MONVOLN%TITLE, T_MONVOLN%IVOLU, ITAB,
154 . IGRSURF(T_MONVOLN%EXT_SURFID),IXC,IXTG,VOL, X, 10)
155
156
157 IFUNCT_ID(1:6) = 0
158 IF (IFBULK > 0) THEN
159 CALL CHECK_FUNCTION_ID(NPC, NFUNCT, IFBULK, IFUNCT_ID(1), FOUND)
160.NOT. IF ( FOUND) THEN
161 CALL ANCMSG(MSGID = 9, ANMODE = ANINFO, MSGTYPE = MSGERROR,
162 . I2 = IFBULK, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, C2 = 'bulk')
163 ENDIF
164 ENDIF
165 IF (IFMIN > 0) THEN
166 CALL CHECK_FUNCTION_ID(NPC, NFUNCT, IFMIN, IFUNCT_ID(2), FOUND)
167.NOT. IF ( FOUND) THEN
168 CALL ANCMSG(MSGID = 9, ANMODE = ANINFO, MSGTYPE = MSGERROR,
169 . I2 = IFMIN, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, C2 = 'mass flow')
170 ENDIF
171 ENDIF
172 IF (IFMOUTT > 0) THEN
173 CALL CHECK_FUNCTION_ID(NPC, NFUNCT, IFMOUTT, IFUNCT_ID(3), FOUND)
174.NOT. IF ( FOUND) THEN
175 CALL ANCMSG(MSGID = 9, ANMODE = ANINFO, MSGTYPE = MSGERROR,
176 . I2 = IFMOUTT, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, C2 = 'mass flow')
177 ENDIF
178 ENDIF
179 IF (IFMOUTP > 0) THEN
180 CALL CHECK_FUNCTION_ID(NPC, NFUNCT, IFMOUTP, IFUNCT_ID(4), FOUND)
181.NOT. IF ( FOUND) THEN
182 CALL ANCMSG(MSGID = 9, ANMODE = ANINFO, MSGTYPE = MSGERROR,
183 . I2 = IFMOUTP, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, C2 = 'mass flow')
184 ENDIF
185 ENDIF
186 IF (IFP0 > 0) THEN
187 CALL CHECK_FUNCTION_ID(NPC, NFUNCT, IFP0, IFUNCT_ID(5), FOUND)
188.NOT. IF ( FOUND) THEN
189 CALL ANCMSG(MSGID = 9, ANMODE = ANINFO, MSGTYPE = MSGERROR,
190 . I2 = IFP0, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, C2 = 'pressure')
191 ENDIF
192 ENDIF
193 IF (IFPMAX > 0) THEN
194 CALL CHECK_FUNCTION_ID(NPC, NFUNCT, IFPMAX, IFUNCT_ID(6), FOUND)
195.NOT. IF ( FOUND) THEN
196 CALL ANCMSG(MSGID = 9, ANMODE = ANINFO, MSGTYPE = MSGERROR,
197 . I2 = IFPMAX, I1 = T_MONVOLN%ID, C1 = T_MONVOLN%TITLE, C2 = 'pressure')
198 ENDIF
199 ENDIF
200
201
202C Default value for time scale factor
203 IF (SCAL_T == ZERO) THEN
204 CALL HM_GET_FLOATV_DIM('ascalet', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
205 SCAL_T = ONE * FAC_GEN
206 ENDIF
207 IF (SCAL_P == ZERO) THEN
208 CALL HM_GET_FLOATV_DIM('ascalep', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
209 SCAL_P = ONE * FAC_GEN
210 ENDIF
211C Default value
212 IF (IFBULK > 0) THEN
213 IF (SFBULK == ZERO) THEN
214 CALL HM_GET_FLOATV_DIM('fscale_k', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
215 SFBULK = ONE * FAC_GEN
216 ENDIF
217 ENDIF
218 IF (IFMIN > 0) THEN
219 IF (SFMIN == ZERO) THEN
220 CALL HM_GET_FLOATV_DIM('fscale_mtin', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
221 SFMIN = ONE * FAC_GEN
222 ENDIF
223 ENDIF
224 IF (IFMOUTT > 0) THEN
225 IF (SFMOUTT == ZERO) THEN
226 CALL HM_GET_FLOATV_DIM('fscale_mtout', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
227 SFMOUTT = ONE * FAC_GEN
228 ENDIF
229 ENDIF
230 IF (IFMOUTP > 0) THEN
231 IF (SFMOUTP == ZERO) THEN
232 CALL HM_GET_FLOATV_DIM('fscale_mpout', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
233 SFMOUTP = ONE * FAC_GEN
234 ENDIF
235 ENDIF
236 IF (IFP0 > 0) THEN
237 IF (SFP0 == ZERO) THEN
238 CALL HM_GET_FLOATV_DIM('fscale_padd', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
239 SFP0 = ONE * FAC_GEN
240 ENDIF
241 ENDIF
242 CALL HM_GET_FLOATV_DIM('fscale_pmax', FAC_GEN, IS_AVAILABLE, LSUBMODEL, UNITAB)
243 IF (IFPMAX > 0) THEN
244 IF (SFPMAX == ZERO) THEN
245 SFPMAX = ONE * FAC_GEN
246 ENDIF
247 ELSE
248 SFPMAX = INFINITY * FAC_GEN
249 ENDIF
250C =====
251C Store
252C =====
253C Store in data structure
254 T_MONVOLN%IVOLU(21) = IFUNCT_ID(1)
255 T_MONVOLN%RVOLU(35) = SFBULK
256 T_MONVOLN%IVOLU(22) = IFUNCT_ID(2)
257 T_MONVOLN%RVOLU(36) = SFMIN
258 T_MONVOLN%IVOLU(23) = IFUNCT_ID(3)
259 T_MONVOLN%RVOLU(37) = SFMOUTT
260 T_MONVOLN%IVOLU(24) = IFUNCT_ID(4)
261 T_MONVOLN%RVOLU(38) = SFMOUTP
262 T_MONVOLN%IVOLU(25) = IFUNCT_ID(5)
263 T_MONVOLN%RVOLU(39) = SFP0
264 T_MONVOLN%IVOLU(26) = IFUNCT_ID(6)
265 T_MONVOLN%RVOLU(40) = SFPMAX
266
267 T_MONVOLN%RVOLU(26) = ONE / SCAL_T
268 T_MONVOLN%RVOLU(27) = ONE / SCAL_P
269 T_MONVOLN%RVOLU(28) = ONE
270 T_MONVOLN%RVOLU(29) = ONE
271 T_MONVOLN%RVOLU(30) = ONE
272
273 T_MONVOLN%RVOLU(34) = RHOI
274C
275 VEPS = MAX(ZERO, VMIN - VOL)
276 T_MONVOLN%RVOLU(4) = VOL + VEPS
277 T_MONVOLN%RVOLU(17) = VEPS
278 T_MONVOLN%RVOLU(20)= RHOI*VOL
279C
280 AMU = ZERO
281 T_MONVOLN%RVOLU(2) = AMU
282 T_MONVOLN%RVOLU(16) = VOL + VEPS
283 T_MONVOLN%RVOLU(18) = SA
284 T_MONVOLN%RVOLU(21) = ROT
285 T_MONVOLN%RVOLU(22:24) = ZERO
286
287C =========
288C Print out
289C =========
290 WRITE(IOUT, 1005) SURFID
291 WRITE(IOUT, 1003) SCAL_T, SCAL_P
292 WRITE(IOUT, 1002) SA, SV, VOL
293 WRITE(IOUT,1800) RHOI, IFBULK, SFBULK, IFMIN, SFMIN, IFMOUTT, SFMOUTT,
294 . IFMOUTP, SFMOUTP, IFP0, SFP0, IFPMAX, SFPMAX
295C-----------------------------------------------
296C E n d o f s o u r c e
297C-----------------------------------------------
298
299 RETURN
300 1002 FORMAT(
301 . /5X,'initial surface of monitored volume . .=',1PG20.13,
302 . /5X,'surface error(ne.0 for non closed surf)=',1PG20.13,
303 . /5X,'initial volume of monitored volume. . .=',1PG20.13)
304 1003 FORMAT(
305 . 5X,'unit scale for time functions =',1PG20.13,
306 . /5X,'unit scale for pressure functions =',1PG20.13)
307 1005 FORMAT( 5X,'EXTERNAL surface id . . . . . . . . . .=',I10)
308
309 1800 FORMAT(
310 . 5X,'fluid density. . . . . . . . . . . . . . . . . . . . . =',1PG20.13,
311 . /5X,'bulk time function. . . . . . . . . . . . . . . . . . .=',I10,
312 . /5X,'bulk time FUNCTION scale factor. . . . . . . . . . . . =',1PG20.13,
313 . /5X,'input mass flow rate time function. . . . . . . . . . .=',I10,
314 . /5X,'input mass flow rate time function scale factor. . . . =',1PG20.13,
315 . /5X,'output mass flow rate time function. . . . . . . . . . =',I10,
316 . /5X,'output mass flow rate time function scale factor. . . .=',1PG20.13,
317 . /5X,'output mass flow rate pressure function. . . . . . . . =',I10,
318 . /5X,'output mass flow rate pressure function scale factor. .=',1PG20.13,
319 . /5X,'additional pressure time function. . . . . . . . . . . =',I10,
320 . /5X,'additional pressure time function scale factor. . . . .=',1PG20.13,
321 . /5X,'maximum pressure time function. . . . . . . . . . . . .=',I10,
322 . /5X,'maximum pressure time function scale factor. . . . . . =',1PG20.13)
323 END SUBROUTINE HM_READ_MONVOL_TYPE10
324 END MODULE HM_READ_MONVOL_TYPE10_MOD
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
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:662
hm_read_monvol_type10_mod
Definition hm_read_monvol_type10.F:28
hm_read_monvol_type10_mod::hm_read_monvol_type10
subroutine hm_read_monvol_type10(t_monvoln, unitab, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)
Definition hm_read_monvol_type10.F:51
message_mod
Definition message_mod.F:1249
monvol_struct_mod
Definition monvol_struct_mod.F:66
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
starter
program starter
Definition starter.F:39
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84
submodel_mod::submodel_data
Definition submodel_mod.F:723
unitab_mod::unit_type_
Definition unitab_mod.F:520