ESMF_XGridDGOverlay Function

private function ESMF_XGridDGOverlay(sparseMat, dim, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_XGridSpec), pointer :: sparseMat(:)
integer, intent(in) :: dim
integer, intent(out), optional :: rc

Return Value type(ESMF_DistGrid)


Calls

proc~~esmf_xgriddgoverlay~~CallsGraph proc~esmf_xgriddgoverlay ESMF_XGridDGOverlay interface~esmf_distgridcreate ESMF_DistGridCreate proc~esmf_xgriddgoverlay->interface~esmf_distgridcreate proc~esmf_logfoundallocerror ESMF_LogFoundAllocError proc~esmf_xgriddgoverlay->proc~esmf_logfoundallocerror proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_xgriddgoverlay->proc~esmf_logfounderror proc~esmf_logseterror ESMF_LogSetError proc~esmf_xgriddgoverlay->proc~esmf_logseterror proc~esmf_distgridcreatedb ESMF_DistGridCreateDB interface~esmf_distgridcreate->proc~esmf_distgridcreatedb proc~esmf_distgridcreatedbai ESMF_DistGridCreateDBAI interface~esmf_distgridcreate->proc~esmf_distgridcreatedbai proc~esmf_distgridcreatedbai1d ESMF_DistGridCreateDBAI1D interface~esmf_distgridcreate->proc~esmf_distgridcreatedbai1d proc~esmf_distgridcreatedbai1d1de ESMF_DistGridCreateDBAI1D1DE interface~esmf_distgridcreate->proc~esmf_distgridcreatedbai1d1de proc~esmf_distgridcreatedbai1d1dei8 ESMF_DistGridCreateDBAI1D1DEI8 interface~esmf_distgridcreate->proc~esmf_distgridcreatedbai1d1dei8 proc~esmf_distgridcreatedbf ESMF_DistGridCreateDBF interface~esmf_distgridcreate->proc~esmf_distgridcreatedbf proc~esmf_distgridcreatedbt ESMF_DistGridCreateDBT interface~esmf_distgridcreate->proc~esmf_distgridcreatedbt proc~esmf_distgridcreatedbtf ESMF_DistGridCreateDBTF interface~esmf_distgridcreate->proc~esmf_distgridcreatedbtf proc~esmf_distgridcreatedg ESMF_DistGridCreateDG interface~esmf_distgridcreate->proc~esmf_distgridcreatedg proc~esmf_distgridcreatedgt ESMF_DistGridCreateDGT interface~esmf_distgridcreate->proc~esmf_distgridcreatedgt proc~esmf_distgridcreaterd ESMF_DistGridCreateRD interface~esmf_distgridcreate->proc~esmf_distgridcreaterd proc~esmf_distgridcreaterdf ESMF_DistGridCreateRDF interface~esmf_distgridcreate->proc~esmf_distgridcreaterdf proc~esmf_distgridcreaterdt ESMF_DistGridCreateRDT interface~esmf_distgridcreate->proc~esmf_distgridcreaterdt proc~esmf_distgridcreaterdtf ESMF_DistGridCreateRDTF interface~esmf_distgridcreate->proc~esmf_distgridcreaterdtf esmf_breakpoint esmf_breakpoint proc~esmf_logfoundallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfoundallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfoundallocerror->proc~esmf_logwrite proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logfounderror->proc~esmf_logwrite proc~esmf_logseterror->esmf_breakpoint proc~esmf_logseterror->proc~esmf_logrc2msg proc~esmf_logseterror->proc~esmf_logwrite

Called by

proc~~esmf_xgriddgoverlay~~CalledByGraph proc~esmf_xgriddgoverlay ESMF_XGridDGOverlay proc~esmf_xgriddistgrids ESMF_XGridDistGrids proc~esmf_xgriddistgrids->proc~esmf_xgriddgoverlay proc~esmf_xgridconstruct ESMF_XGridConstruct proc~esmf_xgridconstruct->proc~esmf_xgriddistgrids proc~esmf_xgridcreate ESMF_XGridCreate proc~esmf_xgridcreate->proc~esmf_xgridconstruct proc~esmf_xgridcreatefromsparsemat ESMF_XGridCreateFromSparseMat proc~esmf_xgridcreatefromsparsemat->proc~esmf_xgridconstruct

Source Code

function ESMF_XGridDGOverlay(sparseMat, dim, rc)
!
! !RETURN VALUE:
    type(ESMF_DistGrid)                         :: ESMF_XGridDGOverlay
!
! !ARGUMENTS:
    type(ESMF_XGridSpec), pointer               :: sparseMat(:)
    integer, intent(in)                         :: dim
    integer, intent(out), optional              :: rc

