File: N:\mfix\model\des\pic\report_stats_pic.f
1
2
3
4
5
6
7
8 SUBROUTINE REPORT_STATS_PIC
9
10
11
12
13 use mfix_pic, only: PIC_REPORT_MIN_EPG
14
15 use fldvar, only: EP_G
16
17 use discretelement, only: XE, YN, ZT
18
19 use param1, only: large_number
20 use mpi_utility
21 USE error_manager
22 USE functions
23
24 IMPLICIT NONE
25
26
27
28
29 INTEGER I, J, K, IJK, IPROC
30
31 INTEGER :: EPg_MIN_loc(0:numpes-1, 4), EPg_MIN_loc2(1)
32 DOUBLE PRECISION :: EPg_MIN(0:numpes-1), EPg_min2
33
34
35
36 CALL INIT_ERR_MSG("REPORT_STATS_PIC")
37
38
39 IF(PIC_REPORT_MIN_EPG) THEN
40
41 EPG_MIN(:) = 0
42 EPG_MIN(mype) = LARGE_NUMBER
43
44 EPG_MIN_LOC(:,:) = 0
45 EPG_MIN_LOC(mype,:) = -1
46
47 DO K = KSTART1, KEND1
48 DO J = JSTART1, JEND1
49 DO I = ISTART1, IEND1
50 IJK = funijk(I,J,K)
51
52 IF(EP_G(IJK) < EPG_MIN(mype)) THEN
53 EPG_MIN_LOC(mype,1) = I
54 EPG_MIN_LOC(mype,2) = J
55 EPG_MIN_LOC(mype,3) = K
56 EPG_MIN_LOC(mype,4) = IJK
57 EPG_MIN(mype) = EP_G(IJK)
58 ENDIF
59 ENDDO
60 ENDDO
61 ENDDO
62
63 call GLOBAL_ALL_SUM(EPg_MIN)
64 CALL GLOBAL_ALL_SUM(EPg_MIN_loc)
65
66 epg_min2 = MINVAL(epg_min(0:numpes-1))
67 epg_min_loc2 = MINLOC(epg_min(0:numpes-1)) - 1
68
69
70
71 = epg_min_loc2(1)
72
73 I = epg_min_loc(iproc, 1)
74 J = epg_min_loc(iproc, 2)
75 K = epg_min_loc(iproc, 3)
76 IJK = epg_min_loc(iproc, 4)
77 WRITE(ERR_MSG,1014) EPG_MIN2, Iproc, I, J, K, IJK, &
78 XE(I) - 0.5*DX(I), YN(J)-0.5*DY(J), ZT(K) - 0.5*DZ(K)
79
80 1014 FORMAT( /, &
81 & 5x,'EPGMIN = ', 2x,g17.8,/ &
82 & 5x,'EPGMIN PROC RANK = ', 2x, I10, / &
83 & 5x,'EPGMIN (I, J, K, IJK) = ', 3(2x,i5),2x,i10,/ &
84 & 5x,'XMID, YMID, ZMID FOR CELL = ', 3(2x,g17.8))
85
86 call flush_err_msg(header = .false., footer = .false.)
87
88 ENDIF
89
90 CALL FINL_ERR_MSG
91
92 RETURN
93 END SUBROUTINE REPORT_STATS_PIC
94
95
96