PROGRAM MPIPRG
      INCLUDE 'mpif.h'
      PARAMETER ( N = 1024*1024 )
      INTEGER MYRANK, NPROCS, IERR, SRC, DEST, TAG, REQUEST(2)
      INTEGER STATUS(MPI_STATUS_SIZE)
      DOUBLE PRECISION A(N), B(N), SUM
*
      CALL MPI_INIT(IERR)
      CALL MPI_COMM_RANK( MPI_COMM_WORLD, MYRANK, IERR)
      CALL MPI_COMM_SIZE( MPI_COMM_WORLD, NPROCS, IERR)
*
      DO I = 1, N
         A(I) = DBLE(MYRANK)
      ENDDO
*
* Compute source and dest
      SRC = MYRANK-1
      IF ( SRC .LT. 0 ) SRC = NPROCS - 1
      DEST = MYRANK + 1
      IF ( DEST .GE. NPROCS ) DEST = 0
*
* Create persistent communication requests
      TAG = 111
      CALL MPI_SEND_INIT( A, N, MPI_DOUBLE_PRECISION, DEST, TAG,
     +                    MPI_COMM_WORLD, REQUEST(1), IERR )
      CALL MPI_RECV_INIT( B, N, MPI_DOUBLE_PRECISION, SRC,  TAG,
     +                    MPI_COMM_WORLD, REQUEST(2), IERR )
*
* Start communications
      CALL MPI_STARTALL(2, REQUEST, IERR)
*
* Wait for completion of recv.
      CALL MPI_WAIT( REQUEST(2), STATUS, IERR )
*
      SUM = 0.D0
      DO I = 1, N
         SUM = SUM + B(I)
      ENDDO
*
      PRINT 1000, MYRANK, SUM/N
1000  FORMAT(' Process ', I3, ':  value = ', 1PG12.5)
*
* Wait for completion of send.
      CALL MPI_WAIT( REQUEST(1), STATUS, IERR )
*
      CALL MPI_FINALIZE(IERR)
      STOP
      END