ESMF_AttributeAddAttPackStdInfo Subroutine

private subroutine ESMF_AttributeAddAttPackStdInfo(info, convention, purpose, attrList, nestConvention, nestPurpose, attpack, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Info), intent(inout) :: info
character(len=*), intent(in) :: convention
character(len=*), intent(in) :: purpose
character(len=*), intent(in), optional, dimension(:) :: attrList
character(len=*), intent(in), optional :: nestConvention
character(len=*), intent(in), optional :: nestPurpose
type(ESMF_AttPack), intent(out), optional :: attpack
integer, intent(out), optional :: rc

Source Code

subroutine ESMF_AttributeAddAttPackStdInfo(info, convention, purpose, attrList, nestConvention, nestPurpose, attpack, rc)
  type(ESMF_Info), intent(inout) :: info
  character(len=*), intent(in) :: convention
  character(len=*), intent(in) :: purpose
  character(len=*), dimension(:), intent(in), optional :: attrList
  character(len=*), intent(in), optional :: nestConvention
  character(len=*), intent(in), optional :: nestPurpose
  type(ESMF_AttPack), intent(out), optional :: attpack
  integer, intent(out), optional :: rc

  integer :: localrc, ii, nest_conv_count
  character(:), allocatable :: key, key_nest_get, key_nest_set
  type(ESMF_Info) :: tmp_info, tmp_nest_info
  logical :: is_present

  if (present(rc)) rc = ESMF_RC_NOT_IMPL
  localrc = ESMF_FAILURE

  if (present(nestConvention)) then
    if (.not. present(nestPurpose)) then
      if (ESMF_LogFoundError(ESMF_FAILURE, msg="nestPurpose required", ESMF_CONTEXT, rcToReturn=rc)) return
    endif
  endif
  if (present(nestPurpose)) then
    if (.not. present(nestConvention)) then
      if (ESMF_LogFoundError(ESMF_FAILURE, msg="nestConvention required", ESMF_CONTEXT, rcToReturn=rc)) return
    endif
  endif

  key = "/"//TRIM(convention)//"/"//TRIM(purpose)
  if (present(nestConvention)) then
    key_nest_get = "/"//TRIM(nestConvention)//"/"//TRIM(nestPurpose)
    key_nest_set = key//key_nest_get
  else
    key_nest_get = ""
    key_nest_set = ""
  end if

  ! Only create a package if it doesn't exist
  is_present = ESMF_InfoIsPresent(info, key, isPointer=.true., rc=localrc)
  if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

  if (.not. is_present) then
    tmp_info = ESMF_InfoCreate(rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

    call ESMF_InfoSet(info, key, tmp_info, force=ESMF_ATTR_DEFAULT_FORCE, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

    call ESMF_InfoDestroy(tmp_info, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

    if (present(nestConvention)) then
       tmp_nest_info = ESMF_InfoCreate(info, key_nest_get, rc=localrc)
       if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

       call ESMF_InfoSet(info, key_nest_set, tmp_nest_info, force=ESMF_ATTR_DEFAULT_FORCE, rc=localrc)
       if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

       call ESMF_InfoDestroy(tmp_nest_info, rc=localrc)
       if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

       call ESMF_InfoRemove(info, nestConvention, keyChild=nestPurpose, rc=localrc)
       if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

       ! -----------------------------------------------------------------------
       ! If the nestConvention now has no members, remove it as well

       call ESMF_InfoGet(info, key=nestConvention, size=nest_conv_count, rc=localrc)
       if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return

       if (nest_conv_count == 0) then
         call ESMF_InfoRemove(info, nestConvention, rc=localrc)
         if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
       end if
       ! -----------------------------------------------------------------------
    end if
  end if

  if (present(attrList)) then
    do ii=1,SIZE(attrList)
      call ESMF_InfoSetNULL(info, key//"/"//trim(attrList(ii)), rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
    end do
  end if

  if (present(attpack)) then
    call attpack%initialize(info, rootKey=key, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
  end if

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