ping.f

网络带宽测试工具

      Program ping
! ----------------------------------------------------------------------
! **********************************************************************
! *** This program is part of the EuroBen Efficiency Benchmark       ***
! ***                                                                ***
! *** Copyright: European Benchmark Group p/o                        ***
! ***            Utrecht University, High Perf. Computing Group      ***
! ***            P.O. Box 80195                                      ***
! ***            3508 TD Utrecht                                     ***
! ***            The Netherlands                                     ***
! ***                                                                ***
! *** Author of this program: Aad J. van der Steen                   ***
! *** Email: [e-mail]                                        ***
! *** Date : Summer 2002                                             ***
! **********************************************************************
! ----------------------------------------------------------------------
      Use                      numerics
      Use                      dist_module
      Implicit                 None
      Include                 'mpif.h'

      Integer               :: comm, ierr, status,
     &                         istat(MPI_Status_Size), my_win 
      Integer               :: i, ireps, length, nreps
      Integer(8), Parameter :: disp = 0
      Integer(8), Parameter :: mlen = 4000000 ! <=== Max window size.
      Logical               :: ok

      Integer               :: message(mlen)
      Real(l_)              :: incpt, perc, slope, time
      Real(l_)              :: bw, bwmax, latency, lperc

      Common /buffer/          message
! ----------------------------------------------------------------------
! --- Initialise MPI, make window, initialise message array. Also
!     initialise the least-squares routine and the maximum bandwidth.
! ----------------------------------------------------------------------
      Call csetup
      comm = MPI_Comm_World
      Call MPI_Win_Create( message, mlen, 4, MPI_Info_Null,
     &                     comm, my_win, ierr )
      message = 0
      If ( me == 0 ) Then
         Do i = 1, mlen
            message(i) = i
         End Do
      End If
      If ( me == 1 ) Then
         Call lsq( 0, 0.0_l_, 0.0_l_, slope, incpt, perc )
         bwmax = 0.0_l_
      End If
! ----------------------------------------------------------------------
! --- Call identification routine.
! ----------------------------------------------------------------------
      If ( me == 0 ) Then
          Call state('ping    ')
          Print 1000
      End If
      Open( 1, File = 'ping.in' )
! ---------------------------------------------------------------------
! --- Get new case from the input file for the MPI_Get test.
! ---------------------------------------------------------------------
   10 Read( 1, *, End = 20 ) length, nreps
! ----------------------------------------------------------------------
! --- Measure MPI_Get:
! ----------------------------------------------------------------------
      If ( me == 1 ) Then
         time = MPI_Wtime()
         Do ireps = 1, nreps
            Call MPI_Get( message, length, MPI_Integer, 0, disp, length,
     &                    MPI_Integer, my_win, ierr )
         End Do
         time = ( MPI_Wtime() - time )/( Real( nreps, l_ ) )
         ok   = .TRUE.
         Call check( message, length, ok )
         Call lsq( 1, Real( length, l_ ), time, slope, incpt, perc )
         If ( length == 50 ) Then
            latency = incpt*1.0e6_l_
            lperc   = perc
         End If
         bw = 1.0e-6_l_*Real( 4*length, l_ )/time
         bwmax = Max( bwmax, bw )
         Print 1010, 4*length, time, bw, ok
      End If
      Call MPI_Win_Fence( 0, my_win, ierr )
      Go To 10                     ! <=================================
   20 If ( me == 1 ) Then
         Print 1020
         Print 1040, bwmax, latency, lperc
      End If
      Call MPI_Barrier( comm, ierr )
! ----------------------------------------------------------------------
! --- Measure MPI_Put:
! ----------------------------------------------------------------------
      Rewind 1
      If ( me == 1 ) message = 0
      If ( me == 0 ) Then
         Print 1030
         Call lsq( 0, 0.0_l_, 0.0_l_, slope, incpt, perc )
         bwmax = 0.0_l_
      End If
   30 Read( 1, *, End = 40 ) length, nreps
      If ( me == 0 ) Then
         time = MPI_Wtime()
         Do ireps = 1, nreps
            Call MPI_Put( message, length, MPI_Integer, 1, disp, length,
     &                    MPI_Integer, my_win, ierr )
         End Do
         time = ( MPI_Wtime() - time )/( Real( nreps, l_ ) )
      End If
      ok = .TRUE.
      If ( me == 1 ) Call check( message, length, ok )
      If ( me == 0 ) Then
         Call MPI_Get( ok, 1, MPI_Logical, 1, disp, 1, MPI_Logical,
     &                 my_win, ierr )
         bw = 1.0e-6_l_*Real( 4*length, l_ )/time
         Call lsq( 1, Real( length, l_ ), time, slope, incpt, perc )
         If ( length == 50 ) Then
            latency = incpt*1.0e6_l_
            lperc   = perc
         End If
         bwmax = Max( bwmax, bw )
         Print 1010, 4*length, time, bw, ok
      End If
      Call MPI_Win_Fence( 0, my_win, ierr )
      Go To 30                     ! <=================================
   40 If ( me == 0 ) Then
         Print 1020
         Print 1040, bwmax, latency, lperc
      End If
      Call MPI_Finalize( ierr )
! ---------------------------------------------------------------------
 1000 Format('Program ping: One-sided distr. memory communication '/
     &       '----------------------------------------------------'/
     &       '| Mess. length |  MPI_Get time |   Bandwidth   |   |'/
     &       '|    (Bytes)   |   (seconds)   |   (Mbyte/s)   |OK?|'/
     &       '----------------------------------------------------' )
 1010 Format('|', 3x, i8, 3x, '|', 1x, g13.5, 1x, '|', 1x, g13.5, 1x,
     &       '|', l2,' |' )
 1020 Format('----------------------------------------------------' )
 1030 Format(//
     &       '----------------------------------------------------'/
     &       '| Mess. length |  MPI_Put time |   Bandwidth   |   |'/
     &       '|    (Bytes)   |   (seconds)   |   (Mbyte/s)   |OK?|'/
     &       '----------------------------------------------------' )
 1040 Format( 'Maximum bandwidth = ' g12.5, ' MB/s'/
     &        'Latency   = ', g11.4, ' microsec., Error = ', f6.2, '%'/
     &        '-------------------------------------------------------')
! ----------------------------------------------------------------------
      End Program ping