! This code naughtily assumes that a double is 8 bytes

program pingpong

use mpi_f08

implicit none

integer :: nproc,rank,pkt_size,rep,i
integer, parameter :: maxpkt_size=134217728
real (kind=kind(1d0)), allocatable :: a(:)
real (kind=kind(1d0)) :: t_start,t_end

allocate(a(maxpkt_size))

call mpi_init()

call mpi_comm_size(mpi_comm_world, nproc)
call mpi_comm_rank(mpi_comm_world, rank)

pkt_size=1
do while (pkt_size<=maxpkt_size)
  rep=100000/pkt_size+1
  t_start=mpi_wtime()
  do i=1,rep
    if (rank.eq.0) then
      call mpi_send(a,pkt_size,MPI_DOUBLE_PRECISION,1,0,MPI_COMM_WORLD)
      call mpi_recv(a,pkt_size,MPI_DOUBLE_PRECISION,1,1,MPI_COMM_WORLD, &
           MPI_STATUS_IGNORE)
    else if (rank.eq.1) then
      call mpi_recv(a,pkt_size,MPI_DOUBLE_PRECISION,0,0,MPI_COMM_WORLD, &
           MPI_STATUS_IGNORE)
      call mpi_send(a,pkt_size,MPI_DOUBLE_PRECISION,0,1,MPI_COMM_WORLD)
    endif
  enddo
  t_end=mpi_wtime()
  if (rank.eq.0) then
    write(*,102)8*pkt_size,(t_end-t_start)/(2*rep*1d-6), &
                2*rep*8*real(pkt_size,kind(1d0))/(1d6*(t_end-t_start))
102 format(i10,' bytes in ',f10.1, ' us at ',f8.0,' MB/s')
  endif
  pkt_size=pkt_size*2
enddo

call mpi_finalize()
end program
