! This file created from test/mpi/f77/pt2pt/allpairf.f with f77tof90
! -*- Mode: Fortran; -*- 
!
!  (C) 2012 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
! This program is based on the allpair.f test from the MPICH-1 test
! (test/pt2pt/allpair.f), which in turn was inspired by a bug report from
! fsset@corelli.lerc.nasa.gov (Scott Townsend)

      program allpair
      use mpi
      integer ierr, errs, comm
      logical mtestGetIntraComm
      logical verbose
      common /flags/ verbose
      
      errs = 0
      verbose = .false.
!      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
!         
      call MTest_Finalize( errs )
      call MPI_Finalize(ierr)
!
      end
!
      subroutine test_pair_send( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Send and recv'
      endif
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 1123
      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_Send(send_buf, count, MPI_REAL, next, tag, &
      &        comm, ierr) 
!
         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr)
!
         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 )
!
         call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr) 
      end if
!
      end
!
      subroutine test_pair_rsend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Rsend and recv'
      endif
!
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 1456
      count = TEST_SIZE / 3
!
      call clear_test_data(recv_buf,TEST_SIZE)
!
      if (rank .eq. 0) then
!        
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag,  &
      &                  comm, status, ierr )
!
         call MPI_Rsend(send_buf, count, MPI_REAL, next, tag, &
      &                  comm, ierr) 
!
         call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr) 
!
         if (status(MPI_SOURCE) .ne. next) then
            print *, 'Rsend: Incorrect source, expected', next, &
      &               ', got', status(MPI_SOURCE)
            errs = errs + 1
         end if
!
         if (status(MPI_TAG) .ne. tag) then
            print *, 'Rsend: Incorrect tag, expected', tag, &
      &               ', got', status(MPI_TAG)
            errs = errs + 1
         end if
!
         call MPI_Get_count(status, MPI_REAL, i, ierr)
!
         if (i .ne. count) then
            print *, 'Rsend: Incorrect count, expected', count, &
      &               ', got', i
            errs = errs + 1
         end if
!
         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm,  &
      &                 status, ierr)
!
         call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, &
      &                   'rsend and recv', errs )
!
      else if (prev .eq. 0) then
!
         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 )
!
         call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, &
      &                  comm, ierr) 
      end if
!
      end
!
      subroutine test_pair_ssend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Ssend and recv'
      endif
!
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 1789
      count = TEST_SIZE / 3
!
      call clear_test_data(recv_buf,TEST_SIZE)
!
      if (rank .eq. 0) then
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Iprobe(MPI_ANY_SOURCE, tag, &
      &                   comm, flag, status, ierr) 
!
         if (flag) then
            print *, 'Ssend: Iprobe succeeded! source',  &
      &               status(MPI_SOURCE), &
      &               ', tag', status(MPI_TAG)
            errs = errs + 1
         end if
!
         call MPI_Ssend(send_buf, count, MPI_REAL, next, tag, &
      &                  comm, ierr) 
!
         do while (.not. flag)
            call MPI_Iprobe(MPI_ANY_SOURCE, tag, &
      &                      comm, flag, status, ierr) 
         end do
!           
         if (status(MPI_SOURCE) .ne. next) then
            print *, 'Ssend: Incorrect source, expected', next, &
      &               ', got', status(MPI_SOURCE)
            errs = errs + 1
         end if
!
         if (status(MPI_TAG) .ne. tag) then
            print *, 'Ssend: Incorrect tag, expected', tag, &
      &               ', got', status(MPI_TAG)
            errs = errs + 1
         end if
!
         call MPI_Get_count(status, MPI_REAL, i, ierr)
!
         if (i .ne. count) then
            print *, 'Ssend: Incorrect count, expected', count, &
      &               ', got', i
            errs = errs + 1
         end if
!
         call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                 MPI_ANY_SOURCE, MPI_ANY_TAG, comm, &
      &                 status, ierr)
!
         call msg_check( recv_buf, next, tag, count, status, &
      &        TEST_SIZE, 'ssend 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, &
      &                   'ssend and recv', errs )
!
         call MPI_Ssend(recv_buf, count, MPI_REAL, prev, tag, &
      &                  comm, ierr) 
      end if
