ESMF_ConfigLoadFile_1proc_ Subroutine

private subroutine ESMF_ConfigLoadFile_1proc_(config, filename, rc)

Arguments

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

Source Code

    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, ls, ptr
      integer :: lu, nrecs
      integer :: iostat
      character(len=LSZ) :: line
      integer :: localrc
      character(LSZ), allocatable :: 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)

      allocate (line_buffer(nrecs))
      do, i = 1, nrecs
        read (lu, '(a)') line_buffer(i)
      end do

!     Read to end of file
!     -------------------
      config%cptr%buffer(1:1) = EOL
      ptr = 2                         ! next buffer position
      do, i = 1, nrecs

!        Read next line
!        --------------
         line = line_buffer(i)            ! copy next line
         call ESMF_Config_trim ( line )      ! remove trailing white space
         call ESMF_Config_pad ( line )       ! Pad with # from end of line

!        A non-empty line
!        ----------------
         ls = index_(line,'#' ) - 1    ! line length
         if ( ls .gt. 0 ) then
            if ( (ptr+ls) .gt. 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+ls) = line(1:ls) // EOL
            ptr = ptr + ls + 1
         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%this_line = ' '
      config%cptr%next_line = 1
      config%cptr%value_begin = 1

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

    end subroutine ESMF_ConfigLoadFile_1proc_