C -*- Mode: Fortran; -*- 

C

C  (C) 2012 by Argonne National Laboratory.

C      See COPYRIGHT in top-level directory.

C

C This program is based on the allpair.f test from the MPICH-1 test

C (test/pt2pt/allpair.f), which in turn was inspired by a bug report from

C fsset@corelli.lerc.nasa.gov (Scott Townsend)

      program allpair

      implicit none

      include 'mpif.h'

      integer ierr, errs, comm

      logical mtestGetIntraComm

      logical verbose

      common /flags/ verbose

      errs = 0

      verbose = .false.

C      verbose = .true.

      call MTest_Init( ierr )

      do while ( mtestGetIntraComm( comm, 2, .false. ) )

         call test_pair_send( comm, errs )

         call test_pair_ssend( comm, errs )

         call test_pair_rsend( comm, errs )

         call test_pair_isend( comm, errs )

         call test_pair_irsend( comm, errs )

         call test_pair_issend( comm, errs )

         call test_pair_psend( comm, errs )

         call test_pair_prsend( comm, errs )

         call test_pair_pssend( comm, errs )

         call test_pair_sendrecv( comm, errs )

         call test_pair_sendrecvrepl( comm, errs )

         call mtestFreeComm( comm )

      enddo

C         

      call MTest_Finalize( errs )

      call MPI_Finalize(ierr)

C

      end

C

      subroutine test_pair_send( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE)

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Send and recv'

      endif

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 1123

      count = TEST_SIZE / 5

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      if (rank .eq. 0) then

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Send(send_buf, count, MPI_REAL, next, tag,

     .        comm, ierr) 

C

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr)

C

         call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,

     .                   'send and recv', errs )

      else if (prev .eq. 0)  then

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr)

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'send and recv', errs )

C

         call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr) 

      end if

C

      end

C

      subroutine test_pair_rsend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, i

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE), requests(1)

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Rsend and recv'

      endif

C

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 1456

      count = TEST_SIZE / 3

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      if (rank .eq. 0) then

C        

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, 

     .                  comm, status, ierr )

C

         call MPI_Rsend(send_buf, count, MPI_REAL, next, tag,

     .                  comm, ierr) 

C

         call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr) 

C

         if (status(MPI_SOURCE) .ne. next) then

            print *, 'Rsend: Incorrect source, expected', next,

     .               ', got', status(MPI_SOURCE)

            errs = errs + 1

         end if

C

         if (status(MPI_TAG) .ne. tag) then

            print *, 'Rsend: Incorrect tag, expected', tag,

     .               ', got', status(MPI_TAG)

            errs = errs + 1

         end if

C

         call MPI_Get_count(status, MPI_REAL, i, ierr)

C

         if (i .ne. count) then

            print *, 'Rsend: Incorrect count, expected', count,

     .               ', got', i

            errs = errs + 1

         end if

C

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm, 

     .                 status, ierr)

C

         call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,

     .                   'rsend and recv', errs )

C

      else if (prev .eq. 0) then

C

         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 requests(1), ierr)

         call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag, 

     .                  comm, ierr )

         call MPI_Wait( requests(1), status, ierr )

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'rsend and recv', errs )

C

         call MPI_Send(recv_buf, count, MPI_REAL, prev, tag,

     .                  comm, ierr) 

      end if

C

      end

C

      subroutine test_pair_ssend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, i

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE)

      logical flag

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Ssend and recv'

      endif

C

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 1789

      count = TEST_SIZE / 3

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      if (rank .eq. 0) then

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Iprobe(MPI_ANY_SOURCE, tag,

     .                   comm, flag, status, ierr) 

C

         if (flag) then

            print *, 'Ssend: Iprobe succeeded! source', 

     .               status(MPI_SOURCE),

     .               ', tag', status(MPI_TAG)

            errs = errs + 1

         end if

C

         call MPI_Ssend(send_buf, count, MPI_REAL, next, tag,

     .                  comm, ierr) 

C

         do while (.not. flag)

            call MPI_Iprobe(MPI_ANY_SOURCE, tag,

     .                      comm, flag, status, ierr) 

         end do

C           

         if (status(MPI_SOURCE) .ne. next) then

            print *, 'Ssend: Incorrect source, expected', next,

     .               ', got', status(MPI_SOURCE)

            errs = errs + 1

         end if

