! This file created from f77/pt2pt/utilsf.f with f77tof90
! -*- Mode: Fortran; -*-
!
!  (C) 2012 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!

!------------------------------------------------------------------------------
!
!  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, ierr, 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