generate_matching_plane_zhao_response_table Subroutine

public subroutine generate_matching_plane_zhao_response_table(cfg, query_path, output_path, status, message)

5列query gridを評価し、既存table backend互換の11列CSVを書く。

Arguments

Type IntentOptional Attributes Name
type(app_config), intent(in) :: cfg
character(len=*), intent(in) :: query_path
character(len=*), intent(in) :: output_path
integer(kind=i32), intent(out) :: status
character(len=*), intent(out) :: message

Calls

proc~~generate_matching_plane_zhao_response_table~~CallsGraph proc~generate_matching_plane_zhao_response_table generate_matching_plane_zhao_response_table none~evaluate~3 matching_plane_response_provider_type%evaluate proc~generate_matching_plane_zhao_response_table->none~evaluate~3 none~initialize~2 matching_plane_response_provider_type%initialize proc~generate_matching_plane_zhao_response_table->none~initialize~2 proc~atomic_rename atomic_rename proc~generate_matching_plane_zhao_response_table->proc~atomic_rename proc~lower_ascii lower_ascii proc~generate_matching_plane_zhao_response_table->proc~lower_ascii proc~read_matching_plane_query_csv read_matching_plane_query_csv proc~generate_matching_plane_zhao_response_table->proc~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~~generate_matching_plane_zhao_response_table~~CalledByGraph proc~generate_matching_plane_zhao_response_table generate_matching_plane_zhao_response_table program~zhao_response_main zhao_response_main program~zhao_response_main->proc~generate_matching_plane_zhao_response_table

Source Code

  subroutine generate_matching_plane_zhao_response_table(cfg, query_path, output_path, status, message)
    type(app_config), intent(in) :: cfg
    character(len=*), intent(in) :: query_path, output_path
    integer(i32), intent(out) :: status
    character(len=*), intent(out) :: message

    type(matching_plane_response_provider_type) :: provider
    type(mpi_context) :: serial_mpi
    real(dp), allocatable :: queries(:, :), responses(:, :)
    integer(i32) :: provider_status
    integer :: row, output_unit, ios, close_ios, rename_status
    character(len=512) :: provider_message
    character(len=:), allocatable :: temporary_output_path

    call accept_generator(status, message)
    if (trim(lower_ascii(cfg%surface_current%model)) /= 'matching_plane_quasistatic' .or. &
        trim(lower_ascii(cfg%surface_current%response_backend)) /= 'zhao_online') then
      call reject_generator( &
        matching_plane_generator_invalid_argument, &
        'response generation requires matching_plane_quasistatic with response_backend="zhao_online".', &
        status, message &
        )
      return
    end if
    if (trim(lower_ascii(cfg%surface_current%zhao_root_selection)) == 'continuation') then
      call reject_generator( &
        matching_plane_generator_invalid_argument, &
        'response-table generation does not define an accepted endpoint for Zhao continuation.', &
        status, message &
        )
      return
    end if
    if (len_trim(query_path) == 0 .or. len_trim(output_path) == 0) then
      call reject_generator( &
        matching_plane_generator_invalid_argument, &
        'query and output paths must not be empty.', status, message &
        )
      return
    end if
    if (trim(query_path) == trim(output_path)) then
      call reject_generator( &
        matching_plane_generator_invalid_argument, &
        'query and output paths must be different.', status, message &
        )
      return
    end if
    temporary_output_path = trim(output_path)//'.beach-zhao-response.tmp'
    if (trim(query_path) == temporary_output_path) then
      call reject_generator( &
        matching_plane_generator_invalid_argument, &
        'query path conflicts with the response generator temporary path.', status, message &
        )
      return
    end if

    serial_mpi = mpi_context()
    call provider%initialize(cfg, serial_mpi, provider_status, provider_message)
    if (provider_status /= matching_plane_provider_ok) then
      call reject_generator( &
        matching_plane_generator_evaluation_failure, &
        'Zhao response initialization failed: '//trim(provider_message), status, message &
        )
      return
    end if

    call read_matching_plane_query_csv( &
      query_path, matching_plane_response_query_csv_header, queries, status, message &
      )
    if (status /= matching_plane_generator_ok) return
    call validate_cartesian_query_grid(queries, status, message)
    if (status /= matching_plane_generator_ok) return

    allocate (responses(matching_plane_response_output_count, size(queries, 2)))
    do row = 1, size(queries, 2)
      call provider%evaluate( &
        queries(:, row), serial_mpi, responses(:, row), provider_status, provider_message &
        )
      if (provider_status /= matching_plane_provider_ok) then
        call reject_generator( &
          matching_plane_generator_evaluation_failure, &
          'Zhao response evaluation failed at query row '//trim(integer_text(row))//': '// &
          trim(provider_message), status, message &
          )
        return
      end if
    end do

    open (newunit=output_unit, file=temporary_output_path, status='replace', action='write', iostat=ios)
    if (ios /= 0) then
      call reject_generator( &
        matching_plane_generator_io_error, &
        'could not open matching-plane response output: '//trim(output_path), status, message &
        )
      return
    end if
    write (output_unit, '(a,es24.16)', iostat=ios) '# matching_plane_z_m=', cfg%sim%box_max(3)
    if (ios == 0) write (output_unit, '(a)', iostat=ios) matching_plane_response_csv_header
    do row = 1, size(queries, 2)
      if (ios /= 0) exit
      write (output_unit, '(11(es24.16,:,","))', iostat=ios) queries(:, row), responses(:, row)
    end do
    close (output_unit, iostat=close_ios)
    if (ios == 0) ios = close_ios
    if (ios /= 0) then
      call reject_generator( &
        matching_plane_generator_io_error, &
        'failed while writing matching-plane response output.', status, message &
        )
      return
    end if
    call atomic_rename(temporary_output_path, trim(output_path), rename_status)
    if (rename_status /= filesystem_success) then
      call reject_generator( &
        matching_plane_generator_io_error, &
        'failed to atomically publish matching-plane response output.', status, message &
        )
    end if
  end subroutine generate_matching_plane_zhao_response_table