ESMF_ReconcileGetStateIDInfo Subroutine

  subroutine ESMF_ReconcileGetStateIDInfo (state, siwrap, id, vmid, rc)
!
! !ARGUMENTS:
    type (ESMF_State), intent(in)  :: state
    type(ESMF_StateItemWrap), pointer :: siwrap(:)! intent(in)
    integer,           pointer     :: id(:)       ! intent(out)
    type(ESMF_VMId),   pointer     :: vmid(:)     ! intent(out)
    integer,           intent(out) :: rc
!
! !DESCRIPTION:
!
!   The arguments are:
!   \begin{description}
!   \item[state]
!     {\tt ESMF\_State} to collect information from.
!   \item[siwrap]
!     Pointers to the items in the State
!   \item[id]
!     The object ids of the State itself (in element 0) and the items
!     contained within it.  It does not return the IDs of nested State
!     items.
!   \item[vmid]
!     The object VMIds of the State itself (in element 0) and the items
!     contained within it.  It does not return the IDs of nested State
!     items.  Note that since VMId is a deep object class, the vmid array
!     has aliases to existing VMId objects, rather than copies of them.
!   \item[rc]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!EOPI

    type(ESMF_Array),           pointer :: arrayp
    type(ESMF_ArrayBundle),     pointer :: abundlep
    type(ESMF_FieldType),       pointer :: fieldp
    type(ESMF_FieldBundleType), pointer :: fbundlep
    type(ESMF_RouteHandle),     pointer :: rhandlep
    type(ESMF_StateClass),      pointer :: statep

    integer :: localrc
    integer :: i
    integer :: memstat
    integer :: nitems

    localrc = ESMF_RC_NOT_IMPL

    if (associated (id) .or. associated (vmid)) then
      if (ESMF_LogFoundError(ESMF_RC_ARG_BAD,  &
          ESMF_ERR_PASSTHRU,  &
          ESMF_CONTEXT, rcToReturn=rc)) return
    end if

    if (associated (siwrap)) then
      nitems = size (siwrap)
    else
      nitems = 0
    end if

    allocate (  &
              id(0:nitems),  &
            vmid(0:nitems),  &
        stat=memstat)
    if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

! Element 0s are for the State itself

    statep => state%statep

    call ESMF_BaseGetID(statep%base, id(0), rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    call ESMF_BaseGetVMId(statep%base, vmid(0), rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

! Loop over each item

    do, i=1, nitems

      select case (siwrap(i)%si%otype%ot)

      case (ESMF_STATEITEM_ARRAY%ot)
        arrayp => siwrap(i)%si%datap%ap

        call c_ESMC_GetID(arrayp, id(i), localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

        call c_ESMC_GetVMId(arrayp, vmid(i), localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      case (ESMF_STATEITEM_ARRAYBUNDLE%ot)
        abundlep => siwrap(i)%si%datap%abp

        call c_ESMC_GetID(abundlep, id(i), localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

        call c_ESMC_GetVMId(abundlep, vmid(i), localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      case (ESMF_STATEITEM_FIELD%ot)
        fieldp => siwrap(i)%si%datap%fp%ftypep

        call ESMF_BaseGetID(fieldp%base, id(i), rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

        call ESMF_BaseGetVMID(fieldp%base, vmid(i), rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      case (ESMF_STATEITEM_FIELDBUNDLE%ot)
        fbundlep => siwrap(i)%si%datap%fbp%this

        call ESMF_BaseGetID(fbundlep%base, id(i), rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

        call ESMF_BaseGetVMID(fbundlep%base, vmid(i), rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      case (ESMF_STATEITEM_ROUTEHANDLE%ot)
        rhandlep => siwrap(i)%si%datap%rp

        call c_ESMC_GetID(rhandlep, id(i), localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

        call c_ESMC_GetVMId(rhandlep, vmid(i), localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      case (ESMF_STATEITEM_STATE%ot)
        statep => siwrap(i)%si%datap%spp

        call ESMF_BaseGetID(statep%base, id(i), rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

        call ESMF_BaseGetVMID(statep%base, vmid(i), rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      case default
        if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, &
            msg="Unknown State item type", &
            ESMF_CONTEXT,  &
            rcToReturn=rc)) return

      end select

    end do

    rc = ESMF_SUCCESS

  end subroutine ESMF_ReconcileGetStateIDInfo