50
51
52
58 use element_mod , only : nixc,nixtg
59
60
61
62#include "implicit_f.inc"
63
64
65
66
67#include "com04_c.inc"
68
69
70#include "param_c.inc"
71
72#include "units_c.inc"
73
74
75
76 TYPE(UNIT_TYPE_), INTENT(IN) :: UNITAB
77 INTEGER, INTENT(IN) :: LUID
78 INTEGER, INTENT(IN) :: 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
83
84
85
86 INTEGER :: II
87 INTEGER :: SURFID
88 my_real :: fac_m, fac_l, fac_t, fac_c
89 my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
90 LOGICAL :: FOUND
91 my_real :: sa, rot, vol, vmin, veps, amu, sv
92 LOGICAL :: IS_AVAILABLE
93
94
95
96
97 is_available = .false.
98
99
100
101
102 CALL hm_get_intv(
'surf_IDex', surfid, is_available, lsubmodel)
103
104
105
106
107 t_monvoln%IVOLU(4) = 0
108 found = .false.
109 DO ii = 1, nsurf
110 IF (surfid == igrsurf(ii)%ID) THEN
111 t_monvoln%IVOLU(4) = ii
112 t_monvoln%EXT_SURFID = ii
113 found = .true.
114 EXIT
115 ENDIF
116 ENDDO
117 IF (.NOT. found) THEN
119 ELSEIF (igrsurf(t_monvoln%IVOLU(4))%ISH4N3N == 0) THEN
120 CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
121 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
123 ENDIF
124
125
127
129 . igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 1)
130
131 CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID),
132 . itab, x, pm, geo, ixc, ixtg,
133 . sa, rot, vol, vmin, veps, sv)
134
136 . igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 1)
137
138
139
140
141 fac_m = unitab%FAC_M(luid)
142 fac_l = unitab%FAC_L(luid)
143 fac_t = unitab%FAC_T(luid)
144 fac_c = fac_m / (fac_l * fac_t * fac_t)
145
146
147 scal_t = one * fac_t
148 scal_p = one * fac_c
149 scal_s = one * fac_l * fac_l
150 scal_a = one
151 scal_d = one * fac_l
152
153
154
155
156 t_monvoln%RVOLU(26) = one / scal_t
157 t_monvoln%RVOLU(27) = one / scal_p
158 t_monvoln%RVOLU(28) = one / scal_s
159 t_monvoln%RVOLU(29) = one / scal_a
160 t_monvoln%RVOLU(30) = one / scal_d
161
162 amu = zero
163 t_monvoln%RVOLU(2) = amu
164 t_monvoln%RVOLU(16) = vol + veps
165 t_monvoln%RVOLU(18) = sa
166 t_monvoln%RVOLU(21) = rot
167 t_monvoln%RVOLU(22:24) = zero
168
169
170
171
172 WRITE(iout, 1005) surfid
173 WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
174 WRITE(iout, 1002) sa, sv, vol
175
176
177
178
179 RETURN
180 1002 FORMAT(
181 . /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
182 . /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
183 . /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)
184 1003 FORMAT(
185 . 5x,'UNIT SCALE FOR TIME FUNCTIONS =',1pg20.13,
186 . /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS =',1pg20.13,
187 . /5x,'UNIT SCALE FOR AREA FUNCTIONS =',1pg20.13,
188 . /5x,'UNIT SCALE FOR ANGLE FUNCTIONS =',1pg20.13,
189 . /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS =',1pg20.13)
190 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
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)