subroutine ESMF_XGridDestroy(xgrid, keywordEnforcer, noGarbage, rc)
!
! !ARGUMENTS:
type(ESMF_XGrid), intent(inout) :: xgrid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
logical, intent(in), optional :: noGarbage
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[8.1.0] Added argument {\tt noGarbage}.
! The argument provides a mechanism to override the default garbage collection
! mechanism when destroying an ESMF object.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! Destroys an {\tt ESMF\_XGrid}, releasing the resources associated
! with the object.
!
! The arguments are:
! \begin{description}
! \item [xgrid]
! {\tt ESMF\_XGrid} object.
! \item[{[noGarbage]}]
! If set to {\tt .TRUE.} the object will be fully destroyed and removed
! from the ESMF garbage collection system. Note however that under this
! condition ESMF cannot protect against accessing the destroyed object
! through dangling aliases -- a situation which may lead to hard to debug
! application crashes.
!
! It is generally recommended to leave the {\tt noGarbage} argument
! set to {\tt .FALSE.} (the default), and to take advantage of the ESMF
! garbage collection system which will prevent problems with dangling
! aliases or incorrect sequences of destroy calls. However this level of
! support requires that a small remnant of the object is kept in memory
! past the destroy call. This can lead to an unexpected increase in memory
! consumption over the course of execution in applications that use
! temporary ESMF objects. For situations where the repeated creation and
! destruction of temporary objects leads to memory issues, it is
! recommended to call with {\tt noGarbage} set to {\tt .TRUE.}, fully
! removing the entire temporary object from memory.
! \item [{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
! Local variables
integer :: localrc, i
type(ESMF_Status) :: xgridstatus
type(ESMF_Logical) :: valid
! Initialize
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! check input variables
ESMF_INIT_CHECK_DEEP(ESMF_XGridGetInit,xgrid,rc)
if (.not. associated(xgrid%xgtypep)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_BAD, &
msg="Uninitialized or already destroyed XGrid: xgtypep unassociated", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! See if this object is even still valid in garbage collection
call c_ESMC_VMValidObject(xgrid%xgtypep%base, valid, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (valid/=ESMF_TRUE) then
! nothing to be done here, return successfully
if (present(rc)) rc = ESMF_SUCCESS
return
endif
if(xgrid%xgtypep%storeOverlay) then
call ESMF_MeshDestroy(xgrid%xgtypep%mesh, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_DistGridDestroy(xgrid%xgtypep%distgridM, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Destruct all xgrid internals and then free xgrid memory.
call ESMF_BaseGetStatus(xgrid%xgtypep%base, xgridstatus, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (xgridstatus .eq. ESMF_STATUS_READY) then
if((xgrid%xgtypep%is_proxy)) then
if(associated(xgrid%xgtypep%sideA)) then
do i = 1, size(xgrid%xgtypep%sideA,1)
call ESMF_XGridGeomBaseDestroy(xgrid%xgtypep%sideA(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%sideB)) then
do i = 1, size(xgrid%xgtypep%sideB,1)
call ESMF_XGridGeomBaseDestroy(xgrid%xgtypep%sideB(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%distgridA)) then
do i = 1, size(xgrid%xgtypep%distgridA,1)
call ESMF_DistGridDestroy(xgrid%xgtypep%distgridA(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%distgridB)) then
do i = 1, size(xgrid%xgtypep%distgridB,1)
call ESMF_DistGridDestroy(xgrid%xgtypep%distgridB(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
endif ! proxy
if(associated(xgrid%xgtypep%centroid)) then
deallocate(xgrid%xgtypep%centroid)
endif
if(associated(xgrid%xgtypep%area)) then
deallocate(xgrid%xgtypep%area)
endif
if(associated(xgrid%xgtypep%sparseMatA2X)) then
do i = 1, size(xgrid%xgtypep%sparseMatA2X)
if(associated(xgrid%xgtypep%sparseMatA2X(i)%factorIndexList)) &
deallocate(xgrid%xgtypep%sparseMatA2X(i)%factorIndexList)
if(associated(xgrid%xgtypep%sparseMatA2X(i)%factorList)) &
deallocate(xgrid%xgtypep%sparseMatA2X(i)%factorList)
enddo
deallocate(xgrid%xgtypep%sparseMatA2X)
endif
if(associated(xgrid%xgtypep%sparseMatX2A)) then
do i = 1, size(xgrid%xgtypep%sparseMatX2A)
if(associated(xgrid%xgtypep%sparseMatX2A(i)%factorIndexList)) &
deallocate(xgrid%xgtypep%sparseMatX2A(i)%factorIndexList)
if(associated(xgrid%xgtypep%sparseMatX2A(i)%factorList)) &
deallocate(xgrid%xgtypep%sparseMatX2A(i)%factorList)
enddo
deallocate(xgrid%xgtypep%sparseMatX2A)
endif
if(associated(xgrid%xgtypep%sparseMatB2X)) then
do i = 1, size(xgrid%xgtypep%sparseMatB2X)
if(associated(xgrid%xgtypep%sparseMatB2X(i)%factorIndexList)) &
deallocate(xgrid%xgtypep%sparseMatB2X(i)%factorIndexList)
if(associated(xgrid%xgtypep%sparseMatB2X(i)%factorList)) &
deallocate(xgrid%xgtypep%sparseMatB2X(i)%factorList)
enddo
deallocate(xgrid%xgtypep%sparseMatB2X)
endif
if(associated(xgrid%xgtypep%sparseMatX2B)) then
do i = 1, size(xgrid%xgtypep%sparseMatX2B)
if(associated(xgrid%xgtypep%sparseMatX2B(i)%factorIndexList)) &
deallocate(xgrid%xgtypep%sparseMatX2B(i)%factorIndexList)
if(associated(xgrid%xgtypep%sparseMatX2B(i)%factorList)) &
deallocate(xgrid%xgtypep%sparseMatX2B(i)%factorList)
enddo
deallocate(xgrid%xgtypep%sparseMatX2B)
endif
! destroy all the fraction arrays for Xgrid created online
if(xgrid%xgtypep%online == 1) then
if(associated(xgrid%xgtypep%fracA2X)) then
do i = 1, size(xgrid%xgtypep%fracA2X,1)
call ESMF_ArrayDestroy(xgrid%xgtypep%fracA2X(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%fracB2X)) then
do i = 1, size(xgrid%xgtypep%fracB2X,1)
call ESMF_ArrayDestroy(xgrid%xgtypep%fracB2X(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%fracX2A)) then
do i = 1, size(xgrid%xgtypep%fracX2A,1)
call ESMF_ArrayDestroy(xgrid%xgtypep%fracX2A(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%fracX2B)) then
do i = 1, size(xgrid%xgtypep%fracX2B,1)
call ESMF_ArrayDestroy(xgrid%xgtypep%fracX2B(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
call ESMF_ArrayDestroy(xgrid%xgtypep%fracX, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(associated(xgrid%xgtypep%frac2A)) then
do i = 1, size(xgrid%xgtypep%frac2A,1)
call ESMF_ArrayDestroy(xgrid%xgtypep%frac2A(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
if(associated(xgrid%xgtypep%frac2B)) then
do i = 1, size(xgrid%xgtypep%frac2B,1)
call ESMF_ArrayDestroy(xgrid%xgtypep%frac2B(i), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
endif ! online
endif ! valid status
! mark object invalid
call ESMF_BaseSetStatus(xgrid%xgtypep%base, ESMF_STATUS_INVALID, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(noGarbage)) then
if (noGarbage) then
! destroy Base object (which also removes it from garbage collection)
call ESMF_BaseDestroy(xgrid%xgtypep%base, noGarbage, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! remove reference to this object from ESMF garbage collection table
call c_ESMC_VMRmFObject(xgrid)
! deallocate the actual field data structure
deallocate(xgrid%xgtypep, stat=localrc)
if (ESMF_LogFoundDeallocError(localrc, &
msg="Deallocating XGrid information", &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
! Mark this XGrid as invalid
nullify(xgrid%xgtypep)
! Set init status to indicate structure has been destroyed
ESMF_INIT_SET_DELETED(xgrid)
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_XGridDestroy