C
C     Open Systems Laboratory
C     http://www.lam-mpi.org/tutorials/
C     University of Notre Dame
C
C     MPI Tutorial
C     Rewrite the ring program with persistent communication
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 stat(MPI_STATUS_SIZE)
      integer sendrequest, recvrequest

      call MPI_INIT(ierr)
      call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
      call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierr)

      tag = 201 
      next = mod(rank + 1, size)

      if (rank .eq. 0) then 
         print *, "Enter the number of times around the ring" 
         read *, num

         print *, "Process  0 sends", num, " to 1"
         call MPI_send(num, 1, MPI_INTEGER, next, tag, 
     $         MPI_COMM_WORLD, ierr)
      endif 

      call MPI_SEND_INIT(num, 1, MPI_INTEGER, next,
     $     tag, MPI_COMM_WORLD, sendrequest, ierr)

      call MPI_RECV_INIT(num, 1, MPI_INTEGER, MPI_ANY_SOURCE,
     $     tag, MPI_COMM_WORLD, recvrequest, ierr)

      
 10   continue

      call MPI_START(recvrequest,ierr)
      call MPI_WAIT(recvrequest, stat, ierr)

      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

      call MPI_START(sendrequest, ierr)
      call MPI_WAIT(sendrequest, stat, ierr)

      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
C     to be received before the program can exit 

 20   if (rank .eq. 0) then
         call MPI_RECV(num, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, 
     $        MPI_COMM_WORLD, stat, ierr)
      endif

C     Free the persistent requests

      call MPI_REQUEST_FREE(sendrequest, ierr)
      call MPI_REQUEST_FREE(recvrequest, ierr)

C     Quit
      
      call MPI_FINALIZE(ierr)      
      stop
      end