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