ESMF_ConfigParseAttributes Subroutine

private subroutine ESMF_ConfigParseAttributes(config, unique, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Config), intent(inout) :: config
logical, intent(in), optional :: unique
integer, intent(out), optional :: rc

Source Code

    subroutine ESMF_ConfigParseAttributes( config, unique, rc )


      implicit none

      type(ESMF_Config), intent(inout) :: config    ! ESMF Configuration
      logical, intent(in), optional :: unique    ! if unique is present & true, 
                                                 !  uniqueness of labels
                                                 !  is checked and error
                                                 !  code is set
      integer, intent(out), optional :: rc       ! Error return code
!
! !DESCRIPTION: Parse all attribute labels in given config object and place
!               into attributes table to track user retrieval
!
!EOPI -------------------------------------------------------------------
      integer :: i, j, k, a, b, localrc
      character(len=LSZ) :: this_line, label
      character(len=ESMF_MAXSTR) :: logmsg
      logical :: duplicate

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

      !check variables
      ESMF_INIT_CHECK_DEEP(ESMF_ConfigGetInit,config,rc)

      ! initialize this config's attributes table "used" flags to "not used"
      do a = 1, NATT_MAX
        config%cptr%attr_used(a)%used = .false.
      enddo

      i = 1  ! start of buffer
      a = 1  ! first slot in attributes table
      do while ( i .lt. config%cptr%nbuf )

        ! get next line from buffer
        j = i + index_(config%cptr%buffer(i:config%cptr%nbuf), EOL) - 1
        this_line = config%cptr%buffer(i:j)

        ! look for label in this_line; non-blank characters followed by a colon
        if (this_line(1:2) .ne. '::' ) then  ! skip end-of-table mark
          k = index_(this_line, ':') - 1     ! label sans colon
          if (k .ge. 1) then  ! non-blank match
            ! found a label, trim it, 
            label = trim(adjustl(this_line(1:k)))

            ! ... check it for uniqueness if requested,
            duplicate = .false.
            if ( present( unique ) ) then
              if (unique) then
                !  TODO:  pre-sort and use binary search, or use hash function
                do b = 1, a-1
                  if (label == ESMF_UtilArray2String (config%cptr%attr_used(b)%label)) then
                    duplicate = .true.
                    logmsg = "Duplicate label '" // trim(label) // &
                                  "' found in attributes file"
                    call ESMF_LogSetError(rcToCheck=ESMF_RC_DUP_NAME, msg=logmsg, &
                                             ESMF_CONTEXT, rcToReturn=rc)
                    localrc = ESMF_RC_DUP_NAME
                  endif
                enddo
              endif
            endif

            ! ... and place it into attributes table
            if (.not.duplicate) then
               if ( a <= NATT_MAX ) then
                  allocate (config%cptr%attr_used(a)%label(len_trim (label)))
                  config%cptr%attr_used(a)%label = ESMF_UtilString2Array (trim (label))
               else
                  if (ESMF_LogFoundError(ESMF_RC_INTNRL_LIST,    &
                       msg="attribute out-of-range; increase NATT_MAX", &
                       ESMF_CONTEXT, rcToReturn=rc)) return
               endif
               a = a + 1
            endif
          endif
        endif

        ! set index to beginning of next line
        i = j + 1

      enddo

      ! remember number of labels found
      config%cptr%nattr = a-1

      if (present(rc)) then
        if (localrc == ESMF_RC_DUP_NAME) then
          rc = localrc
        else
          rc = ESMF_SUCCESS
        end if
      end if
      return

    end subroutine ESMF_ConfigParseAttributes