ESMF_AttributeRemoveAttPackLocStream Subroutine

private subroutine ESMF_AttributeRemoveAttPackLocStream(target, name, attpack, convention, purpose, attnestflag, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_LocStream), intent(inout) :: target
character(len=*), intent(in), optional :: name
type(ESMF_AttPack), intent(inout), optional :: attpack
character(len=*), intent(in), optional :: convention
character(len=*), intent(in), optional :: purpose
type(ESMF_AttNest_Flag), intent(in), optional :: attnestflag
integer, intent(out), optional :: rc

Source Code

subroutine ESMF_AttributeRemoveAttPackLocStream(target, name, attpack, convention, purpose, attnestflag, rc)
  type(ESMF_LocStream), intent(inout) :: target
  character(len=*), intent(in), optional :: name
  type(ESMF_AttPack), intent(inout), optional :: attpack
  character(len=*), intent(in), optional :: convention
  character(len=*), intent(in), optional :: purpose
  type(ESMF_AttNest_Flag), intent(in), optional :: attnestflag
  integer, intent(out), optional :: rc

  integer :: localrc, purpsize
  type(ESMF_InfoDescribe) :: eidesc
  type(ESMF_Info) :: info
  character(:), allocatable :: keyParent, keyChild, keyParent2, keyChild2
  type(ESMF_AttNest_Flag) :: local_attnestflag
  logical, parameter :: debug = .false.
  character(len=ESMF_MAXSTR) :: logmsg

  localrc = ESMF_FAILURE
  if (present(rc)) rc = ESMF_RC_NOT_IMPL
  ! Check object initialization
  ESMF_INIT_CHECK_DEEP(ESMF_LocStreamGetInit, target, rc)

  if (present(attnestflag)) then
    local_attnestflag = attnestflag
  else
    local_attnestflag = ESMF_ATTR_DEFAULT_ATTNEST
  end if

  ! If attpack, use target as info source
  if (present(attpack)) then
    info = attpack%getPayload()
  else
    ! If no attpack, use target as info source
    info = eidesc%GetInfo(target, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
  end if

  if (debug) then
    call ESMF_LogWrite(ESMF_METHOD//": info dump=...", rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_LogWrite(ESMF_InfoDump(info, rc=localrc), rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
  end if

  ! If a name is provided, use this as the key to remove
  if (present(name)) then
    keyChild = name

    if (present(attpack)) then
      keyParent = attpack%formatKey(rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
    else
      call ESMF_InfoFormatKey(keyParent, "", localrc, convention=convention, purpose=purpose)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
    end if

    call ESMF_InfoRemove(info, keyParent, keyChild=keyChild, attnestflag=local_attnestflag, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

  ! Otherwise, remove the whole attpack
  else
    if (.not. present(attpack)) then
      if (.not. present(convention)) then
        if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, msg="No name, attpack, or conv/purp provided. Nothing to remove.", &
          ESMF_CONTEXT, rcToReturn=rc)) return
      else
        call ESMF_InfoRemove(info, TRIM(convention), keyChild=TRIM(purpose), attnestflag=local_attnestflag, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

        ! Check for conventions with no purposes
        call ESMF_InfoGet(info, key=TRIM(convention), size=purpsize, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

        ! If there are no purposes, the convention is orphaned and should be removed
        if (purpsize == 0) then
          call ESMF_InfoRemove(info, "", keyChild=TRIM(convention), rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
        end if
      end if
    else
      keyParent = attpack%formatKey(rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

      call parse_json_pointer(keyParent, keyParent2, keyChild2)

      call ESMF_InfoRemove(info, keyParent2, keyChild=keyChild2, attnestflag=local_attnestflag, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

      ! Check for conventions with no purposes
      call ESMF_InfoGet(info, key=TRIM(keyParent2), size=purpsize, attnestflag=local_attnestflag, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

      ! If there are no purposes, the convention is orphaned and should be removed
      if (purpsize == 0) then
        call ESMF_InfoRemove(info, "", keyChild=TRIM(keyParent2(2:)), attnestflag=local_attnestflag, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
      end if
    end if
  endif

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