File: /nfs/home/0/users/jenkins/mfix.git/model/dmp_modules/mpi_donothing/sendrecv3_mod.f
1 module sendrecv3
2 use parallel_mpi
3 use debug
4 use geometry
5 use compar
6 use indices
7 implicit none
8
9 integer, pointer, dimension(:) :: &
10 recvproc1, recvtag1, xrecv1, recvijk1, &
11 sendproc1, sendtag1, xsend1, sendijk1, &
12 recvproc2, recvtag2, xrecv2, recvijk2, &
13 sendproc2, sendtag2, xsend2, sendijk2
14
15
16 integer,pointer, dimension(:) :: &
17 send_persistent_request, recv_persistent_request, &
18 send_persistent_request1, send_persistent_request2, &
19 recv_persistent_request1, recv_persistent_request2
20
21 integer :: nrecv1,nsend1, nrecv2,nsend2
22
23
24
25
26 integer, pointer, dimension(:) :: &
27 recvproc3, recvtag3, xrecv3, recvijk3, &
28 sendproc3, sendtag3, xsend3, sendijk3, &
29 send_persistent_request3,recv_persistent_request3
30 integer :: nrecv3,nsend3
31 integer, parameter :: nlayers = 3
32
33
34
35
36
37
38 logical,parameter :: localfunc=.false.
39
40 logical,parameter :: use_persistent_message=.true.
41
42
43 double precision, dimension(:), pointer :: &
44 dsendbuffer, drecvbuffer
45 integer, dimension(:), pointer :: &
46 isendbuffer, irecvbuffer
47 character, dimension(:), pointer :: &
48 csendbuffer, crecvbuffer
49
50 integer :: nrecv,nsend
51 integer, pointer, dimension(:) :: &
52 recvrequest, sendrequest, &
53 xrecv,recvproc, recvijk, recvtag, &
54 xsend,sendproc, sendijk, sendtag
55
56 integer :: &
57 kstart_all_myPE, jstart_all_myPE, istart_all_myPE, &
58 kend_all_myPE, jend_all_myPE, iend_all_myPE
59
60 integer :: communicator
61
62
63
64
65 interface sendrecv3_begin
66 module procedure &
67 sendrecv3_begin_1d, &
68 sendrecv3_begin_1i, &
69 sendrecv3_begin_1c
70 end interface
71
72 interface sendrecv3_end
73 module procedure &
74 sendrecv3_end_1d, &
75 sendrecv3_end_1i, &
76 sendrecv3_end_1c
77 end interface
78
79 interface send_recv3
80 module procedure &
81 send_recv3_1d, send_recv3_2d, send_recv3_3d, &
82 send_recv3_1i, &
83 send_recv3_1c
84 end interface
85
86
87 contains
88
89 subroutine ijk_of( ijkp, i,j,k )
90 integer, intent(in) :: ijkp
91 integer, intent(out) :: i,j,k
92
93 integer :: k1,k2, j1,j2, i1,i2, &
94 ijk, isize,jsize,ksize, gijk
95
96 character(len=32), parameter :: name = "ijk_of"
97 logical :: isok_k, isok_j, isok_i, is_same, isok
98
99 ijk = ijkp
100
101
102
103
104
105 = istart4_all(myPE)
106 i2 = iend4_all(myPE)
107 j1 = jstart4_all(myPE)
108 j2 = jend4_all(myPE)
109 k1 = kstart4_all(myPE)
110 k2 = kend4_all(myPE)
111
112
113
114
115
116
117 ksize = (k2-k1+1)
118 jsize = (j2-j1+1)
119 isize = (i2-i1+1)
120
121
122 if (mod(ijk,isize*jsize).ne.0) then
123 k = int( ijk/(isize*jsize) ) + k1
124 else
125 k = int( ijk/(isize*jsize) ) + k1 -1
126 endif
127 ijk = ijk - (k-k1)*(isize*jsize)
128
129 if (mod(ijk,isize).ne.0) then
130 j = int( ijk/isize ) + j1
131 else
132 j = int( ijk/isize ) + j1 - 1
133 endif
134 ijk = ijk - (j-j1)*isize
135
136 i = (ijk-1) + i1
137
138
139
140 = (i1 <= i) .and. (i <= i2)
141 isok_j = (j1 <= j) .and. (j <= j2)
142 isok_k = (k1 <= k) .and. (k <= k2)
143 gijk = 1 + (i-i1) + (j-j1)*(i2-i1+1) + &
144 (k-k1)*(j2-j1+1)*(i2-i1+1)
145 is_same = (gijk .eq. ijkp)
146 isok = isok_i .and. isok_j .and. isok_k .and. is_same
147 if (.not.isok) then
148 call write_debug( name, 'i,j,k ', i,j,k )
149 call write_debug( name, 'ijkp, gijk ', ijkp, gijk )
150 endif
151
152
153 return
154 end subroutine ijk_of
155
156
157 subroutine ijk_of_gl( ijkp, i,j,k )
158 integer, intent(in) :: ijkp
159 integer, intent(out) :: i,j,k
160
161 integer :: k1,k2, j1,j2, i1,i2, &
162 ijk, isize,jsize,ksize, gijk
163
164 character(len=32), parameter :: name = "ijk_of_gl"
165 logical :: isok_k, isok_j, isok_i, is_same, isok
166
167 ijk = ijkp
168
169
170
171
172
173 = minval( kstart4_all(:) )
174 k2 = maxval( kend4_all(:) )
175
176 j1 = minval( jstart4_all(:) )
177 j2 = maxval( jend4_all(:) )
178
179 i1 = minval( istart4_all(:) )
180 i2 = maxval( iend4_all(:) )
181
182
183
184 ksize = (k2-k1+1)
185 jsize = (j2-j1+1)
186 isize = (i2-i1+1)
187
188
189 if (mod(ijk,isize*jsize).ne.0) then
190 k = int( ijk/(isize*jsize) ) + k1
191 else
192 k = int( ijk/(isize*jsize) ) + k1 -1
193 endif
194 ijk = ijk - (k-k1)*(isize*jsize)
195
196 if (mod(ijk,isize).ne.0) then
197 j = int( ijk/isize ) + j1
198 else
199 j = int( ijk/isize ) + j1 - 1
200 endif
201 ijk = ijk - (j-j1)*isize
202
203 i = (ijk-1) + i1
204
205
206
207 = (i1 <= i) .and. (i <= i2)
208 isok_j = (j1 <= j) .and. (j <= j2)
209 isok_k = (k1 <= k) .and. (k <= k2)
210 gijk = 1 + (i-i1) + (j-j1)*(i2-i1+1) + &
211 (k-k1)*(j2-j1+1)*(i2-i1+1)
212 is_same = (gijk .eq. ijkp)
213 isok = isok_i .and. isok_j .and. isok_k .and. is_same
214 if (.not.isok) then
215 call write_debug( name, 'i,j,k ', i,j,k )
216 call write_debug( name, 'ijkp, gijk ', ijkp, gijk )
217 endif
218
219
220 return
221 end subroutine ijk_of_gl
222
223 subroutine sendrecv3_init( &
224 comm, &
225 cyclic_i,cyclic_j,cyclic_k, idebug )
226 implicit none
227
228 integer, intent(in) :: comm
229 logical,intent(in) :: cyclic_i,cyclic_j,cyclic_k
230
231 integer, intent(in), optional :: idebug
232
233 return
234 end subroutine sendrecv3_init
235
236
237
238 subroutine sendrecv3_begin_1d( X, ilayer, idebug )
239 implicit none
240
241 integer, intent(in),optional :: ilayer
242 double precision, intent(inout), dimension(:) :: X
243 integer, intent(in), optional :: idebug
244
245 return
246 end subroutine sendrecv3_begin_1d
247
248
249 subroutine sendrecv3_begin_1i( X, ilayer, idebug )
250 implicit none
251
252 integer, intent(in),optional :: ilayer
253 integer, intent(inout), dimension(:) :: X
254 integer, intent(in), optional :: idebug
255
256 return
257 end subroutine sendrecv3_begin_1i
258
259
260 subroutine sendrecv3_begin_1c( X, ilayer, idebug )
261 implicit none
262
263 integer, intent(in),optional :: ilayer
264 character(len=*), intent(inout), dimension(:) :: X
265 integer, intent(in), optional :: idebug
266
267 return
268 end subroutine sendrecv3_begin_1c
269
270
271 subroutine sendrecv3_end_1d( X, idebug )
272 implicit none
273
274 double precision, intent(inout), dimension(:) :: X
275 integer, intent(in), optional :: idebug
276
277 return
278 end subroutine sendrecv3_end_1d
279
280
281 subroutine sendrecv3_end_1c( X, idebug )
282 implicit none
283
284 character(len=*), intent(inout), dimension(:) :: X
285 integer, intent(in), optional :: idebug
286
287 return
288 end subroutine sendrecv3_end_1c
289
290
291 subroutine sendrecv3_end_1i( X, idebug )
292 implicit none
293
294 integer, intent(inout), dimension(:) :: X
295 integer, intent(in), optional :: idebug
296
297 return
298 end subroutine sendrecv3_end_1i
299
300
301 subroutine send_recv3_1c( X, ilayer, idebug )
302 implicit none
303
304 character(len=*), dimension(:), intent(inout) :: X
305 integer, intent(in), optional :: ilayer,idebug
306
307 return
308 end subroutine send_recv3_1c
309
310 subroutine send_recv3_1d( X, ilayer, idebug )
311 implicit none
312
313 double precision, dimension(:), intent(inout) :: X
314 integer, intent(in), optional :: ilayer,idebug
315
316 return
317 end subroutine send_recv3_1d
318
319 subroutine send_recv3_2d( X, ilayer, idebug )
320 implicit none
321
322 double precision, dimension(:,:), intent(inout) :: X
323 integer, intent(in), optional :: ilayer,idebug
324
325 return
326 end subroutine send_recv3_2d
327
328 subroutine send_recv3_3d( X, ilayer, idebug )
329 implicit none
330
331 double precision, dimension(:,:,:), intent(inout) :: X
332 integer, intent(in), optional :: ilayer,idebug
333
334 return
335 end subroutine send_recv3_3d
336
337 subroutine send_recv3_1i( X, ilayer, idebug )
338 implicit none
339
340 integer, dimension(:), intent(inout) :: X
341 integer, intent(in), optional :: ilayer,idebug
342
343 return
344 end subroutine send_recv3_1i
345
346
347 end module sendrecv3
348