nearn_3d.f

网络带宽测试工具

      Subroutine nearn_3d( 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), c(nmax), d(nmax), e(nmax),
     &                f(nmax), g(nmax)      
      Real(l_)     :: buffer(12*(nmax+MPI_Bsend_Overhead/8))
      Real(l_)     :: t1, t2
      Integer      :: k, kk, tag
      Integer      :: comm, commcart, ie, type
      Integer      :: status(MPI_Status_Size)
      Integer, Parameter :: dim = 3
      Integer      :: dims(dim), npos(dim)
      Integer      :: pos(dim)
      Logical      :: periods(dim)
      Integer      :: moi, myid
      Integer      :: north, south, west, east, up, down
      Integer      :: size
      Save            a, b, c, d, e, f, g
! ----------------------------------------------------------------------
      comm    = MPI_Comm_World
      type    = MPI_Real8
      title   = ' N PEs  <--  6N PEs; Nearst nbr 3D'
      nrpt    = 100
      ncases  = npes
      ops     = 6*8*n
      size    = 8*n 
      tn(1:ncases) = 0.0_l_
      
      periods = .TRUE.                        ! --- Introduce topology
      dims    = 0
        
      Call MPI_Comm_Rank( comm, myid, ie)
      Call MPI_Dims_Create( npes, dim, dims, ie )      
      Call MPI_Cart_Create( comm, dim, dims, periods, .true., commcart,
     &                      ie )
      
! --- Get position and rank in Cartesian grid.
      
      Call MPI_Cart_Get( commcart, dim, dims, periods, pos, ie )
      Call MPI_Cart_Rank( commcart, pos, moi, ie )      
      Call MPI_Buffer_Attach( buffer, 12*(size+MPI_Bsend_Overhead), ie )
      
! --- Get rank of neighbours.
        
      Call MPI_Cart_Coords( commcart, myid, dim, dims, ie )
      Call MPI_Cart_Shift( commcart, 0, -1, myid, west,  ie )
      Call MPI_Cart_Shift( commcart, 0, 1,  myid, east,  ie )
      Call MPI_Cart_Shift( commcart, 1, 1,  myid, north, ie )
      Call MPI_Cart_Shift( commcart, 1, -1, myid, south, ie )
      Call MPI_Cart_Shift( commcart, 2, 1,  myid, up,    ie )
      Call MPI_Cart_Shift( commcart, 2, -1, myid, down,   ie)
        
      t1 = timer()
      Do k = 1, nrpt
         tag = (nrpt * npes * 6)
         Call MPI_Bsend( a, n, type, west, tag + moi,    commcart, ie )
         Call MPI_Bsend( a, n, type, east, tag + moi+1,  commcart, ie )
         Call MPI_Bsend( a, n, type, north, tag + moi+2, commcart, ie )
         Call MPI_Bsend( a, n, type, south, tag + moi+3, commcart, ie )
         Call MPI_Bsend( a, n, type, up, tag + moi + 4,  commcart, ie )
         Call MPI_Bsend( a, n, type, down, tag + moi+5,  commcart, ie )
         Call MPI_Recv( b, n, type, west, tag + west + 1,
     &                  commcart, status, ie )
         Call MPI_Recv( c, n, type, east, tag + east,
     &                  commcart, status, ie )
         Call MPI_Recv( d, n, type, north, tag + north + 3,
     &                  commcart, status, ie )
         Call MPI_Recv( e, n, type, south, tag + south + 2,
     &                  commcart, status, ie )
         Call MPI_Recv( d, n, type, up, tag + up + 5,
     &                  commcart, status, ie )
         Call MPI_Recv( e, n, type, down, tag + down + 4,
     &                  commcart, status, ie )
      End Do
      t2 = timer ()
      tn(myid+1) = (t2-t1) / (2*nrpt )
      Call MPI_Buffer_Detach( buffer, size, ie )
! ----------------------------------------------------------------------
      End Subroutine nearn_3d