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)


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