C
C Open Systems Laboratory
C http://www.lam-mpi.org/tutorials/
C Indiana University
C
C MPI Tutorial
C Lab 2: The cannonical ring program
C
C Mail questions regarding tutorial material to lam at lam dash mpi dot org
C
program main
include 'mpif.h'
integer ierr, rank, size
integer tag, num, next
integer status(MPI_STATUS_SIZE)
call MPI_INIT(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierr)
C Arbitrarily choose 201 to be our tag. Calculate the rank of the
C next process in the ring. Use the modulus operator so that the
C last process "wraps around" to rank zero.
tag = 201
next = mod(rank + 1, size)
prev = mod(rank + size - 1, size)
C If we are the "console" process, get a integer from the user to
C specify how many times we want to go around the ring
if (rank .eq. 0) then
print *, "Enter the number of times around the ring"
read *, num
print *, "Process 0 sends", num, " to 1"
C Send the number to the next process
endif
C Pass the message around the ring. The exit mechanism works as
C follows: the message (a positive integer) is passed around the
C ring. Each time is passes rank 0, it is decremented. When each
C processes receives the 0 message, it passes it on to the next
C process and then quits. By passing the 0 first, every process
C gets the 0 message and can quit normally.
10 continue
C Receive the number
print *, "Process", rank, " received", num
if (rank .eq. 0) then
num = num - 1
print *, "Process 0 decremented num"
endif
print *, "Process", rank, " sending", num, " to", next
C Send the number to the next process
if (num .eq. 0) then
print *, "Process", rank, " exiting"
goto 20
endif
goto 10
C The last process does one extra send to process 0, which needs to
C be received before the program can exit
20 if (rank .eq. 0) then
C Receive the number
endif
C Quit
call MPI_FINALIZE(ierr)
stop
end