d_distribute_BLACS Subroutine

subroutine d_distribute_BLACS(M, Mloc, descMloc, unit)

Uses

  • proc~~d_distribute_blacs~2~~UsesGraph proc~d_distribute_blacs~2 d_distribute_BLACS module~sf_mpi SF_MPI proc~d_distribute_blacs~2->module~sf_mpi

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in), dimension(:,:) :: M
real(kind=8), intent(inout), dimension(:,:) :: Mloc
integer, intent(in), dimension(9) :: descMloc
integer, optional :: unit

Calls

proc~~d_distribute_blacs~2~~CallsGraph proc~d_distribute_blacs~2 d_distribute_BLACS blacs_gridinfo blacs_gridinfo proc~d_distribute_blacs~2->blacs_gridinfo indxl2g indxl2g proc~d_distribute_blacs~2->indxl2g

Source Code

subroutine d_distribute_BLACS(M,Mloc,descMloc,unit)
  USE SF_MPI
  include 'mpif.h'
  real(8),dimension(:,:),intent(in)    :: M
  real(8),dimension(:,:),intent(inout) :: Mloc
  integer,dimension(9),intent(in)      :: descMloc
  integer,optional                     :: unit
  integer                              :: i,j
  integer                              :: myi,myj
  integer                              :: Nbi,Nbj
  integer                              :: Qrows,Qcols
  integer                              :: rankX,rankY
  integer                              :: pNx,pNy
  integer                              :: context
  real(8)                              :: t_start,t_stop
  integer,external                     :: indxG2L,indxL2G
  !
  context = descMloc(2)
  call blacs_gridinfo(context, pNx, pNy, rankX, rankY)
  !
  Qrows  = size(Mloc,1);if(Qrows/=descMloc(9))stop "Distribute_BLACS error: Qrows!=descM(9)"
  Qcols  = size(Mloc,2)
  Nbi = descMloc(5)
  Nbj = descMloc(6)
  !
  if(rankX==0.AND.rankY==0)call cpu_time(t_start)
  do myj=1,Qcols
     j  = indxL2G(myj,Nbj,rankY,0,pNy)
     do myi=1,Qrows
        i  = indxL2G(myi,Nbi,rankX,0,pNx)
        Mloc(myi,myj) = M(i,j)
     enddo
  enddo
  if(rankX==0.AND.rankY==0)call cpu_time(t_stop)
  if(present(unit))then
     if(rankX==0.AND.rankY==0)write(unit,"(A20,F21.12)")"Time Distribute :",t_stop-t_start
  endif
  return
end subroutine D_Distribute_BLACS