! Recv data from north      if ( jlast < jm ) then        j = jlast + 1#if !defined(USE_MLP)#if !defined(MPI2)        nread = nread + 1        call mpi_wait(rqest(nread), Status, ierror)#endif        tdisp = igosouth*idimsize + (ncall_r-1)*idimsize*nbuf        call BufferUnPack3d(q, 1, im, jfirst-nd_s, jlast+nd_n, kfirst, klast, &                               1, im, j,           j,          kfirst, klast, &                               buff_r(tdisp+1))#else!$omp parallel do private(i, k)         do k=kfirst,klast            do i=1,im               q(i,j,k) = g_4d(i,j,k,1)             enddo         enddo#endif      endif#if !defined(USE_MLP)      if (ncall_r == ncall_s) then#if !defined(MPI2)        call mpi_waitall(nsend, sqest, Stats, ierror)        nrecv = 0        nread = 0        nsend = 0#endif        ncall_s = 0        ncall_r = 0      endif#endif      end subroutine mp_recv_n!-----      subroutine mp_send2_ns(im, jm, jfirst, jlast, kfirst, klast, nd, q1, q2)!-----      implicit none      integer, intent(in):: im, jm, jfirst, jlast      integer, intent(in):: kfirst, klast !careful: klast might be klast+1      integer, intent(in):: nd      real, intent(in):: q1(im,jfirst-nd:jlast+nd,kfirst:klast)       real, intent(in):: q2(im,jfirst-nd:jlast+nd,kfirst:klast) ! Local:      integer i, k      integer src, dest      integer qsize      integer recv_tag, send_tag      integer displ#if !defined(USE_MLP) && defined(MPI2)      integer p, tmpsize, mysize      integer(kind=MPI_ADDRESS_KIND) mydisp#endif#if !defined(USE_MLP)      ncall_s = ncall_s + 1#if defined(MPI2)      if (ncall_s == 1) then        call MPI_WIN_FENCE(MPI_MODE_NOPRECEDE, buffwin, ierror)      endif#endif! Send to south      if ( jfirst > 1 ) then#if !defined(MPI2)! Start recv to north        src = gid - 1        recv_tag = src        qsize = im*2*(klast-kfirst+1)        nrecv = nrecv + 1        tdisp = igonorth*idimsize + (ncall_s-1)*idimsize*nbuf        call mpi_irecv(buff_r(tdisp+1), qsize, mp_precision, src, &                       recv_tag, commglobal, rqest(nrecv), ierror)#endif        dest = gid - 1        qsize = im*(klast-kfirst+1)*2        tdisp = igosouth*idimsize + (ncall_s-1)*idimsize*nbuf        call BufferPack3d(q1, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                              1, im, jfirst,    jfirst,   kfirst, klast, &                              buff_s(tdisp+1))        displ = im*(klast-kfirst+1)        call BufferPack3d(q2, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                              1, im, jfirst,    jfirst,   kfirst, klast, &                              buff_s(displ+tdisp+1))#if defined(MPI2)!$omp parallel do private(p,tmpsize,mysize,mydisp)        do p=1,numcpu          tmpsize = ceiling(real(qsize)/real(numcpu))          mysize = MIN(tmpsize, MAX(qsize-(tmpsize*(p-1)),0))          mydisp = tdisp + (p-1)*tmpsize          call MPI_PUT(buff_s(mydisp+1), mysize, mp_precision, dest, &                       mydisp, mysize, mp_precision, buffwin, ierror)        enddo#else        send_tag = gid        nsend = nsend + 1        call mpi_isend(buff_s(tdisp+1), qsize, mp_precision, dest, &                       send_tag, commglobal, sqest(nsend), ierror)#endif      endif! Send to north      if ( jlast < jm ) then#if !defined(MPI2)! Start recv to south        src = gid + 1        recv_tag = src        qsize = im*2*(klast-kfirst+1)        nrecv = nrecv + 1        tdisp = igosouth*idimsize + (ncall_s-1)*idimsize*nbuf        call mpi_irecv(buff_r(tdisp+1), qsize, mp_precision, src, &                       recv_tag, commglobal, rqest(nrecv), ierror)#endif        dest = gid + 1        qsize = im*(klast-kfirst+1)*2        tdisp = igonorth*idimsize + (ncall_s-1)*idimsize*nbuf        call BufferPack3d(q1, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                              1, im, jlast,     jlast,    kfirst, klast, &                              buff_s(tdisp+1))        displ = im*(klast-kfirst+1)        call BufferPack3d(q2, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                              1, im, jlast,     jlast,    kfirst, klast, &                              buff_s(displ+tdisp+1))#if defined(MPI2)!$omp parallel do private(p,tmpsize,mysize,mydisp)        do p=1,numcpu          tmpsize = ceiling(real(qsize)/real(numcpu))          mysize = MIN(tmpsize, MAX(qsize-(tmpsize*(p-1)),0))          mydisp = tdisp + (p-1)*tmpsize          call MPI_PUT(buff_s(mydisp+1), mysize, mp_precision, dest, &                       mydisp, mysize, mp_precision, buffwin, ierror)        enddo#else        send_tag = gid        nsend = nsend + 1        call mpi_isend(buff_s(tdisp+1), qsize, mp_precision, dest, &                       send_tag, commglobal, sqest(nsend), ierror)#endif      endif#else#include "mlp_ptr.h"!$omp parallel do private(i, k)      do k=kfirst,klast! Send to south      if ( jfirst > 1 ) then           do i=1,im              g_t1(i,jfirst,k,1) = q1(i,jfirst,k)              g_t1(i,jfirst,k,2) = q2(i,jfirst,k)           enddo      endif! Send to north      if ( jlast < jm ) then           do i=1,im              g_t1(i,jlast,k,1) = q1(i,jlast,k)              g_t1(i,jlast,k,2) = q2(i,jlast,k)           enddo      endif      enddo#endif      end subroutine mp_send2_ns!-----      subroutine mp_recv2_ns(im, jm, jfirst, jlast, kfirst, klast, nd, q1, q2)!-----      implicit none      integer, intent(in):: im, jm, jfirst, jlast      integer, intent(in):: kfirst, klast !careful: klast might be klast+1      integer, intent(in):: nd      real, intent(inout):: q1(im,jfirst-nd:jlast+nd,kfirst:klast)       real, intent(inout):: q2(im,jfirst-nd:jlast+nd,kfirst:klast) ! Local:      integer i,j, k, n      integer displ#if !defined(USE_MLP)      ncall_r = ncall_r + 1#if defined(MPI2)      if (ncall_r == 1) then        call MPI_WIN_FENCE(MPI_MODE_NOSTORE + MPI_MODE_NOSUCCEED, &                           buffwin, ierror)      endif#endif! Recv from south      if ( jfirst > 1 ) then#if !defined(MPI2)        nread = nread + 1        call mpi_wait(rqest(nread), Status, ierror)#endif        j = jfirst - 1        tdisp = igonorth*idimsize + (ncall_r-1)*idimsize*nbuf        call BufferUnPack3d(q1, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                                1, im, j,         j,        kfirst, klast, &                                buff_r(tdisp+1))        displ = im*(klast-kfirst+1)        call BufferUnPack3d(q2, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                                1, im, j,         j,        kfirst, klast, &                                buff_r(displ+tdisp+1))      endif! Recv from north      if ( jlast < jm ) then#if !defined(MPI2)        nread = nread + 1        call mpi_wait(rqest(nread), Status, ierror)#endif        j = jlast + 1        tdisp = igosouth*idimsize + (ncall_r-1)*idimsize*nbuf        call BufferUnPack3d(q1, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                                1, im, j,         j,        kfirst, klast, &                                buff_r(tdisp+1))        displ = im*(klast-kfirst+1)        call BufferUnPack3d(q2, 1, im, jfirst-nd, jlast+nd, kfirst, klast, &                                1, im, j,         j,        kfirst, klast, &                                buff_r(displ+tdisp+1))      endif      if (ncall_r == ncall_s) then#if !defined(MPI2)        call mpi_waitall(nsend, sqest, Stats, ierror)        nrecv = 0        nread = 0        nsend = 0#endif        ncall_s = 0        ncall_r = 0      endif#else#include "mlp_ptr.h"!$omp parallel do private(i, j, k)      do k=kfirst,klast! Recv data from south      if ( jfirst > 1 ) then            j = jfirst - 1            do i=1,im               q1(i,j,k) = g_t1(i,j,k,1)                q2(i,j,k) = g_t1(i,j,k,2)             enddo      endif! Recv data from north      if ( jlast < jm ) then            j = jlast + 1            do i=1,im               q1(i,j,k) = g_t1(i,j,k,1)                q2(i,j,k) = g_t1(i,j,k,2)             enddo      endif      enddo#endif      end subroutine mp_recv2_ns      subroutine mp_send_pe(im, jm, jfirst, jlast, kfirst, klast, p)!-----      implicit none      integer, intent(in):: im, jm, jfirst, jlast, kfirst, klast      real, intent(in):: p(im,kfirst:klast,jfirst:jlast)       integer i, k      integer src, dest      integer qsize      integer recv_tag, send_tag#if !defined(USE_MLP) && defined(MPI2)      integer n, tmpsize, mysize      integer(kind=MPI_ADDRESS_KIND) mydisp#endif#if defined(USE_MLP)#include "mlp_ptr.h"#endif#if !defined(USE_MLP)      ncall_s = ncall_s + 1#if defined(MPI2)      if (ncall_s == 1) then        call MPI_WIN_FENCE(MPI_MODE_NOPRECEDE, buffwin, ierror)      endif#endif#endif#if !defined(USE_MLP) && !defined(MPI2)! Start recv from south      if ( jfirst > 1 ) then         src = gid - 1         recv_tag = src         qsize = im*(klast-kfirst+1)         nrecv = nrecv + 1         tdisp = igonorth*idimsize + (ncall_s-1)*idimsize*nbuf         call mpi_irecv(buff_r(tdisp+1), qsize, mp_precision, src, &                        recv_tag, commglobal, rqest(nrecv), ierror)      endif#endif! Send data to North      if ( jlast < jm ) then#if !defined(USE_MLP)        dest = gid + 1        qsize = im*(klast-kfirst+1)        tdisp = igonorth*idimsize + (ncall_s-1)*idimsize*nbuf        call BufferPack2d(p(1,1,jlast), 1, im, kfirst, klast, &                                        1, im, kfirst, klast, &                                        buff_s(tdisp+1))#if defined(MPI2)!$omp parallel do private(n,tmpsize,mysize,mydisp)        do n=1,numcpu          tmpsize = ceiling(real(qsize)/real(numcpu))          mysize = MIN(tmpsize, MAX(qsize-(tmpsize*(n-1)),0))          mydisp = tdisp + (n-1)*tmpsize          call MPI_PUT(buff_s(mydisp+1), mysize, mp_precision, dest, &                       mydisp, mysize, mp_precision, buffwin, ierror)        enddo#else        send_tag = gid        nsend = nsend + 1        call mpi_isend(buff_s(tdisp+1), qsize, mp_precision, dest, &                       send_tag, commglobal, sqest(nsend), ierror)#endif#else!$omp parallel do private(i, k)         do k=kfirst,klast            do i=1,im               g_t2(i,k,jlast) = p(i,k,jlast)            enddo         enddo#endif      endif      end subroutine mp_send_pe!-----      subroutine mp_recv_pe(im, jm, jfirst, jlast, kfirst, klast, pesouth)!-----      implicit none      integer, intent(in):: im, jm, jfirst, jlast, kfirst, klast      real, intent(inout):: pesouth(im,kfirst:klast)       integer i, j, k, n#if defined(USE_MLP)#include "mlp_ptr.h"#endif#if !defined(USE_MLP)      ncall_r = ncall_r + 1#if defined(MPI2)      if (ncall_r == 1) then        call MPI_WIN_FENCE(MPI_MODE_NOSTORE + MPI_MODE_NOSUCCEED, &                           buffwin, ierror)      endif#endif#endif! Recv from south      if ( jfirst > 1 ) then#if !defined(USE_MLP)#if !defined(MPI2)        nread = nread + 1        call mpi_wait(rqest(nread), Status, ierror)#endif        tdisp = igonorth*idimsize + (ncall_r-1)*idimsize*nbuf        call BufferUnPack2d(pesouth, 1, im, kfirst, klast, &                                     1, im, kfirst, klast, &                                     buff_r(tdisp+1))#else!$omp parallel do private(i, j, k)         do k=kfirst,klast            j = jfirst - 1            do i=1,im               pesouth(i,k) = g_t2(i,k,j)            enddo         enddo#endif      endif#if !defined(USE_MLP)      if (ncall_r == ncall_s) then#if !defined(MPI2)        call mpi_waitall(nsend, sqest, Stats, ierror)        nrecv = 0        nread = 0        nsend = 0#endif        ncall_s = 0        ncall_r = 0      endif#endif      end subroutine mp_recv_pe      subroutine mp_send(dest, src, qsize_s, qsize_r, b_s, b_r)!-----      implicit none      integer, intent(in) :: qsize_s      integer, intent(in) :: qsize_r      integer, intent(in) :: dest      integer, intent(in) :: src      real, intent(in):: b_s(*)       real, intent(in):: b_r(*)       integer i, k      integer recv_tag, send_tag#if !defined(USE_MLP) && defined(MPI2)      integer n, tmpsize, mysize      integer(kind=MPI_ADDRESS_KIND) mydisp#endif#if defined(USE_MLP)#include "mlp_ptr.h"#endif#if !defined(USE_MLP)      ncall_s = ncall_s + 1#if defined(MPI2)      if (ncall_s == 1) then        call MPI_WIN_FENCE(MPI_MODE_NOPRECEDE, buffwin, ierror)      endif#endif#endif#if !defined(USE_MLP) && !defined(MPI2)! Start recv from src      if ( qsize_r > 0 ) then         recv_tag = src         nrecv = nrecv + 1         call mpi_irecv(b_r, qsize_r, mp_precision, src, &                        recv_tag, commglobal, rqest(nrecv), ierror)      endif#endif! Send data to dest      if ( qsize_s > 0 ) then#if !defined(USE_MLP)#if defined(MPI2)!$omp parallel do private(n,tmpsize,mysize,mydisp)        do n=1,numcpu          tmpsize = ceiling(real(qsize_s)/real(numcpu))          mysize = MIN(tmpsize, MAX(qsize-(tmpsize*(n-1)),0))          mydisp = (n-1)*tmpsize          call MPI_PUT(b_s(mydisp+1), mysize, mp_precision, dest, &                       mydisp, mysize, mp_precision, buffwin, ierror)        enddo#else        send_tag = gid        nsend = nsend + 1        call mpi_isend(b_s, qsize_s, mp_precision, dest, &                       send_tag, commglobal, sqest(nsend), ierror)#endif#elseXXXXXXXXXXXXXXXXXXXXXXXXXX  MLP NOT YET IMPLEMENTED XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX!$omp parallel do private(i, k)         do k=kfirst,klast            do i=1,im               g_t2(i,k,jlast) = p(i,k,jlast)            enddo         enddoXXXXXXXXXXXXXXXXXXXXXXXXXX  MLP NOT YET IMPLEMENTED XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#endif      endif      end subroutine mp_send