!
      end
!
      subroutine test_pair_isend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' isend and irecv'
      endif
!
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 2123
      count = TEST_SIZE / 5
!
      call clear_test_data(recv_buf,TEST_SIZE)
!
      if (rank .eq. 0) then
!
         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm, &
      &                  requests(1), ierr)
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Isend(send_buf, count, MPI_REAL, next, tag, &
      &                  comm, requests(2), ierr) 
!
         call MPI_Waitall(2, requests, statuses, ierr)
!
         call rq_check( requests, 2, 'isend and irecv' )
!
         call msg_check( recv_buf, next, tag, count, statuses(1,1), &
      &        TEST_SIZE, 'isend and irecv', 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, &
      &                   'isend and irecv', errs )
!
         call MPI_Isend(recv_buf, count, MPI_REAL, prev, tag, &
      &                  comm, requests(1), ierr) 
!
         call MPI_Wait(requests(1), status, ierr)
!
         call rq_check( requests(1), 1, 'isend and irecv' )
!
      end if
!
      end
!
      subroutine test_pair_irsend( comm, errs )
      use mpi
      integer comm, errs
      integer rank, size, ierr, next, prev, tag, count, index
      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
!
      if (verbose) then
         print *, ' Irsend and irecv'
      endif
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      call mpi_comm_dup( comm, dupcom, ierr )
!
      tag = 2456
      count = TEST_SIZE / 3
!
      call clear_test_data(recv_buf,TEST_SIZE)
!
      if (rank .eq. 0) then
!
         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm, &
      &                  requests(1), ierr)
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, next, 0,  &
      &                      MPI_BOTTOM, 0, MPI_INTEGER, next, 0,  &
      &                      dupcom, status, ierr )
!
         call MPI_Irsend(send_buf, count, MPI_REAL, next, tag, &
      &                   comm, requests(2), ierr) 
!
         index = -1
         do while (index .ne. 1)
            call MPI_Waitany(2, requests, index, statuses, ierr)
         end do
!
         call rq_check( requests(1), 1, 'irsend and irecv' )
!
         call msg_check( recv_buf, next, tag, count, statuses, &
      &           TEST_SIZE, 'irsend and irecv', errs )
!
      else if (prev .eq. 0) then
!
         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm, &
      &                  requests(1), ierr)
!
         call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, prev, 0,  &
      &                      MPI_BOTTOM, 0, MPI_INTEGER, prev, 0,  &
      &                      dupcom, status, ierr )
!
         flag = .FALSE.
         do while (.not. flag)
            call MPI_Test(requests(1), flag, status, ierr)
         end do
!
         call rq_check( requests, 1, 'irsend and irecv (test)' )
!
         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, &
      &                   'irsend and irecv', errs )
!
         call MPI_Irsend(recv_buf, count, MPI_REAL, prev, tag, &
      &                   comm, requests(1), ierr) 
!
         call MPI_Waitall(1, requests, statuses, ierr)
!
         call rq_check( requests, 1, 'irsend and irecv' )
!
      end if
!
      call mpi_comm_free( dupcom, ierr )
!
      end
!
      subroutine test_pair_issend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' issend and irecv (testall)'
      endif
!
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 2789
      count = TEST_SIZE / 3
!
      call clear_test_data(recv_buf,TEST_SIZE)
!
      if (rank .eq. 0) then
!
         call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL, &
      &                  MPI_ANY_SOURCE, MPI_ANY_TAG, comm, &
      &                  requests(1), ierr)
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Issend(send_buf, count, MPI_REAL, next, tag, &
      &                   comm, requests(2), ierr) 
!
         flag = .FALSE.
         do while (.not. flag)
            call MPI_Testall(2, requests, flag, statuses, ierr)
         end do
!
         call rq_check( requests, 2, 'issend and irecv (testall)' )
!
         call msg_check( recv_buf, next, tag, count, statuses(1,1), &
      &           TEST_SIZE, 'issend and recv (testall)', 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, &
      &                   'issend and recv', errs )

         call MPI_Issend(recv_buf, count, MPI_REAL, prev, tag, &
      &                   comm, requests(1), ierr) 
