C ----------------------------------------------------------------------------- 
C MPI Bandwidth Test - Fortran Version
C FILE: mpi_bandwidth.f
C DESCRIPTION:  
C   This code conducts timing tests on messages sent between two processes.
C   It begins by asking the user to supply the following parameters:
C     -starting message size (J)
C     -finish message size (K)
C     -message increment size (I)
C     -number of round trips per iteration (N)
C   It then sends/receives N roundtrips of incrementally sized messages
C   from start size J to finish size K by increment I.  
C AUTHOR: Blaise Barney 12/21/95
C LAST REVISED: 
C ----------------------------------------------------------------------------- 

      program bandwidth
      include 'mpif.h'

      integer MAXSIZE, task0, task1, tag0, tag1, tag2
      parameter(MAXSIZE = 5000000)
      parameter(task0 = 0)
      parameter(task1 = 1)
      parameter(tag0 = 0)
      parameter(tag1 = 1)

      integer numtasks,rank,n,i,rndtrps,mbytes,startsize,finishsize,
     &        incr, ok, Stat(MPI_STATUS_SIZE), ierr
      real*8 time1, time2, rtc, ttime, tbytes
      character c(MAXSIZE)
      common /shared/ rndtrps,startsize,finishsize,incr,ok,c

      call MPI_INIT(ierr)
      call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
      call MPI_COMM_SIZE(MPI_COMM_WORLD, numtasks, ierr)

      if (rank .eq. 0) then
         call Startup
         call MPI_SEND(ok, 1, MPI_INTEGER, task1, tag0,
     &                 MPI_COMM_WORLD,ierr)
         if (ok .eq. 0) then
            call MPI_FINALIZE(ierr)
            stop
         endif
         call MPI_SEND(startsize, 1, MPI_INTEGER, task1, tag0, 
     &                 MPI_COMM_WORLD, ierr)
         call MPI_SEND(finishsize, 1, MPI_INTEGER, task1, tag0, 
     &                 MPI_COMM_WORLD, ierr)
         call MPI_SEND(incr, 1, MPI_INTEGER, task1, tag0, 
     &                 MPI_COMM_WORLD, ierr)
         call MPI_SEND(rndtrps, 1, MPI_INTEGER, task1, tag0, 
     &                 MPI_COMM_WORLD, ierr)

         do n=startsize, finishsize, incr
            ttime = 0.0
            mbytes = n
            do i=1, rndtrps 
               time1 = rtc()
               call MPI_SEND(c, n, MPI_CHARACTER, task1, tag0, 
     &                       MPI_COMM_WORLD, ierr)
               call MPI_RECV(c, n, MPI_CHARACTER, task1, tag1, 
     &                       MPI_COMM_WORLD, Stat, ierr)
               time2 = rtc()
               ttime = ttime + (time2-time1)
            end do
         tbytes = (mbytes*2.0) * rndtrps
         write(*,111) mbytes,int(tbytes/ttime)
 111     format(i9,i16)
         end do
      endif

C ***************************  task 1 *************************************
      if (rank .eq. 1) then
         call MPI_RECV(ok, 1, MPI_INTEGER, task0, tag0, 
     &                 MPI_COMM_WORLD, Stat, ierr)
         if (ok .eq. 0) then
           call MPI_FINALIZE(ierr)
           stop
         endif

         call MPI_RECV(startsize, 1, MPI_INTEGER, task0, tag0, 
     &                 MPI_COMM_WORLD, Stat, ierr)
         call MPI_RECV(finishsize, 1, MPI_INTEGER, task0, tag0, 
     &                 MPI_COMM_WORLD, Stat, ierr)
         call MPI_RECV(incr, 1, MPI_INTEGER, task0, tag0, 
     &                 MPI_COMM_WORLD, Stat, ierr)
         call MPI_RECV(rndtrps, 1, MPI_INTEGER, task0, tag0, 
     &                 MPI_COMM_WORLD, Stat, ierr)

         do n=startsize, finishsize, incr
            do i=1, rndtrps 
               call MPI_RECV(c, n, MPI_CHARACTER, task0, tag0, 
     &                       MPI_COMM_WORLD, Stat, ierr)
               call MPI_SEND(c, n, MPI_CHARACTER, task0, tag1, 
     &                       MPI_COMM_WORLD, ierr)
            end do
         end do
      endif

      call MPI_FINALIZE(ierr)
      end


C -----------------------------------------------------------------------------
      subroutine Startup
C -----------------------------------------------------------------------------
      integer MAXSIZE
      parameter(MAXSIZE = 5000000)
      integer rndtrps,startsize,finishsize,incr,ok
      character c(MAXSIZE)
      common /shared/ rndtrps,startsize,finishsize,incr,ok,c

      do i=1,MAXSIZE
        c(i) = "x"
      end do
      print *,'************ MPI Communications Timing Test',
     &      '***************'
      print *,'Send/Receive N roundtrips of incrementally sized ',
     &      'messages'
      print *,'from start size J to finish size K by increment I'
      print *,'Note: maximum size is',MAXSIZE
      print *,' '
      print *,'Enter 4 values: startsize, finishsize, increment,', 
     &        ' #roundtrips'
      read *, startsize, finishsize, incr, rndtrps

      ok = 1
      if ((startsize .gt. MAXSIZE) .or. (finishsize .gt. MAXSIZE)  
     &   .or. (startsize .gt. finishsize) .or.
     &   (incr .gt. finishsize) .or.  (rndtrps .lt. 1)) then
         print *,'ERROR: Input error(s) encountered!'
         print *,'Quitting.  Please try again'
         ok = 0
      endif

      if (ok .eq. 1) then
         write(*,*)' '
         write(*,*)'****** MPI Bandwidth Test ****** '
         write(*,*)'start size= ',startsize
         write(*,*)'finish size= ',finishsize
         write(*,*)'increment size= ',incr
         write(*,*)'roundtrips/incr= ',rndtrps
         write(*,*)' '
         write(*,*)'Message Size   Bandwidth (bytes/sec)'
      endif
      end