51
52
53
60
61
62
63#include "implicit_f.inc"
64
65
66
67
68#include "com04_c.inc"
69
70
71#include "param_c.inc"
72
73#include "units_c.inc"
74
75
76
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
84
85
86
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
94
95
96
97
98
99
100
101 CALL hm_get_intv(
'entityiddisplayed', surfid, is_available, lsubmodel)
102
103 CALL hm_get_floatv(
'Scal_T', scal_t, is_available, lsubmodel, unitab)
104
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)
108
109
110
111
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
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)
128 ENDIF
129
130
132
134 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 2)
135
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)
139
141 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 2)
142
143
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
157
158
159
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)
164
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
172
173 IF (ffunc == zero) THEN
174 ffunc = one * fac_c
175 ENDIF
176
177
178
179
180 t_monvoln%RVOLU(15) = ffunc
181
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
187
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
196
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
204
205
206
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
211
212
213
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)'/)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
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)