subroutine read_table_real(flt_value, &
kelements, irow, nrows, ncolumns, new_row, &
lfilename, descriptor_label, localcf, rc)
!-----------------------------------------------------------------------------
! helper routine to read a single real entry of a config file table. The
! tables are designed to have multiple lines for a single entry by using "&"
! continuation symbols to indicate a line continuation. It internally tests
! for the end of the table line and looks for a continuation symbol on the
! next line. If found it advances to the next entry.
!
! This separate routine was created to avoid significant duplication of code
! necessary for parsing the tables.
!-----------------------------------------------------------------------------
character(THARN_MAXSTR), intent(in ) :: lfilename, descriptor_label
real(ESMF_KIND_R8), intent( out) :: flt_value
integer, intent(in ) :: ncolumns(:), new_row(:)
integer, intent(inout) :: irow ! current row of table
integer, intent(in ) :: nrows ! total rows in table
integer, intent(inout) :: kelements ! current element of row irow of table
type(ESMF_Config), intent(inout) :: localcf
integer, intent(inout) :: rc
! local parameters
integer :: localrc ! local error status
! local character strings
character(THARN_MAXSTR) :: lchar, ltmp
real(ESMF_KIND_R8) :: flt_tmp
logical :: flag
! initialize return flag
localrc = ESMF_RC_NOT_IMPL
rc = ESMF_RC_NOT_IMPL
!-----------------------------------------------------------------------------
! if kelements < ncolumns then not at end of the row and can safely read
! another element.
!-----------------------------------------------------------------------------
if( kelements < ncolumns(irow) ) then
if( debug_flag) print*,' get attribute - real '
call ESMF_ConfigGetAttribute(localcf, flt_tmp, rc=localrc)
!--------------------------------------------------------------------------
! if error
!--------------------------------------------------------------------------
write(lchar,"(i5)") irow
if( ESMF_LogFoundError(localrc, &
msg="cannot read row " // trim(adjustL(lchar)) // &
" of table " //trim(descriptor_label) // "in file " // &
trim(lfilename), rcToReturn=rc) ) return
kelements = kelements + 1
flt_value = flt_tmp
elseif( kelements >= ncolumns(irow) .and. irow+1 <= nrows ) then
!--------------------------------------------------------------------------
! reached end of the row, check if another line exists
!--------------------------------------------------------------------------
if( new_row(irow+1) == 0 .and. ncolumns(irow+1) >= 2 ) then
!-----------------------------------------------------------------------
! if new line starts with a continuation and there are at least two
! columns, advance and read
!-----------------------------------------------------------------------
irow = irow + 1
kelements = 1
! if error
if( debug_flag) print*,' get next line in real'
call ESMF_ConfigNextLine(localcf, tableEnd=flag, rc=localrc)
write(lchar,"(i5)") irow
if( ESMF_LogFoundError(localrc, &
msg="cannot read row " // trim(adjustL(lchar)) // &
" of table " //trim(descriptor_label) // "in file " // &
trim(lfilename), rcToReturn=rc) ) return
!-----------------------------------------------------------------------
! read and discard continuation symbol
!-----------------------------------------------------------------------
if( debug_flag) print*,' get attribute - contin symbol '
call ESMF_ConfigGetAttribute(localcf, ltmp, rc=localrc)
if( ESMF_LogFoundError(localrc, &
msg="cannot read row " // trim(adjustL(lchar)) // &
" of table " //trim(descriptor_label) // "in file " // &
trim(lfilename), rcToReturn=rc) ) return
!-----------------------------------------------------------------------
! read string from table
!-----------------------------------------------------------------------
if( debug_flag) print*,' get attribute - real after continuation '
call ESMF_ConfigGetAttribute(localcf, flt_tmp, rc=localrc)
if( ESMF_LogFoundError(localrc, &
msg="cannot read row " // trim(adjustL(lchar)) // &
" of table " //trim(descriptor_label) // "in file " // &
trim(lfilename), rcToReturn=rc) ) return
kelements = kelements + 1
flt_value = flt_tmp
else
!-----------------------------------------------------------------------
! error continuation line missing, but grid not finished
!-----------------------------------------------------------------------
write(lchar,"(i5)") irow
call ESMF_LogSetError( ESMF_FAILURE,msg=" continuation missing " // &
"cannot read row " // trim(adjustL(lchar)) // &
" of table " //trim(descriptor_label) // "in file " // &
trim(lfilename), rcToReturn=rc)
return
endif ! new line
endif !
!-----------------------------------------------------------------------------
rc = ESMF_SUCCESS
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
end subroutine read_table_real