!> @file solver_runtime_2d.f90
!> @brief Polling-friendly 2D solver runtime (Full 2D Parity phase P1).
!!
!! Mirrors `solver_runtime` (1D) for the coexisting `euler_2d` solver: a run
!! context bundling state + time/iteration bookkeeping, a bounded advance-N
!! step loop extracted 1:1 from `run_euler_2d`'s original time loop, a global
!! L2 residual reduction (`resid_glob`, the 2D analogue of the 1D
!! `state % resid_glob`), and a result-write wrapper. `euler_driver_2d` and
!! (phase P2) the dim-aware `solver_session` both drive this runtime, so the
!! CLI and the attached IPC worker observe the SAME numerical run.
!!
!! Bit-for-bit contract: `init_run_context_2d` + `run_solver_steps_2d` +
!! `write_solution_file_2d` reproduce the pre-P1 `run_euler_2d` behaviour —
!! same setup order, same log lines, same checkpoint/print cadence. Time
!! accumulation is Kahan-compensated since Q2b (authorized behavior change,
!! spec `2026-07-10-q2-2d-machinery-alignment-design.md` §6), matching the
!! 1D runtime. The only other additions are the per-step residual
!! reduction (pure observation, no state change) and the polling boundary.
!! There are deliberately NO snapshot files here (spec 2026-07-03 §2.3).
module solver_runtime_2d
  use, intrinsic :: iso_fortran_env, only: int64
  use run_step_engine, only: run_loop_ctx_t, run_bounded_steps
  use precision, only: wp
  use config_2d, only: config_2d_t
  use solver_state_2d, only: solver_state_2d_t, neq2d, &
                             init_from_config_2d, allocate_work_arrays_2d
  use schemes_2d, only: init_recon_scheme_2d
  use mesh_2d, only: build_mesh_2d_local
  use mpi_cart_2d, only: setup_decomp_2d
  use mpi_runtime, only: parallel_fatal
  use domain_decomposition_2d, only: is_decomp_2d_feasible
  use time_integration_2d, only: resolve_time_scheme_2d, compute_dt_2d, stepper_2d_iface
  use initial_conditions_2d, only: apply_initial_condition_2d
  use solution_gather_2d, only: gather_and_write_2d
  use checkpoint_2d, only: write_checkpoint_2d, read_checkpoint_2d
  use parallel_reductions, only: par_sum_real, par_lor
  use logger, only: log_init, log_finalize, log_info
  use run_banner, only: log_run_banner
  implicit none
  private

  public :: solver_run_context_2d_t
  public :: init_run_context_2d, run_solver_steps_2d
  public :: write_solution_file_2d, global_point_count_2d
  public :: teardown_run_context_2d

  !> Aggregate context for one 2D solver run (2D analogue of
  !! `solver_run_context_t`). Populated by `init_run_context_2d`; callers set
  !! `nml_file` BEFORE init (it feeds the `config: loaded` log line).
  !! `t`, `t_comp`, `iter`, and `run_complete` are inherited from
  !! `run_loop_ctx_t` (Q2c) under their historical names.
  type, extends(run_loop_ctx_t) :: solver_run_context_2d_t
    type(solver_state_2d_t) :: state         !< Solution arrays + scheme handles.
    !> Global L2 residual norm of the last-substage residual, reduced across
    !! ranks each step (2D analogue of the 1D `state % resid_glob`; exposed
    !! through the P2 session as the ADVANCE/GET_PROGRESS `residual` field).
    real(wp) :: resid_glob = 0.0_wp
    character(len=512) :: nml_file = 'input.nml' !< Namelist path (for logging).
    procedure(stepper_2d_iface), pointer, nopass :: stepper => null() !< Bound integrator.
  contains
    procedure :: raw_dt => ctx2d_raw_dt
    procedure :: set_dt => ctx2d_set_dt
    procedure :: step => ctx2d_step
    procedure :: write_checkpoint_now => ctx2d_checkpoint
    procedure :: log_iteration_line => ctx2d_log_line
    procedure :: observe => ctx2d_observe
  end type solver_run_context_2d_t