!
         flag = .FALSE.
         do while (.not. flag)
            call MPI_Testany(1, requests(1), index, flag, &
      &                       statuses(1,1), ierr)
         end do
!
         call rq_check( requests, 1, 'issend and recv (testany)' )
!
      end if
!
      end
!
      subroutine test_pair_psend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Persistent send and recv'
      endif
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 3123
      count = TEST_SIZE / 5
!
      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)
!
      if (rank .eq. 0) then
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Send_init(send_buf, count, MPI_REAL, next, tag, &
      &                      comm, requests(1), ierr) 
!
         call MPI_Startall(2, requests, ierr) 
         call MPI_Waitall(2, requests, statuses, ierr)
!
         call msg_check( recv_buf, next, tag, count, statuses(1,2), &
      &        TEST_SIZE, 'persistent send/recv', errs )
!
         call MPI_Request_free(requests(1), ierr)
!
      else if (prev .eq. 0) then
!
         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)
!
         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, &
      &                   'persistent send/recv', errs )
!
         do i = 1,count
            send_buf(i) = recv_buf(i)
         end do
!
         call MPI_Start(requests(1), ierr) 
         call MPI_Wait(requests(1), status, ierr)
!
         call MPI_Request_free(requests(1), ierr)
      end if
!
      call dummyRef( send_buf, count, ierr )
      call MPI_Request_free(requests(2), ierr)
!
      end
!
      subroutine test_pair_prsend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Persistent Rsend and recv'
      endif
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 3456
      count = TEST_SIZE / 3
!
      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)
!
      if (rank .eq. 0) then
!
         call MPI_Rsend_init(send_buf, count, MPI_REAL, next, tag, &
      &                       comm, requests(1), ierr) 
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag,  &
      &                  comm, status, ierr )
!
         call MPI_Startall(2, requests, ierr)
!
         index = -1
!
         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
!
         call MPI_Request_free(requests(1), ierr)
      else if (prev .eq. 0) then
!
         call MPI_Rsend_init(send_buf, count, MPI_REAL, prev, tag, &
      &                       comm, requests(1), ierr) 
!
         call MPI_Start(requests(2), ierr)
!
         call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag,  &
      &                  comm, ierr )
!
         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 )
!
         do i = 1,count
            send_buf(i) = recv_buf(i)
         end do
!
         call MPI_Start(requests(1), ierr)
         call MPI_Wait(requests(1), status, ierr)
!
         call MPI_Request_free(requests(1), ierr)
      end if
!
      call dummyRef( send_buf, count, ierr )
      call MPI_Request_free(requests(2), ierr)
!
      end
!
      subroutine test_pair_pssend( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Persistent Ssend and recv'
      endif
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 3789
      count = TEST_SIZE / 3
!
      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(1), ierr)
!
      if (rank .eq. 0) then
!
         call MPI_Ssend_init(send_buf, count, MPI_REAL, next, tag, &
      &                       comm, requests(2), ierr) 
!
         call init_test_data(send_buf,TEST_SIZE)
!
         call MPI_Startall(2, requests, ierr)
!
         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
!
         call MPI_Request_free(requests(2), ierr)
!
      else if (prev .eq. 0) then
!
         call MPI_Ssend_init(send_buf, count, MPI_REAL, prev, tag, &
      &                       comm, requests(2), ierr) 
!
         call MPI_Start(requests(1), ierr)
!
         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
!
         call MPI_Start(requests(2), ierr)
         call MPI_Wait(requests(2), status, ierr)
!
         call MPI_Request_free(requests(2), ierr)
!
      end if
!
      call dummyRef( send_buf, count, ierr )
      call MPI_Request_free(requests(1), ierr)
!
      end
!
      subroutine test_pair_sendrecv( comm, errs )
      use mpi
      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
!
      if (verbose) then
         print *, ' Sendrecv'
      endif
!
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      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
!
      end
!
      subroutine test_pair_sendrecvrepl( comm, errs )
      use mpi
      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 recv_buf(TEST_SIZE)
      logical verbose
      common /flags/ verbose
!
      if (verbose) then
         print *, ' Sendrecv replace'
      endif
