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