subroutine ESMF_ConfigLoadFile_1proc_( config, filename, rc )
type(ESMF_Config), intent(inout) :: config ! ESMF Configuration
character(len=*), intent(in) :: filename ! file name
integer, intent(out), optional :: rc ! Error code
!
! !DESCRIPTION: Resource file filename is loaded into memory
!
!EOPI -------------------------------------------------------------------
integer :: i, j, lsz, lst, led, qst, qed, cst, ptr
integer :: lu, nrecs
integer :: iostat
integer :: localrc
character(NBUF_MAX) :: line_buffer
! Initialize return code; assume routine not implemented
if (present(rc)) rc = ESMF_RC_NOT_IMPL
localrc = ESMF_RC_NOT_IMPL
!check variables
ESMF_INIT_CHECK_DEEP(ESMF_ConfigGetInit,config,rc)
! Open file
! ---------
call ESMF_UtilIOUnitGet (lu, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! A open through an interface to avoid portability problems.
! (J.G.)
call opntext(lu, filename, 'old', rc=localrc)
if (ESMF_LogFoundError(localrc, &
msg="error opening text file: " // trim (filename), &
ESMF_CONTEXT, rcToReturn=rc)) return
! Count records, then read them into a local buffer
nrecs = 0
do
read (lu, *, iostat=iostat)
if (iostat /= 0) exit
nrecs = nrecs + 1
end do
rewind (lu)
! Read to end of file
! -------------------
config%cptr%buffer(1:1) = EOL
ptr = 2 ! next buffer position
do, i = 1, nrecs
! Read next line
! --------------
read (lu, '(a)', iostat=iostat) line_buffer
if (iostat /= 0) then
if (ESMF_LogFoundError(ESMF_RC_FILE_READ, &
msg="error reading file - "//trim(filename), &
ESMF_CONTEXT, rcToReturn=rc)) return
end if
! find comment start, skip quoted comments
! lst = line start, led = line end
! qst = next quote start, qed = last quote end
! cst = comment start
led = verify(line_buffer,BLK//TAB//DSN,back=.true.)
if (led .gt. 0) then
! replace TAB's with blanks for convenience
! backwards compatibility after removing ESMF_Config_pad
do j = 1, led
if (line_buffer(j:j) .eq. TAB) line_buffer(j:j) = BLK
end do
lst = verify(line_buffer(:led),BLK)
qst = scan(line_buffer(:led),QTS//QTD)
cst = index(line_buffer(:led),CMT)
if (cst .eq. 0) cst = led + 1
qed = 0
do while ((qst .ne. qed) .and. (qst .lt. cst))
! find end of quotation
if (qst .eq. led) then
qed = qst
else
qed = qst + index(line_buffer(qst+1:led),line_buffer(qst:qst))
end if
if (qed .eq. qst) then
if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, &
msg="missing end quote - "//trim(filename), &
ESMF_CONTEXT, rcToReturn=rc)) return
else
! find next quotation start
qst = qed + scan(line_buffer(qed+1:led),QTS//QTD)
! find next comment start
cst = index(line_buffer(qed+1:led),CMT)
if (cst .eq. 0) then
cst = led + 1
else
cst = qed + cst
end if
end if
end do
led = len_trim(line_buffer(1:cst-1))
lsz = led - lst + 1
! append line to buffer
if ( lsz .gt. 0 ) then
if ( (ptr+lsz) .ge. NBUF_MAX ) then
if (ESMF_LogFoundError(ESMF_RC_MEM, msg="exceeded NBUF_MAX size", &
ESMF_CONTEXT, rcToReturn=rc)) return
end if
config%cptr%buffer(ptr:ptr+lsz) = line_buffer(lst:led) // EOL
ptr = ptr + lsz + 1
end if
end if
end do
! All done
! --------
! Close lu
call clstext(lu, rc=localrc)
if(localrc /= ESMF_SUCCESS) then
localrc = ESMF_RC_FILE_CLOSE
if ( present (rc )) then
rc = localrc
endif
return
endif
config%cptr%buffer(ptr:ptr) = EOB
config%cptr%nbuf = ptr
config%cptr%next_item = 1
config%cptr%next_line = 1
config%cptr%value_begin = 1
if ( present (rc )) then
rc = ESMF_SUCCESS
endif
end subroutine ESMF_ConfigLoadFile_1proc_