MAPL_RoundRobinPEList Subroutine

public subroutine MAPL_RoundRobinPEList(List, nNodes, Root, UseFirstRank, FirstRank, RC)

Arguments

Type IntentOptional Attributes Name
integer, intent(out) :: List(:)
integer, intent(in) :: nNodes
integer, intent(in), optional :: Root
logical, intent(in), optional :: UseFirstRank
integer, intent(out), optional :: FirstRank
integer, intent(out), optional :: RC

Calls

proc~~mapl_roundrobinpelist~~CallsGraph proc~mapl_roundrobinpelist MAPL_RoundRobinPEList interface~mapl_getnewrank MAPL_GetNewRank proc~mapl_roundrobinpelist->interface~mapl_getnewrank proc~mapl_return MAPL_Return proc~mapl_roundrobinpelist->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_roundrobinpelist->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

Called by

proc~~mapl_roundrobinpelist~~CalledByGraph proc~mapl_roundrobinpelist MAPL_RoundRobinPEList proc~mapl_cfiocreatefromfile MAPL_CFIOCreateFromFile proc~mapl_cfiocreatefromfile->proc~mapl_roundrobinpelist proc~mapl_cfioreadbundleread MAPL_CFIOReadBundleRead proc~mapl_cfioreadbundleread->proc~mapl_roundrobinpelist proc~mapl_cfiosetkrank MAPL_CFIOSetKrank proc~mapl_cfiosetkrank->proc~mapl_roundrobinpelist proc~mapl_collectivegather3d MAPL_CollectiveGather3D proc~mapl_collectivegather3d->proc~mapl_roundrobinpelist proc~mapl_collectivescatter3d MAPL_CollectiveScatter3D proc~mapl_collectivescatter3d->proc~mapl_roundrobinpelist

Source Code

  subroutine MAPL_RoundRobinPEList(List,nNodes,Root,UseFirstRank,FirstRank,RC)
    integer,           intent(  OUT) :: List(:)
    integer,           intent(IN   ) :: nNodes
    integer, optional, intent(IN   ) :: Root
    logical, optional, intent(IN   ) :: UseFirstRank
    integer, optional, intent(out  ) :: FirstRank
    integer, optional, intent(  OUT) :: RC

    integer                    :: status

    integer, allocatable :: filled(:),nPerNode(:)
    integer :: i,n,nlist,locRoot
    logical :: gotFirstRank,lUseFirstRank

    if (present(Root)) then
       locRoot = Root
    else
       locRoot = 1
    endif
    if (present(UseFirstRank)) then
       lUseFirstRank=UseFirstRank
    else
       lUseFirstRank=.true.
    end if
    gotFirstRank = .false.
    if (present(UseFirstRank)) then
       lUseFirstRank=UseFirstRank
    else
       lUseFirstRank=.true.
    end if

    allocate(filled(nNodes),nPerNode(nNodes),stat=status)
    _VERIFY(STATUS)
    do i=1,nNodes
       nPerNode(i) = size(MAPL_NodeRankList(locRoot+i-1)%rank)
       if (lUseFirstRank) then
          filled(i)=0
       else
          filled(i)=MAPL_GetNewRank(locRoot+i-1,rc=status)-1
          _VERIFY(status)
       end if
    enddo
    nlist = size(list)
    n=0
    do
       do i=1,nNodes
          if (filled(i) < size(MAPL_NodeRankList(locRoot+i-1)%rank)) then
             filled(i) = filled(i) + 1
             n=n+1
             list(n) = MAPL_NodeRankList(locRoot+i-1)%rank(filled(i))
             if (.not.gotFirstRank .and. present(FirstRank)) then
                gotFirstRank=.true.
                FirstRank = list(n)
             end if
          end if

          if (n == nlist) exit
       enddo

       if (n == nlist) exit
       if (All(filled == nPerNode)) filled = 0
    enddo

    deallocate(filled,nPerNode)

    _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_RoundRobinPEList