Commit f721ddce authored by Simon Brass's avatar Simon Brass
Browse files

Add MPI Standard Example 3-16.

parent 04248ace
Pipeline #5823 failed with stages
in 35 seconds
program main
use mpi_f08
implicit none
integer, parameter :: T_CHANNEL = 1
integer, parameter :: n_channel = 10
integer :: rank, size, numdone, ierr
integer :: i, ch
integer, dimension(:), allocatable :: a
integer, dimension(:), allocatable :: indices
type(MPI_Request), dimension(:), allocatable :: request
type(MPI_Status), dimension(:), allocatable :: status
call MPI_INIT ()
call MPI_COMM_RANK (MPI_COMM_WORLD, rank)
call MPI_COMM_SIZE (MPI_COMM_WORLD, size)
allocate (a(size - 1))
allocate (indices(size - 1))
allocate (request(size - 1))
allocate (status(size - 1))
if (rank > 0) then
! Client Code
do ch = 1, n_channel
if (mod (ch - 1, size - 1) + 1 == rank) then
! Do prolonged computation and send.
call sleep(2)
call MPI_ISEND (ch, 1, MPI_INTEGER, 0, T_CHANNEL, MPI_COMM_WORLD, request(rank))
call MPI_WAIT (request(rank), status(rank))
! Send results to master.
end if
end do
else
! Server Code
ch = 0
do i = 1, size - 1
call MPI_IRECV (a(i), 1, MPI_INTEGER, i, &
T_CHANNEL, MPI_COMM_WORLD, request(i), ierr)
end do
do while (ch < n_channel)
call MPI_WAITSOME (size - 1, request, numdone, indices, status, ierr)
do i = 1, numdone
print *, "CH: ", a(indices(i)), " FROM ", indices(i)
! Receive results from indices(i)
ch = ch + 1
call MPI_IRECV (a(indices(i)), 1, MPI_INTEGER, indices(i), &
T_CHANNEL, MPI_COMM_WORLD, request(indices(i)), ierr)
end do
end do
end if
call MPI_BARRIER (MPI_COMM_WORLD)
call MPI_FINALIZE ()
end program main
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment