! -*- Mode: Fortran; -*-

!

!  (C) 2013 by Argonne National Laboratory.

!      See COPYRIGHT in top-level directory.

!

       program main

       use mpi_f08

       integer ierr

       integer smsg(3), rmsg(3), toterrs, wsize, wrank

       common /myinfo/ calls, amount, rcalls, ramount

       integer calls, amount, rcalls, ramount

       toterrs = 0

       call mpi_init( ierr )

       call init_counts()

       call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )

       call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )

       if (wrank .eq. 0) then

           smsg(1) = 3

           call mpi_send( smsg, 1, MPI_INT, 1, 0, MPI_COMM_WORLD, ierr )

       else if (wrank .eq. 1) then

          call mpi_recv( rmsg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &

      &         MPI_STATUS_IGNORE, ierr )

          if (rmsg(1) .ne. 3) then

             toterrs = toterrs + 1

             print *, "Unexpected received value ", rmsg(1)

          endif

       endif

!

!     check that we used the profiling versions of the routines

       toterrs = 0

       if (wrank .eq. 0) then

          if (calls.ne.1) then

             toterrs = toterrs + 1

             print *, "Sender calls is ", calls

          endif

          if (amount.ne.1) then

             toterrs = toterrs + 1

             print *, "Sender amount is ", amount

          endif

       else if (wrank .eq. 1) then

          if (rcalls.ne.1) then

             toterrs = toterrs + 1

             print *, "Receiver calls is ", rcalls

          endif

          if (ramount.ne.1) then

             toterrs = toterrs + 1

             print *, "Receiver amount is ", ramount

          endif

       endif

       call mtest_finalize( toterrs )

!

       end

!

       subroutine mpi_send_f08ts( smsg, count, dtype, dest, tag, comm, ierr )

       use :: mpi_f08, my_noname => mpi_send_f08ts

       type(*), dimension(..), intent(in) :: smsg

       integer, intent(in) :: count, dest, tag

       type(MPI_Datatype), intent(in) :: dtype

       type(MPI_Comm), intent(in) :: comm

       integer, optional, intent(out) :: ierr

       common /myinfo/ calls, amount, rcalls, ramount

       integer calls, amount, rcalls, ramount

!

       calls = calls + 1

       amount = amount + count

       if (present(ierr)) then

         call pmpi_send(smsg, count, dtype, dest, tag, comm, ierr)

       else

         call pmpi_send(smsg, count, dtype, dest, tag, comm)

       end if

       end

!

      subroutine mpi_recv_f08ts( rmsg, count, dtype, src, tag, comm, status, ierr )

       use :: mpi_f08, my_noname => mpi_recv_f08ts

       type(*), dimension(..), intent(in) :: rmsg

       integer, intent(in) :: count, src, tag

       type(MPI_Datatype), intent(in) :: dtype

       type(MPI_Comm), intent(in) :: comm

       type(MPI_Status) :: status

       integer, optional, intent(out) :: ierr

       common /myinfo/ calls, amount, rcalls, ramount

       integer calls, amount, rcalls, ramount

       rcalls = rcalls + 1

       ramount = ramount + 1

       if (present(ierr)) then

         call pmpi_recv(rmsg, count, dtype, src, tag, comm, status, ierr)

       else

         call pmpi_recv(rmsg, count, dtype, src, tag, comm, status)

       end if

       end

!

       subroutine init_counts()

       common /myinfo/ calls, amount, rcalls, ramount

       integer calls, amount, rcalls, ramount

       calls = 0

       amount = 0

       rcalls = 0

       ramount = 0

       end

!

       subroutine mpi_pcontrol( ierr )

       integer ierr

       return

       end