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.
Type | Intent | Optional | 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 |
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