program ping_pong
use mpi
implicit none
integer :: rank, nb_mpi_processes, ierror, tag, statu(MPI_STATUS_SIZE), n, ball
integer :: niter = 6
! Ping Pong program
tag = 7777
call MPI_INIT( ierror )
call MPI_COMM_SIZE( MPI_COMM_WORLD , nb_mpi_processes , ierror )
call MPI_COMM_RANK( MPI_COMM_WORLD , rank , ierror )
if(nb_mpi_processes /= 2) stop 'This program is design to be run with 2 processes only'
ball = 0
do n=1,niter
if(rank==0) then
call MPI_SEND ( ball , 1 , MPI_INTEGER , 1 , tag , MPI_COMM_WORLD , MPI_STATUS_IGNORE , ierror ) ! 0 send ball to 1, and wait for transfer to be finished
call MPI_RECV ( ball , 1 , MPI_INTEGER , 1 , tag , MPI_COMM_WORLD , MPI_STATUS_IGNORE , ierror ) ! 0 receive ball from 1, and wait for transfer to be finished
ball = ball + 2
end if
if(rank==1) then
call MPI_RECV ( ball , 1 , MPI_INTEGER , 0 , tag , MPI_COMM_WORLD , MPI_STATUS_IGNORE , ierror )
ball = ball + 1
call MPI_SEND ( ball , 1 , MPI_INTEGER , 0 , tag , MPI_COMM_WORLD , MPI_STATUS_IGNORE , ierror )
end if
print*, 'Process',rank,'iter',n,'ball value is :',ball
call MPI_BARRIER(MPI_COMM_WORLD,ierror) ! A barrier. processes stop here, and can pass it only if ALL processes are here. Useful for debug, can impact performances
end do
call MPI_FINALIZE ( ierror ) ! Close MPI
end program ping_pong