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

Functions/Subroutines

subroutine hm_read_monvol_type2 (t_monvoln, unitab, luid, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_monvol_type2()

subroutine hm_read_monvol_type2_mod::hm_read_monvol_type2 ( type(monvol_struct_), intent(inout) t_monvoln,
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 48 of file hm_read_monvol_type2.F.

51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE unitab_mod
55 USE groupdef_mod
56 USE message_mod
58 USE submodel_mod
59 USE unitab_mod
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) :: LUID
79 INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
80 my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *)
81 TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
82 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
83 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER :: II
88 INTEGER :: SURFID, IFUNC, ITYPFUN, LOC_IFUNC
89 my_real :: ffunc, fac_m, fac_l, fac_t, fac_c
90 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
91 LOGICAL :: FOUND
92 my_real :: sa, rot, vol, vmin, veps, amu, sv
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('entityiddisplayed', surfid, is_available, lsubmodel)
102C Line 2
103 CALL hm_get_floatv('Scal_T', scal_t, is_available, lsubmodel, unitab)
104C Line 3
105 CALL hm_get_intv('FUN_A1', ifunc, is_available, lsubmodel)
106 CALL hm_get_floatv('Ffunc', ffunc, is_available, lsubmodel, unitab)
107 CALL hm_get_intv('Itype', itypfun, is_available, lsubmodel)
108C ================
109C Check operations
110C ================
111C External surface check
112 t_monvoln%IVOLU(4) = 0
113 found = .false.
114 DO ii = 1, nsurf
115 IF (surfid == igrsurf(ii)%ID) THEN
116 t_monvoln%IVOLU(4) = ii
117 t_monvoln%EXT_SURFID = ii
118 found = .true.
119 EXIT
120 ENDIF
121 ENDDO
122 IF (.NOT. found) THEN
123 CALL freerr(3)
124 ELSEIF (igrsurf(t_monvoln%EXT_SURFID)%ISH4N3N == 0) THEN
125 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
126 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
127 CALL freerr(3)
128 ENDIF
129
130C Check surface closure
131 CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
132C Set all normal on same side
133 CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
134 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 2)
135C Compute Monvon volume
136 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
137 . itab, x, pm, geo, ixc, ixtg,
138 . sa, rot, vol, vmin, veps, sv)
139C Reverse all normals to ensure positive volume
140 CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab,
141 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 2)
142
143C Function id check
144 found = .false.
145 loc_ifunc = 0
146 DO ii = 1, nfunct
147 IF (ifunc == npc(ii)) THEN
148 loc_ifunc = ii
149 found = .true.
150 EXIT
151 ENDIF
152 ENDDO
153 IF (.NOT. found) THEN
154 CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
155 . i2 = ifunc, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'PRESSURE')
156 ENDIF
157C =====
158C Units
159C =====
160 fac_m = unitab%FAC_M(luid)
161 fac_l = unitab%FAC_L(luid)
162 fac_t = unitab%FAC_T(luid)
163 fac_c = fac_m / (fac_l * fac_t * fac_t)
164C Default value for time scale factor
165 IF (scal_t == zero) THEN
166 scal_t = one * fac_t
167 ENDIF
168 scal_p = one * fac_c
169 scal_s = one * fac_l * fac_l
170 scal_a = one
171 scal_d = one * fac_l
172C Default value for FFUNC
173 IF (ffunc == zero) THEN
174 ffunc = one * fac_c
175 ENDIF
176
177C =====
178C Store
179C =====
180 t_monvoln%RVOLU(15) = ffunc
181C Store in data structure
182 t_monvoln%RVOLU(26) = one / scal_t
183 t_monvoln%RVOLU(27) = one / scal_p
184 t_monvoln%RVOLU(28) = one / scal_s
185 t_monvoln%RVOLU(29) = one / scal_a
186 t_monvoln%RVOLU(30) = one / scal_d
187C
188 t_monvoln%RVOLU(3) = zero
189 veps = max(zero, vmin - vol)
190 t_monvoln%RVOLU(4) = vol + veps
191 t_monvoln%RVOLU(5) = zero
192 t_monvoln%RVOLU(12) = zero
193 t_monvoln%RVOLU(17) = veps
194 t_monvoln%IVOLU(7) = loc_ifunc
195 t_monvoln%IVOLU(19) = itypfun
196C
197 amu = zero
198 t_monvoln%RVOLU(2) = amu
199 t_monvoln%RVOLU(16) = vol + veps
200 t_monvoln%RVOLU(18) = sa
201 t_monvoln%RVOLU(21) = rot
202 t_monvoln%RVOLU(22:24) = zero
203
204C =========
205C Print out
206C =========
207 WRITE(iout, 1005) surfid
208 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
209 WRITE(iout, 1002) sa, sv, vol
210 WRITE(iout,1200) ifunc, itypfun
211C-----------------------------------------------
212C E n d o f s o u r c e
213C-----------------------------------------------
214
215 RETURN
216 1002 FORMAT(
217 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
218 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
219 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
220 1003 FORMAT(
221 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
222 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
223 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
224 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
225 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
226 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
227 1200 FORMAT( 5x,'LOAD CURVE NUMBER . . . . . . . . . . .=',i10,
228 . /5x,'CURVE TYPE . . . . . . . . . . . . . .=',i10,
229 . /5x,' 0 : P=F(1/V)',
230 . /5x,' 1 : P=F(T)',
231 . /5x,' 2 : P=F(V)',
232 . /5x,' 3 : P=(1/V) F(T)'/)
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
#define max(a, b)
Definition macros.h:21
subroutine monvol_compute_volume(t_monvoln, title, ivolu, surf, itab, node_coord, pm, geo, ixc, ixtg, sa, rot, vol, vmin, veps, sv)
subroutine monvol_check_surfclose(t_monvoln, itab, surf, x)
subroutine monvol_orient_surf(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, x, itype)
subroutine monvol_reverse_normals(t_monvoln, title, ivolu, itab, surf, ixc, ixtg, vol, x, itype)
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
subroutine freerr(it)
Definition freform.F:506