solver_session.f90 Source File

!> @file solver_session.f90
!> @brief Polling-friendly session API built on top of `solver_runtime`.
module solver_session
  use precision, only: wp
  use config, only: config_t, read_config, validate_config
  use config_schema, only: config_get_integer, config_get_real, config_get_logical, &
                           config_get_string, config_get_real3, config_set_integer, &
                           config_set_real, config_set_logical, config_set_string, &
                           config_set_real3
  use solver_runtime, only: solver_run_context_t, initialize_runtime, run_solver, &
                            run_solver_steps, finalize_runtime, report_performance_summary, teardown_runtime, &
                            copy_current_solution, write_solution_file
  use checkpoint, only: write_checkpoint
  implicit none
  private

  !> Operation completed successfully.
  integer, parameter, public :: solver_status_ok = 0
  !> Caller supplied an invalid handle, key, buffer, or scalar argument.
  integer, parameter, public :: solver_status_invalid_argument = 1
  !> Operation requires an initialised runtime, but the session is not ready.
  integer, parameter, public :: solver_status_invalid_state = 2
  !> Config loading or validation failed.
  integer, parameter, public :: solver_status_config_error = 3
  !> File I/O or other runtime setup/output work failed.
  integer, parameter, public :: solver_status_io_error = 4
  !> Reserved for adapters that need to report temporary v1 exclusivity/busy state.
  integer, parameter, public :: solver_status_busy = 5

  !> Polling-friendly runtime summary exposed to adapters.
  !!
  !! All fields are copy-out values.  No pointer aliasing or ownership is shared
  !! with the underlying runtime state.
  type, public :: solver_progress_t
    integer :: iteration = 0            !< Completed step count.
    integer :: n_point = 0              !< Grid-point count (`n_cell + 1`).
    logical :: is_initialized = .false. !< True after `solver_session_initialize`.
    logical :: is_finished = .false.    !< True once `time_stop` has been reached.
    real(wp) :: sim_time = 0.0_wp       !< Current simulation time. [s]
    real(wp) :: time_stop = 0.0_wp      !< Configured final simulation time. [s]
    real(wp) :: dt = 0.0_wp             !< Most recent or configured time step. [s]
    real(wp) :: residual = 0.0_wp       !< Global residual scalar reported by the runtime.
  end type solver_progress_t

  !> Mutable solver session that owns one configuration and, optionally, one runtime.
  !!
  !! V1 keeps exactly one runtime context inside a session.  Any setter or new
  !! namelist load invalidates the active runtime so the next initialise call
  !! rebuilds state from a coherent configuration snapshot.
  type, public :: solver_session_t
    type(config_t) :: cfg                          !< Authoritative editable configuration.
    type(solver_run_context_t) :: ctx             !< Runtime context once initialised.
    logical :: has_runtime = .false.              !< True when `ctx` owns live allocations.
    character(len=512) :: last_error = ''         !< Last surfaced writable-operation error.
  end type solver_session_t

  public :: solver_session_create, solver_session_destroy
  public :: solver_session_load_namelist, solver_session_initialize
  public :: solver_session_advance, solver_session_run_to_end
  public :: solver_session_get_progress, solver_session_get_point_count
  public :: solver_session_copy_solution, solver_session_write_result
  public :: solver_session_write_checkpoint, solver_session_last_error
  public :: solver_session_get_integer, solver_session_get_real, solver_session_get_logical
  public :: solver_session_get_string, solver_session_get_real3
  public :: solver_session_set_integer, solver_session_set_real, solver_session_set_logical
  public :: solver_session_set_string, solver_session_set_real3

