Skip to content
isend-irecv.F90 2.12 KiB
Newer Older
Jussi Enkovaara's avatar
Jussi Enkovaara committed
program chain
  use mpi
  use iso_fortran_env, only : REAL64

  implicit none
  integer, parameter :: size = 10000000
  integer :: rc, myid, ntasks
  integer :: message(size)
  integer :: receiveBuffer(size)
  integer :: status(MPI_STATUS_SIZE,2)

  real(REAL64) :: t0, t1

  integer :: source, destination
  integer :: count
  integer :: requests(2)

  call mpi_init(rc)
  call mpi_comm_rank(MPI_COMM_WORLD, myid, rc)
  call mpi_comm_size(MPI_COMM_WORLD, ntasks, rc)

  message = myid

  ! Set source and destination ranks
  if (myid < ntasks-1) then
     destination = myid + 1
  else
     destination = MPI_PROC_NULL
  end if
  if (myid > 0) then
     source = myid - 1
  else
     source = MPI_PROC_NULL
  end if

  ! Start measuring the time spent in communication
  call mpi_barrier(mpi_comm_world, rc)
  t0 = mpi_wtime()

  ! Receive messages in the back ground
  call mpi_irecv(receiveBuffer, size, MPI_INTEGER, source, &
       MPI_ANY_TAG, MPI_COMM_WORLD, requests(1), rc)
  ! Send messages in the back ground
  call mpi_isend(message, size, MPI_INTEGER, destination, &
       myid + 1, MPI_COMM_WORLD, requests(2), rc)

  ! Blocking wait for messages
  call mpi_waitall(2, requests, status, rc)

  ! Use status parameter to find out the no. of elements received
  call mpi_get_count(status(:,1), MPI_INTEGER, count, rc)
  write(*,'(A10,I3,A20,I8,A,I3,A,I3)') 'Sender: ', myid, &
       ' Sent elements: ', size, &
       '. Tag: ', myid + 1, &
       '. Receiver: ', destination
  write(*,'(A10,I3,A20,I8,A,I3,A,I3)') 'Receiver: ', myid, &
       'received elements: ', count, &
       '. Tag: ', status(MPI_TAG, 1), &
       '. Sender:   ', status(MPI_SOURCE, 1)

  ! Finalize measuring the time and print it out
  t1 = mpi_wtime()
  call mpi_barrier(mpi_comm_world, rc)
  call flush(6)

  if (myid == 0) then
      write(*,*)
      write(*,*) 'Timings:'
      write(*, '(A20, I3, A, F6.3)') 'Time elapsed in rank', myid, ':', t1-t0
  endif
  call mpi_barrier(mpi_comm_world, rc)
  call flush(6)
  if (myid == ntasks - 1) then
      write(*, '(A20, I3, A, F6.3)') 'Time elapsed in rank', myid, ':', t1-t0
  endif

  call mpi_finalize(rc)
end program chain