! -*- 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