ESMF_ReconcileZappedProxies Subroutine

private subroutine ESMF_ReconcileZappedProxies(state, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_State), intent(inout) :: state
integer, intent(out), optional :: rc

Calls

proc~~esmf_reconcilezappedproxies~~CallsGraph proc~esmf_reconcilezappedproxies ESMF_ReconcileZappedProxies esmf_arraydestroy esmf_arraydestroy proc~esmf_reconcilezappedproxies->esmf_arraydestroy esmf_fieldbundledestroy esmf_fieldbundledestroy proc~esmf_reconcilezappedproxies->esmf_fieldbundledestroy esmf_fieldbundleget esmf_fieldbundleget proc~esmf_reconcilezappedproxies->esmf_fieldbundleget esmf_fieldbundletypedeepcopy esmf_fieldbundletypedeepcopy proc~esmf_reconcilezappedproxies->esmf_fieldbundletypedeepcopy esmf_fielddestroy esmf_fielddestroy proc~esmf_reconcilezappedproxies->esmf_fielddestroy esmf_fieldget esmf_fieldget proc~esmf_reconcilezappedproxies->esmf_fieldget esmf_statedestroy esmf_statedestroy proc~esmf_reconcilezappedproxies->esmf_statedestroy interface~esmf_containerget~2 ESMF_ContainerGet proc~esmf_reconcilezappedproxies->interface~esmf_containerget~2 proc~esmf_arraybundledestroy ESMF_ArrayBundleDestroy proc~esmf_reconcilezappedproxies->proc~esmf_arraybundledestroy proc~esmf_logfounddeallocerror ESMF_LogFoundDeallocError proc~esmf_reconcilezappedproxies->proc~esmf_logfounddeallocerror proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_reconcilezappedproxies->proc~esmf_logfounderror proc~esmf_stateitemget ESMF_StateItemGet proc~esmf_reconcilezappedproxies->proc~esmf_stateitemget proc~esmf_containergetfield ESMF_ContainerGetField interface~esmf_containerget~2->proc~esmf_containergetfield proc~esmf_containergetfieldlist ESMF_ContainerGetFieldList interface~esmf_containerget~2->proc~esmf_containergetfieldlist proc~esmf_containergetfieldlistall ESMF_ContainerGetFieldListAll interface~esmf_containerget~2->proc~esmf_containergetfieldlistall proc~esmf_arraybundledestroy->proc~esmf_logfounderror c_esmc_arraybundledestroy c_esmc_arraybundledestroy proc~esmf_arraybundledestroy->c_esmc_arraybundledestroy proc~esmf_arraybundlegetinit ESMF_ArrayBundleGetInit proc~esmf_arraybundledestroy->proc~esmf_arraybundlegetinit proc~esmf_imerr ESMF_IMErr proc~esmf_arraybundledestroy->proc~esmf_imerr esmf_breakpoint esmf_breakpoint proc~esmf_logfounddeallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfounddeallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfounddeallocerror->proc~esmf_logwrite proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logfounderror->proc~esmf_logwrite proc~esmf_stateitemget->esmf_fieldbundleget proc~esmf_stateitemget->esmf_fieldget proc~esmf_stateitemget->proc~esmf_logfounderror esmf_arrayget esmf_arrayget proc~esmf_stateitemget->esmf_arrayget interface~esmf_arraybundleget ESMF_ArrayBundleGet proc~esmf_stateitemget->interface~esmf_arraybundleget interface~esmf_routehandleget ESMF_RouteHandleGet proc~esmf_stateitemget->interface~esmf_routehandleget proc~esmf_logseterror ESMF_LogSetError proc~esmf_stateitemget->proc~esmf_logseterror

Called by

proc~~esmf_reconcilezappedproxies~~CalledByGraph proc~esmf_reconcilezappedproxies ESMF_ReconcileZappedProxies proc~esmf_statereconcile_driver ESMF_StateReconcile_driver proc~esmf_statereconcile_driver->proc~esmf_reconcilezappedproxies proc~esmf_statereconcile ESMF_StateReconcile proc~esmf_statereconcile->proc~esmf_statereconcile_driver

Source Code

  subroutine ESMF_ReconcileZappedProxies(state, rc)
!
! !ARGUMENTS:
      type(ESMF_State), intent(inout)         :: state
      integer,          intent(out), optional :: rc