C

         if (status(MPI_TAG) .ne. tag) then

            print *, 'Ssend: Incorrect tag, expected', tag,

     .               ', got', status(MPI_TAG)

            errs = errs + 1

         end if

C

         call MPI_Get_count(status, MPI_REAL, i, ierr)

C

         if (i .ne. count) then

            print *, 'Ssend: Incorrect count, expected', count,

     .               ', got', i

            errs = errs + 1

         end if

C

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 status, ierr)

C

         call msg_check( recv_buf, next, tag, count, status,

     .        TEST_SIZE, 'ssend and recv', errs ) 

C

      else if (prev .eq. 0) then

C

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 status, ierr)

C

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'ssend and recv', errs )

C

         call MPI_Ssend(recv_buf, count, MPI_REAL, prev, tag,

     .                  comm, ierr) 

      end if

C

      end

C

      subroutine test_pair_isend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE), requests(2)

      integer statuses(MPI_STATUS_SIZE,2)

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' isend and irecv'

      endif

C

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 2123

      count = TEST_SIZE / 5

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      if (rank .eq. 0) then

C

         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,

     .                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                  requests(1), ierr)

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Isend(send_buf, count, MPI_REAL, next, tag,

     .                  comm, requests(2), ierr) 

C

         call MPI_Waitall(2, requests, statuses, ierr)

C

         call rq_check( requests, 2, 'isend and irecv' )

C

         call msg_check( recv_buf, next, tag, count, statuses(1,1),

     .        TEST_SIZE, 'isend and irecv', errs )

C

      else if (prev .eq. 0) then

C

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 status, ierr)

C

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'isend and irecv', errs )

C

         call MPI_Isend(recv_buf, count, MPI_REAL, prev, tag,

     .                  comm, requests(1), ierr) 

C

         call MPI_Wait(requests(1), status, ierr)

C

         call rq_check( requests(1), 1, 'isend and irecv' )

C

      end if

C

      end

C

      subroutine test_pair_irsend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, index, i

      integer TEST_SIZE

      integer dupcom

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE), requests(2)

      integer statuses(MPI_STATUS_SIZE,2)

      logical flag

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Irsend and irecv'

      endif

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      call mpi_comm_dup( comm, dupcom, ierr )

C

      tag = 2456

      count = TEST_SIZE / 3

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      if (rank .eq. 0) then

C

         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,

     .                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                  requests(1), ierr)

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, next, 0, 

     .                      MPI_BOTTOM, 0, MPI_INTEGER, next, 0, 

     .                      dupcom, status, ierr )

C

         call MPI_Irsend(send_buf, count, MPI_REAL, next, tag,

     .                   comm, requests(2), ierr) 

C

         index = -1

         do while (index .ne. 1)

            call MPI_Waitany(2, requests, index, statuses, ierr)

         end do

C

         call rq_check( requests(1), 1, 'irsend and irecv' )

C

         call msg_check( recv_buf, next, tag, count, statuses,

     .           TEST_SIZE, 'irsend and irecv', errs )

C

      else if (prev .eq. 0) then

C

         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,

     .                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                  requests(1), ierr)

C

         call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, prev, 0, 

     .                      MPI_BOTTOM, 0, MPI_INTEGER, prev, 0, 

     .                      dupcom, status, ierr )

C

         flag = .FALSE.

         do while (.not. flag)

            call MPI_Test(requests(1), flag, status, ierr)

         end do

C

         call rq_check( requests, 1, 'irsend and irecv (test)' )

C

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'irsend and irecv', errs )

C

         call MPI_Irsend(recv_buf, count, MPI_REAL, prev, tag,

     .                   comm, requests(1), ierr) 

C

         call MPI_Waitall(1, requests, statuses, ierr)

C

         call rq_check( requests, 1, 'irsend and irecv' )

C

      end if

C

      call mpi_comm_free( dupcom, ierr )

C

      end

C

      subroutine test_pair_issend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, index

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE), requests(2)

      integer statuses(MPI_STATUS_SIZE,2)

      logical flag

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' issend and irecv (testall)'

      endif

C

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 2789

      count = TEST_SIZE / 3

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      if (rank .eq. 0) then

C

         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL,

     .                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                  requests(1), ierr)

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Issend(send_buf, count, MPI_REAL, next, tag,

     .                   comm, requests(2), ierr) 

C

         flag = .FALSE.

         do while (.not. flag)

            call MPI_Testall(2, requests, flag, statuses, ierr)

         end do

