      PROGRAM COMMS3
C
      INCLUDE 'mpif.h'
      INCLUDE 'dattyp.inc'
      INCLUDE 'comms3.inc'

C     =================================================
C     ===                                           ===
C     ===   Program:  Saturation Bandwidth          ===
C     ===   Version:  PVM3 + Fortran 77             ===
C     ===                                           ===
C     =================================================

C     /* Program name */
      CHARACTER*10  NAME /'comms3_mpi'/


C     /* Timer routine */
C
      EXTERNAL DWALLTIME00
      DOUBLE PRECISION DWALLTIME00
C
C     Variables:
C     
      CHARACTER*6  GROUP /'comms3'/
      INTEGER I, ierr, my_rank, status(MPI_STATUS_SIZE)
      INTEGER request(0:MAXNOD-1)
C
      INTEGER numprocs, MAXEND, NEND, NREPT, NSEL, NSLAVE, 
     &        NEXED, NSTOP, NMIN
      PARAMETER(MAXEND=17, NSTOP=3, NMIN=11)
C
C      /* the unit number of output files */
C
      INTEGER IOUNIT, NW1
      PARAMETER(IOUNIT=10)
      PARAMETER(NW1=11)
C
C
C      /* the maximum message length */
C
      INTEGER MAXBYT, NMAX
      PARAMETER(MAXBYT=10000000)
      PARAMETER(NMAX=MAXBYT/IDPLEN)
C
      INTEGER ILEN, IWORD, LEN(17)
      DOUBLE PRECISION RAVMAX, TN, XN, RAV
      DOUBLE PRECISION T0,T1,T2
      DOUBLE PRECISION A(NMAX), B(NMAX)


C     Initialize MPI.
C
      CALL MPI_INIT(ierr)
C     
      IF( ierr.NE.MPI_SUCCESS )
     &    PRINT *,'ERROR: MPI_INIT returned ', ierr
C
      CALL MPI_COMM_RANK( MPI_COMM_WORLD, my_rank, ierr)
      CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr)
			     
      IF( my_rank.EQ.0 )THEN
C
C        Get parameters from input file
C
         PRINT *
         PRINT *,'           Saturation Bandwidth Test'
         PRINT *,'           -------------------------'
         PRINT *,'Every process broadcasts a message of length, n,'
         PRINT *,'to every other process, and then waits to receive'
         PRINT *,'all messages directed to it. Message length is varied'
         PRINT *,'until the bandwidth saturates. The program records'
         PRINT *,'the maximum observed bandwidth and bandwidth per'
         PRINT *,'process.'
         PRINT *,'            ------------------------'
         PRINT *
         OPEN(UNIT=IOUNIT,FILE='comms3.dat',STATUS='OLD')
         READ( IOUNIT,FMT = * ) 
         PRINT *,'Number of processes =',numprocs
C
         PRINT *
         PRINT *,'    NEND=  5 messages up to      1,000 Byte'
         PRINT *,'    NEND=  8 messages up to     10,000 Byte'
         PRINT *,'    NEND= 11 messages up to    100,000 Byte'
         PRINT *,'    NEND= 14 messages up to  1,000,000 Byte'
         PRINT *,'    NEND= 17 messages up to 10,000,000 Byte'
         PRINT *
C
         READ( IOUNIT,FMT = *) NEND
         IF( NEND.LT.1 .OR. NEND.GT.MAXEND )THEN
            PRINT *,'The NEND value', NEND, 'is invalid.'
            PRINT *,'Try again:  1 <= NEND <= ', MAXEND
            CALL MPI_FINALIZE(ierr)
            STOP
         ENDIF
         PRINT *,'NEND =',NEND
         CLOSE(IOUNIT)
C
C        /* Send all process ids to each process */
C        /* Send NEND to processes */