!
! !DESCRIPTION:
!   Top-level proxy objects that have been zapped from the State during a
!   previous call to the companion method ESMF_ReconcileZapProxies() must now be
!   handled after the reconcile work is done. There is special handling for
!   Field and FieldBundle objects for which new proxies have been
!   created. The internal information of those new proxies must be copied
!   under the old proxy wrappers. Old wrappers must replace the new ones
!   inside the State. Finally the old inside members must be cleaned up.
!   There is also a chance that zapped proxy are not associated with new proxy
!   counter parts (e.g. if the actual objects have been removed from the State).
!   In that case the old proxy object must be cleaned up for good by removing
!   it from the garbage collection.
!
!   The arguments are:
!   \begin{description}
!   \item[state]
!     The State from which proxies have been zapped and must either be
!     restored or completely removed from the garbage collection.
!   \item[{[rc]}]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!
!EOPI
    integer                           :: localrc, i, k
    integer                           :: memstat
    type(ESMF_StateClass),    pointer :: stypep
    type(ESMF_StateItemWrap), pointer :: itemList(:)
    type(ESMF_StateItemWrap), pointer :: zapList(:)
    logical,                  pointer :: zapFlag(:)
    character(len=ESMF_MAXSTR)        :: thisname
    character(len=ESMF_MAXSTR)        :: name
    type(ESMF_Field)                  :: tempField
    type(ESMF_FieldType)              :: tempFieldType
    type(ESMF_FieldBundle)            :: tempFB
    type(ESMF_FieldBundleType)        :: tempFBType
    type(ESMF_State)                  :: wrapper

    ! Initialize return code; assume routine not implemented
    if (present(rc)) rc = ESMF_RC_NOT_IMPL
    localrc = ESMF_RC_NOT_IMPL

    stypep => state%statep
    zapList => stypep%zapList
    zapFlag => stypep%zapFlag

    itemList => null ()
    call ESMF_ContainerGet(container=stypep%stateContainer, itemList=itemList, &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
      rcToReturn=rc)) return

#ifdef RECONCILE_ZAP_LOG_on
    call ESMF_VMLogGarbageInfo(prefix="ZappedProxies bef: ", &
      logMsgFlag=ESMF_LOGMSG_DEBUG, rc=localrc)
#endif

    if (associated(itemList).and.associated(zapList)) then
#ifdef RECONCILE_ZAP_LOG_on
      call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): have lists", &
        ESMF_LOGMSG_DEBUG, rc=localrc)