!
      call mpi_comm_rank( comm, rank, ierr )
      call mpi_comm_size( comm, size, ierr )
      next = rank + 1
      if (next .ge. size) next = 0
!
      prev = rank - 1
      if (prev .lt. 0) prev = size - 1
!
      tag = 4456
      count = TEST_SIZE / 3

      if (rank .eq. 0) then
!
         call init_test_data(recv_buf, TEST_SIZE)
!
         do 11 i = count+1,TEST_SIZE
            recv_buf(i) = 0.0
 11      continue
!
         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)

         call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, &
      &                   'recv/send for replace', errs )

         call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, &
      &                 comm, ierr) 
      end if
!
      end
!
!------------------------------------------------------------------------------
!
!  Check for correct source, tag, count, and data in test message.
!
!------------------------------------------------------------------------------
      subroutine msg_check( recv_buf, source, tag, count, status, n,  &
      &                      name, errs )
      use mpi
      integer n, errs
      real    recv_buf(n)
      integer source, tag, count, rank, status(MPI_STATUS_SIZE)
      character*(*) name
      logical foundError

      integer ierr, recv_src, recv_tag, recv_count

      foundError = .false.
      recv_src = status(MPI_SOURCE)
      recv_tag = status(MPI_TAG)
      call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr )
      call MPI_Get_count(status, MPI_REAL, recv_count, ierr)

      if (recv_src .ne. source) then
         print *, '[', rank, '] Unexpected source:', recv_src,  &
      &            ' in ', name
         errs       = errs + 1
         foundError = .true.
      end if

      if (recv_tag .ne. tag) then
         print *, '[', rank, '] Unexpected tag:', recv_tag, ' in ', name
         errs       = errs + 1
         foundError = .true.
      end if

      if (recv_count .ne. count) then
         print *, '[', rank, '] Unexpected count:', recv_count, &
      &            ' in ', name
         errs       = errs + 1
         foundError = .true.
      end if
         
      call verify_test_data(recv_buf, count, n, name, errs )

      end
!------------------------------------------------------------------------------
!
!  Check that requests have been set to null
!
!------------------------------------------------------------------------------
      subroutine rq_check( requests, n, msg )
      use mpi
      integer n, requests(n)
      character*(*) msg
      integer i
!
      do 10 i=1, n
         if (requests(i) .ne. MPI_REQUEST_NULL) then
            print *, 'Nonnull request in ', msg
         endif
 10   continue
!      
      end
!------------------------------------------------------------------------------
!
!  Initialize test data buffer with integral sequence.
!
!------------------------------------------------------------------------------
      subroutine init_test_data(buf,n)
      integer n
      real buf(n)
      integer i

      do 10 i = 1, n
         buf(i) = REAL(i)
 10    continue
      end

!------------------------------------------------------------------------------
!
!  Clear test data buffer
!
!------------------------------------------------------------------------------
      subroutine clear_test_data(buf, n)
      integer n
      real buf(n)
      integer i

      do 10 i = 1, n
         buf(i) = 0.
 10   continue

      end

!------------------------------------------------------------------------------
!
!  Verify test data buffer
!
!------------------------------------------------------------------------------
      subroutine verify_test_data( buf, count, n, name, errs )
      use mpi
      integer n, errs
      real buf(n)
      character *(*) name
      integer count, i
!
      do 10 i = 1, count
         if (buf(i) .ne. REAL(i)) then
            print 100, buf(i), i, count, name
            errs = errs + 1
         endif
 10   continue
!
      do 20 i = count + 1, n
         if (buf(i) .ne. 0.) then
            print 100, buf(i), i, n, name
            errs = errs + 1
         endif
 20   continue
!      
100   format('Invalid data', f6.1, ' at ', i4, ' of ', i4, ' in ', a)
!
      end
!
!    This routine is used to prevent the compiler from deallocating the 
!    array "a", which may happen in some of the tests (see the text in 
!    the MPI standard about why this may be a problem in valid Fortran 
!    codes).  Without this, for example, tests fail with the Cray ftn
!    compiler.
!
      subroutine dummyRef( a, n, ie )
      integer n, ie
      real    a(n)
! This condition will never be true, but the compile won't know that
      if (ie .eq. -1) then
          print *, a(n)
      endif
      return
      end
