*----------------------------------------------------------------------- * Filename: mpi_pong.f *----------------------------------------------------------------------- PROGRAM Pong IMPLICIT NONE INTEGER ierr, myproc, nprocs INTEGER size, other_proc, i, last DOUBLE PRECISION t0, t1, time DOUBLE PRECISION max_rate, min_latency DOUBLE PRECISION a(132000), b(132000) *----------------------------------------------------------------------- * Init MPI *----------------------------------------------------------------------- INCLUDE "mpif.h" INTEGER status(MPI_STATUS_SIZE) INTEGER request, request_a, request_b CALL MPI_Init(ierr) CALL MPI_Comm_Rank(MPI_COMM_WORLD,myproc,ierr) CALL MPI_Comm_Size(MPI_COMM_WORLD,nprocs,ierr) *----------------------------------------------------------------------- * *----------------------------------------------------------------------- min_latency = 10e6 max_rate = 0.0 DO i = 1,132000 a(i) = i b(i) = .0 ENDDO IF( nprocs .NE. 2) STOP other_proc = MOD(myproc + 1, 2) PRINT*,'Hello from ',myproc,' of ',nprocs CALL MPI_Barrier(MPI_COMM_WORLD, ierr) *----------------------------------------------------------------------- * Timer accuracy test *----------------------------------------------------------------------- t0 = MPI_Wtime() 10 t1 = MPI_Wtime() IF( t1 .EQ. t0) GOTO 10 IF( myproc .EQ. 0 )THEN PRINT*,'Timer accuracy of ',(t1-t0)*1000000, 'usecs' ENDIF *----------------------------------------------------------------------- * Communications between nodes * - Blocking sends and receives * - No guarantee of prepost, so data might pass through comm buffer *----------------------------------------------------------------------- size = 8 20 CONTINUE DO i = 1, size/8 a(i) = i b(i) = 0.0 ENDDO last = size/8 CALL MPI_Barrier(MPI_COMM_WORLD, ierr) t0 = MPI_Wtime() IF( myproc .EQ. 0 )THEN CALL MPI_Send(a, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, ierr) CALL MPI_Recv(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, status, ierr) ELSE CALL MPI_Recv(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, status, ierr) b(1) = b(1) + 1.0 IF( last .NE. 1 )THEN b(last) = b(last) + 1.0 ENDIF CALL MPI_Send(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, ierr) ENDIF t1 = MPI_Wtime() time = 1e6 * (t1 - t0) CALL MPI_Barrier(MPI_COMM_WORLD, ierr) IF( (b(1) .NE. 2.0) .OR. (b(last) .NE. last + 1) )THEN PRINT*,'ERROR - b[1] = ',b(1),' b[',last,'] = ',b(last) STOP ENDIF DO i = 2, last - 1 IF( b(i) .NE. i ) PRINT*,'ERROR - b[',i,'] = ',b(i) ENDDO IF( (myproc .EQ. 0) .AND. (time .GT. 0.000001) )THEN PRINT 1020,size,' bytes took ',time,' usec (',2.0*size/time, & ' MB/sec)' 1020 FORMAT(I8, A, F15.2, A, F10.7, A ) IF( 2*size/time .GT. max_rate ) max_rate = 2 * size / time IF( time / 2 .LT. min_latency ) min_latency = time / 2 ELSE IF( myproc .EQ. 0 ) & PRINT*,size,' bytes took less than the timer accuracy' ENDIF size = size * 2 IF( size .LE. 1048576 ) GOTO 20 *----------------------------------------------------------------------- * Async communications * - Prepost receives to guarantee bypassing the comm buffer *----------------------------------------------------------------------- CALL MPI_Barrier(MPI_COMM_WORLD, ierr) IF( myproc .EQ. 0 )THEN PRINT*,' ' PRINT*,'Asynchronous ping-pong' PRINT*,' ' ENDIF size = 8 30 CONTINUE DO i = 1, size/8 a(i) = i b(i) = 0.0 ENDDO last = size/8 CALL MPI_Irecv(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, request) CALL MPI_Barrier(MPI_COMM_WORLD, ierr) t0 = MPI_Wtime() IF( myproc .EQ. 0 )THEN CALL MPI_Send(a, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, ierr) CALL MPI_Wait(request, status, ierr) ELSE CALL MPI_Wait(request, status, ierr) b(1) = b(1) + 1.0 IF( last .NE. 1 ) b(last) = b(last) + 1.0 CALL MPI_Send(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, ierr) ENDIF t1 = MPI_Wtime() time = 1e6 * (t1 - t0) CALL MPI_Barrier(MPI_COMM_WORLD, ierr) IF( (b(1) .NE. 2.0) .OR. (b(last) .NE. last + 1) )THEN PRINT*,'ERROR - b[1] = ',b(1),' b[',last,'] = ',b(last) STOP ENDIF DO i = 2, last - 1 IF( b(i) .NE. i ) PRINT*,'ERROR - b[',i,'] = ',b(i) ENDDO IF( (myproc .EQ. 0) .AND. (time .GT. 0.000001) )THEN PRINT 1030,size,' bytes took ',time,' usec (',2.0*size/time, & ' MB/sec)' 1030 FORMAT(I8, A, F15.2, A, F10.7, A ) IF( 2*size/time .GT. max_rate ) max_rate = 2 * size / time IF( time / 2 .LT. min_latency ) min_latency = time / 2 ELSE IF( myproc .EQ. 0 )THEN PRINT*,size,' bytes took less than the timer accuracy' ENDIF size = size * 2 IF( size .LE. 1048576 ) GOTO 30 *----------------------------------------------------------------------- * Bi-directional asynchronous ping-pong *----------------------------------------------------------------------- CALL MPI_Barrier(MPI_COMM_WORLD, ierr) IF( myproc .EQ. 0 )THEN PRINT*,' ' PRINT*,'Bi-directional asynchronous ping-pong' PRINT*,' ' ENDIF size = 8 40 CONTINUE DO i = 1, size/8 a(i) = i b(i) = 0.0 ENDDO last = size/8 CALL MPI_Irecv(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, request_b) CALL MPI_Irecv(a, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, request_a) CALL MPI_Barrier(MPI_COMM_WORLD, ierr) t0 = MPI_Wtime() CALL MPI_Send(a, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, ierr) CALL MPI_Wait(request_b, status, ierr) b(1) = b(1) + 1.0 IF( last .NE. 1 )b(last) = b(last) + 1.0 CALL MPI_Send(b, size/8, MPI_DOUBLE_PRECISION, other_proc, & 0, MPI_COMM_WORLD, ierr) CALL MPI_Wait(request_a, status, ierr) t1 = MPI_Wtime() time = 1e6 * (t1 - t0) CALL MPI_Barrier(MPI_COMM_WORLD, ierr) IF( (b(1) .NE. 2.0) .OR. (b(last) .NE. last + 1) )THEN PRINT*,'ERROR - b[1] = ',b(1),' b[',last,'] = ',b(last) STOP ENDIF DO i = 2, last - 1 IF( b(i) .NE. i ) PRINT*,'ERROR - b[',i,'] = ',b(i) ENDDO IF( (myproc .EQ. 0) .AND. (time .GT. 0.000001) )THEN PRINT 1040,size,' bytes took ',time,' usec (',2.0*size/time, & ' MB/sec)' 1040 FORMAT(I8, A, F15.2, A, F10.7, A ) IF( 2*size/time .GT. max_rate ) max_rate = 2 * size / time IF( time / 2 .LT. min_latency ) min_latency = time / 2 ELSE IF( myproc .EQ. 0 ) & PRINT*,size,' bytes took less than the timer accuracy' ENDIF size = size * 2 IF( size .LE. 1048576 ) GOTO 40 *----------------------------------------------------------------------- * Max rate, Min latency *----------------------------------------------------------------------- IF( myproc .EQ. 0 )THEN PRINT*,' ' PRINT 1050,'Max rate = ',max_rate,' MB/sec Min latency = ', & min_latency 1050 FORMAT(A, F10.7, A, F25.12) PRINT*,' ' ENDIF *----------------------------------------------------------------------- * Leave MPI *----------------------------------------------------------------------- CALL MPI_Finalize(ierr) END