!
! !DESCRIPTION:
!      Compute the overlay distgrid from offline input of indices
!
!     The arguments are:
!     \begin{description}
!     \item [sparseMat]
!           the {ESMF\_XGridSpec} object containing indices and weights.
!     \item [dim]
!           dimension of the indices used to retrieve the seq. index list.
!     \item [{[rc]}]
!           Return code; equals {\tt ESMF\_SUCCESS} only if successful.
!     \end{description}
!
!EOPI

    integer :: i, j, ii, ngrid, localrc, nidx, nidx_tot, l, u
    integer :: minidx, maxidx, minidx1, maxidx1, minidx_n, maxidx_n
    integer, allocatable :: indices(:), indices_diff(:), indices_union(:)
    integer, allocatable :: iarray(:), iarray_t(:)

    ! Initialize
    localrc = ESMF_RC_NOT_IMPL

    ! Initialize return code   
    if(present(rc)) rc = ESMF_RC_NOT_IMPL

    ngrid = size(sparseMat, 1)

    ! generate the union of indices from all the factorIndexLists:
    ! generate the initial array that has the index positions marked '1'
    ! Because of the distributed nature of the indices, there may be
    ! duplicate entries in the index union residing on the other PETs
    ! this is currently left to to the SMM engine to detect such an error.
    !
    ! TODO: query the distributed data directory to avoid duplication
    ! and return to user an error as early as possible
    minidx = minval(sparseMat(1)%factorIndexList(dim,:))
    maxidx = maxval(sparseMat(1)%factorIndexList(dim,:))
    allocate(iarray(minidx:maxidx), stat=localrc)
    if (ESMF_LogFoundAllocError(localrc, &
        msg="- Allocating iarray(minidx:maxidx) ", &
        ESMF_CONTEXT, rcToReturn=rc)) return
    iarray = 0
    l = lbound(sparseMat(1)%factorIndexList, dim)
    u = ubound(sparseMat(1)%factorIndexList, dim)
    do j = l, u
        iarray(sparseMat(1)%factorIndexList(dim,j)) = 1
    enddo

    do i = 2, ngrid

        minidx1 = minval(sparseMat(i)%factorIndexList(dim,:))
        maxidx1 = maxval(sparseMat(i)%factorIndexList(dim,:))
        minidx_n = min(minidx, minidx1)
        maxidx_n = max(maxidx, maxidx1)

        allocate(iarray_t(minidx_n:maxidx_n), stat=localrc)
        if (ESMF_LogFoundAllocError(localrc, &
            msg="- Allocating iarray_t(minidx_n:maxidx_n) ", &
            ESMF_CONTEXT, rcToReturn=rc)) return
        ! copy the old index position array
        iarray_t = 0
        do j = minidx, maxidx
            iarray_t(j) = iarray(j)
        enddo
        ! toggle the index position array with the new index list
        ! do local uniqueness checking
        l = lbound(sparseMat(i)%factorIndexList, dim)
        u = ubound(sparseMat(i)%factorIndexList, dim)
        do j = l, u
            if(iarray_t(sparseMat(i)%factorIndexList(dim,j)) == 1) then
              call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_RANK, &
                msg=" - local duplicate index entry discovered", &
                ESMF_CONTEXT, rcToReturn=rc)
              return
            endif
            iarray_t(sparseMat(i)%factorIndexList(dim,j)) = 1
        enddo

        minidx = minidx_n
        maxidx = maxidx_n

        ! reset the index posity array, swap the temp one over
        deallocate(iarray)         
        allocate(iarray(minidx:maxidx), stat=localrc)
        if (ESMF_LogFoundAllocError(localrc, &
            msg="- Allocating iarray(minidx:maxidx) ", &
            ESMF_CONTEXT, rcToReturn=rc)) return
        do j = minidx, maxidx
            iarray(j) = iarray_t(j)
        enddo
        deallocate(iarray_t)
    enddo

    ! compress the iarray into the index list
    ! first count how many 1s are thyere
    nidx = 0
    do i = minidx, maxidx
        if(iarray(i) .eq. 1) nidx = nidx + 1
    enddo

    allocate(indices(nidx), stat=localrc)
    if (ESMF_LogFoundAllocError(localrc, &
        msg="- Allocating indices(nidx) ", &
        ESMF_CONTEXT, rcToReturn=rc)) return

    ! every marked position means that index exists
    ! add that index to indices array
    ii = 1
    do i = minidx, maxidx
        if(iarray(i) .eq. 1) then
            indices(ii) = i
            ii = ii + 1
        endif
    enddo

    ESMF_XGridDGOverlay = ESMF_DistGridCreate(indices, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
    
    deallocate(iarray, indices)

    if(present(rc)) rc = ESMF_SUCCESS

end function ESMF_XGridDGOverlay