MAPL_BalanceCreate Subroutine

public subroutine MAPL_BalanceCreate(OrgLen, Comm, MaxPasses, BalCond, Handle, BalLen, BufLen, rc)

This routine creates a balancing strategy over an MPI communicator (Comm) given the work in the local rank (OrgLen). The startegy can be committed and used later through Handle. If a handle is not requested, the latest non-committed strategy is kept at Handle=0, which will be the default strategy for the other methods. The number of passes may be optionally controlled with an upper limit (MaxPasses) or a limiting criterion (BalCond). The amount of work resulting for the local rank can be returned (BalLen).

Note

As there may be more than one communicator, Comm is required. This will most likely be the communicator from the ESMF VM.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: OrgLen
integer, intent(in) :: Comm
integer, intent(in), optional :: MaxPasses
real, intent(in), optional :: BalCond
integer, intent(out), optional :: Handle
integer, intent(out), optional :: BalLen
integer, intent(out), optional :: BufLen
integer, intent(out), optional :: rc

Calls

proc~~mapl_balancecreate~~CallsGraph proc~mapl_balancecreate MAPL_BalanceCreate interface~mapl_assert MAPL_Assert proc~mapl_balancecreate->interface~mapl_assert interface~mapl_sort MAPL_Sort proc~mapl_balancecreate->interface~mapl_sort mpi_allgather mpi_allgather proc~mapl_balancecreate->mpi_allgather mpi_comm_rank mpi_comm_rank proc~mapl_balancecreate->mpi_comm_rank mpi_comm_size mpi_comm_size proc~mapl_balancecreate->mpi_comm_size proc~mapl_return MAPL_Return proc~mapl_balancecreate->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_balancecreate->proc~mapl_verify at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception

Source Code

  subroutine MAPL_BalanceCreate(OrgLen, Comm, MaxPasses, BalCond, &
                                Handle, BalLen, BufLen, rc)

    integer,           intent(IN)  :: OrgLen
    integer,           intent(IN)  :: Comm
    integer, optional, intent(IN)  :: MaxPasses
    real,    optional, intent(IN)  :: BalCond
    integer, optional, intent(OUT) :: Handle, BalLen, BufLen
    integer, optional, intent(OUT) :: rc

    real    :: BalCond_
    integer :: MaxPasses_
    integer :: KPASS, STATUS, Balance, MyNewWork, MyBufSize
    integer :: NPES, MyPE, J

    integer, allocatable :: WORK(:), RANK(:), NOP(:,:)

! Defaults of optional Inputs
!----------------------------

    if(present(BalCond)) then
       BalCond_ = BalCond
    else
       BalCond_ = 0.1
    end if

    if(present(MaxPasses)) then
       MaxPasses_ = MaxPasses
    else
       MaxPasses_ = 100
    end if

! Get Communicator parameters
!----------------------------

    call MPI_COMM_RANK(Comm, MyPE, STATUS)
    _ASSERT(STATUS==MPI_SUCCESS,'needs informative message')
    call MPI_COMM_SIZE(Comm, NPES, STATUS)
    _ASSERT(STATUS==MPI_SUCCESS,'needs informative message')

! Allocate temporary space
!-------------------------

    allocate(NOP(2,MaxPasses_), Work(NPES), Rank(NPES), stat=STATUS)
    _VERIFY(STATUS)

! Initialize global lists of work load and corresponding rank
!------------------------------------------------------------

    call MPI_AllGather(OrgLen,1,MPI_INTEGER,&
                       Work  ,1,MPI_INTEGER,Comm,status)
    _ASSERT(STATUS==MPI_SUCCESS,'needs informative message')

    do concurrent (J=1:NPES)
       Rank(J) = J-1
    end do

    call CreateStrategy(Work, Rank, MyPE, BalCond_, Kpass, MyNewWork, MyBufSize, NOP)

    deallocate(Work, Rank)

