ESMF_ConfigSetString Subroutine

private subroutine ESMF_ConfigSetString(config, value, keywordEnforcer, label, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Config), intent(inout) :: config
character(len=*), intent(in) :: value
type(ESMF_KeywordEnforcer), optional :: keywordEnforcer
character(len=*), intent(in), optional :: label
integer, intent(out), optional :: rc

Source Code

      subroutine ESMF_ConfigSetString(config, value, &
        keywordEnforcer, label, rc)

! !ARGUMENTS:
      type(ESMF_Config),     intent(inout)         :: config
      character(*),          intent(in)            :: value
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
      character(len=*),      intent(in),  optional :: label
      integer,               intent(out), optional :: rc

!
! !DESCRIPTION: 
!  Sets an integer {\tt value} in the {\tt config} object.
!
!   The arguments are:
!   \begin{description}
!   \item [config]
!     Already created {\tt ESMF\_Config} object.
!   \item [value]
!     String to set.
!   \item [{[label]}]
!     Identifying attribute label. 
!   \item [{[rc]}]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!
!EOPI -------------------------------------------------------------------
!
      integer :: localrc
      character(len=ESMF_MAXSTR) :: logmsg
      character(len=LSZ) :: curVal, newVal
      integer :: i, j, k, m, nchar, ninsert, ndelete, lenThisLine

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

      !check variables
      ESMF_INIT_CHECK_DEEP(ESMF_ConfigGetInit,config,rc)

      ! Set config buffer at desired attribute
      if ( present (label) ) then
         call ESMF_ConfigGetString( config, curVal, label=label, rc=localrc)
      else
         call ESMF_ConfigGetString( config, curVal, rc = localrc )
      endif

      if ( localrc /= ESMF_SUCCESS ) then
        if ( localrc == ESMF_RC_NOT_FOUND ) then
          ! set config buffer at end for appending
          i = config%cptr%nbuf
        else
          if ( present( rc ) ) then
            rc = localrc
          endif
          return
        endif
      else ! attribute found
        ! set config buffer for overwriting/inserting
        i = config%cptr%value_begin
        curVal = BLK // trim(curVal) // BLK // EOL ! like config%cptr%this_line
      endif

      ! for appending, create new attribute string with label and value
      if ( i .eq. config%cptr%nbuf .and. present(label) ) then
        write(newVal, *) label, BLK, value
        newVal = trim(adjustl(newVal)) // EOL
        j = i + len_trim(newVal)

        ! check to ensure len of newVal doesn't exceed LSZ
        if ( (j-i) .gt. LSZ) then
           write(logmsg, *) ", attribute label, value & EOL are ", j-i, &
               " characters long, only ", LSZ, " characters allowed per line"
           if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, &
                                     ESMF_CONTEXT, rcToReturn=rc)) return
        endif

        ! check if enough space left in config buffer
        if (j .ge. NBUF_MAX) then   ! room for EOB if necessary
           write(logmsg, *) ", attribute label & value require ", j-i+1, &
               " characters (including EOL & EOB), only ", NBUF_MAX-i, &
               " characters left in config buffer"
           if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, &
                                     ESMF_CONTEXT, rcToReturn=rc)) return
        endif
      endif

      ! overwrite, with possible insertion or deletion of extra characters
      if (i .eq. config%cptr%value_begin) then
         write(newVal, *) value
         newVal = BLK // trim(adjustl(newVal)) // EOL
         j = i + len_trim(newVal) - 1

         !  check if we need more space to insert new characters;
         !  shift buffer down (linked-list redesign would be better!)
         nchar = j-i+1
         lenThisLine = len_trim(curVal) - 1
         if ( nchar .gt. lenThisLine) then

            ! check to ensure length of extended line doesn't exceed LSZ
            do m = i, 1, -1
              if (config%cptr%buffer(m:m) .eq. EOL) then
                exit
              endif
            enddo
            if (j-m+1 .gt. LSZ) then
               write(logmsg, *) ", attribute label, value & EOL are ", j-m+1, &
                  " characters long, only ", LSZ, " characters allowed per line"
               if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, &
                                         ESMF_CONTEXT, rcToReturn=rc)) return
            endif

            ! check if enough space left in config buffer to extend line
            if (j+1 .ge. NBUF_MAX) then   ! room for EOB if necessary
               write(logmsg, *) ", attribute label & value require ", j-m+1, &
                   " characters (including EOL & EOB), only ", NBUF_MAX-i, &
                   " characters left in config buffer"
               if (ESMF_LogFoundError(ESMC_RC_LONG_STR, msg=logmsg, &
                                         ESMF_CONTEXT, rcToReturn=rc)) return
            endif

            ninsert = nchar - lenThisLine
            do k = config%cptr%nbuf, j, -1
               config%cptr%buffer(k+ninsert:k+ninsert) = config%cptr%buffer(k:k)
            enddo
            config%cptr%nbuf = config%cptr%nbuf + ninsert

         ! or if we need less space and remove characters;
         ! shift buffer up
         elseif ( nchar .lt. lenThisLine ) then
           ndelete = lenThisLine - nchar
            do k = j+1, config%cptr%nbuf
               config%cptr%buffer(k-ndelete:k-ndelete) = config%cptr%buffer(k:k)
            enddo
            config%cptr%nbuf = config%cptr%nbuf - ndelete
         endif
      endif

      ! write new attribute value into config
      config%cptr%buffer(i:j) = newVal(1:len_trim(newVal))

      ! if appended, reset EOB marker and nbuf
      if (i .eq. config%cptr%nbuf) then
        config%cptr%buffer(j:j) = EOB
        config%cptr%nbuf = j
      endif

      if( present( rc )) then
        rc = ESMF_SUCCESS
      endif

      return
    end subroutine ESMF_ConfigSetString