MFIX  2016-1
sendrecv3_mod.f
Go to the documentation of this file.
1 module sendrecv3
2  use compar
3  use debug
4  use exit, only: mfix_exit
5  use geometry
6  use indices
7  use parallel_mpi
8  implicit none
9 
10  integer, pointer, dimension(:) :: &
11  recvproc1, recvtag1, xrecv1, recvijk1, &
12  sendproc1, sendtag1, xsend1, sendijk1, &
13  recvproc2, recvtag2, xrecv2, recvijk2, &
14  sendproc2, sendtag2, xsend2, sendijk2
15 
16 
17  integer,pointer, dimension(:) :: &
18  send_persistent_request, recv_persistent_request, &
19  send_persistent_request1, send_persistent_request2, &
20  recv_persistent_request1, recv_persistent_request2
21 
22  integer :: nrecv1,nsend1, nrecv2,nsend2
23 
24  !---------------
25  !EFD extra layer
26  !---------------
27  integer, pointer, dimension(:) :: &
28  recvproc3, recvtag3, xrecv3, recvijk3, &
29  sendproc3, sendtag3, xsend3, sendijk3, &
30  send_persistent_request3,recv_persistent_request3
31  integer :: nrecv3,nsend3
32  integer, parameter :: nlayers = 3
33 
34  logical,parameter :: localfunc=.false.
35 
36  logical,parameter :: use_persistent_message=.true.
37 
38 
39  double precision, dimension(:), pointer :: &
40  dsendbuffer, drecvbuffer
41  integer, dimension(:), pointer :: &
42  isendbuffer, irecvbuffer
43  character, dimension(:), pointer :: &
44  csendbuffer, crecvbuffer
45 
46  integer :: nrecv,nsend
47  integer, pointer, dimension(:) :: &
48  recvrequest, sendrequest, &
49  xrecv,recvproc, recvijk, recvtag, &
50  xsend,sendproc, sendijk, sendtag
51 
52  integer :: &
53  kstart_all_mype, jstart_all_mype, istart_all_mype, &
54  kend_all_mype, jend_all_mype, iend_all_mype
55 
56  integer :: communicator
57 
58  ! -----------------
59  ! generic interface
60  ! -----------------
61  interface sendrecv3_begin
62  module procedure &
63  sendrecv3_begin_1d, &
64  sendrecv3_begin_1i, &
65  sendrecv3_begin_1c
66  end interface sendrecv3_begin
67 
68  interface sendrecv3_end
69  module procedure &
70  sendrecv3_end_1d, &
71  sendrecv3_end_1i, &
72  sendrecv3_end_1c
73  end interface sendrecv3_end
74 
75  interface send_recv3
76  module procedure &
77  send_recv3_1d, send_recv3_2d, send_recv3_3d, &
78  send_recv3_1i, &
79  send_recv3_1c
80  end interface send_recv3
81 
82 
83 contains
84 
85  subroutine ijk_of( ijkp, i,j,k )
86  integer, intent(in) :: ijkp
87  integer, intent(out) :: i,j,k
88 
89  integer :: k1,k2, j1,j2, i1,i2, &
90  ijk, isize,jsize,ksize, gijk
91 
92  character(len=32), parameter :: name = "ijk_of"
93  logical :: isok_k, isok_j, isok_i, is_same, isok
94 
95  ijk = ijkp
96 
97 
98  !---------------
99  !EFD extra layer
100  !---------------
101  i1 = istart4_all(mype)
102  i2 = iend4_all(mype)
103  j1 = jstart4_all(mype)
104  j2 = jend4_all(mype)
105  k1 = kstart4_all(mype)
106  k2 = kend4_all(mype)
107 
108 
109 
110 
111 
112 
113  ksize = (k2-k1+1)
114  jsize = (j2-j1+1)
115  isize = (i2-i1+1)
116 
117 
118  if (mod(ijk,isize*jsize).ne.0) then
119  k = int( ijk/(isize*jsize) ) + k1
120  else
121  k = int( ijk/(isize*jsize) ) + k1 -1
122  endif
123  ijk = ijk - (k-k1)*(isize*jsize)
124 
125  if (mod(ijk,isize).ne.0) then
126  j = int( ijk/isize ) + j1
127  else
128  j = int( ijk/isize ) + j1 - 1
129  endif
130  ijk = ijk - (j-j1)*isize
131 
132  i = (ijk-1) + i1
133  ! ------------
134  ! double check
135  ! ------------
136  isok_i = (i1 <= i) .and. (i <= i2)
137  isok_j = (j1 <= j) .and. (j <= j2)
138  isok_k = (k1 <= k) .and. (k <= k2)
139  gijk = 1 + (i-i1) + (j-j1)*(i2-i1+1) + &
140  (k-k1)*(j2-j1+1)*(i2-i1+1)
141  is_same = (gijk .eq. ijkp)
142  isok = isok_i .and. isok_j .and. isok_k .and. is_same
143  if (.not.isok) then
144  call write_debug( name, 'i,j,k ', i,j,k )
145  call write_debug( name, 'ijkp, gijk ', ijkp, gijk )
146  endif
147 
148 
149  return
150  end subroutine ijk_of
151 
152 
153  subroutine ijk_of_gl( ijkp, i,j,k )
154  integer, intent(in) :: ijkp
155  integer, intent(out) :: i,j,k
156 
157  integer :: k1,k2, j1,j2, i1,i2, &
158  ijk, isize,jsize,ksize, gijk
159 
160  character(len=32), parameter :: name = "ijk_of_gl"
161  logical :: isok_k, isok_j, isok_i, is_same, isok
162 
163  ijk = ijkp
164 
165 
166  !---------------
167  !EFD extra layer
168  !---------------
169  k1 = minval( kstart4_all(:) )
170  k2 = maxval( kend4_all(:) )
171 
172  j1 = minval( jstart4_all(:) )
173  j2 = maxval( jend4_all(:) )
174 
175  i1 = minval( istart4_all(:) )
176  i2 = maxval( iend4_all(:) )
177 
178 
179 
180  ksize = (k2-k1+1)
181  jsize = (j2-j1+1)
182  isize = (i2-i1+1)
183 
184 
185  if (mod(ijk,isize*jsize).ne.0) then
186  k = int( ijk/(isize*jsize) ) + k1
187  else
188  k = int( ijk/(isize*jsize) ) + k1 -1
189  endif
190  ijk = ijk - (k-k1)*(isize*jsize)
191 
192  if (mod(ijk,isize).ne.0) then
193  j = int( ijk/isize ) + j1
194  else
195  j = int( ijk/isize ) + j1 - 1
196  endif
197  ijk = ijk - (j-j1)*isize
198 
199  i = (ijk-1) + i1
200  ! ------------
201  ! double check
202  ! ------------
203  isok_i = (i1 <= i) .and. (i <= i2)
204  isok_j = (j1 <= j) .and. (j <= j2)
205  isok_k = (k1 <= k) .and. (k <= k2)
206  gijk = 1 + (i-i1) + (j-j1)*(i2-i1+1) + &
207  (k-k1)*(j2-j1+1)*(i2-i1+1)
208  is_same = (gijk .eq. ijkp)
209  isok = isok_i .and. isok_j .and. isok_k .and. is_same
210  if (.not.isok) then
211  call write_debug( name, 'i,j,k ', i,j,k )
212  call write_debug( name, 'ijkp, gijk ', ijkp, gijk )
213  endif
214 
215 
216  return
217  end subroutine ijk_of_gl
218 
219  subroutine sendrecv3_init( &
220  comm, &
221  cyclic_i,cyclic_j,cyclic_k, idebug )
222 
223  use functions
224 
225  implicit none
226 
227  integer, intent(in) :: comm
228  logical,intent(in) :: cyclic_i,cyclic_j,cyclic_k
229 
230  integer, intent(in), optional :: idebug
231 
232 #ifdef MPI
233 
234  ! -------------------------------------
235  ! set up tables and data structures for
236  ! exchanging ghost regions
237  ! -------------------------------------
238 
239  ! ---------------
240  ! local variables
241  ! ---------------
242  character(len=80), parameter :: name = 'sendrecv3_init'
243 
244  character(len=80), pointer, dimension(:) :: line
245  integer :: ip, lmax
246 
247  integer :: layer,request, source, tag, datatype
248 
249  integer :: lidebug
250  integer :: isize,jsize,ksize, ijksize
251  integer :: recvsize1, recvsize2, &
252  sendsize1, sendsize2
253 
254  integer :: iter, i,j,k, ii, jj,kk, &
255  ntotal, icount,ipos, &
256  ilayer, i1,i2, j1,j2, k1,k2, &
257  ijk, ijk2, iproc, jproc, src,dest, &
258  ierror
259 
260  logical :: isok, isvalid, ismine, is_halobc
261 
262  integer, dimension(:,:,:), pointer :: ijk2proc
263  integer, pointer, dimension(:) :: &
264  istartx,iendx, jstartx,jendx, kstartx,kendx, &
265  ncount, &
266  recvproc, recvtag, xrecv, recvijk, &
267  sendproc, sendtag, xsend, sendijk
268 
269  logical, parameter :: jfastest = .true.
270 
271 
272  integer, parameter :: message_tag_offset = 1000
273 
274 
275  ! ----------------
276  ! inline functions
277  ! ----------------
278  integer :: message_tag
279 
280  message_tag(src,dest) = message_tag_offset + (1+src + dest*10*numpes)
281 
282  nullify( &
283  recvproc1, recvtag1, xrecv1, recvijk1, &
284  sendproc1, sendtag1, xsend1, sendijk1, &
285  recvproc2, recvtag2, xrecv2, recvijk2, &
286  sendproc2, sendtag2, xsend2, sendijk2)
287 
288  nullify( &
289  send_persistent_request, recv_persistent_request, &
290  send_persistent_request1, send_persistent_request2, &
291  recv_persistent_request1, recv_persistent_request2 )
292 
293  nullify( dsendbuffer, drecvbuffer )
294  nullify( isendbuffer, irecvbuffer )
295  nullify( csendbuffer, crecvbuffer )
296 
297  nullify( &
298  recvrequest, sendrequest, &
299  xrecv,recvproc, recvijk, recvtag, &
300  xsend,sendproc, sendijk, sendtag )
301 
302 
303 
304 
305  ! --------------------
306  ! initialize variables
307  ! --------------------
308  lidebug = 0
309  if (present(idebug)) then
310  lidebug = idebug
311  endif
312 
313  communicator = comm
314  call mpi_comm_size( comm, numpes, ierror )
315  call mpi_check( 'sendrecv3_init:MPI_COMM_SIZE ', ierror )
316 
317  call mpi_comm_rank( comm, mype, ierror )
318  call mpi_check( 'sendrecv3_init:MPI_COMM_RANK ', ierror )
319 
320  ! ---------------------------
321  ! check obtain bounds of domain
322  ! ---------------------------
323 
324 
325  ! -----------------------
326  ! check bounds for k-axis
327  ! -----------------------
328  call assert( kmin1 .eq. minval( kstart1_all(:) ), &
329  '** sendrecv3_init: invalid kmin1, ' // &
330  ' kmin1, minval(kstart1_all(:)) ', &
331  kmin1, minval(kstart1_all(:)) )
332 
333  call assert( kmin2 .eq. minval( kstart2_all(:) ), &
334  '** sendrecv3_init: invalid kmin2, ' // &
335  ' kmin2, minval(kstart2_all(:)) ', &
336  kmin2, minval(kstart2_all(:)) )
337 
338  call assert( kmin3 .eq. minval( kstart3_all(:) ), &
339  '** sendrecv3_init: invalid kmin3, ' // &
340  ' kmin3, minval(kstart3_all(:)) ', &
341  kmin3, minval(kstart3_all(:)) )
342 
343 
344  call assert( kmax1 .eq. maxval( kend1_all(:) ), &
345  '** sendrecv3_init: invalid kmax1, ' // &
346  ' kmax1, maxval(kend1_all(:)) ', &
347  kmax1, maxval(kend1_all(:)) )
348 
349  call assert( kmax2 .eq. maxval( kend2_all(:) ), &
350  '** sendrecv3_init: invalid kmax2, ' // &
351  ' kmax2, maxval(kend2_all(:)) ', &
352  kmax2, maxval(kend2_all(:)) )
353 
354  call assert( kmax3 .eq. maxval( kend3_all(:) ), &
355  '** sendrecv3_init: invalid kmax3, ' // &
356  ' kmax3, maxval(kend3_all(:)) ', &
357  kmax3, maxval(kend3_all(:)) )
358 
359  !---------------
360  !EFD extra layer
361  !---------------
362  call assert( kmin4 .eq. minval( kstart4_all(:) ), &
363  '** sendrecv3_init: invalid kmin4, ' // &
364  ' kmin4, minval(kstart4_all(:)) ', &
365  kmin4, minval(kstart4_all(:)) )
366  call assert( kmax4 .eq. maxval( kend4_all(:) ), &
367  '** sendrecv3_init: invalid kmax4, ' // &
368  ' kmax4, maxval(kend4_all(:)) ', &
369  kmax4, maxval(kend4_all(:)) )
370 
371  ! -----------------------
372  ! check bounds for j-axis
373  ! -----------------------
374  call assert( jmin1 .eq. minval( jstart1_all(:) ), &
375  '** sendrecv3_init: invalid jmin1, ' // &
376  ' jmin1, minval(jstart1_all(:)) ', &
377  jmin1, minval(jstart1_all(:)) )
378 
379  call assert( jmin2 .eq. minval( jstart2_all(:) ), &
380  '** sendrecv3_init: invalid jmin2, ' // &
381  ' jmin2, minval(jstart2_all(:)) ', &
382  jmin2, minval(jstart2_all(:)) )
383 
384  call assert( jmin3 .eq. minval( jstart3_all(:) ), &
385  '** sendrecv3_init: invalid jmin3, ' // &
386  ' jmin3, minval(jstart3_all(:)) ', &
387  jmin3, minval(jstart3_all(:)) )
388 
389 
390  call assert( jmax1 .eq. maxval( jend1_all(:) ), &
391  '** sendrecv3_init: invalid jmax1, ' // &
392  ' jmax1, maxval(jend1_all(:)) ', &
393  jmax1, maxval(jend1_all(:)) )
394 
395  call assert( jmax2 .eq. maxval( jend2_all(:) ), &
396  '** sendrecv3_init: invalid jmax2, ' // &
397  ' jmax2, maxval(jend2_all(:)) ', &
398  jmax2, maxval(jend2_all(:)) )
399 
400  call assert( jmax3 .eq. maxval( jend3_all(:) ), &
401  '** sendrecv3_init: invalid jmax3, ' // &
402  ' jmax3, maxval(jend3_all(:)) ', &
403  jmax3, maxval(jend3_all(:)) )
404  !---------------
405  !EFD extra layer
406  !---------------
407  call assert( jmin4 .eq. minval( jstart4_all(:) ), &
408  '** sendrecv3_init: invalid jmin4, ' // &
409  ' jmin4, minval(jstart4_all(:)) ', &
410  jmin4, minval(jstart4_all(:)) )
411  call assert( jmax4 .eq. maxval( jend4_all(:) ), &
412  '** sendrecv3_init: invalid jmax4, ' // &
413  ' jmax4, maxval(jend4_all(:)) ', &
414  jmax4, maxval(jend4_all(:)) )
415 
416  ! -----------------------
417  ! check bounds for i-axis
418  ! -----------------------
419  call assert( imin1 .eq. minval( istart1_all(:) ), &
420  '** sendrecv3_init: invalid imin1, ' // &
421  ' imin1, minval(istart1_all(:)) ', &
422  imin1, minval(istart1_all(:)) )
423 
424  call assert( imin2 .eq. minval( istart2_all(:) ), &
425  '** sendrecv3_init: invalid imin2, ' // &
426  ' imin2, minval(istart2_all(:)) ', &
427  imin2, minval(istart2_all(:)) )
428 
429  call assert( imin3 .eq. minval( istart3_all(:) ), &
430  '** sendrecv3_init: invalid imin3, ' // &
431  ' imin3, minval(istart3_all(:)) ', &
432  imin3, minval(istart3_all(:)) )
433 
434 
435  call assert( imax1 .eq. maxval( iend1_all(:) ), &
436  '** sendrecv3_init: invalid imax1, ' // &
437  ' imax1, maxval(iend1_all(:)) ', &
438  imax1, maxval(iend1_all(:)) )
439 
440  call assert( imax2 .eq. maxval( iend2_all(:) ), &
441  '** sendrecv3_init: invalid imax2, ' // &
442  ' imax2, maxval(iend2_all(:)) ', &
443  imax2, maxval(iend2_all(:)) )
444 
445  call assert( imax3 .eq. maxval( iend3_all(:) ), &
446  '** sendrecv3_init: invalid imax3, ' // &
447  ' imax3, maxval(iend3_all(:)) ', &
448  imax3, maxval(iend3_all(:)) )
449 
450  !---------------
451  !EFD extra layer
452  !---------------
453  call assert( imin4 .eq. minval( istart4_all(:) ), &
454  '** sendrecv3_init: invalid imin4, ' // &
455  ' imin4, minval(istart4_all(:)) ', &
456  imin4, minval(istart4_all(:)) )
457  call assert( imax4 .eq. maxval( iend4_all(:) ), &
458  '** sendrecv3_init: invalid imax4, ' // &
459  ' imax4, maxval(iend4_all(:)) ', &
460  imax4, maxval(iend4_all(:)) )
461 
462 
463 
464  call assert( jmin1 .le. jmax1, &
465  '** sendrecv3_init: jmin1,jmax1 ', jmin1,jmax1 )
466  call assert( jmin2 .le. jmax2, &
467  '** sendrecv3_init: jmin2,jmax2 ', jmin2,jmax2 )
468  call assert( jmin3 .le. jmax3, &
469  '** sendrecv3_init: jmin3,jmax3 ', jmin3,jmax3 )
470 
471  call assert( kmin1 .le. kmax1, &
472  '** sendrecv3_init: kmin1,kmax1 ', kmin1,kmax1 )
473  call assert( kmin2 .le. kmax2, &
474  '** sendrecv3_init: kmin2,kmax2 ', kmin2,kmax2 )
475  call assert( kmin3 .le. kmax3, &
476  '** sendrecv3_init: kmin3,kmax3 ', kmin3,kmax3 )
477 
478  call assert( imin1 .le. imax1, &
479  '** sendrecv3_init: imin1,imax1 ', imin1,imax1 )
480  call assert( imin2 .le. imax2, &
481  '** sendrecv3_init: imin2,imax2 ', imin2,imax2 )
482  call assert( imin3 .le. imax3, &
483  '** sendrecv3_init: imin3,imax3 ', imin3,imax3 )
484 
485 
486  !---------------
487  !EFD extra layer
488  !---------------
489  call assert( jmin4 .le. jmax4, &
490  '** sendrecv3_init: jmin4,jmax4 ', jmin4,jmax4 )
491  call assert( imin4 .le. imax4, &
492  '** sendrecv3_init: imin4,imax4 ', imin4,imax4 )
493  call assert( kmin4 .le. kmax4, &
494  '** sendrecv3_init: kmin4,kmax4 ', kmin4,kmax4 )
495 
496 
497 
498 
499 
500 
501  k1 = min( kmin1, min(kmin2, kmin3) )
502  k2 = max( kmax1, max(kmax2, kmax3) )
503  j1 = min( jmin1, min(jmin2, jmin3) )
504  j2 = max( jmax1, max(jmax2, jmax3) )
505  i1 = min( imin1, min(imin2, imin3) )
506  i2 = max( imax1, max(imax2, imax3) )
507 
508  !----------------
509  !EFD extra layer
510  !----------------
511  k1 = min(k1,kmin4)
512  k2 = max(k2,kmax4)
513  j1 = min(j1,jmin4)
514  j2 = max(j2,jmax4)
515  i1 = min(i1,imin4)
516  i2 = max(i2,imax4)
517 
518 
519  allocate( ijk2proc( i1:i2, j1:j2, k1:k2 ) )
520 
521 
522  if(localfunc) then
523  ! --------------------------------------
524  ! double check ijk_of()
525  ! --------------------------------------
526 
527 
528  !---------------
529  !EFD extra layer
530  !---------------
531  kstart_all_mype = min( kstart3_all(mype), kstart4_all(mype))
532  kend_all_mype = max( kend3_all(mype), kend4_all(mype))
533 
534  jstart_all_mype = min( jstart3_all(mype), jstart4_all(mype))
535  jend_all_mype = max( jend3_all(mype), jend4_all(mype))
536 
537  istart_all_mype = min( istart3_all(mype), istart4_all(mype))
538  iend_all_mype = max( iend3_all(mype), iend4_all(mype))
539 
540 
541  do k=kstart_all_mype,kend_all_mype
542  do j=jstart_all_mype,jend_all_mype
543  do i=istart_all_mype,iend_all_mype
544  ijk = funijk(i,j,k)
545  call ijk_of(ijk, ii,jj,kk)
546  ijk2 = funijk( ii,jj,kk)
547 
548  isvalid = (ii.eq.i).and.(jj.eq.j).and.(kk.eq.k).and.(ijk.eq.ijk2)
549  if (.not.isvalid) then
550  call write_debug( name, 'error with ijk_of ')
551 
552  call write_debug( name, 'istart3_all(myPE),iend3_all(myPE) ', &
553  istart3_all(mype),iend3_all(mype) )
554  call write_debug( name, 'jstart3_all(myPE),jend3_all(myPE) ', &
555  jstart3_all(mype),jend3_all(mype) )
556  call write_debug( name, 'kstart3_all(myPE),kend3_all(myPE) ', &
557  kstart3_all(mype),kend3_all(mype) )
558 
559  call write_debug( name, 'i,j,k, ijk ', i,j,k, ijk )
560  call write_debug( name, 'ii,jj,kk, ijk2 ',ii,jj,kk,ijk2 )
561 
562  endif
563  enddo
564  enddo
565  enddo
566  endif ! Local Function
567 
568 
569  if (lidebug.ge.1) then
570  call write_debug( name, 'imap ', imap )
571  call write_debug( name, 'jmap ', jmap )
572  call write_debug( name, 'kmap ', kmap )
573  endif
574 
575 
576  ! ----------------------------
577  ! set up table ijk2proc(:,:,:)
578  !
579  ! ijk2proc(i,j,k) maps (i,j,k) index to
580  ! unique processor that 'owns' that node.
581  ! ----------------------------
582 
583 
584 
585  ijk2proc( :,:,: ) = 0
586 
587  ! --------------------------------------------------
588  ! double check domain decomposition that
589  ! each interior node is assigned to UNIQUE processor
590  ! --------------------------------------------------
591  do iproc=0,numpes-1
592 
593 
594 
595 
596  i1 = istart1_all(iproc)
597  i2 = iend1_all(iproc)
598  j1 = jstart1_all(iproc)
599  j2 = jend1_all(iproc)
600  k1 = kstart1_all(iproc)
601  k2 = kend1_all(iproc)
602 
603  if(istart3_all(iproc).eq.imin3) i1 = istart3_all(iproc)
604  if(iend3_all(iproc).eq.imax3) i2 = iend3_all(iproc)
605  if(jstart3_all(iproc).eq.jmin3) j1 = jstart3_all(iproc)
606  if(jend3_all(iproc).eq.jmax3) j2 = jend3_all(iproc)
607  if(kstart3_all(iproc).eq.kmin3) k1 = kstart3_all(iproc)
608  if(kend3_all(iproc).eq.kmax3) k2 = kend3_all(iproc)
609 
610 
611 
612 
613  do k=k1,k2
614  do j=j1,j2
615  do i=i1,i2
616  ijk2proc(i,j,k) = ijk2proc(i,j,k) + 1
617  enddo
618  enddo
619  enddo
620 
621  enddo
622 
623  do k=lbound(ijk2proc,3),ubound(ijk2proc,3)
624  do j=lbound(ijk2proc,2),ubound(ijk2proc,2)
625  do i=lbound(ijk2proc,1),ubound(ijk2proc,1)
626  isvalid = (ijk2proc(i,j,k) .eq. 1)
627  if (.not.isvalid) then
628 
629  call write_debug(name, ' invalid decomposition ')
630  call write_debug(name, 'i,j,k ',i,j,k )
631  call write_debug(name, 'ijk2proc(i,j,k) ', ijk2proc(i,j,k))
632 
633  call mfix_exit( mype )
634  endif
635  enddo
636  enddo
637  enddo
638 
639  ijk2proc(:,:,:) = -1
640  do iproc=0,numpes-1
641 
642 
643 
644  i1 = istart1_all(iproc)
645  i2 = iend1_all(iproc)
646  j1 = jstart1_all(iproc)
647  j2 = jend1_all(iproc)
648  k1 = kstart1_all(iproc)
649  k2 = kend1_all(iproc)
650 
651  if(istart3_all(iproc).eq.imin3) i1 = istart3_all(iproc)
652  if(iend3_all(iproc).eq.imax3) i2 = iend3_all(iproc)
653  if(jstart3_all(iproc).eq.jmin3) j1 = jstart3_all(iproc)
654  if(jend3_all(iproc).eq.jmax3) j2 = jend3_all(iproc)
655  if(kstart3_all(iproc).eq.kmin3) k1 = kstart3_all(iproc)
656  if(kend3_all(iproc).eq.kmax3) k2 = kend3_all(iproc)
657 
658 
659  !---------------
660  !EFD extra layer
661  !but not sure if this is needed
662  !---------------
663  ! if(istart4_all(iproc).eq.imin4) i1 = istart4_all(iproc)
664  ! if(iend4_all(iproc).eq.imax4) i2 = iend4_all(iproc)
665  ! if(jstart4_all(iproc).eq.jmin4) j1 = jstart4_all(iproc)
666  ! if(jend4_all(iproc).eq.jmax4) j2 = jend4_all(iproc)
667  ! if(kstart4_all(iproc).eq.kmin4) k1 = kstart4_all(iproc)
668  ! if(kend4_all(iproc).eq.kmax4) k2 = kend4_all(iproc)
669 
670 
671  do k=k1,k2
672  do j=j1,j2
673  do i=i1,i2
674  ijk2proc(i,j,k) = iproc
675  enddo
676  enddo
677  enddo
678 
679  enddo
680 
681 
682 
683  allocate( ncount(0:numpes-1) )
684 
685  allocate( istartx(0:numpes-1) )
686  allocate( jstartx(0:numpes-1) )
687  allocate( kstartx(0:numpes-1) )
688 
689  allocate( iendx(0:numpes-1) )
690  allocate( jendx(0:numpes-1) )
691  allocate( kendx(0:numpes-1) )
692 
693  !---------------
694  !EFD extra layer
695  !---------------
696  do ilayer=nlayers,nlayers
697 
698  if (ilayer.eq.1) then
699  kstartx(:) = kstart2_all(:)
700  kendx(:) = kend2_all(:)
701  jstartx(:) = jstart2_all(:)
702  jendx(:) = jend2_all(:)
703  istartx(:) = istart2_all(:)
704  iendx(:) = iend2_all(:)
705  else if (ilayer.eq.2) then
706  kstartx(:) = kstart3_all(:)
707  kendx(:) = kend3_all(:)
708  jstartx(:) = jstart3_all(:)
709  jendx(:) = jend3_all(:)
710  istartx(:) = istart3_all(:)
711  iendx(:) = iend3_all(:)
712  else if (ilayer.eq.3) then
713  !
714  !---------------
715  !EFD extra layer
716  !---------------
717  kstartx(:) = kstart4_all(:)
718  kendx(:) = kend4_all(:)
719  jstartx(:) = jstart4_all(:)
720  jendx(:) = jend4_all(:)
721  istartx(:) = istart4_all(:)
722  iendx(:) = iend4_all(:)
723 
724  endif
725 
726 
727 
728  if (lidebug.ge.1) then
729  call write_debug(name, 'determine send schedule ', mype )
730  endif
731 
732  ! -----------------------
733  ! determine send schedule
734  !
735  ! examine all neighboring processors
736  ! to see if they need my data
737  ! -----------------------
738 
739 
740  ! -----------------------------------
741  ! first pass to determine array sizes
742  ! -----------------------------------
743 
744 
745 
746  ncount(:) = 0
747 
748  do iproc=0,numpes-1
749  if (iproc.ne.mype) then
750 
751 
752  k1 = lbound(ijk2proc,3)
753  k2 = ubound(ijk2proc,3)
754  j1 = lbound(ijk2proc,2)
755  j2 = ubound(ijk2proc,2)
756  i1 = lbound(ijk2proc,1)
757  i2 = ubound(ijk2proc,1)
758 
759 
760  do k=kstartx(iproc),kendx(iproc)
761  do j=jstartx(iproc),jendx(iproc)
762  do i=istartx(iproc),iendx(iproc)
763 
764  ii = imap(i)
765  jj = jmap(j)
766  kk = kmap(k)
767 
768  isvalid = (k1.le.kk).and.(kk.le.k2)
769  call assert( isvalid, '** sendrecv3_init: invalid kk ', kk )
770 
771  isvalid = (j1.le.jj).and.(jj.le.j2)
772  call assert( isvalid, '** sendrecv3_init: invalid jj ', jj )
773 
774  isvalid = (i1.le.ii).and.(ii.le.i2)
775  call assert( isvalid, '** sendrecv3_init: invalid ii ', ii )
776 
777  jproc = ijk2proc( ii,jj,kk )
778 
779  ismine = (jproc .eq. mype)
780  if (ismine) then
781  ncount(iproc) = ncount(iproc) + 1
782  endif
783 
784  enddo
785  enddo
786  enddo
787 
788  endif
789  enddo
790 
791 
792  ! --------------
793  ! prepare arrays
794  ! --------------
795  ntotal = 0
796  nsend = 0
797  do iproc=0,numpes-1
798  ntotal = ntotal + ncount(iproc)
799  if (ncount(iproc).ge.1) then
800  nsend = nsend + 1
801  endif
802  enddo
803 
804  if (lidebug.ge.1) then
805  call write_debug( name, 'ncount = ', ncount )
806  call write_debug( name, 'nsend, ntotal ', nsend, ntotal )
807  endif
808 
809 
810  allocate( xsend(nsend+1) )
811 
812  allocate( sendijk( max(1,ntotal) ) )
813  allocate( sendproc(max(1,nsend)) )
814 
815  nsend = 0
816  do iproc=0,numpes-1
817  if (ncount(iproc).ne.0) then
818  nsend = nsend + 1
819  sendproc(nsend) = iproc
820  endif
821  enddo
822 
823  xsend(1) = 1
824  do i=1,nsend
825  iproc = sendproc(i)
826  xsend(i+1) = xsend(i) + ncount(iproc)
827  enddo
828 
829  allocate( sendtag( max(1,nsend) ) )
830  do ii=1,nsend
831  iproc = sendproc(ii)
832  src = mype
833  dest = iproc
834  sendtag(ii) = message_tag( src, dest )
835  enddo
836 
837  ! -----------------------------
838  ! second pass to fill in arrays
839  ! -----------------------------
840 
841 
842  ipos = 1
843  do iter=1,nsend
844  iproc = sendproc(iter)
845  icount = 0
846 
847  do k=kstartx(iproc),kendx(iproc)
848 
849  if (jfastest) then
850 
851  do i=istartx(iproc),iendx(iproc)
852  do j=jstartx(iproc),jendx(iproc)
853 
854 
855  ii = imap(i)
856  jj = jmap(j)
857  kk = kmap(k)
858  jproc = ijk2proc(ii,jj,kk)
859  ismine = (jproc.eq.mype)
860  if (ismine) then
861  icount = icount + 1
862  ijk = funijk(ii,jj,kk)
863 
864  ipos = xsend(iter)-1 + icount
865  sendijk( ipos ) = ijk
866  endif
867 
868  enddo
869  enddo
870 
871 
872  else
873 
874  do j=jstartx(iproc),jendx(iproc)
875  do i=istartx(iproc),iendx(iproc)
876 
877 
878  ii = imap(i)
879  jj = jmap(j)
880  kk = kmap(k)
881  jproc = ijk2proc(ii,jj,kk)
882  ismine = (jproc.eq.mype)
883  if (ismine) then
884  icount = icount + 1
885  ijk = funijk(ii,jj,kk)
886 
887  ipos = xsend(iter)-1 + icount
888  sendijk( ipos ) = ijk
889  endif
890 
891  enddo
892  enddo
893 
894  endif
895  enddo
896 
897  isvalid = (icount .eq. ncount(iproc))
898  call assert( isvalid, &
899  '** sendrecv3_init: icount != ncount(iproc) ', iproc)
900 
901  enddo
902 
903 
904 
905  if (lidebug.ge.1) then
906  call write_debug(name, 'determine recv schedule ', mype )
907  endif
908 
909  ! ---------------------------
910  ! determine recv schedule
911  !
912  ! examine nodes in my ghost region and
913  ! see what data is needed from my neighbors
914  ! ---------------------------
915 
916  ! -----------------------------------
917  ! first pass to determine array sizes
918  ! -----------------------------------
919 
920  ncount(:) = 0
921 
922  k1 = lbound(ijk2proc,3)
923  k2 = ubound(ijk2proc,3)
924  j1 = lbound(ijk2proc,2)
925  j2 = ubound(ijk2proc,2)
926  i1 = lbound(ijk2proc,1)
927  i2 = ubound(ijk2proc,1)
928 
929 
930  do k=kstartx(mype),kendx(mype)
931  do j=jstartx(mype),jendx(mype)
932  do i=istartx(mype),iendx(mype)
933 
934  ii = imap(i)
935  jj = jmap(j)
936  kk = kmap(k)
937 
938  isvalid = (k1.le.kk).and.(kk.le.k2)
939  call assert( isvalid, '** sendrecv3_init: invalid kk ', kk )
940 
941  isvalid = (j1.le.jj).and.(jj.le.j2)
942  call assert( isvalid, '** sendrecv3_init: invalid jj ', jj )
943 
944  isvalid = (i1.le.ii).and.(ii.le.i2)
945  call assert( isvalid, '** sendrecv3_init: invalid ii ', ii )
946 
947 
948 
949 
950 
951  iproc = ijk2proc(ii,jj,kk)
952  is_halobc = (iproc.eq.-1)
953  ismine = (iproc.eq.mype)
954  if (.not.ismine) then
955 
956  isvalid = (0 .le. iproc) .and. &
957  (iproc.le.numpes-1) .and. &
958  (iproc.ne.mype)
959 
960  call assert( isvalid, &
961  '** sendrecv3_init: invalid iproc ',iproc)
962 
963  ncount(iproc) = ncount(iproc) + 1
964  endif
965  enddo
966  enddo
967  enddo
968 
969  ncount(mype) = 0
970 
971  ntotal = 0
972  do iproc=0,numpes-1
973  ntotal = ntotal + ncount(iproc)
974  enddo
975 
976  nrecv = count( ncount(:) .ne. 0)
977 
978  allocate( recvproc( max(1,nrecv) ) )
979 
980  nrecv = 0
981  do iproc=0,numpes-1
982  if (ncount(iproc).ne.0) then
983  nrecv = nrecv + 1
984  recvproc(nrecv) = iproc
985  endif
986  enddo
987 
988  allocate( xrecv(nrecv+1) )
989  allocate( recvijk(max(1,ntotal)) )
990 
991  xrecv(1) = 1
992  do iter=1,nrecv
993  iproc = recvproc(iter)
994  xrecv(iter+1) = xrecv(iter) + ncount(iproc)
995  enddo
996 
997  allocate( recvtag( max(1,nrecv) ) )
998 
999  do iter=1,nrecv
1000  iproc = recvproc(iter)
1001  src = iproc
1002  dest = mype
1003  recvtag(iter) = message_tag( src, dest )
1004  enddo
1005 
1006 
1007  ! ----------------------------
1008  ! second pass to fill in array
1009  ! ----------------------------
1010  if (lidebug.ge.1) then
1011  call write_debug( name, 'recv second pass ', mype )
1012  endif
1013 
1014  ipos = 1
1015 
1016  do iter=1,nrecv
1017  jproc = recvproc(iter)
1018 
1019  do k=kstartx(mype),kendx(mype)
1020 
1021  if (jfastest) then
1022 
1023  do i=istartx(mype),iendx(mype)
1024  do j=jstartx(mype),jendx(mype)
1025 
1026  ii = imap(i)
1027  jj = jmap(j)
1028  kk = kmap(k)
1029 
1030  iproc = ijk2proc(ii,jj,kk)
1031  is_halobc = (iproc.eq.-1)
1032 
1033  ismine = (iproc.eq.mype)
1034  if ((.not.ismine) .and. (iproc.eq.jproc)) then
1035 
1036 
1037  ijk = funijk( i,j,k)
1038  recvijk( ipos ) = ijk
1039  ipos = ipos + 1
1040  endif
1041  enddo
1042  enddo
1043 
1044 
1045 
1046  else
1047 
1048  do j=jstartx(mype),jendx(mype)
1049  do i=istartx(mype),iendx(mype)
1050 
1051  ii = imap(i)
1052  jj = jmap(j)
1053  kk = kmap(k)
1054 
1055  iproc = ijk2proc(ii,jj,kk)
1056  is_halobc = (iproc.eq.-1)
1057 
1058  ismine = (iproc.eq.mype)
1059  if ((.not.ismine) .and. (iproc.eq.jproc)) then
1060 
1061 
1062  ijk = funijk( i,j,k)
1063  recvijk( ipos ) = ijk
1064  ipos = ipos + 1
1065  endif
1066  enddo
1067  enddo
1068 
1069  endif
1070  enddo
1071 
1072  enddo
1073 
1074  if (ilayer.eq.1) then
1075 
1076  nsend1 = nsend
1077  xsend1 => xsend
1078  sendijk1 => sendijk
1079  sendproc1 => sendproc
1080  sendtag1 => sendtag
1081 
1082  nrecv1 = nrecv
1083  xrecv1 => xrecv
1084  recvijk1 => recvijk
1085  recvproc1 => recvproc
1086  recvtag1 => recvtag
1087 
1088  else if (ilayer.eq.2) then
1089 
1090  nsend2 = nsend
1091  xsend2 => xsend
1092  sendijk2 => sendijk
1093  sendproc2 => sendproc
1094  sendtag2 => sendtag
1095 
1096  nrecv2 = nrecv
1097  xrecv2 => xrecv
1098  recvijk2 => recvijk
1099  recvproc2 => recvproc
1100  recvtag2 => recvtag
1101 
1102  else if (ilayer.eq.3) then
1103  !---------------
1104  !EFD extra layer
1105  !---------------
1106  nsend3 = nsend
1107  xsend3 => xsend
1108  sendijk3 => sendijk
1109  sendproc3 => sendproc
1110  sendtag3 => sendtag
1111 
1112  nrecv3 = nrecv
1113  xrecv3 => xrecv
1114  recvijk3 => recvijk
1115  recvproc3 => recvproc
1116  recvtag3 => recvtag
1117 
1118 
1119  endif
1120 
1121 
1122  nullify( xsend )
1123  nullify( sendijk )
1124  nullify( sendproc )
1125  nullify( sendtag )
1126 
1127  nullify( xrecv )
1128  nullify( recvijk )
1129  nullify( recvproc )
1130  nullify( recvtag )
1131 
1132  enddo ! do ilayer
1133 
1134 
1135  deallocate( ncount )
1136  deallocate( ijk2proc )
1137 
1138  deallocate( istartx )
1139  deallocate( jstartx )
1140  deallocate( kstartx )
1141  deallocate( iendx )
1142  deallocate( jendx )
1143  deallocate( kendx )
1144 
1145  nullify( ncount )
1146  nullify( ijk2proc )
1147 
1148  nullify( istartx )
1149  nullify( jstartx )
1150  nullify( kstartx )
1151  nullify( iendx )
1152  nullify( jendx )
1153  nullify( kendx )
1154 
1155 
1156 
1157  if (lidebug.ge.1) then
1158 
1159  call write_debug( name, ' allocate message buffers ' )
1160  call write_debug( name, 'nrecv1 ', nrecv1 )
1161  call write_debug( name, 'recvproc1 ', recvproc1 )
1162  call write_debug( name, 'recvtag1 ', recvtag1 )
1163  call write_debug( name, 'xrecv1 ', xrecv1 )
1164 
1165 
1166  lmax = size(recvijk1)
1167  allocate( line(lmax) )
1168  line(:) = " "
1169 
1170  ip = 1
1171  do ii=lbound(recvijk1,1),ubound(recvijk1,1)
1172  ijk = recvijk1(ii)
1173  if(localfunc) then
1174  call ijk_of(ijk,i,j,k)
1175  else
1176  i = i_of(ijk)
1177  j = j_of(ijk)
1178  k = k_of(ijk)
1179  endif
1180  write(line(ip),9001) ii,ijk, i,j,k
1181 9001 format('recvijk1( ', i6,') = ', &
1182  i6, '( ', i6,',',i6,',',i6,') ')
1183  ip = ip + 1
1184  enddo
1185  call write_error( name, line, lmax )
1186  deallocate( line )
1187  nullify( line )
1188 
1189  lmax = size(recvijk2)
1190  allocate( line(lmax) )
1191  line(:) = " "
1192 
1193  ip = 1
1194  do ii=lbound(recvijk2,1),ubound(recvijk2,1)
1195  ijk = recvijk2(ii)
1196  if(localfunc) then
1197  call ijk_of(ijk,i,j,k)
1198  else
1199  i = i_of(ijk)
1200  j = j_of(ijk)
1201  k = k_of(ijk)
1202  endif
1203 
1204  write(line(ip),9101) ii,ijk, i,j,k
1205 9101 format('recvijk2( ', i6,') = ', &
1206  i6, '( ', i6,',',i6,',',i6,') ')
1207  ip = ip + 1
1208  enddo
1209  call write_error( name, line, lmax )
1210  deallocate( line )
1211  nullify( line )
1212 
1213 
1214  call write_debug( name, ' allocate message buffers ' )
1215  call write_debug( name, 'nsend1 ', nsend1 )
1216  call write_debug( name, 'sendproc1 ', sendproc1 )
1217  call write_debug( name, 'sendtag1 ', sendtag1 )
1218  call write_debug( name, 'xsend1 ', xsend1 )
1219 
1220 
1221 
1222  lmax = size(sendijk1)
1223  allocate(line(lmax))
1224  line(:) = " "
1225 
1226  ip = 1
1227  do ii=lbound(sendijk1,1),ubound(sendijk1,1)
1228  ijk = sendijk1(ii)
1229  if(localfunc) then
1230  call ijk_of(ijk,i,j,k)
1231  else
1232  i = i_of(ijk)
1233  j = j_of(ijk)
1234  k = k_of(ijk)
1235  endif
1236 
1237  write(line(ip),9002) ii,ijk, i,j,k
1238 9002 format('sendijk1( ', i6,') = ', &
1239  i6, '( ', i6,',',i6,',',i6,') ')
1240  ip = ip + 1
1241  enddo
1242 
1243  call write_error( name, line, lmax )
1244  deallocate( line )
1245  nullify( line )
1246 
1247 
1248  lmax = size(sendijk2)
1249  allocate(line(lmax))
1250  line(:) = " "
1251 
1252  ip = 1
1253  do ii=lbound(sendijk2,1),ubound(sendijk2,1)
1254  ijk = sendijk2(ii)
1255  if(localfunc) then
1256  call ijk_of(ijk,i,j,k)
1257  else
1258  i = i_of(ijk)
1259  j = j_of(ijk)
1260  k = k_of(ijk)
1261  endif
1262 
1263  write(line(ip),9102) ii,ijk, i,j,k
1264 9102 format('sendijk2( ', i6,') = ', &
1265  i6, '( ', i6,',',i6,',',i6,') ')
1266  ip = ip + 1
1267  enddo
1268 
1269  call write_error( name, line, lmax )
1270  deallocate( line )
1271  nullify( line )
1272 
1273 
1274 
1275  endif
1276 
1277 
1278 
1279  ! ------------------------
1280  ! allocate message buffers
1281  ! ------------------------
1282 
1283 
1284  isize = max(1,max(nsend1,nsend2))
1285  allocate( sendrequest( isize ) )
1286  allocate( send_persistent_request1( isize ) )
1287  allocate( send_persistent_request2( isize ) )
1288 
1289  isize = max(1,max(nrecv1,nrecv2))
1290  allocate( recvrequest( isize ) )
1291  allocate( recv_persistent_request1( isize ) )
1292  allocate( recv_persistent_request2( isize ) )
1293 
1294  ! -----------------------------------
1295  ! preallocate buffers for common case
1296  ! -----------------------------------
1297  recvsize1 = xrecv1( nrecv1+1)-1
1298  recvsize2 = xrecv2( nrecv2+1)-1
1299 
1300  isize = max(1,max(recvsize1,recvsize2))
1301  allocate( drecvbuffer( isize ) )
1302 
1303  sendsize1 = xsend1( nsend1+1)-1
1304  sendsize2 = xsend2( nsend2+1)-1
1305 
1306  isize = max(1,max(sendsize1,sendsize2))
1307  allocate( dsendbuffer( isize ) )
1308 
1309 
1310  if (use_persistent_message) then
1311 
1312  datatype = mpi_double_precision
1313 
1314  do layer=nlayers,nlayers
1315 
1316 
1317  if (layer.eq.1) then
1318  nrecv = nrecv1
1319  recvtag =>recvtag1
1320  recvproc => recvproc1
1321  recvijk => recvijk1
1322  xrecv => xrecv1
1323 
1324  nsend = nsend1
1325  sendtag => sendtag1
1326  sendproc => sendproc1
1327  sendijk => sendijk1
1328  xsend => xsend1
1329 
1330  send_persistent_request => send_persistent_request1
1331  recv_persistent_request => recv_persistent_request1
1332 
1333  else if (layer.eq.2) then
1334  nrecv = nrecv2
1335  recvtag =>recvtag2
1336  recvproc => recvproc2
1337  recvijk => recvijk2
1338  xrecv => xrecv2
1339 
1340  nsend = nsend2
1341  sendtag => sendtag2
1342  sendproc => sendproc2
1343  sendijk => sendijk2
1344  xsend => xsend2
1345 
1346  send_persistent_request => send_persistent_request2
1347  recv_persistent_request => recv_persistent_request2
1348 
1349  else if (layer.eq.3) then
1350  !----------------
1351  !EFD extra layer
1352  !----------------
1353 
1354  nrecv = nrecv3
1355  recvtag =>recvtag3
1356  recvproc => recvproc3
1357  recvijk => recvijk3
1358  xrecv => xrecv3
1359 
1360  nsend = nsend3
1361  sendtag => sendtag3
1362  sendproc => sendproc3
1363  sendijk => sendijk3
1364  xsend => xsend3
1365 
1366  send_persistent_request => send_persistent_request3
1367  recv_persistent_request => recv_persistent_request3
1368 
1369  endif
1370 
1371 
1372 
1373  do ii=1,nrecv
1374  j1 = xrecv(ii)
1375  j2 = xrecv(ii+1)-1
1376  icount = j2-j1+1
1377  source = recvproc( ii )
1378  tag = recvtag( ii )
1379 
1380 
1381  if (lidebug.ge.2) then
1382 
1383  call write_debug(name, 'mpi_recv_init: ii,j1,j2 ', &
1384  ii,j1,j2 )
1385  call write_debug(name, 'icount, source, tag ', &
1386  icount,source,tag )
1387  endif
1388 
1389 
1390  call mpi_recv_init( drecvbuffer(j1), icount, datatype, &
1391  source, tag, comm, request, ierror )
1392  call mpi_check( 'sendrecv3_begin_1d:MPI_IRECV ', ierror )
1393 
1394  recv_persistent_request(ii) = request
1395  enddo
1396 
1397 
1398  do ii=1,nsend
1399  j1 = xsend(ii)
1400  j2 = xsend(ii+1)-1
1401  dest = sendproc( ii )
1402  tag = sendtag( ii )
1403  icount = j2-j1+1
1404 
1405  if (lidebug.ge.2) then
1406 
1407  call write_debug(name, 'mpi_send_init: ii,j1,j2 ', &
1408  ii,j1,j2)
1409  call write_debug(name, 'icount, dest, tag ', &
1410  icount,dest,tag )
1411  endif
1412 
1413 
1414  call mpi_send_init( dsendbuffer(j1), icount, datatype, &
1415  dest, tag, &
1416  comm, request, ierror )
1417  call mpi_check( 'sendrecv3_begin_1d:MPI_SEND_INIT ', ierror )
1418 
1419  send_persistent_request( ii ) = request
1420  enddo
1421  enddo
1422 
1423  endif
1424 
1425  if (lidebug.ge.1) then
1426  call write_debug(name, ' end of sendrecv3_init ', mype )
1427  endif
1428 
1429 #endif
1430  return
1431 
1432  end subroutine sendrecv3_init
1433 
1434 
1435 
1436  subroutine sendrecv3_begin_1d( XX, ilayer, idebug )
1437 
1438  use functions
1439 
1440  implicit none
1441 
1442  integer, intent(in),optional :: ilayer
1443  double precision, intent(inout), dimension(:) :: XX
1444  integer, intent(in), optional :: idebug
1445 
1446 #ifdef MPI
1447 
1448  ! ---------------
1449  ! local variables
1450  ! ---------------
1451  character(len=80), parameter :: name = 'sendrecv3_begin_1d'
1452 
1453  integer :: lidebug
1454 
1455  integer :: layer, datatype, comm, recvsize, sendsize, &
1456  ijk,jj,j1,j2, request, ii,count,source,dest, tag, ierror
1457 
1458  lidebug = 0
1459 
1460  if (present(idebug)) then
1461  lidebug = idebug
1462  endif
1463 
1464  layer = 1
1465  if (present(ilayer)) then
1466  layer = ilayer
1467  endif
1468 
1469  if (layer.eq.1) then
1470  nrecv = nrecv1
1471  recvtag =>recvtag1
1472  recvproc => recvproc1
1473  recvijk => recvijk1
1474  xrecv => xrecv1
1475 
1476  nsend = nsend1
1477  sendtag => sendtag1
1478  sendproc => sendproc1
1479  sendijk => sendijk1
1480  xsend => xsend1
1481 
1482  send_persistent_request => send_persistent_request1
1483  recv_persistent_request => recv_persistent_request1
1484 
1485  else if (layer.eq.2) then
1486  nrecv = nrecv2
1487  recvtag =>recvtag2
1488  recvproc => recvproc2
1489  recvijk => recvijk2
1490  xrecv => xrecv2
1491 
1492  nsend = nsend2
1493  sendtag => sendtag2
1494  sendproc => sendproc2
1495  sendijk => sendijk2
1496  xsend => xsend2
1497 
1498  send_persistent_request => send_persistent_request2
1499  recv_persistent_request => recv_persistent_request2
1500 
1501  else if (layer.eq.3) then
1502  !---------------
1503  !EFD extra layer
1504  !---------------
1505 
1506  nrecv = nrecv3
1507  recvtag =>recvtag3
1508  recvproc => recvproc3
1509  recvijk => recvijk3
1510  xrecv => xrecv3
1511 
1512  nsend = nsend3
1513  sendtag => sendtag3
1514  sendproc => sendproc3
1515  sendijk => sendijk3
1516  xsend => xsend3
1517 
1518  send_persistent_request => send_persistent_request3
1519  recv_persistent_request => recv_persistent_request3
1520 
1521  endif
1522 
1523 
1524  ! --------------------------
1525  ! post asynchronous receives
1526  ! --------------------------
1527 
1528  if (lidebug.ge.1) then
1529  call write_debug(name, 'post asynchronous receives, nrecv = ', nrecv )
1530  endif
1531 
1532  if (nrecv.ge.1) then
1533  recvsize = xrecv( nrecv+1)-1
1534 
1535 
1536  if (lidebug.ge.1) then
1537  call write_debug( name, 'recvsize, ubound(drecvbuffer,1) ', &
1538  recvsize, ubound(drecvbuffer,1) )
1539 
1540  call write_debug( name, 'ubound(xrecv,1) ', &
1541  ubound(xrecv,1) )
1542  call write_debug( name, 'ubound(recvproc,1) ', &
1543  ubound(recvproc,1) )
1544  call write_debug( name, 'ubound(recvtag,1) ', &
1545  ubound(recvtag,1) )
1546 
1547  endif
1548 
1549  ! -------------
1550  ! post receives
1551  ! -------------
1552  datatype = mpi_double_precision
1553  comm = communicator
1554 
1555  if (use_persistent_message) then
1556 
1557  ! ---------------------------------------
1558  ! persistent request already established
1559  ! ---------------------------------------
1560  if (lidebug.ge.2) then
1561  call write_debug( name,'before startall for recv ',&
1562  recv_persistent_request)
1563  endif
1564 
1565  call mpi_startall( nrecv, recv_persistent_request, ierror )
1566 
1567  if (lidebug.ge.2) then
1568  call write_debug( name,'after startall for recv, ierror',&
1569  ierror)
1570  endif
1571 
1572  call mpi_check( 'sendrecv3_begin: MPI_STARTALL ', ierror )
1573 
1574 
1575  else
1576  ! ---------
1577  ! use irecv
1578  ! ---------
1579 
1580  do ii=1,nrecv
1581  j1 = xrecv(ii)
1582  j2 = xrecv(ii+1)-1
1583  count = j2-j1+1
1584  source = recvproc( ii )
1585  tag = recvtag( ii )
1586 
1587 
1588  if (lidebug.ge.2) then
1589 
1590  call write_debug(name, 'mpi_irecv: ii,j1,j2 ', ii,j1,j2 )
1591  call write_debug(name, 'count, source, tag ', &
1592  count,source,tag )
1593  endif
1594 
1595  call mpi_irecv( drecvbuffer(j1), count, datatype, source, tag, &
1596  comm, request, ierror )
1597 
1598  call mpi_check( 'sendrecv3_begin_1d:MPI_IRECV ', ierror )
1599 
1600  recvrequest( ii ) = request
1601  enddo
1602  endif
1603 
1604  endif
1605 
1606  ! -----------------------
1607  ! post asynchronous sends
1608  ! -----------------------
1609 
1610  if (lidebug.ge.1) then
1611 
1612  call write_debug(name, 'post asynchronous sends ')
1613  endif
1614 
1615  if (nsend.ge.1) then
1616  sendsize = xsend( nsend+1)-1
1617 
1618 
1619  if (lidebug.ge.1) then
1620 
1621  call write_debug( name, &
1622  'sendsize, ubound(dsendbuffer,1) ', &
1623  sendsize, ubound(dsendbuffer,1) )
1624 
1625  call write_debug( name, 'ubound(xsend,1) ', &
1626  ubound(xsend,1) )
1627  call write_debug( name, 'ubound(sendproc,1) ', &
1628  ubound(sendproc,1) )
1629  call write_debug( name, 'ubound(sendtag,1) ', &
1630  ubound(sendtag,1) )
1631 
1632  endif
1633 
1634 
1635 
1636 
1637  ! -------------
1638  ! perform sends
1639  ! -------------
1640  datatype = mpi_double_precision
1641  comm = communicator
1642 
1643  if (use_persistent_message) then
1644 
1645  ! -----------------------------
1646  ! perform copy into dsendbuffer
1647  ! -----------------------------
1648  j1 = xsend(1)
1649  j2 = xsend(nsend+1)-1
1650 
1651  do jj=j1,j2
1652  ijk = sendijk( jj )
1653  dsendbuffer( jj ) = xx(ijk)
1654  enddo
1655 
1656 
1657 
1658  if (lidebug.ge.2) then
1659  call write_debug(name,'before mpi_startall send ',&
1660  send_persistent_request )
1661  endif
1662 
1663  call mpi_startall( nsend, send_persistent_request, ierror )
1664 
1665  if (lidebug .ge.2) then
1666  call write_debug(name,'after mpi_startall send ',&
1667  send_persistent_request )
1668  endif
1669 
1670  call mpi_check( 'sendrecv3_begin_1d:MPI_STARTALL ', ierror )
1671 
1672 
1673  else
1674 
1675  do ii=1,nsend
1676 
1677  ! ----------------------------
1678  ! perform copy into dsendbuffer
1679  ! ----------------------------
1680 
1681  j1 = xsend(ii)
1682  j2 = xsend(ii+1)-1
1683  count = j2-j1+1
1684 
1685  do jj=j1,j2
1686  ijk = sendijk( jj )
1687  dsendbuffer(jj) = xx(ijk)
1688  enddo
1689 
1690  dest = sendproc( ii )
1691  tag = sendtag( ii )
1692 
1693  if (lidebug.ge.2) then
1694 
1695  call write_debug(name, 'mpi_isend: ii,j1,j2 ', ii,j1,j2)
1696  call write_debug(name, 'count, dest, tag ', count,dest,tag )
1697  endif
1698 
1699 
1700  call mpi_isend( dsendbuffer(j1), count, datatype, dest, tag, &
1701  comm, request, ierror )
1702  call mpi_check( 'sendrecv3_begin_1d:MPI_ISEND ', ierror )
1703 
1704  sendrequest( ii ) = request
1705  enddo
1706 
1707  endif
1708 
1709  endif
1710 
1711 #endif
1712 
1713  return
1714  end subroutine sendrecv3_begin_1d
1715 
1716 
1717  subroutine sendrecv3_begin_1i( XX, ilayer, idebug )
1718 
1719  use functions
1720 
1721  implicit none
1722 
1723  integer, intent(in),optional :: ilayer
1724  integer, intent(inout), dimension(:) :: XX
1725  integer, intent(in), optional :: idebug
1726 
1727 #ifdef MPI
1728 
1729  ! ---------------
1730  ! local variables
1731  ! ---------------
1732  character(len=80), parameter :: name = 'sendrecv3_begin_1i'
1733 
1734  integer :: lidebug
1735 
1736  integer :: layer, datatype, comm, recvsize, sendsize, &
1737  ijk,jj,j1,j2, request, ii,count,source,dest, tag, ierror
1738 
1739  lidebug = 0
1740  if (present(idebug)) then
1741  lidebug = idebug
1742  endif
1743 
1744  layer = 1
1745  if (present(ilayer)) then
1746  layer = ilayer
1747  endif
1748 
1749  if (layer.eq.1) then
1750  nrecv = nrecv1
1751  recvtag =>recvtag1
1752  recvproc => recvproc1
1753  recvijk => recvijk1
1754  xrecv => xrecv1
1755 
1756  nsend = nsend1
1757  sendtag => sendtag1
1758  sendproc => sendproc1
1759  sendijk => sendijk1
1760  xsend => xsend1
1761  else if (layer.eq.2) then
1762  nrecv = nrecv2
1763  recvtag =>recvtag2
1764  recvproc => recvproc2
1765  recvijk => recvijk2
1766  xrecv => xrecv2
1767 
1768  nsend = nsend2
1769  sendtag => sendtag2
1770  sendproc => sendproc2
1771  sendijk => sendijk2
1772  xsend => xsend2
1773  else if (layer.eq.3) then
1774  !---------------
1775  !EFD extra layer
1776  !---------------
1777  nrecv = nrecv3
1778  recvtag =>recvtag3
1779  recvproc => recvproc3
1780  recvijk => recvijk3
1781  xrecv => xrecv3
1782 
1783  nsend = nsend3
1784  sendtag => sendtag3
1785  sendproc => sendproc3
1786  sendijk => sendijk3
1787  xsend => xsend3
1788  endif
1789 
1790 
1791  ! --------------------------
1792  ! post asynchronous receives
1793  ! --------------------------
1794 
1795  if (lidebug.ge.1) then
1796  call write_debug(name, &
1797  'post asynchronous receives, nrecv = ', nrecv )
1798  endif
1799 
1800  if (nrecv.ge.1) then
1801  recvsize = xrecv( nrecv+1)-1
1802  allocate( irecvbuffer( recvsize ) )
1803 
1804  if (lidebug.ge.1) then
1805  call write_debug( name, &
1806  'recvsize, ubound(irecvbuffer,1) ', &
1807  recvsize, ubound(irecvbuffer,1) )
1808 
1809  call write_debug( name, 'ubound(xrecv,1) ', &
1810  ubound(xrecv,1) )
1811  call write_debug( name, 'ubound(recvproc,1) ', &
1812  ubound(recvproc,1) )
1813  call write_debug( name, 'ubound(recvtag,1) ', &
1814  ubound(recvtag,1) )
1815 
1816  endif
1817 
1818  ! -------------
1819  ! post receives
1820  ! -------------
1821  datatype = mpi_integer
1822  comm = communicator
1823 
1824  do ii=1,nrecv
1825  j1 = xrecv(ii)
1826  j2 = xrecv(ii+1)-1
1827  count = j2-j1+1
1828  source = recvproc( ii )
1829  tag = recvtag( ii )
1830 
1831 
1832  if (lidebug.ge.2) then
1833 
1834  call write_debug(name, 'mpi_irecv: ii,j1,j2 ', ii,j1,j2 )
1835  call write_debug(name, 'count, source, tag ', &
1836  count,source,tag )
1837  endif
1838 
1839  call mpi_irecv( irecvbuffer(j1), count, datatype, source, tag, &
1840  comm, request, ierror )
1841 
1842  call mpi_check( 'sendrecv3_begin_1i:MPI_IRECV ', ierror )
1843 
1844  recvrequest( ii ) = request
1845  enddo
1846 
1847  endif
1848 
1849  ! -----------------------
1850  ! post asynchronous sends
1851  ! -----------------------
1852 
1853  if (lidebug.ge.1) then
1854 
1855  call write_debug(name, 'post asynchronous sends ')
1856  endif
1857 
1858  if (nsend.ge.1) then
1859  sendsize = xsend( nsend+1)-1
1860  allocate( isendbuffer( sendsize ) )
1861 
1862  if (lidebug.ge.1) then
1863 
1864  call write_debug( name, 'sendsize, ubound(isendbuffer,1) ', &
1865  sendsize, ubound(isendbuffer,1) )
1866 
1867  call write_debug( name, 'ubound(xsend,1) ', &
1868  ubound(xsend,1) )
1869  call write_debug( name, 'ubound(sendproc,1) ', &
1870  ubound(sendproc,1) )
1871  call write_debug( name, 'ubound(sendtag,1) ', &
1872  ubound(sendtag,1) )
1873 
1874  endif
1875 
1876 
1877 
1878 
1879  ! -------------
1880  ! perform sends
1881  ! -------------
1882  datatype = mpi_integer
1883  comm = communicator
1884 
1885  do ii=1,nsend
1886 
1887  ! ----------------------------
1888  ! perform copy into sendbuffer
1889  ! ----------------------------
1890 
1891  j1 = xsend(ii)
1892  j2 = xsend(ii+1)-1
1893  count = j2-j1+1
1894 
1895  do jj=j1,j2
1896  ijk = sendijk( jj )
1897  isendbuffer(jj) = xx(ijk)
1898  enddo
1899 
1900  dest = sendproc( ii )
1901  tag = sendtag( ii )
1902 
1903  if (lidebug.ge.2) then
1904 
1905  call write_debug(name, 'mpi_isend: ii,j1,j2 ', ii,j1,j2)
1906  call write_debug(name, 'count, dest, tag ', count,dest,tag )
1907  endif
1908 
1909 
1910  call mpi_isend( isendbuffer(j1), count, datatype, dest, tag, &
1911  comm, request, ierror )
1912  call mpi_check( 'sendrecv3_begin_1i:MPI_ISEND ', ierror )
1913 
1914  sendrequest( ii ) = request
1915  enddo
1916 
1917  endif
1918 
1919 #endif
1920 
1921  return
1922  end subroutine sendrecv3_begin_1i
1923 
1924 
1925  subroutine sendrecv3_begin_1c( XX, ilayer, idebug )
1926 
1927  use functions
1928 
1929  implicit none
1930 
1931  integer, intent(in),optional :: ilayer
1932  character(len=*), intent(inout), dimension(:) :: XX
1933  integer, intent(in), optional :: idebug
1934 
1935 #ifdef MPI
1936 
1937  ! ---------------
1938  ! local variables
1939  ! ---------------
1940  character(len=80), parameter :: name = 'sendrecv3_begin_1c'
1941 
1942  integer :: lidebug
1943 
1944  integer :: layer, datatype, comm, recvsize, sendsize, &
1945  ijk,jj,j1,j2, request, ii,count,source,dest, tag, ierror
1946 
1947  integer :: ic, clen, jpos
1948 
1949  lidebug = 0
1950  if (present(idebug)) then
1951  lidebug = idebug
1952  endif
1953 
1954  layer = 1
1955  if (present(ilayer)) then
1956  layer = ilayer
1957  endif
1958 
1959  jpos = lbound(xx,1)
1960  clen = len( xx( jpos ) )
1961 
1962  if (layer.eq.1) then
1963  nrecv = nrecv1
1964  recvtag =>recvtag1
1965  recvproc => recvproc1
1966  recvijk => recvijk1
1967  xrecv => xrecv1
1968 
1969  nsend = nsend1
1970  sendtag => sendtag1
1971  sendproc => sendproc1
1972  sendijk => sendijk1
1973  xsend => xsend1
1974  else if (layer.eq.2) then
1975  nrecv = nrecv2
1976  recvtag =>recvtag2
1977  recvproc => recvproc2
1978  recvijk => recvijk2
1979  xrecv => xrecv2
1980 
1981  nsend = nsend2
1982  sendtag => sendtag2
1983  sendproc => sendproc2
1984  sendijk => sendijk2
1985  xsend => xsend2
1986  else if (layer.eq.3) then
1987  !----------------
1988  !EFD extra layer
1989  !----------------
1990 
1991  nrecv = nrecv3
1992  recvtag =>recvtag3
1993  recvproc => recvproc3
1994  recvijk => recvijk3
1995  xrecv => xrecv3
1996 
1997  nsend = nsend3
1998  sendtag => sendtag3
1999  sendproc => sendproc3
2000  sendijk => sendijk3
2001  xsend => xsend3
2002  endif
2003 
2004 
2005  ! --------------------------
2006  ! post asynchronous receives
2007  ! --------------------------
2008 
2009  if (lidebug.ge.1) then
2010  call write_debug(name, 'post asynchronous receives, nrecv = ', nrecv )
2011  endif
2012 
2013  if (nrecv.ge.1) then
2014  recvsize = xrecv( nrecv+1)-1
2015 
2016  allocate( crecvbuffer( recvsize*clen ) )
2017 
2018  if (lidebug.ge.1) then
2019  call write_debug( name, 'recvsize, ubound(crecvbuffer,1) ', &
2020  recvsize, ubound(crecvbuffer,1) )
2021 
2022  call write_debug( name, 'ubound(xrecv,1) ', &
2023  ubound(xrecv,1) )
2024  call write_debug( name, 'ubound(recvproc,1) ', &
2025  ubound(recvproc,1) )
2026  call write_debug( name, 'ubound(recvtag,1) ', &
2027  ubound(recvtag,1) )
2028 
2029  endif
2030 
2031  ! -------------
2032  ! post receives
2033  ! -------------
2034  datatype = mpi_character
2035  comm = communicator
2036 
2037  do ii=1,nrecv
2038  j1 = xrecv(ii)
2039  j2 = xrecv(ii+1)-1
2040 
2041  count = j2-j1+1
2042  count = count*clen
2043 
2044  source = recvproc( ii )
2045  tag = recvtag( ii )
2046 
2047 
2048  if (lidebug.ge.2) then
2049 
2050  call write_debug(name, 'mpi_irecv: ii,j1,j2 ', ii,j1,j2 )
2051  call write_debug(name, 'count, source, tag ', &
2052  count,source,tag )
2053  endif
2054 
2055  jpos = 1 + (j1-1)*clen
2056  call mpi_irecv( crecvbuffer(jpos), count, datatype, source, tag, &
2057  comm, request, ierror )
2058 
2059  call mpi_check( 'sendrecv3_begin_1c:MPI_IRECV ', ierror )
2060 
2061  recvrequest( ii ) = request
2062  enddo
2063 
2064  endif
2065 
2066  ! -----------------------
2067  ! post asynchronous sends
2068  ! -----------------------
2069 
2070  if (lidebug.ge.1) then
2071 
2072  call write_debug(name, 'post asynchronous sends ')
2073  endif
2074 
2075  if (nsend.ge.1) then
2076  sendsize = xsend( nsend+1)-1
2077 
2078  allocate( csendbuffer( sendsize*clen ) )
2079 
2080  if (lidebug.ge.1) then
2081 
2082  call write_debug( name, 'sendsize, ubound(csendbuffer,1) ', &
2083  sendsize, ubound(csendbuffer,1) )
2084 
2085  call write_debug( name, 'ubound(xsend,1) ', &
2086  ubound(xsend,1) )
2087  call write_debug( name, 'ubound(sendproc,1) ', &
2088  ubound(sendproc,1) )
2089  call write_debug( name, 'ubound(sendtag,1) ', &
2090  ubound(sendtag,1) )
2091 
2092  endif
2093 
2094 
2095 
2096 
2097  ! -------------
2098  ! perform sends
2099  ! -------------
2100  datatype = mpi_character
2101  comm = communicator
2102 
2103  do ii=1,nsend
2104 
2105  ! ----------------------------
2106  ! perform copy into sendbuffer
2107  ! ----------------------------
2108 
2109  j1 = xsend(ii)
2110  j2 = xsend(ii+1)-1
2111 
2112 
2113  count = j2-j1+1
2114  count = count*clen
2115 
2116  do jj=j1,j2
2117  ijk = sendijk( jj )
2118  do ic=1,clen
2119  jpos = (jj-1)*clen + ic
2120  csendbuffer(jpos) = xx(ijk)(ic:ic)
2121  enddo
2122  enddo
2123 
2124  dest = sendproc( ii )
2125  tag = sendtag( ii )
2126 
2127  if (lidebug.ge.2) then
2128 
2129  call write_debug(name, 'mpi_isend: ii,j1,j2 ', ii,j1,j2)
2130  call write_debug(name, 'count, dest, tag ', count,dest,tag )
2131  endif
2132 
2133 
2134  jpos = (j1-1)*clen + 1
2135  call mpi_isend( csendbuffer(jpos), count, datatype, dest, tag, &
2136  comm, request, ierror )
2137  call mpi_check( 'sendrecv3_begin_1c:MPI_ISEND ', ierror )
2138 
2139  sendrequest( ii ) = request
2140  enddo
2141 
2142  endif
2143 #endif
2144 
2145  return
2146  end subroutine sendrecv3_begin_1c
2147 
2148 
2149  subroutine sendrecv3_end_1d( XX, idebug )
2150 
2151  use functions
2152 
2153  implicit none
2154 
2155  double precision, intent(inout), dimension(:) :: XX
2156  integer, intent(in), optional :: idebug
2157 
2158 #ifdef MPI
2159 
2160  ! ---------------
2161  ! local variables
2162  ! ---------------
2163  character(len=80), parameter :: name = 'sendrecv3_end_1d'
2164 
2165  logical, parameter :: use_waitany = .false.
2166 
2167  integer :: lidebug
2168  integer :: jj,ijk, jindex, ii,j1,j2, ierror
2169 
2170  integer, dimension(:,:), pointer :: send_status
2171 
2172  ! --------------------------
2173  ! wait for sends to complete
2174  ! --------------------------
2175 
2176  lidebug = 0
2177  if (present(idebug)) then
2178  lidebug = idebug
2179  endif
2180 
2181  if (nsend .ge.1) then
2182 
2183  if (lidebug.ge.1) then
2184 
2185  call write_debug(name, &
2186  'waiting for sends to complete, nsend = ', nsend )
2187  endif
2188 
2189  allocate( send_status(mpi_status_size,nsend))
2190 
2191  if (use_persistent_message) then
2192  call mpi_waitall( nsend, send_persistent_request, &
2193  send_status, ierror )
2194  else
2195  call mpi_waitall( nsend, sendrequest, send_status, ierror )
2196  endif
2197 
2198  call mpi_check( 'sendrecv3_end_1d:MPI_WAITALL ', ierror )
2199 
2200  deallocate( send_status )
2201  nullify( send_status )
2202 
2203 
2204  endif
2205 
2206 
2207  ! --------------------------
2208  ! wait for recvs to complete
2209  ! --------------------------
2210  if (nrecv.ge.1) then
2211 
2212  if (lidebug.ge.1) then
2213 
2214  call write_debug( name, &
2215  'waiting for receives to complete, nrecv = ', nrecv )
2216  endif
2217 
2218  if (use_waitany) then
2219  do ii=1,nrecv
2220 
2221  if (use_persistent_message) then
2222  call mpi_waitany( nrecv, recv_persistent_request, &
2223  jindex, mpi_status_ignore, ierror )
2224  else
2225  call mpi_waitany( nrecv, recvrequest, &
2226  jindex, mpi_status_ignore, ierror )
2227  endif
2228 
2229  call mpi_check( 'sendrecv3_end_1d:MPI_WAITANY ', ierror )
2230 
2231  j1 = xrecv( jindex )
2232  j2 = xrecv( jindex + 1)-1
2233 
2234  if (lidebug.ge.2) then
2235  call write_debug(name, 'jindex, j1,j2 ', jindex,j1,j2 )
2236  endif
2237 
2238  do jj=j1,j2
2239  ijk = recvijk( jj )
2240  xx(ijk) = drecvbuffer(jj)
2241  enddo
2242  enddo
2243  else
2244  if (use_persistent_message) then
2245  call mpi_waitall( nrecv, recv_persistent_request, mpi_statuses_ignore, ierror )
2246  else
2247  call mpi_waitall( nrecv, recvrequest, mpi_statuses_ignore, ierror )
2248  endif
2249  call mpi_check( 'sendrecv3_end_1d:MPI_WAITALL recv ', ierror )
2250 
2251  j1 = xrecv(1)
2252  j2 = xrecv( nrecv +1)-1
2253  do jj=j1,j2
2254  ijk = recvijk( jj )
2255  xx(ijk) = drecvbuffer(jj)
2256  enddo
2257  endif
2258  endif
2259 #endif
2260 
2261  return
2262  end subroutine sendrecv3_end_1d
2263 
2264 
2265  subroutine sendrecv3_end_1c( XX, idebug )
2266 
2267  use functions
2268 
2269  implicit none
2270 
2271  character(len=*), intent(inout), dimension(:) :: XX
2272  integer, intent(in), optional :: idebug
2273 
2274 #ifdef MPI
2275 
2276  ! ---------------
2277  ! local variables
2278  ! ---------------
2279  character(len=80), parameter :: name = 'sendrecv3_end_1c'
2280 
2281  integer :: ic, clen, jpos
2282 
2283  logical, parameter :: use_waitany = .false.
2284 
2285  integer :: lidebug
2286  integer :: jj,ijk, jindex, ii,j1,j2, ierror
2287 
2288  integer, dimension(:,:), pointer :: send_status
2289 
2290  ! --------------------------
2291  ! wait for sends to complete
2292  ! --------------------------
2293 
2294  lidebug = 0
2295  if (present(idebug)) then
2296  lidebug = idebug
2297  endif
2298 
2299  jpos = lbound(xx,1)
2300  clen = len(xx(jpos))
2301 
2302  if (nsend .ge.1) then
2303 
2304  if (lidebug.ge.1) then
2305 
2306  call write_debug(name, &
2307  'waiting for sends to complete, nsend = ', nsend )
2308  endif
2309 
2310 
2311  allocate( send_status(mpi_status_size,nsend))
2312 
2313  call mpi_waitall( nsend, sendrequest, send_status, ierror )
2314  call mpi_check( 'sendrecv3_end_1c:MPI_WAITALL ', ierror )
2315 
2316  deallocate( send_status )
2317  nullify( send_status )
2318 
2319  deallocate( csendbuffer )
2320  nullify( csendbuffer )
2321 
2322  endif
2323 
2324 
2325  ! --------------------------
2326  ! wait for recvs to complete
2327  ! --------------------------
2328  if (nrecv.ge.1) then
2329 
2330  if (lidebug.ge.1) then
2331 
2332  call write_debug( name, &
2333  'waiting for receives to complete, nrecv = ', nrecv )
2334  endif
2335 
2336  if (use_waitany) then
2337  do ii=1,nrecv
2338  call mpi_waitany( nrecv, recvrequest, jindex, mpi_status_ignore, ierror )
2339  call mpi_check( 'sendrecv3_end_1c:MPI_WAITANY ', ierror )
2340 
2341  j1 = xrecv( jindex )
2342  j2 = xrecv( jindex + 1)-1
2343 
2344  if (lidebug.ge.2) then
2345  call write_debug(name, 'jindex, j1,j2 ', jindex,j1,j2 )
2346  endif
2347 
2348  do jj=j1,j2
2349  ijk = recvijk( jj )
2350 
2351  do ic=1,clen
2352  jpos = (jj-1)*clen + ic
2353  xx(ijk)(ic:ic) = crecvbuffer(jpos)
2354  enddo
2355 
2356  enddo
2357  enddo
2358  else
2359  call mpi_waitall( nrecv, recvrequest, mpi_statuses_ignore, ierror )
2360  call mpi_check( 'sendrecv3_end_1c:MPI_WAITALL recv ', ierror )
2361 
2362  j1 = xrecv(1)
2363  j2 = xrecv( nrecv +1)-1
2364  do jj=j1,j2
2365  ijk = recvijk( jj )
2366 
2367  do ic=1,clen
2368  jpos = (jj-1)*clen + ic
2369  xx(ijk)(ic:ic) = crecvbuffer(jpos)
2370  enddo
2371 
2372 
2373 
2374  enddo
2375  endif
2376 
2377  deallocate( crecvbuffer )
2378  nullify( crecvbuffer )
2379 
2380  endif
2381 #endif
2382 
2383  return
2384  end subroutine sendrecv3_end_1c
2385 
2386 
2387  subroutine sendrecv3_end_1i( XX, idebug )
2388 
2389  use functions
2390 
2391  implicit none
2392 
2393  integer, intent(inout), dimension(:) :: XX
2394  integer, intent(in), optional :: idebug
2395 
2396 #ifdef MPI
2397 
2398  ! ---------------
2399  ! local variables
2400  ! ---------------
2401  character(len=80), parameter :: name = 'sendrecv3_end_1i'
2402 
2403  logical, parameter :: use_waitany = .false.
2404 
2405  integer :: lidebug
2406  integer :: jj,ijk, jindex, ii,j1,j2, ierror
2407 
2408  integer, dimension(:,:), pointer :: send_status
2409 
2410  ! --------------------------
2411  ! wait for sends to complete
2412  ! --------------------------
2413 
2414  lidebug = 0
2415  if (present(idebug)) then
2416  lidebug = idebug
2417  endif
2418 
2419  if (nsend .ge.1) then
2420 
2421  if (lidebug.ge.1) then
2422 
2423  call write_debug(name, &
2424  'waiting for sends to complete, nsend = ', nsend )
2425  endif
2426 
2427  allocate( send_status(mpi_status_size,nsend))
2428 
2429  call mpi_waitall( nsend, sendrequest, send_status, ierror )
2430  call mpi_check( 'sendrecv3_end_1i:MPI_WAITALL ', ierror )
2431 
2432  deallocate( send_status )
2433  nullify( send_status )
2434 
2435  deallocate( isendbuffer )
2436  nullify( isendbuffer )
2437 
2438  endif
2439 
2440 
2441  ! --------------------------
2442  ! wait for recvs to complete
2443  ! --------------------------
2444  if (nrecv.ge.1) then
2445 
2446  if (lidebug.ge.1) then
2447 
2448  call write_debug( name, &
2449  'waiting for receives to complete, nrecv = ', nrecv )
2450  endif
2451 
2452  if (use_waitany) then
2453  do ii=1,nrecv
2454  call mpi_waitall( nrecv, recvrequest, mpi_statuses_ignore, ierror )
2455  call mpi_check( 'sendrecv3_end_1i:MPI_WAITANY ', ierror )
2456 
2457  j1 = xrecv( jindex )
2458  j2 = xrecv( jindex + 1)-1
2459 
2460  if (lidebug.ge.2) then
2461  call write_debug(name, 'jindex, j1,j2 ', jindex,j1,j2 )
2462  endif
2463 
2464  do jj=j1,j2
2465  ijk = recvijk( jj )
2466  xx(ijk) = irecvbuffer(jj)
2467  enddo
2468  enddo
2469  else
2470  call mpi_waitall( nrecv, recvrequest, mpi_statuses_ignore, ierror )
2471  call mpi_check( 'sendrecv3_end_1i:MPI_WAITALL recv ', ierror )
2472 
2473  j1 = xrecv(1)
2474  j2 = xrecv( nrecv +1)-1
2475  do jj=j1,j2
2476  ijk = recvijk( jj )
2477  xx(ijk) = irecvbuffer(jj)
2478  enddo
2479  endif
2480 
2481  deallocate( irecvbuffer )
2482  nullify( irecvbuffer )
2483 
2484  endif
2485 #endif
2486 
2487  return
2488  end subroutine sendrecv3_end_1i
2489 
2490 
2491  subroutine send_recv3_1c( XX, ilayer, idebug )
2492  implicit none
2493 
2494  character(len=*), dimension(:), intent(inout) :: XX
2495  integer, intent(in), optional :: ilayer,idebug
2496 
2497  integer :: lidebug, layer
2498 
2499 #ifdef MPI
2500  lidebug = 0
2501  if (present(idebug)) then
2502  lidebug = idebug
2503  endif
2504 
2505  layer = 1
2506  if (present(ilayer)) then
2507  layer = ilayer
2508  endif
2509 
2510  call sendrecv3_begin(xx,layer,lidebug)
2511  call sendrecv3_end( xx, lidebug )
2512 #endif
2513 
2514  return
2515  end subroutine send_recv3_1c
2516 
2517  subroutine send_recv3_1d( XX, ilayer, idebug )
2518  implicit none
2519 
2520  double precision, dimension(:), intent(inout) :: XX
2521  integer, intent(in), optional :: ilayer,idebug
2522 
2523  integer :: lidebug, layer
2524 
2525 #ifdef MPI
2526  lidebug = 0
2527  if (present(idebug)) then
2528  lidebug = idebug
2529  endif
2530 
2531  layer = 1
2532  if (present(ilayer)) then
2533  layer = ilayer
2534  endif
2535 
2536  call sendrecv3_begin(xx,layer,lidebug)
2537  call sendrecv3_end( xx, lidebug )
2538 #endif
2539 
2540  return
2541  end subroutine send_recv3_1d
2542 
2543  subroutine send_recv3_2d( XX, ilayer, idebug )
2544  implicit none
2545 
2546  double precision, dimension(:,:), intent(inout) :: XX
2547  integer, intent(in), optional :: ilayer,idebug
2548 
2549  integer :: lidebug, layer
2550 #ifdef MPI
2551  integer :: j
2552 
2553  lidebug = 0
2554  if (present(idebug)) then
2555  lidebug = idebug
2556  endif
2557 
2558  layer = 1
2559  if (present(ilayer)) then
2560  layer = ilayer
2561  endif
2562 
2563  do j=lbound(xx,2),ubound(xx,2)
2564  call sendrecv3_begin(xx(:,j),layer,lidebug)
2565  call sendrecv3_end( xx(:,j), lidebug )
2566  enddo
2567 #endif
2568 
2569  return
2570  end subroutine send_recv3_2d
2571 
2572  subroutine send_recv3_3d( XX, ilayer, idebug )
2573  implicit none
2574 
2575  double precision, dimension(:,:,:), intent(inout) :: XX
2576  integer, intent(in), optional :: ilayer,idebug
2577 
2578  integer :: lidebug, layer
2579 
2580 #ifdef MPI
2581  integer :: j,k
2582 
2583  lidebug = 0
2584  if (present(idebug)) then
2585  lidebug = idebug
2586  endif
2587 
2588  layer = 1
2589  if (present(ilayer)) then
2590  layer = ilayer
2591  endif
2592 
2593  do k=lbound(xx,3),ubound(xx,3)
2594  do j=lbound(xx,2),ubound(xx,2)
2595  call sendrecv3_begin(xx(:,j,k),layer,lidebug)
2596  call sendrecv3_end( xx(:,j,k), lidebug )
2597  enddo
2598  enddo
2599 #endif
2600 
2601  return
2602  end subroutine send_recv3_3d
2603 
2604  subroutine send_recv3_1i( XX, ilayer, idebug )
2605  implicit none
2606 
2607  integer, dimension(:), intent(inout) :: XX
2608  integer, intent(in), optional :: ilayer,idebug
2609 
2610  integer :: lidebug, layer
2611 
2612 #ifdef MPI
2613  lidebug = 0
2614  if (present(idebug)) then
2615  lidebug = idebug
2616  endif
2617 
2618  layer = 1
2619  if (present(ilayer)) then
2620  layer = ilayer
2621  endif
2622 
2623  call sendrecv3_begin(xx,layer,lidebug)
2624  call sendrecv3_end( xx, lidebug )
2625 #endif
2626 
2627  return
2628  end subroutine send_recv3_1i
2629 
2630 end module sendrecv3
compar::istart1_all
integer, dimension(:), allocatable istart1_all
Definition: compar_mod.f:65
sendrecv3::jend_all_mype
integer jend_all_mype
Definition: sendrecv3_mod.f:52
compar::imap
integer, dimension(:), allocatable imap
Definition: compar_mod.f:77
sendrecv3::recvproc2
integer, dimension(:), pointer recvproc2
Definition: sendrecv3_mod.f:10
sendrecv3::sendrecv3_begin_1c
subroutine sendrecv3_begin_1c(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:1926
compar::kstart1_all
integer, dimension(:), allocatable kstart1_all
Definition: compar_mod.f:65
sendrecv3::send_persistent_request
integer, dimension(:), pointer send_persistent_request
Definition: sendrecv3_mod.f:17
sendrecv3::communicator
integer communicator
Definition: sendrecv3_mod.f:56
geometry::imax2
integer imax2
Definition: geometry_mod.f:61
indices::i_of
integer, dimension(:), allocatable i_of
Definition: indices_mod.f:45
sendrecv3::nsend2
integer nsend2
Definition: sendrecv3_mod.f:22
compar::jstart4_all
integer, dimension(:), allocatable jstart4_all
Definition: compar_mod.f:90
sendrecv3::ijk_of
subroutine ijk_of(ijkp, i, j, k)
Definition: sendrecv3_mod.f:86
compar::kend4_all
integer, dimension(:), allocatable kend4_all
Definition: compar_mod.f:90
compar::kend1_all
integer, dimension(:), allocatable kend1_all
Definition: compar_mod.f:65
compar::istart2_all
integer, dimension(:), allocatable istart2_all
Definition: compar_mod.f:65
geometry::imax3
integer imax3
Definition: geometry_mod.f:91
sendrecv3::ijk_of_gl
subroutine ijk_of_gl(ijkp, i, j, k)
Definition: sendrecv3_mod.f:154
sendrecv3::send_recv3_2d
subroutine send_recv3_2d(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:2544
sendrecv3::recv_persistent_request
integer, dimension(:), pointer recv_persistent_request
Definition: sendrecv3_mod.f:17
compar::kstart2_all
integer, dimension(:), allocatable kstart2_all
Definition: compar_mod.f:65
sendrecv3::nsend1
integer nsend1
Definition: sendrecv3_mod.f:22
geometry::kmin4
integer kmin4
Definition: geometry_mod.f:94
sendrecv3::irecvbuffer
integer, dimension(:), pointer irecvbuffer
Definition: sendrecv3_mod.f:41
compar::iend3_all
integer, dimension(:), allocatable iend3_all
Definition: compar_mod.f:65
sendrecv3::nsend3
integer nsend3
Definition: sendrecv3_mod.f:31
compar::istart4_all
integer, dimension(:), allocatable istart4_all
Definition: compar_mod.f:90
sendrecv3::send_persistent_request3
integer, dimension(:), pointer send_persistent_request3
Definition: sendrecv3_mod.f:27
sendrecv3::recvproc1
integer, dimension(:), pointer recvproc1
Definition: sendrecv3_mod.f:10
debug::write_debug
Definition: debug_mod.f:15
geometry::imax4
integer imax4
Definition: geometry_mod.f:95
sendrecv3::localfunc
logical, parameter localfunc
Definition: sendrecv3_mod.f:34
sendrecv3::xsend2
integer, dimension(:), pointer xsend2
Definition: sendrecv3_mod.f:10
sendrecv3::sendrecv3_end_1c
subroutine sendrecv3_end_1c(XX, idebug)
Definition: sendrecv3_mod.f:2266
sendrecv3::send_recv3_1c
subroutine send_recv3_1c(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:2492
geometry::jmin2
integer jmin2
Definition: geometry_mod.f:89
geometry::imin3
integer imin3
Definition: geometry_mod.f:90
sendrecv3::send_recv3_3d
subroutine send_recv3_3d(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:2573
sendrecv3::sendtag3
integer, dimension(:), pointer sendtag3
Definition: sendrecv3_mod.f:27
sendrecv3::istart_all_mype
integer istart_all_mype
Definition: sendrecv3_mod.f:52
sendrecv3::csendbuffer
character, dimension(:), pointer csendbuffer
Definition: sendrecv3_mod.f:43
sendrecv3::sendrecv3_begin_1d
subroutine sendrecv3_begin_1d(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:1437
sendrecv3::nrecv1
integer nrecv1
Definition: sendrecv3_mod.f:22
compar::numpes
integer numpes
Definition: compar_mod.f:24
sendrecv3::sendproc
integer, dimension(:), pointer sendproc
Definition: sendrecv3_mod.f:47
sendrecv3::recvtag
integer, dimension(:), pointer recvtag
Definition: sendrecv3_mod.f:47
sendrecv3::recvproc3
integer, dimension(:), pointer recvproc3
Definition: sendrecv3_mod.f:27
sendrecv3::send_recv3_1i
subroutine send_recv3_1i(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:2605
sendrecv3::recvijk1
integer, dimension(:), pointer recvijk1
Definition: sendrecv3_mod.f:10
indices::k_of
integer, dimension(:), allocatable k_of
Definition: indices_mod.f:47
ic
Definition: ic_mod.f:9
sendrecv3::sendrecv3_end_1d
subroutine sendrecv3_end_1d(XX, idebug)
Definition: sendrecv3_mod.f:2150
sendrecv3::drecvbuffer
double precision, dimension(:), pointer drecvbuffer
Definition: sendrecv3_mod.f:39
geometry::kmax4
integer kmax4
Definition: geometry_mod.f:95
compar::kstart4_all
integer, dimension(:), allocatable kstart4_all
Definition: compar_mod.f:90
geometry::kmax1
integer kmax1
Definition: geometry_mod.f:58
sendrecv3::nlayers
integer, parameter nlayers
Definition: sendrecv3_mod.f:32
geometry::imin4
integer imin4
Definition: geometry_mod.f:94
compar::kstart3_all
integer, dimension(:), allocatable kstart3_all
Definition: compar_mod.f:65
exit::mfix_exit
subroutine mfix_exit(myID, normal_termination)
Definition: exit.f:5
compar::istart3_all
integer, dimension(:), allocatable istart3_all
Definition: compar_mod.f:65
sendrecv3::crecvbuffer
character, dimension(:), pointer crecvbuffer
Definition: sendrecv3_mod.f:43
sendrecv3::xsend
integer, dimension(:), pointer xsend
Definition: sendrecv3_mod.f:47
sendrecv3::xrecv
integer, dimension(:), pointer xrecv
Definition: sendrecv3_mod.f:47
sendrecv3::recv_persistent_request2
integer, dimension(:), pointer recv_persistent_request2
Definition: sendrecv3_mod.f:17
indices::j_of
integer, dimension(:), allocatable j_of
Definition: indices_mod.f:46
parallel_mpi
Definition: parallel_mpi_mod.f:1
compar::jend2_all
integer, dimension(:), allocatable jend2_all
Definition: compar_mod.f:65
sendrecv3::nrecv2
integer nrecv2
Definition: sendrecv3_mod.f:22
compar::jend4_all
integer, dimension(:), allocatable jend4_all
Definition: compar_mod.f:90
geometry::imax1
integer imax1
Definition: geometry_mod.f:54
debug
Definition: debug_mod.f:1
sendrecv3::recv_persistent_request3
integer, dimension(:), pointer recv_persistent_request3
Definition: sendrecv3_mod.f:27
geometry::jmax2
integer jmax2
Definition: geometry_mod.f:63
sendrecv3::send_persistent_request2
integer, dimension(:), pointer send_persistent_request2
Definition: sendrecv3_mod.f:17
exit
Definition: exit.f:2
sendrecv3::isendbuffer
integer, dimension(:), pointer isendbuffer
Definition: sendrecv3_mod.f:41
compar::iend2_all
integer, dimension(:), allocatable iend2_all
Definition: compar_mod.f:65
compar::jstart3_all
integer, dimension(:), allocatable jstart3_all
Definition: compar_mod.f:65
sendrecv3::nsend
integer nsend
Definition: sendrecv3_mod.f:46
sendrecv3::sendtag1
integer, dimension(:), pointer sendtag1
Definition: sendrecv3_mod.f:10
geometry::jmax3
integer jmax3
Definition: geometry_mod.f:91
sendrecv3::xrecv1
integer, dimension(:), pointer xrecv1
Definition: sendrecv3_mod.f:10
sendrecv3::sendijk3
integer, dimension(:), pointer sendijk3
Definition: sendrecv3_mod.f:27
sendrecv3::xrecv2
integer, dimension(:), pointer xrecv2
Definition: sendrecv3_mod.f:10
compar::kend2_all
integer, dimension(:), allocatable kend2_all
Definition: compar_mod.f:65
sendrecv3::send_recv3
Definition: sendrecv3_mod.f:75
sendrecv3::sendproc1
integer, dimension(:), pointer sendproc1
Definition: sendrecv3_mod.f:10
sendrecv3::sendrequest
integer, dimension(:), pointer sendrequest
Definition: sendrecv3_mod.f:47
geometry::kmax2
integer kmax2
Definition: geometry_mod.f:65
geometry::jmax1
integer jmax1
Definition: geometry_mod.f:56
sendrecv3::send_persistent_request1
integer, dimension(:), pointer send_persistent_request1
Definition: sendrecv3_mod.f:17
sendrecv3::sendrecv3_begin
Definition: sendrecv3_mod.f:61
sendrecv3::sendproc3
integer, dimension(:), pointer sendproc3
Definition: sendrecv3_mod.f:27
parallel_mpi::mpi_check
subroutine mpi_check(msg, ierr)
Definition: parallel_mpi_mod.f:45
debug::idebug
integer idebug
Definition: debug_mod.f:7
geometry::jmin3
integer jmin3
Definition: geometry_mod.f:90
compar::jstart1_all
integer, dimension(:), allocatable jstart1_all
Definition: compar_mod.f:65
sendrecv3::nrecv3
integer nrecv3
Definition: sendrecv3_mod.f:31
sendrecv3::sendijk2
integer, dimension(:), pointer sendijk2
Definition: sendrecv3_mod.f:10
sendrecv3::recvrequest
integer, dimension(:), pointer recvrequest
Definition: sendrecv3_mod.f:47
geometry::jmin4
integer jmin4
Definition: geometry_mod.f:94
geometry::jmin1
integer jmin1
Definition: geometry_mod.f:42
sendrecv3::sendrecv3_end_1i
subroutine sendrecv3_end_1i(XX, idebug)
Definition: sendrecv3_mod.f:2388
geometry::kmax3
integer kmax3
Definition: geometry_mod.f:91
compar::kend3_all
integer, dimension(:), allocatable kend3_all
Definition: compar_mod.f:65
sendrecv3::xrecv3
integer, dimension(:), pointer xrecv3
Definition: sendrecv3_mod.f:27
compar::mype
integer mype
Definition: compar_mod.f:24
sendrecv3::recvijk3
integer, dimension(:), pointer recvijk3
Definition: sendrecv3_mod.f:27
sendrecv3::kstart_all_mype
integer kstart_all_mype
Definition: sendrecv3_mod.f:52
sendrecv3::sendrecv3_init
subroutine sendrecv3_init( comm, cyclic_i, cyclic_j, cyclic_k, idebug)
Definition: sendrecv3_mod.f:222
compar::jend3_all
integer, dimension(:), allocatable jend3_all
Definition: compar_mod.f:65
sendrecv3::sendproc2
integer, dimension(:), pointer sendproc2
Definition: sendrecv3_mod.f:10
compar::jend1_all
integer, dimension(:), allocatable jend1_all
Definition: compar_mod.f:65
geometry::kmin3
integer kmin3
Definition: geometry_mod.f:90
sendrecv3::sendrecv3_end
Definition: sendrecv3_mod.f:68
sendrecv3::xsend1
integer, dimension(:), pointer xsend1
Definition: sendrecv3_mod.f:10
sendrecv3::sendtag
integer, dimension(:), pointer sendtag
Definition: sendrecv3_mod.f:47
compar::jmap
integer, dimension(:), allocatable jmap
Definition: compar_mod.f:77
sendrecv3::recvijk2
integer, dimension(:), pointer recvijk2
Definition: sendrecv3_mod.f:10
geometry::imin2
integer imin2
Definition: geometry_mod.f:89
sendrecv3::nrecv
integer nrecv
Definition: sendrecv3_mod.f:46
sendrecv3::sendijk1
integer, dimension(:), pointer sendijk1
Definition: sendrecv3_mod.f:10
sendrecv3::send_recv3_1d
subroutine send_recv3_1d(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:2518
compar::iend4_all
integer, dimension(:), allocatable iend4_all
Definition: compar_mod.f:90
sendrecv3::iend_all_mype
integer iend_all_mype
Definition: sendrecv3_mod.f:52
sendrecv3::recvproc
integer, dimension(:), pointer recvproc
Definition: sendrecv3_mod.f:47
sendrecv3::recvtag3
integer, dimension(:), pointer recvtag3
Definition: sendrecv3_mod.f:27
sendrecv3::recvijk
integer, dimension(:), pointer recvijk
Definition: sendrecv3_mod.f:47
sendrecv3::use_persistent_message
logical, parameter use_persistent_message
Definition: sendrecv3_mod.f:36
sendrecv3::sendtag2
integer, dimension(:), pointer sendtag2
Definition: sendrecv3_mod.f:10
geometry::imin1
integer imin1
Definition: geometry_mod.f:40
sendrecv3::recvtag1
integer, dimension(:), pointer recvtag1
Definition: sendrecv3_mod.f:10
sendrecv3::jstart_all_mype
integer jstart_all_mype
Definition: sendrecv3_mod.f:52
sendrecv3::recv_persistent_request1
integer, dimension(:), pointer recv_persistent_request1
Definition: sendrecv3_mod.f:17
sendrecv3::recvtag2
integer, dimension(:), pointer recvtag2
Definition: sendrecv3_mod.f:10
sendrecv3::dsendbuffer
double precision, dimension(:), pointer dsendbuffer
Definition: sendrecv3_mod.f:39
debug::write_error
subroutine write_error(name, line, lmax)
Definition: debug_mod.f:281
compar::jstart2_all
integer, dimension(:), allocatable jstart2_all
Definition: compar_mod.f:65
sendrecv3::xsend3
integer, dimension(:), pointer xsend3
Definition: sendrecv3_mod.f:27
geometry::kmin1
integer kmin1
Definition: geometry_mod.f:44
geometry::jmax4
integer jmax4
Definition: geometry_mod.f:95
sendrecv3::sendijk
integer, dimension(:), pointer sendijk
Definition: sendrecv3_mod.f:47
compar::kmap
integer, dimension(:), allocatable kmap
Definition: compar_mod.f:77
compar::iend1_all
integer, dimension(:), allocatable iend1_all
Definition: compar_mod.f:65
sendrecv3::sendrecv3_begin_1i
subroutine sendrecv3_begin_1i(XX, ilayer, idebug)
Definition: sendrecv3_mod.f:1718
sendrecv3::kend_all_mype
integer kend_all_mype
Definition: sendrecv3_mod.f:52
geometry::kmin2
integer kmin2
Definition: geometry_mod.f:89