C
C       /* Broadcast NEND to each node */
C
        CALL MPI_BCAST(NEND, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
C
      ELSE
C
C       /* All slaves receive NEND from master */  
C
        CALL MPI_BCAST(NEND, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
      ENDIF

C     ======================

C
C     /* Define message lengths. */
C
      LEN(1)=200  
      LEN(2) = 400
      LEN(3) = 600
      LEN(4) = 800
      LEN(5) = 1000
      LEN(6) = 2000
      LEN(7) = 5000
      LEN(8) = 10000
      LEN(9) = 20000
      LEN(10) = 50000
      LEN(11) = 100000
      LEN(12) = 200000
      LEN(13) = 500000
      LEN(14) = 1000000
      LEN(15) = 2000000
      LEN(16) = 5000000
      LEN(17) = 10000000
C
      IF( my_rank.EQ.0 )THEN
         OPEN(NW1,FILE='comms3.res')
C
C        /*  print header */
C
         CALL HEADER(NW1,NAME)
         RAVMAX=0.0
C
         WRITE(NW1,998)
         WRITE(6,998)
  998    FORMAT(/,2X,'  Case  LENGTH(B)   TIME(sec)   RAV(B/s)')
C
      ENDIF
C
C     /* Global synchronisation */
C
      CALL MPI_BARRIER( MPI_COMM_WORLD, ierr)
      IF( ierr.NE.MPI_SUCCESS )
     &    PRINT *,'ERROR: MPI_BARRIER returned ', ierr
C
      DO 50 NSEL = 1,NEND
        ILEN = LEN(NSEL)
        NREPT=NITER
        IF (ILEN .GE. 5000) NREPT=NITER/10
        IF (ILEN .GE. 50000) NREPT=NITER/20
        IF (NREPT .LT. 1) NREPT=1
        IF (my_rank .EQ. 0)THEN
C          /* measure timing overhead, t0 */
           T1 = DWALLTIME00()
           DO 10 I = 1,NREPT
             CALL DUMMY(I)
   10      CONTINUE
           T2 = DWALLTIME00()
           T0 = T2-T1
        ENDIF
C
        T1 = DWALLTIME00()
C 
        IWORD=ILEN/IDPLEN
        DO 20 I = 1,NREPT
          CALL DUMMY(I)
C
C         /* send messages to all other processes */
C
          DO 200 NSLAVE = 0, numprocs-1
            IF( my_rank.NE.NSLAVE )THEN
               CALL MPI_ISEND(A, IWORD, MPI_DOUBLE_PRECISION, NSLAVE,
     &                  NSLAVE, MPI_COMM_WORLD, request(NSLAVE), ierr)
            ENDIF
  200     CONTINUE
C
C         /* receive messages from all other processes */
C
          DO 201 NSLAVE = 0, numprocs-1
            IF( my_rank.NE.NSLAVE )THEN
               CALL MPI_RECV(B, IWORD, MPI_DOUBLE_PRECISION, 
     &                  MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD,
     &                  status, ierr)
            ENDIF
  201     CONTINUE 
C
C         /* Wait for all messages to be sent */
C
          DO 202 NSLAVE = 0, numprocs-1
            IF( my_rank.NE.NSLAVE )THEN
               CALL MPI_WAIT(request(NSLAVE), status, ierr)
            ENDIF
  202     CONTINUE 
C
   20   CONTINUE
C
        T2 = DWALLTIME00()
C
C       /* divide by numprocs*(numprocs-1) because numprocs */
C       /* processes send (numprocs-1) messages  */
C
        TN = (T2-T1-T0)/(NREPT*numprocs*(numprocs-1))
        XN = ILEN
        RAV= ILEN/TN
        RAVMAX=MAX(RAVMAX,RAV)
C
        IF( my_rank.EQ.0 )THEN
C          /* write latest values */
           WRITE(NW1,999) NSEL,ILEN,TN,RAV
           WRITE(6,999) NSEL,ILEN,TN,RAV
  999      FORMAT(1X,I6,I9,3X,2(1PE12.3))
        ENDIF
C
C       /* if at least NSTOP measurements show decreasing performance we stop */
C       /* but only if we have made at least NMIN measurements  */

        IF (RAV .GE. RAVMAX) THEN
           NEXED = 0
        ELSE
           NEXED = NEXED + 1
           IF (NEXED .GE. NSTOP .AND. NSEL .GE. NMIN) GOTO 51
        ENDIF

C     /* end NSEL loop */
C
  50  CONTINUE
 51   CONTINUE
C
C      /* print result summary */
C
      IF( my_rank.EQ.0 )THEN
         WRITE(NW1,996) numprocs,RAVMAX,RAVMAX/numprocs
         WRITE(6,996) numprocs,RAVMAX,RAVMAX/numprocs
C
  996    FORMAT(/,
     &   10X,'       ----------------------------',/,
     &   10X,'       COMMS3: Saturation Bandwidth',/,
     &   10X,'       ----------------------------',/,
     &   10X,'              Result Summary          ',/,
     &   10X,'              --------------         ',//,
     &   ' Number of Processes in test =',I6,//,
     &   ' Maximum Observed Total Bandwidth =',(1PE12.3),' Byte/s',//
     &   ' Maximum Bandwidth per Processor  =',(1PE12.3),' Byte/s',/)
C
         CLOSE(NW1)
C
         PRINT *,'Benchmark completed.'
C
      ENDIF
C
C     /* Global synchronisation */
C
      CALL MPI_BARRIER( MPI_COMM_WORLD, ierr)
      IF( ierr.NE.MPI_SUCCESS )
     &    PRINT *,'ERROR: MPI_BARRIER returned ', ierr
		 
C
C     Program finished. Leave group and PVM before exiting
C
      CALL MPI_FINALIZE(ierr)
C      
      STOP
C
      END
