!> @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