! Done with balancing strategy. Prepare optional Outputs.
!--------------------------------------------------------

    if(present(Handle)) then
       do Balance=1,MAX_NUM_STRATEGIES
          if(.not.associated(THE_STRATEGIES(Balance)%NOP)) exit
       enddo

       _ASSERT(Balance <= MAX_NUM_STRATEGIES,'needs informative message')
       Handle  = Balance
    else
       Balance = 0
       if( associated(THE_STRATEGIES(Balance)%NOP) ) &
           deallocate(THE_STRATEGIES(Balance)%NOP)
    end if

    if(present(BalLen)) BalLen =  MyNewWork
    if(present(BufLen)) BufLen =  MyBufSize

! Save the Strategy
!------------------

    allocate(THE_STRATEGIES(Balance)%NOP(2,KPASS))

    THE_STRATEGIES(Balance)%BALANCED_LENGTH   = MyNewWork
    THE_STRATEGIES(Balance)%BUFFER_LENGTH     = MyBufSize
    THE_STRATEGIES(Balance)%UNBALANCED_LENGTH = OrgLen
    THE_STRATEGIES(Balance)%PASSES            = KPASS
    THE_STRATEGIES(Balance)%COMM              = Comm
    THE_STRATEGIES(Balance)%NOP               = NOP(:,:KPASS)

    deallocate(NOP)

    _RETURN(LDB_SUCCESS)

  contains

    subroutine CreateStrategy(Work, Rank, MyPE, BalCond, KPASS, MyNewWork, MyBufSize, NOP)
      integer, intent(INOUT) :: Work(:), Rank(:)
      integer, intent(IN   ) :: MyPE
      real   , intent(IN   ) :: BalCond
      integer, intent(  OUT) :: NOP(:,:), KPASS, MyNewWork, MyBufSize

      integer :: NPES, J, JSPARD, LEN, MaxPasses
      real    :: MEAN

      NPES      = size(Work)
      MaxPasses = size(NOP,2)

! Loop over passes until either MaxPasses or BalanceCondition is met
!-------------------------------------------------------------------

      KPASS     = 0
      MEAN      = sum(Work)/real(NPES)
      MyNewWork = OrgLen
      MyBufSize = OrgLen

      PASSES: do while(KPASS<MaxPasses)

! Sort latest work-load and rank lists in ascending order of work
!----------------------------------------------------------------

         call MAPL_Sort(Work, Rank)

! Check for balance condition on the ratio of max minus min work
!  to the ideal average work
!---------------------------------------------------------------

         if((Work(NPES)-Work(1))/MEAN < BalCond) exit

! Fold the sorted work list and compute the transfers needed
!  to balance the "least with the greatest".
!-----------------------------------------------------------

         KPASS = KPASS+1

         FOLD: do J=1,NPES/2

            ! Js partner in the fold has >= the work as J
            JSPARD = NPES + 1 - J

            ! Half the difference will be sent to J (can be zero)
            LEN    = (Work(JSPARD)-Work(J))/2

            ! New lengths that obtain after completion of this pass
            Work(J     ) = Work(J     ) + LEN
            Work(JSPARD) = Work(JSPARD) - LEN

            ! A negative length means J receives from partner
            if(Rank(J    ) == MyPE) then
               NOP(1,KPASS) = -LEN
               NOP(2,KPASS) = Rank(JSPARD) ! Partners rank
               MyNewWork    = Work(J)
               MyBufSize    = max(MyBufSize,MyNewWork)
            endif

            ! If I am the partner, I will send to J
            if(Rank(JSPARD) == MyPE) then
               NOP(1,KPASS) = LEN
               NOP(2,KPASS) = Rank(J)  ! Js rank
               MyNewWork    = Work(JSPARD)
               MyBufSize    = max(MyBufSize,MyNewWork)
            endif

         enddo FOLD

      enddo PASSES

    end subroutine CreateStrategy

  end subroutine MAPL_BalanceCreate