read_table_real Subroutine

public subroutine read_table_real(flt_value, kelements, irow, nrows, ncolumns, new_row, lfilename, descriptor_label, localcf, rc)

Arguments

Type IntentOptional Attributes Name
real(kind=ESMF_KIND_R8), intent(out) :: flt_value
integer, intent(inout) :: kelements
integer, intent(inout) :: irow
integer, intent(in) :: nrows
integer, intent(in) :: ncolumns(:)
integer, intent(in) :: new_row(:)
character(len=THARN_MAXSTR), intent(in) :: lfilename
character(len=THARN_MAXSTR), intent(in) :: descriptor_label
type(ESMF_Config), intent(inout) :: localcf
integer, intent(inout) :: rc

Source Code

  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