      PROGRAM PINGPONG
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER            NUMTST
      PARAMETER          (NUMTST = 10)
      DOUBLE PRECISION   BUF(1100000), RATE
      INTEGER            RANK, N
      DOUBLE PRECISION   T1, T2, TMIN
      INTEGER            I, J, K, NLOOP, II
      INTEGER            STATUS(MPI_STATUS_SIZE), R
      INTEGER            IERR
*     ..
*     .. Executable Statements ..
*
*     Init MPI: No MPI calls before this
      CALL MPI_INIT(IERR)
*
*     Get my ID 0..P-1
      CALL MPI_COMM_RANK(MPI_COMM_WORLD, RANK, IERR)
      N = 1
      DO 10 II = 1, 20 
         N = N*2
         NLOOP  = 1000/N
         IF (NLOOP .LT. 1) NLOOP = 1

         TMIN = 1000
         DO 20 k = 0, NUMTST
            IF (RANK .EQ. 0) THEN
		CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) 
                T1 = MPI_WTIME()
                DO 30 J=0, NLOOP
                    CALL MPI_ISEND( BUF, N, MPI_DOUBLE_PRECISION, 1, K, 
     +                                   MPI_COMM_WORLD, R, IERR )
                    CALL MPI_WAIT( R, STATUS, IERR )
                    CALL MPI_IRECV( BUF, N, MPI_DOUBLE_PRECISION, 1, K, 
     +                                   MPI_COMM_WORLD, R, IERR )
                    CALL MPI_Wait( R, STATUS, IERR )
30              CONTINUE
                T2 = (MPI_WTIME() - T1) / NLOOP
                IF (T2 .LT. TMIN) THEN
                    TMIN = T2
                ENDIF
            ELSE IF (RANK .EQ. 1) THEN 
		CALL MPI_BARRIER(MPI_COMM_WORLD, IERR)
                DO 40 J=0, NLOOP
                    CALL MPI_IRECV( BUF, N, MPI_DOUBLE_PRECISION, 0, K, 
     +                                   MPI_COMM_WORLD, R, IERR )
                    CALL MPI_WAIT( R, STATUS, IERR )
                    CALL MPI_ISEND( BUF, N, MPI_DOUBLE_PRECISION, 0, K, 
     +                                   MPI_COMM_WORLD, R, IERR )
                    CALL MPI_WAIT( R, STATUS, IERR )
40              CONTINUE
             ENDIF
20       CONTINUE
C      Convert to half the round-trip time 
       TMIN = TMIN / 2.0
       IF (RANk .EQ. 0) THEN
            IF (TMIN .GT. 0) THEN
                RATE = N * 8 * 1.0e-6 /TMIN
            ELSE          
                RATE = 0.0
            ENDIF
            WRITE(*,100)'Isend/Irecv', n, tmin, rate
       ENDIF
10     CONTINUE
*
*      Shut down MPI
       CALL MPI_FINALIZE(IERR )
100    FORMAT(' ',A,I10,F12.5,F12.5)
       STOP
       END
