dddot3.f

来自「网络带宽测试工具」· F 代码 · 共 40 行

      Function dddot3( k, partcomm, n, x, y )          Result( dotres )
! ---------------------------------------------------------------------
      Use                   dist_module
      Use                   numerics
      Implicit              None 
      Integer            :: k, n, partcomm
      Real(l_)           :: x(n), y(n), dotres

      Include               'mpif.h'
 
      Integer           :: datype, ierr
      Integer           :: i
      Real(l_)          :: s
! ---------------------------------------------------------------------
! --- Do local part of dotproduct.

      s = 0.0_l_
      Do i = 1, n
         s = s + x(i)*y(i)
      End Do
      dotres = s
! ---------------------------------------------------------------------
! --- If on 1 processor we are done: Return.
 
      If ( k == 1 ) Return
! ---------------------------------------------------------------------
! --- Send partial results from all processors in communicator 
!     partcomm to processor 1.
   
      datype = MPI_Real8
      Call MPI_Reduce( s, dotres, 1, datype, MPI_Sum, 0,
     &                               partcomm, ierr )
! ---------------------------------------------------------------------
! --- Send sum to all processors in communicator partcomm.
 
      If ( me < k ) Call MPI_Bcast( dotres, 1, datype, 0, partcomm,
     &                              ierr )
! ---------------------------------------------------------------------
      End Function dddot3