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