generate_matching_plane_zhao_atlas Subroutine

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

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_atlas~~CallsGraph proc~generate_matching_plane_zhao_atlas generate_matching_plane_zhao_atlas none~evaluate_zhao_local matching_plane_response_provider_type%evaluate_zhao_local proc~generate_matching_plane_zhao_atlas->none~evaluate_zhao_local none~initialize~2 matching_plane_response_provider_type%initialize proc~generate_matching_plane_zhao_atlas->none~initialize~2 proc~atomic_rename atomic_rename proc~generate_matching_plane_zhao_atlas->proc~atomic_rename proc~lower_ascii lower_ascii proc~generate_matching_plane_zhao_atlas->proc~lower_ascii proc~read_matching_plane_query_csv read_matching_plane_query_csv proc~generate_matching_plane_zhao_atlas->proc~read_matching_plane_query_csv none~evaluate~2 matching_plane_zhao_model_type%evaluate none~evaluate_zhao_local->none~evaluate~2 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_atlas~~CalledByGraph proc~generate_matching_plane_zhao_atlas generate_matching_plane_zhao_atlas program~zhao_atlas_main zhao_atlas_main program~zhao_atlas_main->proc~generate_matching_plane_zhao_atlas

Source Code

  subroutine generate_matching_plane_zhao_atlas(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(app_config) :: branch_cfg
    type(matching_plane_response_provider_type) :: providers(branch_count)
    type(matching_plane_zhao_diagnostics_type) :: diagnostics
    type(mpi_context) :: serial_mpi
    real(dp), allocatable :: queries(:, :)
    real(dp) :: input(matching_plane_response_input_count)
    real(dp) :: output(matching_plane_response_output_count)
    integer(i32) :: provider_status, zhao_status
    integer :: branch, row, output_unit, ios, close_ios, rename_status
    character(len=512) :: provider_message, zhao_message
    character(len=:), allocatable :: temporary_output_path

    call accept_atlas(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_atlas( &
        matching_plane_atlas_invalid_argument, &
        'Zhao atlas requires matching_plane_quasistatic with response_backend="zhao_online".', &
        status, message &
        )
      return
    end if
    if (len_trim(query_path) == 0 .or. len_trim(output_path) == 0 .or. &
        trim(query_path) == trim(output_path)) then
      call reject_atlas( &
        matching_plane_atlas_invalid_argument, &
        'atlas query and output paths must be nonempty and different.', status, message &
        )
      return
    end if
    temporary_output_path = trim(output_path)//'.beach-zhao-atlas.tmp'
    if (trim(query_path) == temporary_output_path) then
      call reject_atlas( &
        matching_plane_atlas_invalid_argument, &
        'atlas query path conflicts with the temporary output path.', status, message &
        )
      return
    end if

    serial_mpi = mpi_context()
    do branch = 1, branch_count
      branch_cfg = cfg
      branch_cfg%surface_current%zhao_branch = branch_names(branch)
      branch_cfg%surface_current%zhao_root_selection = 'require_unique'
      call providers(branch)%initialize( &
        branch_cfg, serial_mpi, provider_status, provider_message &
        )
      if (provider_status /= matching_plane_provider_ok) then
        call reject_atlas( &
          matching_plane_atlas_initialization_failure, &
          'Zhao-'//branch_names(branch)//' initialization failed: '//trim(provider_message), &
          status, message &
          )
        return
      end if
    end do

    call read_matching_plane_query_csv( &
      query_path, matching_plane_zhao_atlas_query_csv_header, queries, status, message &
      )
    if (status /= matching_plane_atlas_ok) return

    open (newunit=output_unit, file=temporary_output_path, status='replace', action='write', iostat=ios)
    if (ios /= 0) then
      call reject_atlas( &
        matching_plane_atlas_io_error, 'could not open Zhao atlas output: '//trim(output_path), &
        status, message &
        )
      return
    end if
    write (output_unit, '(a)', iostat=ios) matching_plane_zhao_atlas_csv_header
    do row = 1, size(queries, 2)
      if (ios /= 0) exit
      input = [queries(:, row), 0.0_dp, 0.0_dp]
      do branch = 1, branch_count
        call providers(branch)%evaluate_zhao_local( &
          input, output, zhao_status, zhao_message, diagnostics &
          )
        call write_atlas_row( &
          output_unit, queries(:, row), branch_names(branch), zhao_status, output, &
          diagnostics, ios &
          )
        if (ios /= 0) exit
      end do
    end do
    close (output_unit, iostat=close_ios)
    if (ios == 0) ios = close_ios
    if (ios /= 0) then
      call reject_atlas( &
        matching_plane_atlas_io_error, 'failed while writing Zhao atlas 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_atlas( &
        matching_plane_atlas_io_error, 'failed to atomically publish Zhao atlas output.', &
        status, message &
        )
    end if
  end subroutine generate_matching_plane_zhao_atlas