ping2_i.f

网络带宽测试工具

      subroutine ping2_i( title, me, npes, nrpt, ncases, n, tn,
     &                    ops )
! ----------------------------------------------------------------------
      Use            numerics
      Use            max_params      
      Implicit       None
      
      Include        'mpif.h'
      
      Character*50 :: title
      Integer      :: me, npes, nrpt, ncases, n
      Real(l_)     :: tn(maxcases), ops, timer
      Real(l_)     :: a(nmax), b(nmax)      
      Real(l_)     :: t1, t2
      Integer      :: send_pe, recv_pe
      Integer      :: i, k, k2, k3, kk
      Integer      :: comm, ie, tag, type, newtype
      Integer      :: st(MPI_Status_Size)
      Save            a, b
! ----------------------------------------------------------------------
      comm   = MPI_Comm_World
      type   = MPI_Real8
      title = ' 1 PE   <--> 1 PE; Bidir.'
      nrpt   = 100
      ncases = (npes - 1)*maxstride 
      ops    = 8*n
      i       = 0
      tn (1:ncases) = 0.0_l_ 
      If ( n > nmax/maxstride ) Then
         ncases = 0
         Return
      End If
      Do k = 0, npes-1
         b   = 0.0_l_
         Do k2 = 0,npes-1
            Do k3 = 1, maxstride
               Call MPI_Type_Vector( 1, 1, k3, type, newtype, ie )
               Call MPI_Type_Commit( newtype, ie )
               Call MPI_Barrier( comm, ie )
               If ( k /= k2 ) Then
                  If ( me == k ) Then
                     Do kk = 1, nrpt
                        Call MPI_Sendrecv( a, n, newtype, k2, kk*2,
     &                    b, n, newtype, k2, (kk*2) +1, comm, st, ie )
                     End Do
                  End If
                  If ( me == k2 ) Then
                     i = i + 1
                     t1 = timer()
                     Do kk = 1,nrpt
                        Call MPI_Sendrecv( a, n, newtype, k, (kk*2)+1,
     &                    b, n, newtype, k, kk*2, comm, st, ie )              
                     End Do
                     t2 = timer()
                     tn(i) = (t2 - t1)/(2*nrpt)
                  End If 
               End If
               Call MPI_Barrier( comm, ie )
               Call MPI_Type_Free( newtype, ie )
            End Do 
         End Do
      End Do
! ----------------------------------------------------------------------
      End