read_table_integer Subroutine

public subroutine read_table_integer(int_value, kelements, irow, nrows, ncolumns, new_row, lfilename, descriptor_label, localcf, rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(out) :: int_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_integer(int_value,                                    &
                                kelements, irow, nrows, ncolumns, new_row,     &
                                lfilename, descriptor_label, localcf, rc)  

  !-----------------------------------------------------------------------------
  ! helper routine to read a single integer 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
  integer, intent(  out) :: int_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
  integer :: int_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 integer '
     call ESMF_ConfigGetAttribute(localcf, int_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
         int_value = int_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 '
        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 integer - 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 integer - after contin symbol '
        call ESMF_ConfigGetAttribute(localcf, int_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
        int_value = int_tmp

     else
        !-----------------------------------------------------------------------
        ! error continuation line missing, but grid not finished
        !-----------------------------------------------------------------------
        write(lchar,"(i5)") irow
        call ESMF_LogSetError( ESMF_FAILURE,                                &
              msg="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_integer