read_matching_plane_query_csv Subroutine

public subroutine read_matching_plane_query_csv(path, expected_header, queries, status, message)

指定 header の列数だけ有限の十進実数を読み、入力順の列ベクトルとして返す。

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: path
character(len=*), intent(in) :: expected_header
real(kind=dp), intent(out), allocatable :: queries(:,:)
integer(kind=i32), intent(out) :: status
character(len=*), intent(out) :: message

Calls

proc~~read_matching_plane_query_csv~~CallsGraph proc~read_matching_plane_query_csv read_matching_plane_query_csv proc~is_decimal_real_token is_decimal_real_token proc~read_matching_plane_query_csv->proc~is_decimal_real_token

Called by

proc~~read_matching_plane_query_csv~~CalledByGraph proc~read_matching_plane_query_csv read_matching_plane_query_csv proc~generate_matching_plane_zhao_atlas generate_matching_plane_zhao_atlas proc~generate_matching_plane_zhao_atlas->proc~read_matching_plane_query_csv proc~generate_matching_plane_zhao_response_table generate_matching_plane_zhao_response_table proc~generate_matching_plane_zhao_response_table->proc~read_matching_plane_query_csv program~zhao_atlas_main zhao_atlas_main program~zhao_atlas_main->proc~generate_matching_plane_zhao_atlas program~zhao_response_main zhao_response_main program~zhao_response_main->proc~generate_matching_plane_zhao_response_table

Source Code

  subroutine read_matching_plane_query_csv(path, expected_header, queries, status, message)
    character(len=*), intent(in) :: path, expected_header
    real(dp), allocatable, intent(out) :: queries(:, :)
    integer(i32), intent(out) :: status
    character(len=*), intent(out) :: message

    real(dp), allocatable :: buffer(:, :), grown(:, :), query(:)
    character(len=query_line_length) :: line
    character(len=:), allocatable :: record
    integer :: unit_id, ios, line_number, row_count, capacity, column_count
    logical :: header_found

    status = matching_plane_query_ok
    message = ''
    column_count = count_character(expected_header, ',') + 1
    capacity = initial_query_capacity
    allocate (queries(column_count, 0), buffer(column_count, capacity), query(column_count))
    row_count = 0
    line_number = 0
    header_found = .false.
    open (newunit=unit_id, file=trim(path), status='old', action='read', iostat=ios)
    if (ios /= 0) then
      status = matching_plane_query_io_error
      message = 'could not open matching-plane query CSV: '//trim(path)
      return
    end if

    do
      read (unit_id, '(a)', iostat=ios) line
      if (ios < 0) exit
      line_number = line_number + 1
      if (ios > 0) then
        status = matching_plane_query_io_error
        message = 'failed to read matching-plane query CSV line '//trim(integer_text(line_number))//'.'
        exit
      end if
      record = trim(adjustl(line))
      if (len(record) == 0) cycle
      if (record(1:1) == '#') cycle
      if (.not. header_found) then
        if (record /= expected_header) then
          status = matching_plane_query_invalid_grid
          message = 'matching-plane query CSV header does not match the required columns.'
          exit
        end if
        header_found = .true.
        cycle
      end if
      if (count_character(record, ',') /= column_count - 1) then
        status = matching_plane_query_invalid_grid
        message = 'matching-plane query row '//trim(integer_text(line_number))// &
                  ' must contain exactly '//trim(integer_text(column_count))//' values.'
        exit
      end if
      call parse_query_record(record, query, ios)
      if (ios /= 0 .or. any(.not. ieee_is_finite(query))) then
        status = matching_plane_query_invalid_grid
        message = 'matching-plane query row '//trim(integer_text(line_number))//' contains invalid values.'
        exit
      end if
      if (row_count == capacity) then
        if (capacity > huge(capacity)/2) then
          status = matching_plane_query_invalid_grid
          message = 'matching-plane query row capacity overflowed.'
          exit
        end if
        allocate (grown(column_count, 2*capacity))
        grown(:, :capacity) = buffer
        call move_alloc(grown, buffer)
        capacity = 2*capacity
      end if
      row_count = row_count + 1
      buffer(:, row_count) = query
    end do
    close (unit_id)
    if (status /= matching_plane_query_ok) return

    if (.not. header_found .or. row_count == 0) then
      status = matching_plane_query_invalid_grid
      message = 'matching-plane query CSV must contain the required header and at least one row.'
      return
    end if
    queries = buffer(:, :row_count)
  end subroutine read_matching_plane_query_csv