!************************************************************************
!  Purpose:     A program to experiment with point-to-point
!               communications.   
! 
!  Contents:    F90 source code.
! 
!************************************************************************

      program pingpong
      include "mpif.h"

      integer ping, namx, proc_A, proc_B
      parameter(ping=101, proc_A = 0, proc_B=1, nmax=700000)
      real buffer(2*nmax)

      integer ierror, rank, size         ! "the usual suspects"
      integer i, length
      integer status(MPI_STATUS_SIZE)
      
      real*8 start, finish, ttime        ! used for timing



      call MPI_Init(ierror)
      call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror)
      
      buffer = 1.0

      if (rank == proc_A) then  ! ######  The main man  ######### !

         write(*, '("Length    Total Time   Transfer Rate(MB/s)")')
         
         length = 1
         do while(length <= nmax)
            start = MPI_Wtime()
            
            do i = 1,100
               call MPI_Send(buffer, length, MPI_REAL, proc_B, ping,
     .              MPI_COMM_WORLD, ierror)
               call MPI_Recv( buffer, length, MPI_REAL, proc_B, pong,  
     .              MPI_COMM_WORLD, status, ierror)
            enddo
     
            finish = MPI_Wtime()
            ttime = finish - start

            write(*, '(i6, "    ",f9.6,"     ",f7.3)') 
     .           length, ttime/200., (2*4*100*length)/(1000000.0*ttime)

            length = 2*length
         enddo

      else  ! proc_B           ! ######  The fall guy  ######### !

         length = 1
         do while(length <= nmax)
            
            do i = 1,100
               call MPI_Recv( buffer, length, MPI_REAL, proc_A, ping, 
     .              MPI_COMM_WORLD, status, ierror)
               call MPI_Send(buffer, length, MPI_REAL, proc_A, pong,
     .              MPI_COMM_WORLD, ierror)
            enddo
            length = 2*length
         enddo

      endif
      
      call MPI_Finalize(ierror)
      
      stop
      end 


!
! Interchange the MPI_Recv and MPI_Send in the proc_B code to find
! the buffering limit
!