C

         call rq_check( requests, 2, 'issend and irecv (testall)' )

C

         call msg_check( recv_buf, next, tag, count, statuses(1,1),

     .           TEST_SIZE, 'issend and recv (testall)', errs )

C

      else if (prev .eq. 0) then

C

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 status, ierr)

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'issend and recv', errs )

         call MPI_Issend(recv_buf, count, MPI_REAL, prev, tag,

     .                   comm, requests(1), ierr) 

C

         flag = .FALSE.

         do while (.not. flag)

            call MPI_Testany(1, requests(1), index, flag,

     .                       statuses(1,1), ierr)

         end do

C

         call rq_check( requests, 1, 'issend and recv (testany)' )

C

      end if

C

      end

C

      subroutine test_pair_psend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, i

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE)

      integer statuses(MPI_STATUS_SIZE,2), requests(2)

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Persistent send and recv'

      endif

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 3123

      count = TEST_SIZE / 5

C

      call clear_test_data(recv_buf,TEST_SIZE)

      call MPI_Recv_init(recv_buf, TEST_SIZE, MPI_REAL,

     .                   MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                   requests(2), ierr)

C

      if (rank .eq. 0) then

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Send_init(send_buf, count, MPI_REAL, next, tag,

     .                      comm, requests(1), ierr) 

C

         call MPI_Startall(2, requests, ierr) 

         call MPI_Waitall(2, requests, statuses, ierr)

C

         call msg_check( recv_buf, next, tag, count, statuses(1,2),

     .        TEST_SIZE, 'persistent send/recv', errs )

C

         call MPI_Request_free(requests(1), ierr)

C

      else if (prev .eq. 0) then

C

         call MPI_Send_init(send_buf, count, MPI_REAL, prev, tag,

     .                      comm, requests(1), ierr) 

         call MPI_Start(requests(2), ierr) 

         call MPI_Wait(requests(2), status, ierr)

C

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     *                   'persistent send/recv', errs )

C

         do i = 1,count

            send_buf(i) = recv_buf(i)

         end do

C

         call MPI_Start(requests(1), ierr) 

         call MPI_Wait(requests(1), status, ierr)

C

         call MPI_Request_free(requests(1), ierr)

      end if

C

      call dummyRef( send_buf, count, ierr )

      call MPI_Request_free(requests(2), ierr)

C

      end

C

      subroutine test_pair_prsend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, index, i

      integer outcount, indices(2)

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer statuses(MPI_STATUS_SIZE,2), requests(2)

      integer status(MPI_STATUS_SIZE)

      logical flag

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Persistent Rsend and recv'

      endif

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 3456

      count = TEST_SIZE / 3

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      call MPI_Recv_init(recv_buf, TEST_SIZE, MPI_REAL,

     .                   MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                   requests(2), ierr)

C

      if (rank .eq. 0) then

C

         call MPI_Rsend_init(send_buf, count, MPI_REAL, next, tag,

     .                       comm, requests(1), ierr) 

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, 

     .                  comm, status, ierr )

C

         call MPI_Startall(2, requests, ierr)

C

         index = -1

C

         do while (index .ne. 2)

            call MPI_Waitsome(2, requests, outcount,

     .                        indices, statuses, ierr)

            do i = 1,outcount

               if (indices(i) .eq. 2) then

                  call msg_check( recv_buf, next, tag, count,

     .                 statuses(1,i), TEST_SIZE, 'waitsome', errs )

                  index = 2

               end if

            end do

         end do

C

         call MPI_Request_free(requests(1), ierr)

      else if (prev .eq. 0) then

C

         call MPI_Rsend_init(send_buf, count, MPI_REAL, prev, tag,

     .                       comm, requests(1), ierr) 

C

         call MPI_Start(requests(2), ierr)

C

         call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag, 

     .                  comm, ierr )

C

         flag = .FALSE.

         do while (.not. flag)

            call MPI_Test(requests(2), flag, status, ierr)

         end do

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'test', errs )

C

         do i = 1,count

            send_buf(i) = recv_buf(i)

         end do

C

         call MPI_Start(requests(1), ierr)

         call MPI_Wait(requests(1), status, ierr)

C

         call MPI_Request_free(requests(1), ierr)

      end if

C

      call dummyRef( send_buf, count, ierr )

      call MPI_Request_free(requests(2), ierr)

C

      end