contains

  !> Bring a 2D run context to ready-to-step state.
  !!
  !! This is the setup block of the pre-P1 `run_euler_2d`, moved verbatim
  !! (same call order, same log lines): logger + banner + config-loaded line,
  !! state init, scheme binding, decomposition, local mesh, case/schemes log
  !! lines, work arrays, restart-or-IC, time-scheme binding.
  !!
  !! @param ctx      Context to initialise (`ctx % nml_file` read for logging).
  !! @param cfg      Validated 2D configuration.
  !! @param status   0 on success, 1 on failure (logger already finalised).
  !! @param message  Human-readable error when status /= 0.
  subroutine init_run_context_2d(ctx, cfg, status, message)
    type(solver_run_context_2d_t), intent(inout) :: ctx
    type(config_2d_t), intent(in) :: cfg
    integer, intent(out) :: status
    character(len=*), intent(out) :: message

    logical :: ok
    character(len=512) :: line

    status = 1
    message = ''

    call log_init(cfg % verbosity, cfg % log_file)
    call log_run_banner('euler_2d')
    call log_info('config: loaded "'//trim(ctx % nml_file)//'"')

    call init_from_config_2d(ctx % state, cfg)
    call init_recon_scheme_2d(ctx % state)
    call setup_decomp_2d(ctx % state)
    ! Over-fine MPI process grid: at least one rank's local tile is smaller than
    ! the scheme's halo. Report it as a clean, collective status error (every
    ! rank agrees via par_lor) instead of a per-rank `error stop`, so the
    ! attached/session (Cortex) path replies to the GUI with an actionable
    ! message and keeps the worker alive, and the CLI prints it. Mirrors the
    ! collective-agreement pattern of the 1D gather guard.
    if (par_lor(.not. is_decomp_2d_feasible(ctx % state % decomp_2d))) then
      write (line, '(a,i0,a,i0,a,i0,a,i0,a,i0,a)') &
        'euler_2d: grid ', ctx % state % decomp_2d % nx_global, 'x', &
        ctx % state % decomp_2d % ny_global, &
        ' is too small to decompose across a ', ctx % state % decomp_2d % dim_x, &
        'x', ctx % state % decomp_2d % dim_y, &
        ' MPI process grid at halo width ', ctx % state % decomp_2d % halo_width, &
        '; use fewer MPI ranks or a larger grid'
      message = trim(line)
      call log_finalize()
      return
    end if
    block
      logical :: mok
      character(len=256) :: mmsg
      call build_mesh_2d_local(ctx % state % mesh, ctx % state % decomp_2d % ix_first_global, &
                               ctx % state % decomp_2d % iy_first_global, &
                               ctx % state % decomp_2d % nx_local, ctx % state % decomp_2d % ny_local, &
                               mok, mmsg)
      if (.not. mok) then
        message = 'euler_2d: '//trim(mmsg)
        call log_finalize()
        return
      end if
    end block
    write (line, '(a,i0,a,i0,a,i0,a,i0,a)') 'case: '//trim(cfg % problem_type)//' grid ', &
      ctx % state % decomp_2d % nx_global, 'x', ctx % state % decomp_2d % ny_global, &
      ' on ', ctx % state % decomp_2d % dim_x, 'x', ctx % state % decomp_2d % dim_y, ' ranks'
    call log_info(trim(line))
    write (line, '(a)') 'schemes: flux='//trim(cfg % flux_scheme)//' recon='//trim(cfg % recon_scheme)// &
      ' time='//trim(cfg % time_scheme)//' | BC L/R/B/T='//trim(cfg % bc_left)//'/'// &
      trim(cfg % bc_right)//'/'//trim(cfg % bc_bottom)//'/'//trim(cfg % bc_top)
    call log_info(trim(line))
    call allocate_work_arrays_2d(ctx % state)
    ctx % t_comp = 0.0_wp ! fresh compensation; persisted since v6 (Q2d) — overwritten below on restart
    if (len_trim(cfg % restart_file) > 0) then
      ! t_comp is persisted since v6 (Q2d); a restarted run resumes with the true compensation.
      call read_checkpoint_2d(ctx % state, trim(cfg % restart_file), ctx % t, ctx % iter, ok, message, &
                              t_comp=ctx % t_comp)
      if (.not. ok) then
        call log_finalize()
        return
      end if
      call log_info('restart: resumed from "'//trim(cfg % restart_file)//'"')
    else
      call apply_initial_condition_2d(ctx % state, cfg)
      ctx % t = cfg % time_start
      ctx % iter = 0
    end if
    call resolve_time_scheme_2d(ctx % stepper, cfg % time_scheme)

    ctx % run_complete = .false.
    ctx % resid_glob = 0.0_wp
    status = 0
    message = ''
  end subroutine init_run_context_2d

  !> Advance the 2D time loop by at most `max_steps` iterations.
  !!
  !! The loop skeleton itself lives in `run_step_engine` (Q2c); everything
  !! 2D arrives there through the `ctx2d_*` type-bound hooks below: identical
  !! dt logic (adaptive via compute_dt_2d, clipped at time_stop),
  !! Kahan-compensated time accumulation (Q2b, matching the 1D loop's F2
  !! block), identical checkpoint and print cadence. After every step the
  !! global L2 residual norm is reduced into `ctx % resid_glob` (collective;
  !! observation only — no state change, so the CLI output is bit-for-bit
  !! unchanged). The final "odd" iteration log line (when iter is not a
  !! multiple of print_freq) fires exactly once, when the run first
  !! completes — the same output position as before.
  !! Ordering note: within one iteration the shared engine logs the print-
  !! cadence line BEFORE writing the checkpoint (spec §7 micro-deviation #1),
  !! the reverse of this module's pre-Q2c order; both share the same
  !! `ctx % iter` value, so this is observable only on the (rare) failure
  !! path where a checkpoint write goes fatal after the line has printed.
  subroutine run_solver_steps_2d(ctx, max_steps, steps_taken, finished, status, message)
    type(solver_run_context_2d_t), intent(inout) :: ctx
    integer, intent(in) :: max_steps
    integer, intent(out) :: steps_taken
    logical, intent(out) :: finished
    integer, intent(out) :: status
    character(len=*), intent(out) :: message

    status = 0
    message = ''
    steps_taken = 0

    if (ctx % run_complete) then
      finished = .true.
      return
    end if
    if (.not. associated(ctx % stepper)) then
      finished = .true.
      status = 1
      message = 'solver_runtime_2d: time integrator not initialised'
      return
    end if

    call run_bounded_steps(ctx, max_steps, steps_taken, finished, &
                           ctx % state % cfg % time_stop, ctx % state % cfg % max_iter, &
                           ctx % state % cfg % checkpoint_freq, ctx % state % cfg % print_freq, &
                           snapshot_freq=0, max_iter_top_check=.true.)
  end subroutine run_solver_steps_2d

  !> 2D `raw_dt` hook: recompute and store `state % dt` from the adaptive
  !! CFL condition, then return it (Q2c; body lifted verbatim from the
  !! pre-engine `run_solver_steps_2d` loop).
  function ctx2d_raw_dt(ctx) result(dt)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    real(wp) :: dt
    ctx % state % dt = compute_dt_2d(ctx % state)
    dt = ctx % state % dt
  end function ctx2d_raw_dt

  !> 2D `set_dt` hook: store the engine's time_stop-clipped dt.
  subroutine ctx2d_set_dt(ctx, dt)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    real(wp), intent(in) :: dt
    ctx % state % dt = dt
  end subroutine ctx2d_set_dt

  !> 2D `step` hook: advance one step via the bound integrator.
  subroutine ctx2d_step(ctx)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    call ctx % stepper(ctx % state)
  end subroutine ctx2d_step

  !> 2D `write_checkpoint_now` hook: write the checkpoint and own the
  !! failure policy.
  subroutine ctx2d_checkpoint(ctx)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    logical :: cok
    character(len=256) :: cmsg
    ! par_lor inside write_checkpoint_2d makes cok/cmsg identical on
    ! every rank, so all ranks agree on the failure and the fatal is
    ! deterministic. (parallel_fatal is MPI_Abort-based and safe to
    ! reach from any subset of ranks; the agreement just keeps the
    ! decision and message consistent.) Q2b: aligned to the 1D
    ! loop's hard policy - a silently skipped checkpoint is data loss.
    call write_checkpoint_2d(ctx % state, trim(ctx % state % cfg % checkpoint_file), &
                             ctx % t, ctx % iter, cok, cmsg, t_comp=ctx % t_comp)
    if (.not. cok) call parallel_fatal('checkpoint: '//trim(cmsg))
  end subroutine ctx2d_checkpoint

  !> 2D `log_iteration_line` hook: one iteration summary line.
  subroutine ctx2d_log_line(ctx)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    character(len=512) :: line
    write (line, '(a,i0,a,es12.5,a,es12.5)') 'iter=', ctx % iter, ' t=', ctx % t, &
      ' dt=', ctx % state % dt
    call log_info(trim(line))
  end subroutine ctx2d_log_line

  !> 2D `observe` hook: reduce the global L2 residual norm (collective,
  !! observation only — no state change).
  subroutine ctx2d_observe(ctx)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    call compute_resid_glob_2d(ctx)
  end subroutine ctx2d_observe

  !> Reduce the global L2 norm of the last-substage residual into
  !! `ctx % resid_glob` (2D analogue of the 1D `compute_resid_glob`):
  !!   resid_glob = sqrt( par_sum(sum resid^2) / (nx_g*ny_g * neq2d) )
  !! The denominator uses GLOBAL counts so the norm is decomposition-
  !! independent (np=1 == np=2 up to summation reordering, ~1e-13).
  !! Collective: every rank must call.
  !! Dummy widened `type` -> `class` (Q2c): called from the `ctx2d_observe`
  !! hook, whose own dummy is `class(solver_run_context_2d_t)` per the
  !! abstract `run_loop_ctx_t` interface, so the actual argument here is
  !! polymorphic and the callee must accept it as such.
  subroutine compute_resid_glob_2d(ctx)
    class(solver_run_context_2d_t), intent(inout) :: ctx
    real(wp) :: local_sumsq, global_sumsq
    integer :: i, j, k
    integer(int64) :: n_glob

    local_sumsq = 0.0_wp
    do j = 1, ctx % state % ny_local
      do i = 1, ctx % state % nx_local
        do k = 1, neq2d
          local_sumsq = local_sumsq + ctx % state % resid(k, i, j)**2
        end do
      end do
    end do
    global_sumsq = par_sum_real(local_sumsq)
    n_glob = int(ctx % state % decomp_2d % nx_global, int64) * &
             int(ctx % state % decomp_2d % ny_global, int64)
    ctx % resid_glob = sqrt(global_sumsq / (real(n_glob, wp) * real(neq2d, wp)))
  end subroutine compute_resid_glob_2d

  !> Gather to root and write the standard 6-column `x y rho u v p` result
  !! (plus any tec/plt/vtk formats the config requests). Collective.
  subroutine write_solution_file_2d(ctx, filename, is_ok, message)
    type(solver_run_context_2d_t), intent(inout) :: ctx
    character(len=*), intent(in) :: filename
    logical, intent(out) :: is_ok
    character(len=*), intent(out) :: message

    call gather_and_write_2d(ctx % state, filename, is_ok, message)
  end subroutine write_solution_file_2d

  !> Release runtime handles and finalise the logger. The state's allocatable
  !! arrays are released by intrinsic assignment when the owner resets the
  !! context (`ctx = solver_run_context_2d_t()`), mirroring the 1D session.
  subroutine teardown_run_context_2d(ctx)
    type(solver_run_context_2d_t), intent(inout) :: ctx
    call log_finalize()
    ctx % stepper => null()
    ctx % run_complete = .false.
  end subroutine teardown_run_context_2d

  !> Whole-domain point count (FVM cells / FDM nodes), identical on all ranks.
  pure function global_point_count_2d(ctx) result(n)
    type(solver_run_context_2d_t), intent(in) :: ctx
    integer :: n
    n = ctx % state % decomp_2d % nx_global * ctx % state % decomp_2d % ny_global
  end function global_point_count_2d

end module solver_runtime_2d
