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