C

      subroutine test_pair_pssend( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, index, i

      integer outcount, indices(2)

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer statuses(MPI_STATUS_SIZE,2), requests(2)

      integer status(MPI_STATUS_SIZE)

      logical flag

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Persistent Ssend and recv'

      endif

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 3789

      count = TEST_SIZE / 3

C

      call clear_test_data(recv_buf,TEST_SIZE)

C

      call MPI_Recv_init(recv_buf, TEST_SIZE, MPI_REAL,

     .                   MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                   requests(1), ierr)

C

      if (rank .eq. 0) then

C

         call MPI_Ssend_init(send_buf, count, MPI_REAL, next, tag,

     .                       comm, requests(2), ierr) 

C

         call init_test_data(send_buf,TEST_SIZE)

C

         call MPI_Startall(2, requests, ierr)

C

         index = -1

         do while (index .ne. 1)

            call MPI_Testsome(2, requests, outcount,

     .                        indices, statuses, ierr)

            do i = 1,outcount

               if (indices(i) .eq. 1) then

                  call msg_check( recv_buf, next, tag, count,

     .                 statuses(1,i), TEST_SIZE, 'testsome', errs )

                  index = 1

               end if

            end do

         end do

C

         call MPI_Request_free(requests(2), ierr)

C

      else if (prev .eq. 0) then

C

         call MPI_Ssend_init(send_buf, count, MPI_REAL, prev, tag,

     .                       comm, requests(2), ierr) 

C

         call MPI_Start(requests(1), ierr)

C

         flag = .FALSE.

         do while (.not. flag)

            call MPI_Testany(1, requests(1), index, flag,

     .                       statuses(1,1), ierr)

         end do

         call msg_check( recv_buf, prev, tag, count, statuses(1,1),

     .           TEST_SIZE, 'testany', errs )

         do i = 1,count

            send_buf(i) = recv_buf(i)

         end do

C

         call MPI_Start(requests(2), ierr)

         call MPI_Wait(requests(2), status, ierr)

C

         call MPI_Request_free(requests(2), ierr)

C

      end if

C

      call dummyRef( send_buf, count, ierr )

      call MPI_Request_free(requests(1), ierr)

C

      end

C

      subroutine test_pair_sendrecv( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE)

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Sendrecv'

      endif

C

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 4123

      count = TEST_SIZE / 5

      call clear_test_data(recv_buf,TEST_SIZE)

      if (rank .eq. 0) then

         call init_test_data(send_buf,TEST_SIZE)

         call MPI_Sendrecv(send_buf, count, MPI_REAL, next, tag,

     .                     recv_buf, count, MPI_REAL, next, tag,

     .                     comm, status, ierr) 

         call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,

     .                   'sendrecv', errs )

      else if (prev .eq. 0) then

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 status, ierr)

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE,

     .                   'recv/send', errs )

         call MPI_Send(recv_buf, count, MPI_REAL, prev, tag,

     .                 comm, ierr) 

      end if

C

      end

C

      subroutine test_pair_sendrecvrepl( comm, errs )

      implicit none

      include 'mpif.h'

      integer comm, errs

      integer rank, size, ierr, next, prev, tag, count, i

      integer TEST_SIZE

      parameter (TEST_SIZE=2000)

      integer status(MPI_STATUS_SIZE)

      real send_buf(TEST_SIZE), recv_buf(TEST_SIZE)

      logical verbose

      common /flags/ verbose

C

      if (verbose) then

         print *, ' Sendrecv replace'

      endif

C

      call mpi_comm_rank( comm, rank, ierr )

      call mpi_comm_size( comm, size, ierr )

      next = rank + 1

      if (next .ge. size) next = 0

C

      prev = rank - 1

      if (prev .lt. 0) prev = size - 1

C

      tag = 4456

      count = TEST_SIZE / 3

      if (rank .eq. 0) then

C

         call init_test_data(recv_buf, TEST_SIZE)

C

         do 11 i = count+1,TEST_SIZE

            recv_buf(i) = 0.0

 11      continue

C

         call MPI_Sendrecv_replace(recv_buf, count, MPI_REAL,

     .                             next, tag, next, tag,

     .                             comm, status, ierr)  

         call msg_check( recv_buf, next, tag, count, status, TEST_SIZE,

     .                   'sendrecvreplace', errs )

      else if (prev .eq. 0) then

         call clear_test_data(recv_buf,TEST_SIZE)

         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL,

     .                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,

     .                 status, ierr)