File: /nfs/home/0/users/jenkins/mfix.git/model/des/comp_mean_fields0.f
1
2
3 SUBROUTINE COMP_MEAN_FIELDS0
4
5
6
7
8 USE param
9 USE param1
10 USE parallel
11 USE constant
12 USE physprop
13 USE fldvar
14 USE run
15 USE geometry
16 USE indices
17 USE bc
18 USE compar
19 USE sendrecv
20 USE discretelement
21 USE drag
22 USE interpolation
23 use desmpi
24 USE cutcell
25 USE mfix_pic
26 USE mpi_utility
27
28
29 use mpi_node_des, only: des_addnodevalues_mean_fields
30 use particle_filter, only: DES_REPORT_MASS_INTERP
31
32
33 use functions, only: FLUID_AT
34 use functions, only: FUNIJK
35 use functions, only: IS_ON_myPE_wobnd
36
37 IMPLICIT NONE
38
39
40
41
42 INTEGER :: I, J, K, IJK, &
43 II, JJ, KK
44 INTEGER :: I1, I2, J1, J2, K1, K2
45 INTEGER :: IDIM, IJK2
46 INTEGER :: ICUR, JCUR, KCUR, CUR_IJK
47
48
49 INTEGER :: IW, IE, JS, JN, KB, KTP
50
51
52 INTEGER, DIMENSION(3):: PCELL
53
54
55
56 INTEGER :: ONEW
57
58
59 DOUBLE PRECISION :: AVG_FACTOR
60
61 INTEGER :: M
62
63 INTEGER :: NP, NINDX
64
65 DOUBLE PRECISION :: WTP
66
67 DOUBLE PRECISION :: OEPS
68
69 DOUBLE PRECISION :: MASS_SOL1, MASS_SOL2
70
71 DOUBLE PRECISION :: MASS_SOL1_ALL, MASS_SOL2_ALL
72
73 DOUBLE PRECISION :: TEMP1, TEMP2
74
75 DOUBLE PRECISION, DIMENSION(3) :: DES_VEL_DENSITY
76 DOUBLE PRECISION :: DES_ROP_DENSITY
77
78 INTEGER :: COUNT_NODES_OUTSIDE, COUNT_NODES_INSIDE, &
79 COUNT_NODES_INSIDE_MAX
80 double precision :: RESID_ROPS(DES_MMAX), &
81 RESID_VEL(3, DES_MMAX)
82 double precision :: NORM_FACTOR, VOL_RATIO
83
84 DOUBLE PRECISION, DIMENSION(2,2,2,3) :: gst_tmp
85 DOUBLE PRECISION, DIMENSION(2,2,2) :: weight_ft
86
87
88
89 = ZERO
90 MASS_SOL2 = ZERO
91 MASS_SOL1_ALL = ZERO
92 MASS_SOL2_ALL = ZERO
93
94 = merge(0.5d0, 0.25D0, NO_K)
95
96
97 = merge(4, 8, NO_K)
98
99
100
101 = ZERO
102 DES_ROPS_NODE = ZERO
103 DES_ROP_S = zero
104 DES_U_S = ZERO
105 DES_V_S = ZERO
106 IF(DO_K) DES_W_S = ZERO
107
108
109
110
111 CALL SET_INTERPOLATION_SCHEME(2)
112
113
114
115
116
117
118
119 DO IJK = IJKSTART3,IJKEND3
120
121
122
123 IF(.NOT.FLUID_AT(IJK)) CYCLE
124 IF( PINC(IJK) == 0) CYCLE
125
126 PCELL(1) = I_OF(IJK)-1
127 PCELL(2) = J_OF(IJK)-1
128 PCELL(3) = merge(K_OF(IJK)-1, 1, DO_K)
129
130
131
132 CALL SET_INTERPOLATION_STENCIL(PCELL, IW, IE, JS, JN, KB, KTP,&
133 INTERP_SCHEME, DIMN, ORDERNEW=ONEW)
134
135 COUNT_NODES_OUTSIDE = 0
136
137 DO K=1, merge(1, ONEW, NO_K)
138 DO J=1, ONEW
139 DO I=1, ONEW
140
141 II = IW + I-1
142 JJ = JS + J-1
143 KK = KB + K-1
144 CUR_IJK = funijk_map_c(II,JJ,KK)
145
146 GST_TMP(I,J,K,1) = XE(II)
147 GST_TMP(I,J,K,2) = YN(JJ)
148 GST_TMP(I,J,K,3) = merge(DZ(1), ZT(KK), NO_K)
149
150 IF(CARTESIAN_GRID) THEN
151 IF(SCALAR_NODE_ATWALL(CUR_IJK)) &
152 COUNT_NODES_OUTSIDE = COUNT_NODES_OUTSIDE + 1
153 ENDIF
154
155 ENDDO
156 ENDDO
157 ENDDO
158
159
160
161
162
163
164 DO NINDX=1, PINC(IJK)
165 NP = PIC(IJK)%P(NINDX)
166
167 call DRAG_WEIGHTFACTOR(gst_tmp,des_pos_new(:,np),weight_ft)
168
169 M = PIJK(NP,5)
170 WTP = ONE
171 IF(MPPIC) WTP = DES_STAT_WT(NP)
172
173 MASS_SOL1 = MASS_SOL1 + PMASS(NP)*WTP
174
175 TEMP2 = DES_RO_S(M)*PVOL(NP)*WTP
176
177 DO K = 1, merge(1, ONEW, NO_K)
178 DO J = 1, ONEW
179 DO I = 1, ONEW
180
181 = IW + I-1
182 JJ = JS + J-1
183 KK = KB + K-1
184
185 CUR_IJK = FUNIJK_MAP_C(II,JJ,KK)
186
187 TEMP1 = WEIGHT_FT(I,J,K)*TEMP2
188
189 DES_ROPS_NODE(CUR_IJK,M) = DES_ROPS_NODE(CUR_IJK,M) + &
190 TEMP1
191
192 DES_VEL_NODE(CUR_IJK,:,M) = DES_VEL_NODE(CUR_IJK,:,M) + &
193 TEMP1*DES_VEL_NEW(:,NP)
194 ENDDO
195 ENDDO
196 ENDDO
197 ENDDO
198
199
200
201
202
203
204
205
206
207 IF (CARTESIAN_GRID) THEN
208
209
210 = &
211 COUNT_NODES_INSIDE_MAX - COUNT_NODES_OUTSIDE
212
213 IF(COUNT_NODES_INSIDE.LT.COUNT_NODES_INSIDE_MAX) THEN
214
215
216 (1:DES_MMAX) = ZERO
217 RESID_VEL(:, 1:DES_MMAX) = ZERO
218
219
220
221
222
223
224
225
226
227 = I_OF(IJK)
228 J = J_OF(IJK)
229 K = K_OF(IJK)
230 I1 = I-1
231 I2 = I
232 J1 = J-1
233 J2 = J
234 K1 = merge(K, K-1, NO_K)
235 K2 = K
236
237
238
239 DO KK = K1, K2
240 DO JJ = J1, J2
241 DO II = I1, I2
242
243 IJK2 = funijk(II, JJ, KK)
244
245 IF(SCALAR_NODE_ATWALL(IJK2)) THEN
246 RESID_ROPS(1:DES_MMAX) = RESID_ROPS(1:DES_MMAX) + &
247 DES_ROPS_NODE(IJK2,1:DES_MMAX)
248
249 DES_ROPS_NODE(IJK2,1:DES_MMAX) = ZERO
250 DO IDIM = 1, merge(2,3,NO_K)
251 RESID_VEL(IDIM, 1:DES_MMAX) = &
252 RESID_VEL(IDIM, 1:DES_MMAX) + &
253 DES_VEL_NODE(IJK2,IDIM, 1:DES_MMAX)
254 DES_VEL_NODE(IJK2,IDIM, 1:DES_MMAX) = ZERO
255 ENDDO
256 ENDIF
257 ENDDO
258 ENDDO
259 ENDDO
260
261
262 = ONE/REAL(COUNT_NODES_INSIDE)
263 DO KK = K1, K2
264 DO JJ = J1, J2
265 DO II = I1, I2
266 IJK2 = funijk(II, JJ, KK)
267
268 IF(.NOT.SCALAR_NODE_ATWALL(IJK2)) THEN
269 DES_ROPS_NODE(IJK2,1:DES_MMAX) = &
270 DES_ROPS_NODE(IJK2,1:DES_MMAX) + &
271 RESID_ROPS(1:DES_MMAX)*NORM_FACTOR
272 DO IDIM = 1, merge(2,3,NO_K)
273 DES_VEL_NODE(IJK2,IDIM, 1:DES_MMAX) = &
274 DES_VEL_NODE(IJK2,IDIM, 1:DES_MMAX) + &
275 RESID_VEL(IDIM, 1:DES_MMAX)*NORM_FACTOR
276 ENDDO
277 ENDIF
278
279 ENDDO
280 ENDDO
281 ENDDO
282 ENDIF
283 ENDIF
284 ENDDO
285
286
287
288
289
290
291
292
293 CALL DES_ADDNODEVALUES_MEAN_FIELDS
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325 DO K = KSTART2, KEND1
326 DO J = JSTART2, JEND1
327 DO I = ISTART2, IEND1
328 IF (DEAD_CELL_AT(I,J,K)) CYCLE
329 = funijk(I,J,K)
330 if (VOL_SURR(IJK).eq.ZERO) CYCLE
331
332
333 DO M = 1, DES_MMAX
334
335 DES_ROP_DENSITY = DES_ROPS_NODE(IJK, M)/VOL_SURR(IJK)
336 DES_VEL_DENSITY(:) = DES_VEL_NODE(IJK, :, M)/VOL_SURR(IJK)
337
338 DO KK = K, merge(K+1, K, DO_K)
339 DO JJ = J, J+1
340 DO II = I, I+1
341 IF (DEAD_CELL_AT(II,JJ,KK)) CYCLE
342
343 = funijk_map_c(II, JJ, KK)
344 IF(FLUID_AT(IJK2).and.(IS_ON_myPE_wobnd(II, JJ, KK))) THEN
345
346
347
348
349 (IJK2, M) = DES_ROP_S(IJK2, M) + DES_ROP_DENSITY*VOL(IJK2)
350 DES_U_S(IJK2, M) = DES_U_S(IJK2, M) + DES_VEL_DENSITY(1)*VOL(IJK2)
351 DES_V_S(IJK2, M) = DES_V_S(IJK2, M) + DES_VEL_DENSITY(2)*VOL(IJK2)
352 IF(DO_K) DES_W_S(IJK2, M) = DES_W_S(IJK2, M) + DES_VEL_DENSITY(3)*VOL(IJK2)
353 ENDIF
354 ENDDO
355 ENDDO
356 ENDDO
357 ENDDO
358 ENDDO
359 ENDDO
360 ENDDO
361
362
363
364
365
366
367
368
369 DO IJK = IJKSTART3, IJKEND3
370 IF(.NOT.FLUID_AT(IJK)) CYCLE
371
372 DO M = 1, DES_MMAX
373 IF(DES_ROP_S(IJK, M).GT.ZERO) THEN
374 DES_U_S(IJK, M) = DES_U_S(IJK,M)/DES_ROP_S(IJK, M)
375 DES_V_S(IJK, M) = DES_V_S(IJK,M)/DES_ROP_S(IJK, M)
376 IF(DO_K) DES_W_S(IJK, M) = DES_W_S(IJK,M)/DES_ROP_S(IJK, M)
377
378
379 (IJK, M) = DES_ROP_S(IJK, M)/VOL(IJK)
380
381 ENDIF
382 ENDDO
383 ENDDO
384
385
386
387 IF (MPPIC) CALL SEND_RECV(DES_ROP_S,2)
388
389 CALL CALC_EPG_DES
390
391
392 IF(MPPIC) THEN
393
394
395 CALL SEND_RECV(DES_U_S,2)
396 CALL SEND_RECV(DES_V_S,2)
397 IF(DO_K) CALL SEND_RECV(DES_W_S,2)
398
399
400
401
402
403
404
405
406
407
408
409
410 IF(.NOT.CARTESIAN_GRID) THEN
411 CALL MPPIC_COMP_EULERIAN_VELS_NON_CG
412 ELSE
413 CALL MPPIC_COMP_EULERIAN_VELS_CG
414 ENDIF
415 ENDIF
416
417
418
419
420 IF(DES_REPORT_MASS_INTERP) THEN
421
422
423 DO IJK = IJKSTART3, IJKEND3
424 IF(.NOT.FLUID_AT(IJK)) CYCLE
425
426 I = I_OF(IJK)
427 J = J_OF(IJK)
428 K = K_OF(IJK)
429
430
431 IF(IS_ON_myPE_wobnd(I,J,K)) MASS_SOL2 = MASS_SOL2 + &
432 sum(DES_ROP_S(IJK,1:DES_MMAX))*VOL(IJK)
433 ENDDO
434
435
436 CALL GLOBAL_SUM(MASS_SOL1, MASS_SOL1_ALL)
437 CALL GLOBAL_SUM(MASS_SOL2, MASS_SOL2_ALL)
438 if(myPE.eq.pe_IO) THEN
439 WRITE(*,'(/,5x,A,4(2x,g17.8),/)') &
440 'SOLIDS MASS DISCRETE AND CONTINUUM = ', &
441 MASS_SOL1_ALL, MASS_SOL2_ALL
442 ENDIF
443 ENDIF
444 END SUBROUTINE COMP_MEAN_FIELDS0
445
446
447
448
449
450
451
452
453
454
455
456 SUBROUTINE DRAG_WEIGHTFACTOR(GSTEN,DESPOS,WEIGHTFACTOR)
457
458 use geometry, only: NO_K
459
460 IMPLICIT NONE
461
462
463
464
465 DOUBLE PRECISION, DIMENSION(2,2,2,3), INTENT(IN):: GSTEN
466 DOUBLE PRECISION, DIMENSION(3), INTENT(IN):: DESPOS
467 DOUBLE PRECISION, DIMENSION(2,2,2), INTENT(OUT) :: WEIGHTFACTOR
468 INTEGER :: II, JJ, KK
469
470 DOUBLE PRECISION, DIMENSION(2) :: XXVAL, YYVAL, ZZVAL
471 DOUBLE PRECISION :: DXX, DYY, DZZ
472 DOUBLE PRECISION, DIMENSION(3) :: ZETAA
473
474 DXX = GSTEN(2,1,1,1) - GSTEN(1,1,1,1)
475 DYY = GSTEN(1,2,1,2) - GSTEN(1,1,1,2)
476
477 ZETAA(1:2) = DESPOS(1:2) - GSTEN(1,1,1,1:2)
478
479 ZETAA(1) = ZETAA(1)/DXX
480 ZETAA(2) = ZETAA(2)/DYY
481
482 XXVAL(1)=1-ZETAA(1)
483 YYVAL(1)=1-ZETAA(2)
484 XXVAL(2)=ZETAA(1)
485 YYVAL(2)=ZETAA(2)
486
487 IF(NO_K) THEN
488 DO JJ=1,2
489 DO II=1,2
490 WEIGHTFACTOR(II,JJ,1) = XXVAL(II)*YYVAL(JJ)
491 ENDDO
492 ENDDO
493 ELSE
494 DZZ = GSTEN(1,1,2,3) - GSTEN(1,1,1,3)
495 ZETAA(3) = DESPOS(3) - GSTEN(1,1,1,3)
496 ZETAA(3) = ZETAA(3)/DZZ
497 ZZVAL(1)=1-ZETAA(3)
498 ZZVAL(2)=ZETAA(3)
499 DO KK=1,2
500 DO JJ=1,2
501 DO II=1,2
502 WEIGHTFACTOR(II,JJ,KK) = XXVAL(II)*YYVAL(JJ)*ZZVAL(KK)
503 ENDDO
504 ENDDO
505 ENDDO
506 ENDIF
507
508 END SUBROUTINE DRAG_WEIGHTFACTOR
509