contains

  !> Reset a session to its default empty state.
  subroutine solver_session_create(session)
    type(solver_session_t), intent(out) :: session

    session = solver_session_t()
  end subroutine solver_session_create

  !> Tear down any live runtime allocations and clear the last error.
  subroutine solver_session_destroy(session)
    type(solver_session_t), intent(inout) :: session

    call reset_runtime(session)
    session % last_error = ''
  end subroutine solver_session_destroy

  !> Load configuration from a namelist file into the session.
  !!
  !! Any currently initialised runtime is discarded first so the session cannot
  !! retain stale arrays that disagree with the newly loaded configuration.
  subroutine solver_session_load_namelist(session, filename, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in) :: filename
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call reset_runtime(session)
    call read_config(filename, session % cfg, ok, err)
    if (.not. ok) then
      call finish(session, solver_status_config_error, err, status, message)
      return
    end if

    call finish(session, solver_status_ok, '', status, message)
  end subroutine solver_session_load_namelist

  !> Validate the current configuration and allocate the runtime context.
  subroutine solver_session_initialize(session, status, message)
    type(solver_session_t), intent(inout) :: session
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call reset_runtime(session)
    call validate_config(session % cfg, ok, err)
    if (.not. ok) then
      call finish(session, solver_status_config_error, err, status, message)
      return
    end if

    call initialize_runtime(session % ctx, session % cfg, 'session', ok, err)
    if (.not. ok) then
      call teardown_runtime(session % ctx)
      call finish(session, solver_status_io_error, err, status, message)
      return
    end if

    session % has_runtime = .true.
    call finish(session, solver_status_ok, '', status, message)
  end subroutine solver_session_initialize

  !> Advance the runtime by at most `max_steps` iterations.
  !!
  !! This is the canonical polling-first stepping API used by GUI-facing
  !! adapters.  Checkpoints and compatibility snapshot-file writes still occur
  !! inside the bounded loop so polling and CLI code paths stay numerically aligned.
  subroutine solver_session_advance(session, max_steps, steps_taken, finished, status, message)
    type(solver_session_t), intent(inout) :: session
    integer, intent(in) :: max_steps
    integer, intent(out) :: steps_taken
    logical, intent(out) :: finished
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message

    steps_taken = 0
    finished = .false.
    if (.not. session % has_runtime) then
      call finish(session, solver_status_invalid_state, 'solver_session: session is not initialised', status, message)
      return
    end if
    if (max_steps < 0) then
      call finish(session, solver_status_invalid_argument, 'solver_session: max_steps must be >= 0', status, message)
      return
    end if

    call run_solver_steps(session % ctx, max_steps, steps_taken, finished)
    call finish(session, solver_status_ok, '', status, message)
  end subroutine solver_session_advance

  !> Run the current session until `time_stop` is reached.
  subroutine solver_session_run_to_end(session, status, message)
    type(solver_session_t), intent(inout) :: session
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message

    if (.not. session % has_runtime) then
      call finish(session, solver_status_invalid_state, 'solver_session: session is not initialised', status, message)
      return
    end if

    call run_solver(session % ctx)
    call finish(session, solver_status_ok, '', status, message)
  end subroutine solver_session_run_to_end

  !> Copy out a lightweight progress snapshot for polling clients.
  subroutine solver_session_get_progress(session, progress, status, message)
    type(solver_session_t), intent(in) :: session
    type(solver_progress_t), intent(out) :: progress
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message

    progress = solver_progress_t()
    ! Even before initialisation, adapters can discover the expected grid size
    ! and configured time window to size buffers and present form defaults.
    progress % time_stop = session % cfg % time_stop
    progress % dt = session % cfg % dt
    progress % n_point = session % cfg % n_cell + 1
    progress % is_initialized = session % has_runtime

    if (session % has_runtime) then
      progress % iteration = session % ctx % iter
      progress % n_point = session % ctx % state % n_pt
      progress % sim_time = session % ctx % t
      progress % time_stop = session % ctx % state % cfg % time_stop
      progress % dt = session % ctx % state % dt
      progress % residual = session % ctx % state % resid_glob
      progress % is_finished = session % ctx % run_complete
    end if

    call finish_readonly(solver_status_ok, '', status, message)
  end subroutine solver_session_get_progress

  !> Return the current grid-point count expected by solution copy-out buffers.
  subroutine solver_session_get_point_count(session, n_point, status, message)
    type(solver_session_t), intent(in) :: session
    integer, intent(out) :: n_point
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message

    if (session % has_runtime) then
      n_point = session % ctx % state % n_pt
    else
      n_point = session % cfg % n_cell + 1
    end if

    call finish_readonly(solver_status_ok, '', status, message)
  end subroutine solver_session_get_point_count

  !> Copy the current primitive-variable solution into caller-owned arrays.
  !!
  !! All four arrays must be sized exactly to `solver_session_get_point_count`.
  !! The session never returns aliased storage across the API boundary.
  subroutine solver_session_copy_solution(session, x, rho, u, p, status, message)
    type(solver_session_t), intent(in) :: session
    real(wp), intent(out) :: x(:), rho(:), u(:), p(:)
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    integer :: n_point

    if (.not. session % has_runtime) then
      call finish_readonly(solver_status_invalid_state, 'solver_session: session is not initialised', status, message)
      return
    end if

    n_point = session % ctx % state % n_pt
    if (size(x) /= n_point .or. size(rho) /= n_point .or. size(u) /= n_point .or. size(p) /= n_point) then
      call finish_readonly(solver_status_invalid_argument, &
                           'solver_session: solution buffers must match the solver grid size', status, message)
      return
    end if

    call copy_current_solution(session % ctx, x, rho, u, p)
    call finish_readonly(solver_status_ok, '', status, message)
  end subroutine solver_session_copy_solution

  !> Write the current solution in the standard `result.dat`-style text format.
  !!
  !! Completed runs also flush the opt-in performance summary here so the
  !! session-based CLI, Python bindings, and C ABI preserve the same timing
  !! behaviour as the legacy direct runtime driver.
  subroutine solver_session_write_result(session, filename, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in), optional :: filename
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err
    character(len=512) :: output_path

    if (.not. session % has_runtime) then
      call finish(session, solver_status_invalid_state, 'solver_session: session is not initialised', status, message)
      return
    end if

    output_path = trim(session % ctx % state % cfg % output_file)
    if (present(filename)) then
      if (len_trim(filename) > 0) output_path = trim(filename)
    end if

    call write_solution_file(session % ctx, trim(output_path), ok, err)
    if (.not. ok) then
      call finish(session, solver_status_io_error, err, status, message)
      return
    end if

    call report_performance_summary(session % ctx)

    call finish(session, solver_status_ok, '', status, message)
  end subroutine solver_session_write_result

  !> Force an immediate checkpoint write using the configured or overridden base name.
  subroutine solver_session_write_checkpoint(session, base, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in), optional :: base
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err
    character(len=512) :: checkpoint_base

    if (.not. session % has_runtime) then
      call finish(session, solver_status_invalid_state, 'solver_session: session is not initialised', status, message)
      return
    end if

    checkpoint_base = trim(session % ctx % state % cfg % checkpoint_file)
    if (present(base)) then
      if (len_trim(base) > 0) checkpoint_base = trim(base)
    end if

    call write_checkpoint(session % ctx % state, trim(checkpoint_base), session % ctx % t, session % ctx % iter, ok, err)
    if (.not. ok) then
      call finish(session, solver_status_io_error, err, status, message)
      return
    end if

    call finish(session, solver_status_ok, '', status, message)
  end subroutine solver_session_write_checkpoint

  !> Copy the last stored writable-operation error message.
  subroutine solver_session_last_error(session, message)
    type(solver_session_t), intent(in) :: session
    character(len=*), intent(out) :: message

    message = trim(session % last_error)
  end subroutine solver_session_last_error

  !> Read an integer configuration field by canonical schema key.
  subroutine solver_session_get_integer(session, key, value, status, message)
    type(solver_session_t), intent(in) :: session
    character(len=*), intent(in) :: key
    integer, intent(out) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call config_get_integer(session % cfg, key, value, ok, err)
    call finish_readonly(merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_get_integer

  !> Read a scalar real configuration field by canonical schema key.
  subroutine solver_session_get_real(session, key, value, status, message)
    type(solver_session_t), intent(in) :: session
    character(len=*), intent(in) :: key
    real(wp), intent(out) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call config_get_real(session % cfg, key, value, ok, err)
    call finish_readonly(merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_get_real

  !> Read a logical configuration field by canonical schema key.
  subroutine solver_session_get_logical(session, key, value, status, message)
    type(solver_session_t), intent(in) :: session
    character(len=*), intent(in) :: key
    logical, intent(out) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call config_get_logical(session % cfg, key, value, ok, err)
    call finish_readonly(merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_get_logical

  !> Read a string or choice-token configuration field by canonical schema key.
  subroutine solver_session_get_string(session, key, value, status, message)
    type(solver_session_t), intent(in) :: session
    character(len=*), intent(in) :: key
    character(len=*), intent(out) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call config_get_string(session % cfg, key, value, ok, err)
    call finish_readonly(merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_get_string

  !> Read a real-3 configuration field by canonical schema key.
  subroutine solver_session_get_real3(session, key, value, status, message)
    type(solver_session_t), intent(in) :: session
    character(len=*), intent(in) :: key
    real(wp), intent(out) :: value(3)
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    logical :: ok
    character(len=256) :: err

    call config_get_real3(session % cfg, key, value, ok, err)
    call finish_readonly(merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_get_real3

  !> Set an integer configuration field and invalidate any live runtime.
  subroutine solver_session_set_integer(session, key, value, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in) :: key
    integer, intent(in) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    type(config_t) :: next_cfg
    logical :: ok
    character(len=256) :: err

    next_cfg = session % cfg
    call config_set_integer(next_cfg, key, value, ok, err)
    if (ok) then
      call reset_runtime(session)
      session % cfg = next_cfg
    end if
    call finish(session, merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_set_integer

  !> Set a scalar real configuration field and invalidate any live runtime.
  subroutine solver_session_set_real(session, key, value, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in) :: key
    real(wp), intent(in) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    type(config_t) :: next_cfg
    logical :: ok
    character(len=256) :: err

    next_cfg = session % cfg
    call config_set_real(next_cfg, key, value, ok, err)
    if (ok) then
      call reset_runtime(session)
      session % cfg = next_cfg
    end if
    call finish(session, merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_set_real

  !> Set a logical configuration field and invalidate any live runtime.
  subroutine solver_session_set_logical(session, key, value, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in) :: key
    logical, intent(in) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    type(config_t) :: next_cfg
    logical :: ok
    character(len=256) :: err

    next_cfg = session % cfg
    call config_set_logical(next_cfg, key, value, ok, err)
    if (ok) then
      call reset_runtime(session)
      session % cfg = next_cfg
    end if
    call finish(session, merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_set_logical

  !> Set a string or choice-token configuration field and invalidate any runtime.
  subroutine solver_session_set_string(session, key, value, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in) :: key
    character(len=*), intent(in) :: value
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    type(config_t) :: next_cfg
    logical :: ok
    character(len=256) :: err

    next_cfg = session % cfg
    call config_set_string(next_cfg, key, value, ok, err)
    if (ok) then
      call reset_runtime(session)
      session % cfg = next_cfg
    end if
    call finish(session, merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_set_string

  !> Set a real-3 configuration field and invalidate any live runtime.
  subroutine solver_session_set_real3(session, key, value, status, message)
    type(solver_session_t), intent(inout) :: session
    character(len=*), intent(in) :: key
    real(wp), intent(in) :: value(3)
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message
    type(config_t) :: next_cfg
    logical :: ok
    character(len=256) :: err

    next_cfg = session % cfg
    call config_set_real3(next_cfg, key, value, ok, err)
    if (ok) then
      call reset_runtime(session)
      session % cfg = next_cfg
    end if
    call finish(session, merge(solver_status_ok, solver_status_invalid_argument, ok), trim(err), status, message)
  end subroutine solver_session_set_real3

  !> Tear down the live runtime context while keeping editable config state.
  !!
  !! This is called before every mutating config change so the next initialise
  !! pass cannot accidentally reuse arrays, timers, or procedure pointers from
  !! an incompatible earlier run.
  subroutine reset_runtime(session)
    type(solver_session_t), intent(inout) :: session

    if (session % has_runtime) then
      call teardown_runtime(session % ctx)
      session % ctx = solver_run_context_t()
      session % has_runtime = .false.
    end if
  end subroutine reset_runtime

  !> Store the last writable-operation error and mirror it to optional outputs.
  subroutine finish(session, status_code, err, status, message)
    type(solver_session_t), intent(inout) :: session
    integer, intent(in) :: status_code
    character(len=*), intent(in) :: err
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message

    session % last_error = trim(err)
    if (present(status)) status = status_code
    if (present(message)) message = trim(err)
  end subroutine finish

  !> Mirror readonly-operation status without mutating the session state.
  subroutine finish_readonly(status_code, err, status, message)
    integer, intent(in) :: status_code
    character(len=*), intent(in) :: err
    integer, intent(out), optional :: status
    character(len=*), intent(out), optional :: message

    if (present(status)) status = status_code
    if (present(message)) message = trim(err)
  end subroutine finish_readonly

end module solver_session