dist_size Subroutine

public subroutine dist_size(nPEs, erank, noper, oper, value, dist, memRank, rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nPEs
integer, intent(in) :: erank
integer, intent(in) :: noper(:)
type(character_array), intent(in) :: oper(:,:)
real(kind=ESMF_KIND_R8) :: value(:,:)
type(dist_specification_record), intent(inout) :: dist
integer, intent(in) :: memRank
integer, intent(inout) :: rc

Calls

proc~~dist_size~~CallsGraph proc~dist_size dist_size proc~esmf_logseterror ESMF_LogSetError proc~dist_size->proc~esmf_logseterror proc~pattern_query pattern_query proc~dist_size->proc~pattern_query esmf_breakpoint esmf_breakpoint proc~esmf_logseterror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logseterror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logseterror->proc~esmf_logwrite c_esmc_loggeterrormsg c_esmc_loggeterrormsg proc~esmf_logrc2msg->c_esmc_loggeterrormsg c_esmc_vmwtime c_esmc_vmwtime proc~esmf_logwrite->c_esmc_vmwtime proc~esmf_logclose ESMF_LogClose proc~esmf_logwrite->proc~esmf_logclose proc~esmf_logflush ESMF_LogFlush proc~esmf_logwrite->proc~esmf_logflush proc~esmf_logopenfile ESMF_LogOpenFile proc~esmf_logwrite->proc~esmf_logopenfile proc~esmf_utiliounitflush ESMF_UtilIOUnitFlush proc~esmf_logwrite->proc~esmf_utiliounitflush proc~esmf_utilstring2array ESMF_UtilString2Array proc~esmf_logwrite->proc~esmf_utilstring2array proc~esmf_logclose->proc~esmf_logflush proc~esmf_logflush->proc~esmf_utiliounitflush proc~esmf_utilarray2string ESMF_UtilArray2String proc~esmf_logflush->proc~esmf_utilarray2string proc~esmf_logopenfile->proc~esmf_utiliounitflush proc~esmf_utiliounitget ESMF_UtilIOUnitGet proc~esmf_logopenfile->proc~esmf_utiliounitget

Called by

proc~~dist_size~~CalledByGraph proc~dist_size dist_size proc~read_dist_specification read_dist_specification proc~read_dist_specification->proc~dist_size proc~read_testharness_specifier Read_TestHarness_Specifier proc~read_testharness_specifier->proc~read_dist_specification program~esmf_test_harness esmf_test_harness program~esmf_test_harness->proc~read_testharness_specifier

Source Code

  subroutine dist_size(nPEs, erank, noper, oper, value, dist, memRank, rc)
  !-----------------------------------------------------------------------------
  ! routine to populate the distribution sizes according to the specification
  ! file.
  !-----------------------------------------------------------------------------
  integer, intent(in   ) :: nPEs   ! number of PEs  
  integer, intent(in   ) :: erank  ! rank of dim seeded with base dist size
  integer, intent(in   ) :: noper(:)  ! number of operators 
  type(character_array), intent(in   ) :: oper(:,:)  ! operator
  real(ESMF_KIND_R8) :: value(:,:)  ! value for operator
  type(dist_specification_record), intent(inout) :: dist  ! dist spec record
  integer, intent(in   ) :: memRank  ! rank of memory
  integer, intent(inout) :: rc

  ! local integers
  integer :: ibase, irank, n

  ! local reals
  real(ESMF_KIND_R8) :: arg, base

  ! initialize return flag
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! compute the base distribution dimension size. Base is always at least one.
  !-----------------------------------------------------------------------------
  ibase = 1
  if( erank > 0 ) then
     arg = 1.0*erank
     base = (nPEs)**(1.0/arg)
     ibase = int(base)
  endif

  !-----------------------------------------------------------------------------
  ! initialize distribution size to base value
  !-----------------------------------------------------------------------------
  do irank=1, dist%drank
     dist%dsize(irank) = ibase
  enddo

  !-----------------------------------------------------------------------------
  ! modify distribution size based on operators
  !-----------------------------------------------------------------------------
  do irank=1, dist%drank
    do n=1,noper(irank)
      if( pattern_query(trim(adjustL(oper(irank,n)%string)), "==") /= 0 ) then
        ! if equivalence operator, overwrite base value, and set to value
        dist%dsize(irank) = value(irank,n)
        if( noper(irank) > 1 ) then
          ! error - should only be one operator when equivalence is found
          call ESMF_LogSetError(ESMF_FAILURE,msg="only one operator " //        &
                "should be found when equivalence operator == is used. " //    &
                " More than one was found. ", rcToReturn=rc)
          return
        endif

      elseif( pattern_query(trim(adjustL(oper(irank,n)%string)),"=+") /= 0) then
        ! if addition operator, add new value to base value.
        dist%dsize(irank) =  dist%dsize(irank) + value(irank,n)

      elseif( pattern_query(trim(adjustL(oper(irank,n)%string)),"=*") /= 0) then
        ! if multiplication operator, multiply new value with base value.
        dist%dsize(irank) =  dist%dsize(irank) * value(irank,n)

      else
        ! error - unrecognized operator
        call ESMF_LogSetError(ESMF_FAILURE,msg="unrecognized operator " //      &
               trim(adjustL(oper(irank,n)%string)) // " found. ", rcToReturn=rc)
        return
      endif
    enddo   ! n
  enddo    !irank

  !-----------------------------------------------------------------------------
  ! check that each dimension has a minimum value of 1, specifically the memory
  ! locations beyond the dist rank. This means that tensor dimensions are
  ! distributed by one processor.
  !-----------------------------------------------------------------------------
  do irank=1, memRank
     if( dist%dsize(irank) < 1 ) dist%dsize(irank) = 1
  enddo    !irank

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS     
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine dist_size