#endif

      do i=1, size(itemList)
        if (itemList(i)%si%proxyFlag .and. &
          (itemList(i)%si%otype==ESMF_STATEITEM_FIELD .or. &
           itemList(i)%si%otype==ESMF_STATEITEM_FIELDBUNDLE )) then
          call ESMF_StateItemGet(itemList(i)%si, name=thisname, rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
            rcToReturn=rc)) return
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found a proxy field: "//&
  trim(thisname), ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
          do k=1, size(zapList)
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): scanning zapList", &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
            if (associated (zapList(k)%si)) then
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): found valid zapList object", &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
              ! Note that only Fields and FieldBundles receive the restoration
              ! treatment, and therefore persist during repeated Reconcile()
              ! calls. The method only works for these two types carried by
              ! State, because they are deep Fortran classes, and there is an
              ! extra layer of indirection that is used by the implemented
              ! approach. For deep C++ implemented classes this extra layer of
              ! indirection is missing, and the method would not work.
              ! For practical cases under NUOPC only Field and FieldBundle
              ! objects are relevant direct objects handled under State, and
              ! therefore the implemented method suffices.
              if (zapList(k)%si%otype==ESMF_STATEITEM_FIELD) then
                call ESMF_FieldGet(zapList(k)%si%datap%fp, name=name, rc=localrc)
                if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
                  ESMF_CONTEXT, rcToReturn=rc)) return
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking for name match Field: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
                if (name == thisname) then
                  zapFlag(k) = .false.  ! indicate that proxy has been restored
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): restore persistent proxy for Field: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
                  ! Bend pointers and copy contents to result in the desired
                  ! behavior for re-reconcile. From a user perspective of
                  ! Reconcile() proxies should persist when a State is
                  ! re-reconciled, and the same proxies are needed. Basically
                  ! a user should be able to hang on to a proxy.
                  tempField%ftypep => itemList(i)%si%datap%fp%ftypep
                  tempFieldType = zapList(k)%si%datap%fp%ftypep
                  zapList(k)%si%datap%fp%ftypep = itemList(i)%si%datap%fp%ftypep
                  itemList(i)%si%datap%fp%ftypep => zapList(k)%si%datap%fp%ftypep
                  tempField%ftypep = tempFieldType
                  ! Finally destroy the old Field internals
                  ESMF_INIT_SET_CREATED(tempField)
                  call ESMF_FieldDestroy(tempField, noGarbage=.true., rc=localrc)
                  if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return
                  ! deallocate the associated StateItem
                  deallocate(zapList(k)%si)
                end if
              else if (zapList(k)%si%otype==ESMF_STATEITEM_FIELDBUNDLE) then
                call ESMF_FieldBundleGet(zapList(k)%si%datap%fbp, name=name, rc=localrc)
                if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
                  ESMF_CONTEXT, rcToReturn=rc)) return
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): checking for name match FieldBundle: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
                if (name == thisname) then
                  zapFlag(k) = .false.  ! indicate that proxy has been restored
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): restore persistent proxy for FieldBundle: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
                  ! Bend pointers and copy contents to result in the desired
                  ! behavior for re-reconcile. From a user perspective of
                  ! Reconcile() proxies should persist when a State is
                  ! re-reconciled, and the same proxies are needed. Basically
                  ! a user should be able to hang on to a proxy.
                  tempFB%this => itemList(i)%si%datap%fbp%this
                  call ESMF_FieldBundleTypeDeepCopy(zapList(k)%si%datap%fbp%this, tempFBType)
                  call ESMF_FieldBundleTypeDeepCopy(itemList(i)%si%datap%fbp%this, zapList(k)%si%datap%fbp%this)
                  itemList(i)%si%datap%fbp%this => zapList(k)%si%datap%fbp%this
                  call ESMF_FieldBundleTypeDeepCopy(tempFBType, tempFB%this)
                  ! Finally destroy the old FieldBundle internals
                  ESMF_INIT_SET_CREATED(tempFB)
                  call ESMF_FieldBundleDestroy(tempFB, noGarbage=.true., &
                    rc=localrc)
                  if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return
                  ! deallocate the associated StateItem
                  deallocate(zapList(k)%si)
                end if

              end if
            end if
          end do ! k
        end if
      end do ! i
    endif

    ! Completely destroy any zapped proxies that did not get restored.
    ! This applies to all zapped proxy objects, regardless of type.
    if (associated(zapFlag)) then
      do k=1, size(zapFlag)
        if (zapFlag(k)) then
          if (zapList(k)%si%otype==ESMF_STATEITEM_FIELD) then
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_FieldGet(zapList(k)%si%datap%fp, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, &
  ESMF_ERR_PASSTHRU, &
  ESMF_CONTEXT, rcToReturn=rc)) &
  return
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored Field: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
            call ESMF_FieldDestroy(zapList(k)%si%datap%fp, &
              noGarbage=.true., rc=localrc)
            if (ESMF_LogFoundError(localrc, &
              ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) &
              return
          else if (zapList(k)%si%otype==ESMF_STATEITEM_FIELDBUNDLE) then
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_FieldBundleGet(zapList(k)%si%datap%fbp, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, &
  ESMF_ERR_PASSTHRU, &
  ESMF_CONTEXT, rcToReturn=rc)) &
  return
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored FieldBundle: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
            call ESMF_FieldBundleDestroy(zapList(k)%si%datap%fbp, &
              noGarbage=.true., rc=localrc)
            if (ESMF_LogFoundError(localrc, &
              ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) &
              return
          else if (zapList(k)%si%otype==ESMF_STATEITEM_ARRAY) then
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_ArrayGet(zapList(k)%si%datap%ap, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, &
  ESMF_ERR_PASSTHRU, &
  ESMF_CONTEXT, rcToReturn=rc)) &
  return
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored Array: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
            call ESMF_ArrayDestroy(zapList(k)%si%datap%ap, &
              noGarbage=.true., rc=localrc)
            if (ESMF_LogFoundError(localrc, &
              ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) &
              return
          else if (zapList(k)%si%otype==ESMF_STATEITEM_ARRAYBUNDLE) then
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_ArrayBundleGet(zapList(k)%si%datap%abp, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, &
  ESMF_ERR_PASSTHRU, &
  ESMF_CONTEXT, rcToReturn=rc)) &
  return
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored ArrayBundle: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
            call ESMF_ArrayBundleDestroy(zapList(k)%si%datap%abp, &
              noGarbage=.true., rc=localrc)
            if (ESMF_LogFoundError(localrc, &
              ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) &
              return
          else if (zapList(k)%si%otype==ESMF_STATEITEM_STATE) then
            wrapper%statep => zapList(k)%si%datap%spp
            ESMF_INIT_SET_CREATED(wrapper)
#ifdef RECONCILE_ZAP_LOG_on
call ESMF_StateGet(wrapper, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, &
  ESMF_ERR_PASSTHRU, &
  ESMF_CONTEXT, rcToReturn=rc)) &
  return
call ESMF_LogWrite("ESMF_ReconcileZappedProxies(): destroy with noGarbage unrestored State: "//trim(name), &
  ESMF_LOGMSG_DEBUG, rc=localrc)
#endif
            call ESMF_StateDestroy(wrapper, &
              noGarbage=.true., rc=localrc)
            if (ESMF_LogFoundError(localrc, &
              ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) &
              return
          endif
          ! deallocate the associated StateItem
          if (associated(zapList(k)%si)) deallocate(zapList(k)%si)
        endif
      end do ! k
    endif

#ifdef RECONCILE_ZAP_LOG_on
    call ESMF_VMLogGarbageInfo(prefix="ZappedProxies aft: ", &
      logMsgFlag=ESMF_LOGMSG_DEBUG, rc=localrc)
#endif

    if (associated (itemList)) then
      deallocate(itemList, stat=memstat)
      if (ESMF_LogFoundDeallocError(memstat, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
    end if

    if (associated (zapList)) then
      deallocate(zapList, stat=memstat)
      if (ESMF_LogFoundDeallocError(memstat, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
      stypep%zapList => null()
    end if

    if (associated (zapFlag)) then
      deallocate(zapFlag, stat=memstat)
      if (ESMF_LogFoundDeallocError(memstat, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
      stypep%zapFlag => null()
    end if

    if (present(rc)) rc = ESMF_SUCCESS
  end subroutine ESMF_ReconcileZappedProxies