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
59 use element_mod , only : nixc,nixtg
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67C NSURF, NFUNCT
68#include "com04_c.inc"
69C KMONVO, IREC
70C NIMV, NRVOLU
71#include "param_c.inc"
72C IIN
73#include "units_c.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 TYPE(unit_type_), INTENT(IN) :: UNITAB
78 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
79 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *)
80 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
81 TYPE(monvol_struct_), INTENT(INOUT) :: T_MONVOLN
82 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER :: II
87 INTEGER :: SURFID, IFUNCT_ID(6), IFBULK, IFMIN, IFMOUTT, IFMOUTP, IFP0, IFPMAX
88 my_real :: fac_gen
89 my_real :: scal_t, scal_p
90 my_real :: sa, rot, vol, vmin, veps, amu, sv
91 my_real :: rhoi, sfbulk, sfmin, sfmoutt, sfmoutp, sfp0, sfpmax
92 LOGICAL :: FOUND
93 LOGICAL :: IS_AVAILABLE
94C-----------------------------------------------
95C B e g i n n i n g o f s o u r c e
96C-----------------------------------------------
97C =======
98C Reading
99C =======
100C Line 1
101 CALL hm_get_intv('surf_IDex', surfid, is_available, lsubmodel)
102C Line 2
103 CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
104 CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
105C Line 3
106 CALL hm_get_floatv('Rho', rhoi, is_available, lsubmodel, unitab)
107C Line 4
108 CALL hm_get_intv('fct_K', ifbulk, is_available, lsubmodel)
109 CALL hm_get_intv('fct_Mtin', ifmin, is_available, lsubmodel)
110 CALL hm_get_floatv('Fscale_K', sfbulk, is_available, lsubmodel, unitab)
111 CALL hm_get_floatv('Fscale_Mtin', sfmin, is_available, lsubmodel, unitab)
112C Line 5
113 CALL hm_get_intv('fct_Mtout', ifmoutt, is_available, lsubmodel)
114 CALL hm_get_intv('fct_Mpout', ifmoutp, is_available, lsubmodel)
115 CALL hm_get_floatv('Fscale_Mtout', sfmoutt, is_available, lsubmodel, unitab)
116 CALL hm_get_floatv('Fscale_Mpout', sfmoutp, is_available, lsubmodel, unitab)
117C Line 6
118 CALL hm_get_intv('fct_Padd', ifp0, is_available, lsubmodel)
119 CALL hm_get_intv('fct_Pmax', ifpmax, is_available, lsubmodel)
120 CALL hm_get_floatv('Fscale_Padd', sfp0, is_available, lsubmodel, unitab)
121 CALL hm_get_floatv('Fscale_Pmax', sfpmax, is_available, lsubmodel, unitab)
122C ================
123C Check operations
124C ================
125C External surface check
126 t_monvoln%IVOLU(4) = 0
127 found = .false.
128 DO ii = 1, nsurf
129 IF (surfid == igrsurf(ii)%ID) THEN
130 t_monvoln%IVOLU(4) = ii
131 t_monvoln%EXT_SURFID = ii
132 found = .true.
133 EXIT
134 ENDIF
135 ENDDO
136 IF (.NOT. found) THEN
137 CALL freerr(3)
138 ELSEIF (igrsurf(t_monvoln%EXT_SURFID)%ISH4N3N == 0) THEN
139 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
140 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
141 CALL freerr(3)
142 ENDIF
143
144C Check surface closure
145 CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
146C Set all normal on same side
147 CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
148 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 10)
149C Compute Monvon volume
150 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
151 . itab, x, pm, geo, ixc, ixtg,
152 . sa, rot, vol, vmin, veps, sv)
153C Reverse all normals to ensure positive volume
154 CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
155 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 10)
156
157
158 ifunct_id(1:6) = 0
159 IF (ifbulk > 0) THEN
160 CALL check_function_id(npc, nfunct, ifbulk, ifunct_id(1), found)
161 IF (.NOT. found) THEN
162 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
163 . i2 = ifbulk, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'BULK')
164 ENDIF
165 ENDIF
166 IF (ifmin > 0) THEN
167 CALL check_function_id(npc, nfunct, ifmin, ifunct_id(2), found)
168 IF (.NOT. found) THEN
169 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
170 . i2 = ifmin, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'MASS FLOW')
171 ENDIF
172 ENDIF
173 IF (ifmoutt > 0) THEN
174 CALL check_function_id(npc, nfunct, ifmoutt, ifunct_id(3), found)
175 IF (.NOT. found) THEN
176 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
177 . i2 = ifmoutt, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'MASS FLOW')
178 ENDIF
179 ENDIF
180 IF (ifmoutp > 0) THEN
181 CALL check_function_id(npc, nfunct, ifmoutp, ifunct_id(4), found)
182 IF (.NOT. found) THEN
183 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
184 . i2 = ifmoutp, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'MASS FLOW')
185 ENDIF
186 ENDIF
187 IF (ifp0 > 0) THEN
188 CALL check_function_id(npc, nfunct, ifp0, ifunct_id(5), found)
189 IF (.NOT. found) THEN
190 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
191 . i2 = ifp0, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'PRESSURE')
192 ENDIF
193 ENDIF
194 IF (ifpmax > 0) THEN
195 CALL check_function_id(npc, nfunct, ifpmax, ifunct_id(6), found)
196 IF (.NOT. found) THEN
197 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
198 . i2 = ifpmax, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'PRESSURE')
199 ENDIF
200 ENDIF
201
202
203C Default value for time scale factor
204 IF (scal_t == zero) THEN
205 CALL hm_get_floatv_dim('Ascalet', fac_gen, is_available, lsubmodel, unitab)
206 scal_t = one * fac_gen
207 ENDIF
208 IF (scal_p == zero) THEN
209 CALL hm_get_floatv_dim('AscaleP', fac_gen, is_available, lsubmodel, unitab)
210 scal_p = one * fac_gen
211 ENDIF
212C Default value
213 IF (ifbulk > 0) THEN
214 IF (sfbulk == zero) THEN
215 CALL hm_get_floatv_dim('Fscale_K', fac_gen, is_available, lsubmodel, unitab)
216 sfbulk = one * fac_gen
217 ENDIF
218 ENDIF
219 IF (ifmin > 0) THEN
220 IF (sfmin == zero) THEN
221 CALL hm_get_floatv_dim('Fscale_Mtin', fac_gen, is_available, lsubmodel, unitab)
222 sfmin = one * fac_gen
223 ENDIF
224 ENDIF
225 IF (ifmoutt > 0) THEN
226 IF (sfmoutt == zero) THEN
227 CALL hm_get_floatv_dim('Fscale_Mtout', fac_gen, is_available, lsubmodel, unitab)
228 sfmoutt = one * fac_gen
229 ENDIF
230 ENDIF
231 IF (ifmoutp > 0) THEN
232 IF (sfmoutp == zero) THEN
233 CALL hm_get_floatv_dim('Fscale_Mpout', fac_gen, is_available, lsubmodel, unitab)
234 sfmoutp = one * fac_gen
235 ENDIF
236 ENDIF
237 IF (ifp0 > 0) THEN
238 IF (sfp0 == zero) THEN
239 CALL hm_get_floatv_dim('Fscale_Padd', fac_gen, is_available, lsubmodel, unitab)
240 sfp0 = one * fac_gen
241 ENDIF
242 ENDIF
243 CALL hm_get_floatv_dim('Fscale_Pmax', fac_gen, is_available, lsubmodel, unitab)
244 IF (ifpmax > 0) THEN
245 IF (sfpmax == zero) THEN
246 sfpmax = one * fac_gen
247 ENDIF
248 ELSE
249 sfpmax = infinity * fac_gen
250 ENDIF
251C =====
252C Store
253C =====
254C Store in data structure
255 t_monvoln%IVOLU(21) = ifunct_id(1)
256 t_monvoln%RVOLU(35) = sfbulk
257 t_monvoln%IVOLU(22) = ifunct_id(2)
258 t_monvoln%RVOLU(36) = sfmin
259 t_monvoln%IVOLU(23) = ifunct_id(3)
260 t_monvoln%RVOLU(37) = sfmoutt
261 t_monvoln%IVOLU(24) = ifunct_id(4)
262 t_monvoln%RVOLU(38) = sfmoutp
263 t_monvoln%IVOLU(25) = ifunct_id(5)
264 t_monvoln%RVOLU(39) = sfp0
265 t_monvoln%IVOLU(26) = ifunct_id(6)
266 t_monvoln%RVOLU(40) = sfpmax
267
268 t_monvoln%RVOLU(26) = one / scal_t
269 t_monvoln%RVOLU(27) = one / scal_p
270 t_monvoln%RVOLU(28) = one
271 t_monvoln%RVOLU(29) = one
272 t_monvoln%RVOLU(30) = one
273
274 t_monvoln%RVOLU(34) = rhoi
275C
276 veps = max(zero, vmin - vol)
277 t_monvoln%RVOLU(4) = vol + veps
278 t_monvoln%RVOLU(17) = veps
279 t_monvoln%RVOLU(20)= rhoi*vol
280C
281 amu = zero
282 t_monvoln%RVOLU(2) = amu
283 t_monvoln%RVOLU(16) = vol + veps
284 t_monvoln%RVOLU(18) = sa
285 t_monvoln%RVOLU(21) = rot
286 t_monvoln%RVOLU(22:24) = zero
287
288C =========
289C Print out
290C =========
291 WRITE(iout, 1005) surfid
292 WRITE(iout, 1003) scal_t, scal_p
293 WRITE(iout, 1002) sa, sv, vol
294 WRITE(iout,1800) rhoi, ifbulk, sfbulk, ifmin, sfmin, ifmoutt, sfmoutt,
295 . ifmoutp, sfmoutp, ifp0, sfp0, ifpmax, sfpmax
296C-----------------------------------------------
297C E n d o f s o u r c e
298C-----------------------------------------------
299
300 RETURN
301 1002 FORMAT(
302 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
303 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
304 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
305 1003 FORMAT(
306 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
307 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13)
308 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
309
310 1800 FORMAT(
311 . 5x,'FLUID DENSITY. . . . . . . . . . . . . . . . . . . . . =',1pg20.13,
312 . /5x,'BULK TIME FUNCTION. . . . . . . . . . . . . . . . . . .=',i10,
313 . /5x,'BULK TIME FUNCTION SCALE FACTOR. . . . . . . . . . . . =',1pg20.13,
314 . /5x,'INPUT MASS FLOW RATE TIME FUNCTION. . . . . . . . . . .=',i10,
315 . /5x,'INPUT MASS FLOW RATE TIME FUNCTION SCALE FACTOR. . . . =',1pg20.13,
316 . /5x,'OUTPUT MASS FLOW RATE TIME FUNCTION. . . . . . . . . . =',i10,
317 . /5x,'OUTPUT MASS FLOW RATE TIME FUNCTION SCALE FACTOR. . . .=',1pg20.13,
318 . /5x,'OUTPUT MASS FLOW RATE PRESSURE FUNCTION. . . . . . . . =',i10,
319 . /5x,'OUTPUT MASS FLOW RATE PRESSURE FUNCTION SCALE FACTOR. .=',1pg20.13,
320 . /5x,'ADDITIONAL PRESSURE TIME FUNCTION. . . . . . . . . . . =',i10,
321 . /5x,'ADDITIONAL PRESSURE TIME FUNCTION SCALE FACTOR. . . . .=',1pg20.13,
322 . /5x,'MAXIMUM PRESSURE TIME FUNCTION. . . . . . . . . . . . .=',i10,
323 . /5x,'MAXIMUM PRESSURE TIME FUNCTION SCALE FACTOR. . . . . . =',1pg20.13)
324 END SUBROUTINE hm_read_monvol_type10
325 END MODULE hm_read_monvol_type10_mod
check_function_id
subroutine check_function_id(npc, nfunct, ifunct_in, ifunct_out, ifound)
Definition check_function.F:29
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: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_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
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:1257
monvol_struct_mod
Definition monvol_struct_mod.F:66
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
starter
program starter
Definition starter.F:39
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84
submodel_mod::submodel_data
Definition submodel_mod.F:728
unitab_mod::unit_type_
Definition unitab_mod.F:524