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

Source Code

  subroutine ESMF_ReconcileZappedProxies(state, rc)
!
! !ARGUMENTS:
      type(ESMF_State), intent(inout)         :: state
      integer,          intent(out), optional :: rc
!
! !DESCRIPTION:
!     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. Potentially new proxies have been
!   created, and the internal information of those new proxies must be copied
!   under the old proxy wrappers, then 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
    character(len=80)                 :: msgString

    ! 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 associated 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 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(): found 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 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(): found 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
            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
            call ESMF_FieldBundleDestroy(zapList(k)%si%datap%fbp, &
              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