File: RELATIVE:/../../../mfix.git/model/calc_vol_fr.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 SUBROUTINE CALC_VOL_FR(P_STAR, RO_G, ROP_G, EP_G, ROP_S, IER)
19
20
21
22
23 USE param
24 USE param1
25 USE parallel
26 USE run
27 USE geometry
28 USE indices
29 USE physprop
30 USE visc_s
31 USE constant
32 USE pgcor
33 USE pscor
34 USE compar
35 USE sendrecv
36 USE discretelement
37 USE mpi_utility
38 use fldvar, only: RO_S, EP_S
39 USE solids_pressure
40 USE functions
41
42 IMPLICIT NONE
43
44
45
46
47 DOUBLE PRECISION, INTENT(IN) :: P_star(DIMENSION_3)
48
49 DOUBLE PRECISION, INTENT(INOUT) :: RO_g(DIMENSION_3)
50
51 DOUBLE PRECISION, INTENT(INOUT) :: ROP_g(DIMENSION_3)
52
53 DOUBLE PRECISION, INTENT(INOUT) :: EP_g(DIMENSION_3)
54
55 DOUBLE PRECISION, INTENT(INOUT) :: ROP_s(DIMENSION_3, DIMENSION_M)
56
57 INTEGER, INTENT(INOUT) :: IER
58
59
60
61
62 DOUBLE PRECISION :: VOL_M
63
64 DOUBLE PRECISION :: EPcp
65
66 DOUBLE PRECISION :: EPS
67
68 DOUBLE PRECISION :: SUMVF
69
70
71
72
73 INTEGER :: MF
74
75
76
77
78
79 INTEGER :: MCPl
80
81 INTEGER :: M
82
83 INTEGER :: IJK
84
85
86
87
88 INTEGER :: Err_l(0:numPEs-1)
89 INTEGER :: Err_g(0:numPEs-1)
90
91 LOGICAL, PARAMETER :: REPORT_NEG_VOLFRAC = .TRUE.
92
93
94 LOGICAL :: wHeader
95
96
97
98
99 = .TRUE.
100
101 = 0
102
103
104
105
106 DO IJK = ijkstart3, ijkend3
107 IF (FLUID_AT(IJK)) THEN
108
109
110
111
112
113
114 IF (PHASE_4_P_S(IJK) /= UNDEFINED_I) THEN
115
116
117
118
119
120
121
122 = PHASE_4_P_s(IJK)
123
124
125
126 = 1. - INV_H(P_STAR(IJK),EP_g_blend_end(ijk))
127
128
129
130 = ZERO
131 DO M = 1, MMAX
132 IF (CLOSE_PACKED(M) .AND. M/=MCPl) SUMVF = SUMVF + EP_S(IJK,M)
133 ENDDO
134
135 IF (DES_CONTINUUM_HYBRID) THEN
136 DO M = 1,DES_MMAX
137 EPS = DES_ROP_S(IJK,M)/DES_RO_S(M)
138 SUMVF = SUMVF + EPS
139 ENDDO
140 ENDIF
141 ROP_S(IJK,MCPl) = (EPCP - SUMVF)*RO_S(IJK,MCPl)
142 ENDIF
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161 = PHASE_4_P_G(IJK)
162
163 SUMVF = ZERO
164 IF (0 /= MF) THEN
165
166
167 (IJK) = ROP_G(IJK)/RO_G(IJK)
168 SUMVF = SUMVF + EP_G(IJK)
169 ENDIF
170
171
172 IF(KT_TYPE_ENUM == GHD_2007) THEN
173 ROP_S(IJK,MMAX) = ZERO
174 DO M = 1, SMAX
175
176 = PI*D_P0(M)**3/6d0
177 IF (M /= MF) THEN
178 SUMVF = SUMVF + EP_S(IJK,M)
179 ROP_S(IJK,MMAX) = ROP_S(IJK,MMAX) + RO_S(IJK,M)*EP_S(IJK,M)
180 ENDIF
181 ENDDO
182 ELSE
183
184
185
186 DO M = 1, MMAX
187 IF (M /= MF) SUMVF = SUMVF + EP_S(IJK,M)
188 ENDDO
189 ENDIF
190
191
192 IF (DES_CONTINUUM_HYBRID) THEN
193 DO M = 1,DES_MMAX
194 EPS = DES_ROP_S(IJK,M)/DES_RO_S(M)
195 SUMVF = SUMVF + EPS
196 ENDDO
197 ENDIF
198
199 IF (0 == MF) THEN
200
201
202
203 (IJK) = ONE - SUMVF
204
205
206 IF (EP_G(IJK) < ZERO) THEN
207 Err_l(myPE) = 110
208 IF(REPORT_NEG_VOLFRAC) CALL EPgErr_LOG(IJK, wHeader)
209 ENDIF
210
211 ROP_G(IJK) = EP_G(IJK)*RO_G(IJK)
212 ELSE
213
214 (IJK,MF) = (ONE - SUMVF)*RO_S(IJK,MF)
215 ENDIF
216
217
218 ENDIF
219 ENDDO
220
221 CALL send_recv(EP_G, 2)
222 CALL send_recv(ROP_G, 2)
223 CALL send_recv(ROP_S, 2)
224
225 CALL global_all_sum(Err_l, Err_g)
226 IER = maxval(Err_g)
227
228
229 RETURN
230 END SUBROUTINE CALC_VOL_FR
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247 SUBROUTINE SET_EP_FACTORS
248
249
250
251 use compar, only: ijkstart3, ijkend3
252 use fldvar, only: ep_g, ep_s
253 use fldvar, only: epg_ifac, eps_ifac, epg_jfac
254 use param1, only: one, undefined
255 use physprop, only: mmax, mu_s0
256 use run, only: jackson, ishii
257 IMPLICIT NONE
258
259
260
261 INTEGER :: ijk, m
262
263 (:) = one
264 epg_ifac(:) = one
265 eps_ifac(:,:) = one
266
267 if (jackson) then
268 do ijk = ijkstart3, ijkend3
269 epg_jfac(ijk) = ep_g(ijk)
270 enddo
271 endif
272 if (ishii) then
273 do ijk = ijkstart3, ijkend3
274 epg_ifac(ijk) = ep_g(ijk)
275 do m = 1, mmax
276
277
278 IF (mu_s0(m) /= undefined) THEN
279 eps_ifac(ijk,m) = ep_s(ijk,m)
280 ENDIF
281 enddo
282 enddo
283 endif
284
285 RETURN
286 END SUBROUTINE SET_EP_FACTORS
287
288
289
290
291
292
293
294
295
296
297
298 SUBROUTINE EPgErr_LOG(IJK, tHeader)
299
300
301 use run, only: TIME
302
303 use fldvar, only: EP_g, EP_s, ROP_s, RO_s, U_s, V_s, W_s
304 use cutcell
305
306 use physprop, only: SMAX
307 use compar
308 use indices
309 use functions
310 use error_manager
311
312
313 IMPLICIT NONE
314
315 INTEGER, intent(in) :: IJK
316 LOGICAL, intent(inout) :: tHeader
317
318 LOGICAL :: lExists
319 CHARACTER(LEN=255) :: lFile
320 INTEGER, parameter :: lUnit = 4868
321 LOGICAL, save :: fHeader = .TRUE.
322
323 INTEGER :: M
324
325 lFile = '';
326 if(numPEs > 1) then
327 write(lFile,"('EPgErr_',I4.4,'.log')") myPE
328 else
329 write(lFile,"('EPgErr.log')")
330 endif
331 inquire(file=trim(lFile),exist=lExists)
332 if(lExists) then
333 open(lUnit,file=trim(adjustl(lFile)), &
334 status='old', position='append')
335 else
336 open(lUnit,file=trim(adjustl(lFile)), status='new')
337 endif
338
339 if(fHeader) then
340 write(lUnit,1000)
341 fHeader = .FALSE.
342 endif
343
344 if(tHeader) then
345 write(lUnit,"(/2x,'Simulation time: ',g12.5)") TIME
346 tHeader = .FALSE.
347 endif
348
349 write(lUnit,1001) IJK, I_OF(IJK), J_OF(IJK), K_OF(IJK)
350 write(lUnit,"(6x,A,1X,g12.5)",ADVANCE='NO') 'EP_g:', EP_g(IJK)
351 DO M=1,SMAX
352 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
353 trim(iVar('EP_s',M)), EP_s(IJK,M)
354 ENDDO
355 write(lUnit,"(' ')")
356
357 write(lUnit,"(24x)", ADVANCE='NO')
358 DO M=1,SMAX
359 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
360 trim(iVar('RO_s',M)), RO_s(IJK,M)
361 ENDDO
362 write(lUnit,"(' ')")
363
364 write(lUnit,"(24x)", ADVANCE='NO')
365 DO M=1,SMAX
366 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
367 trim(iVar('ROPs',M)), ROP_s(IJK,M)
368 ENDDO
369 write(lUnit,"(24x,' ')")
370
371
372 write(lUnit,"(24x)", ADVANCE='NO')
373 DO M=1,SMAX
374 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
375 trim(iVar('U_se',M)), U_s(IJK,M)
376 ENDDO
377 write(lUnit,"(24x,' ')")
378
379 write(lUnit,"(24x)", ADVANCE='NO')
380 DO M=1,SMAX
381 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
382 trim(iVar('V_sn',M)), V_s(IJK,M)
383 ENDDO
384 write(lUnit,"(24x,' ')")
385
386 write(lUnit,"(24x)", ADVANCE='NO')
387 DO M=1,SMAX
388 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
389 trim(iVar('W_st',M)), W_s(IJK,M)
390 ENDDO
391 write(lUnit,"(24x,' ')")
392
393 write(lUnit,"(24x)", ADVANCE='NO')
394 DO M=1,SMAX
395 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
396 trim(iVar('U_sw',M)), U_s(WEST_OF(IJK),M)
397 ENDDO
398 write(lUnit,"(24x,' ')")
399
400 write(lUnit,"(24x)", ADVANCE='NO')
401 DO M=1,SMAX
402 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
403 trim(iVar('V_ss',M)), V_s(SOUTH_OF(IJK),M)
404 ENDDO
405 write(lUnit,"(24x,' ')")
406
407 write(lUnit,"(24x)", ADVANCE='NO')
408 DO M=1,SMAX
409 write(lUnit,"(2x,A,1X,g12.5)", ADVANCE='NO') &
410 trim(iVar('W_sb',M)), W_s(BOTTOM_OF(IJK),M)
411 ENDDO
412 write(lUnit,"(24x,' ')")
413
414
415 if(CARTESIAN_GRID) then
416 write(lUnit,"(6x,A,1X,L1)",ADVANCE='NO') 'Cut Cell:', CUT_CELL_AT(IJK)
417 write(lUnit,"(6x,A,1X,L1)") 'Small Cell:', SMALL_CELL_AT(IJK)
418 write(lUnit,"(6x,'Coordinates (E/N/T): ',1X,3(2x, g17.8))") &
419 xg_e(I_OF(IJK)), yg_n(J_of(ijk)), zg_t(k_of(ijk))
420 endif
421
422 close(lUnit)
423
424 RETURN
425
426 1000 FORMAT('One or more cells have reported a negative gas volume ', &
427 'fraction (EP_g).',/)
428
429 1001 FORMAT(/4X,'IJK: ',I8,7X,'I: ',I4,' J: ',I4,' K: ',I4)
430
431 END SUBROUTINE EPgErr_LOG
432