program pingpong
  implicit none
  include 'mpif.h'

  integer, parameter :: packet_size = 100
  integer, parameter :: num_rounds = 500000

  integer, dimension(packet_size) :: packet
  
  integer :: ierror
  integer :: rank, size
  integer :: nrank, prank
  integer :: iter

  double precision :: time_begin, time_end

  ! Initialize MPI environment
  call mpi_init(ierror)

  ! Get communicator size
  call mpi_comm_size(MPI_COMM_WORLD, size, ierror)
  ! Get process rank in the world communicator
  call mpi_comm_rank(MPI_COMM_WORLD, rank, ierror)

  ! Calculate neighbors' ranks
  nrank = mod(rank+1, size)
  prank = mod(rank-1+size, size)

  time_begin = mpi_wtime()
  
  do iter = 1, num_rounds
    if (rank == 0) then
      ! Fire
      call mpi_send(packet, packet_size, MPI_INTEGER, nrank, 0, &
&       MPI_COMM_WORLD, ierror)
      ! Wait for the packet
      call mpi_recv(packet, packet_size, MPI_INTEGER, prank, 0, &
&       MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror)
    else
      ! Wait for the packet
      call mpi_recv(packet, packet_size, MPI_INTEGER, prank, 0, &
&       MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror)
      ! Forward it
      call mpi_send(packet, packet_size, MPI_INTEGER, nrank, 0, &
&       MPI_COMM_WORLD, ierror)
    end if
  end do

  time_end = mpi_wtime()

  ! Only master process outputs statistics
  if (rank == 0) then
    time_end = time_end - time_begin
    print "(' Number of nodes: ',I9)", size
    print *
    print "('     Packet size: ',I9,' Bytes')", 4*packet_size
    print "('Number of rounds: ',I9)", num_rounds
    print *
    print "('        Mean RTT: ',F9.4,' ms')", 1000.*time_end/real(num_rounds)
    print "('    Mean latency: ',F9.4,' ms')", &
&     1000.*time_end/real(size*num_rounds)
    print "('  Mean bandwidth: ',F9.4,' MB/s')", &
&     real(packet_size*size*num_rounds)/(2.5e+5*time_end)
  end if
  
  ! Shut down MPI environment
  call mpi_finalize()

end program pingpong
