File: /nfs/home/0/users/jenkins/mfix.git/model/des/desmpi_mod.f
1
2
3
4
5
6
7
8 module desmpi
9
10
11 INTEGER :: iGhostPacketSize
12 INTEGER :: iParticlePacketSize
13 INTEGER :: iPairPacketSize
14
15
16 integer, dimension(:), allocatable :: ineighproc
17 logical, dimension(:), allocatable :: iexchflag
18
19
20 double precision, dimension(:,:), allocatable :: dcycl_offset
21
22
23 double precision, dimension(:,:), allocatable :: dsendbuf
24 double precision, dimension(:,:), allocatable :: drecvbuf
25
26 integer,dimension(:),allocatable:: isendcnt
27 integer,dimension(:),allocatable:: isendreq
28 integer,dimension(:),allocatable:: irecvreq
29
30 integer,parameter :: ibufoffset = 2
31
32
33 integer :: imaxbuf
34 integer :: ispot
35
36
37 double precision, dimension(:), allocatable :: drootbuf
38 double precision, dimension(:), allocatable :: dprocbuf
39 integer, dimension(:), allocatable :: irootbuf
40 integer, dimension(:), allocatable :: iprocbuf
41
42 integer,dimension(:), allocatable:: idispls
43 integer,dimension(:), allocatable:: iscattercnts
44 integer,dimension(:), allocatable:: igathercnts
45
46 integer :: iscr_recvcnt
47 integer :: igath_sendcnt
48
49
50 integer,dimension(:,:),allocatable :: isendindices
51 integer,dimension(:,:),allocatable :: irecvindices
52
53
54 double precision, dimension(:,:), allocatable:: dpar_pos
55 double precision, dimension(:,:), allocatable:: dpar_vel
56 double precision, dimension(:), allocatable:: dpar_den
57 double precision, dimension(:), allocatable:: dpar_rad
58
59 contains
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75 subroutine des_dbgmpi(ptype)
76
77 use discretelement, only: DES_POS_NEW
78 use discretelement, only: PEA
79 use discretelement, only: iGLOBAL_ID
80
81 use discretelement, only: S_TIME
82 use discretelement, only: DIMN
83 use discretelement, only: DO_NSEARCH
84 use discretelement, only: iGHOST_CNT
85 use discretelement, only: MAX_PIP, PIP
86
87 use geometry, only: NO_K
88 use compar, only: myPE
89
90 use desgrid, only: dg_funijk, iofpos, jofpos
91
92
93 implicit none
94
95
96
97 integer ptype
98
99
100
101 character (30) filename
102 integer lcurpar,lpacketsize,lface,lparcnt,lbuf,lindx,ltordimn
103 integer lneighcnt,lneighindx
104 integer lsize
105 double precision xpos,ypos
106 integer li,lj,lparcount
107
108
109 write(filename,'("dbg_desmpi",I4.4,".dat")') mype
110 open(44,file=filename)
111 select case(ptype)
112 case (1)
113 write(44,*)&
114 "------------------------------------------------------"
115 write(44,*) "Flag Information"
116 do lface =1,dimn*2
117 write(44,*) "details for face =" , lface
118 write(44,*) "Exchflag, cyclfac, neighproc" ,iexchflag(lface),ineighproc(lface)
119 end do
120 write(44,*) &
121 "------------------------------------------------------"
122 case (2)
123 ltordimn = merge(1,3,NO_K)
124 lpacketsize = 2*dimn + ltordimn+ 5
125 do lface =1,dimn*2
126 if (.not.iexchflag(lface))cycle
127 lparcnt = dsendbuf(1,lface)
128 if (lparcnt .gt. 0) then
129 write(44,*) &
130 "------------------------------------------------------"
131 write(44,*) "ghost send buffer for face", lface
132 write(44,*) "Number of particles in sendbuf",lparcnt
133 write(44,*) "particle number global_id ijk prvijk ",&
134 "radius material new_pos new_vel omega_new"
135 write(44,*) &
136 "-----------------------------------------------------"
137 do lcurpar = 1,lparcnt
138 lbuf = (lcurpar-1) * lpacketsize + ibufoffset
139 write(44,*) lcurpar,(dsendbuf(lindx,lface),lindx=lbuf,lbuf+lpacketsize-1)
140 end do
141 end if
142 end do
143 case (3)
144 ltordimn = merge(1,3,NO_K)
145 lpacketsize = 2*dimn + ltordimn+ 5
146 do lface =1,dimn*2
147 if (.not.iexchflag(lface))cycle
148 lparcnt = drecvbuf(1,lface)
149 if (lparcnt .gt. 0) then
150 write(44,*) &
151 "------------------------------------------------------"
152 write(44,*) "ghost recv buffer for face", lface
153 write(44,*) "Number of particles in recvbuf",lparcnt
154 write(44,*) "particle number global_id ijk prvijk ",&
155 "radius material new_pos new_vel omega_new"
156 write(44,*) &
157 "-----------------------------------------------------"
158 do lcurpar = 1,lparcnt
159 lbuf = (lcurpar-1) * lpacketsize + ibufoffset
160 write(44,*) lcurpar,(drecvbuf(lindx,lface),lindx=lbuf,lbuf+lpacketsize-1)
161 end do
162 end if
163 end do
164 case (4)
165 write(44,*) &
166 "---------------------------------------------------------"
167 write(44,*) "Particle info"
168 write(44,*) "max_pip,pip =" , max_pip,pip
169 write(44,*) "ghost position ",&
170 "i j k ijk"
171 write(44,*) &
172 "---------------------------------------------------------"
173 lparcount = 1
174 do lcurpar=1,max_pip
175 if (lparcount.gt.pip) exit
176 if (.not.pea(lcurpar,1))cycle
177 lparcount=lparcount + 1
178 xpos = des_pos_new(1,lcurpar)
179 ypos = des_pos_new(2,lcurpar)
180 li=iofpos(xpos);lj=jofpos(ypos)
181 write(44,*)pea(lcurpar,4),xpos,ypos,li,lj,dg_funijk(li,lj,1)
182 end do
183 case (5)
184 ltordimn = merge(1,3,NO_K)
185 lpacketsize = 9*dimn + ltordimn*4 + 13
186 do lface =1,dimn*2
187 if (.not.iexchflag(lface))cycle
188 lparcnt = dsendbuf(1,lface)
189 if (lparcnt .gt. 0) then
190 write(44,*) &
191 "------------------------------------------------------"
192 write(44,*) "particle crossing info send buffer", lface
193 write(44,*) "Number of particles in sendbuf",lparcnt
194 do lcurpar = 1,lparcnt
195 lbuf = (lcurpar-1) * lpacketsize + ibufoffset
196 write(44,*) "global_id ijk prvijk radius i,j,k, ijk"
197 write(44,*) &
198 "-----------------------------------------------------"
199 lsize = 8
200 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
201 lbuf = lbuf + lsize
202
203 write(44,*) "phase density vol mass omoi pos_old"
204 write(44,*) &
205 "-----------------------------------------------------"
206 lsize = 5+dimn
207 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
208 lbuf = lbuf + lsize
209
210 write(44,*) "pos_new vel_old vel_new"
211 write(44,*) &
212 "-----------------------------------------------------"
213 lsize = 3*dimn
214 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
215 lbuf = lbuf + lsize
216
217 write(44,*) "omega_old omega_new"
218 write(44,*) &
219 "-----------------------------------------------------"
220 lsize = ltordimn*2
221 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
222 lbuf = lbuf + lsize
223
224 write(44,*) "acc_old rot_acc_old fc "
225 write(44,*) &
226 "-----------------------------------------------------"
227 lsize = 2*dimn + ltordimn
228 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
229 lbuf = lbuf + lsize
230
231 write(44,*) "fn ft tow"
232 write(44,*) &
233 "-----------------------------------------------------"
234 lsize = 2*dimn + ltordimn
235 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
236 lbuf = lbuf + lsize
237
238
239 =dsendbuf(lbuf,lface);lbuf = lbuf + 1
240 write(44,*) "total neighbour=",lneighcnt
241 write(44,*) "neighbou",lneighcnt
242 do lneighindx = 1, lneighcnt
243 lsize = 3
244 write(44,'(5(2x,f8.4))') (dsendbuf(lindx,lface),lindx=lbuf,lbuf+lsize-1)
245 lbuf = lbuf + lsize
246 enddo
247 enddo
248 endif
249 enddo
250 case (6)
251 write(44,*) "-----------------------------------------------"
252 write(44,*) "at Time =",s_time
253 write(44,*) "Total paticles =",pip
254 write(44,*) "Total ghost paticles =",ighost_cnt
255 write(44,*) "do_nsearch =",do_nsearch
256 lparcnt = 1
257 do lcurpar = 1,max_pip
258 if(lparcnt.gt.pip) exit
259 lparcnt = lparcnt + 1
260 write(44,*) "particle position =",des_pos_new(1:dimn,lcurpar)
261 end do
262 write(44,*) "-----------------------------------------------"
263 case (7)
264 write(44,*) "-----------------------------------------------"
265 write(44,*) "pip and max_pip" , pip, max_pip,pea(1,1)
266 write(44,*) s_time
267 lparcnt = 1
268 do lcurpar =1,max_pip
269 if(lparcnt.gt.pip) exit
270 if(.not.pea(lcurpar,1)) cycle
271 lparcnt = lparcnt+1
272 if(pea(lcurpar,4)) cycle
273 write(44,*) "Info for particle", iglobal_id(lcurpar)
274 write(44,*) "position new ", des_pos_new(:,lcurpar)
275 end do
276 write(44,*) "-----------------------------------------------"
277 end select
278 close(44)
279 end subroutine des_dbgmpi
280
281
282 end module
283