!> @file run_step_engine.f90 !> @brief Dimension-blind bounded-step run loop (Q2c, spec §7). !! !! Owns the loop skeleton both solver runtimes share: max_steps/time_stop/ !! max_iter exits, the time_stop dt clip, Kahan-compensated time accumulation !! (F2/Q2b grouping — load-bearing, do not re-associate), iteration counters, !! checkpoint/print/snapshot cadences, the final "odd" log line, the !! run_complete latch, and the optional wall-clock progress tick. Everything !! dimension-specific arrives through `run_loop_ctx_t` type-bound hooks. !! !! Ordering contract (byte-for-bit load-bearing): begin_work -> raw_dt -> !! clip/set_dt -> step -> Kahan -> counters -> observe -> log(print cadence) !! -> checkpoint -> snapshot -> [bottom max_iter exit] -> tick. The !! `max_iter_top_check` flag preserves the dims' historical exit positions !! (2D checks before stepping, 1D after the side effects, before the tick). module run_step_engine use, intrinsic :: iso_fortran_env, only: int64 use precision, only: wp implicit none private public :: run_loop_ctx_t, run_bounded_steps, progress_callback_i, tick_seconds !> Shared run bookkeeping + per-dim hooks. Extended by !! `solver_run_context_t` (1D) and `solver_run_context_2d_t` (2D); the !! concrete fields keep their historical names so `ctx % t`-style access !! throughout the codebase is unchanged. type, abstract :: run_loop_ctx_t real(wp) :: t = 0.0_wp !< Current simulation time. [s] real(wp) :: t_comp = 0.0_wp !< Kahan compensation for `t` (F2/Q2b). integer :: iter = 0 !< Completed iteration count. logical :: run_complete = .false. !< Latched once time_stop/max_iter reached. contains procedure(hook_dt_i), deferred :: raw_dt !< Compute+store this step's dt; return it. procedure(hook_set_dt_i), deferred :: set_dt !< Store the clipped dt. procedure(hook_void_i), deferred :: step !< Advance one step (1D wraps its iter timer here). procedure(hook_void_i), deferred :: write_checkpoint_now !< Write + own failure policy/message. procedure(hook_void_i), deferred :: log_iteration_line !< One iteration log line, dim's own format. procedure :: begin_work => hook_noop !< 1D: lazy total-timer start. procedure :: observe => hook_noop !< 2D: resid_glob reduction. procedure :: write_snapshot_now => hook_noop !< 1D only. procedure :: finish_work => hook_noop !< 1D: total-timer stop. !> 1D: state residual norm for ticks. Must be observationally read-only !! (it is referenced inside the on_progress argument list). procedure :: progress_residual => hook_zero end type run_loop_ctx_t abstract interface function hook_dt_i(ctx) result(dt) import :: run_loop_ctx_t, wp class(run_loop_ctx_t), intent(inout) :: ctx real(wp) :: dt end function hook_dt_i subroutine hook_set_dt_i(ctx, dt) import :: run_loop_ctx_t, wp class(run_loop_ctx_t), intent(inout) :: ctx real(wp), intent(in) :: dt end subroutine hook_set_dt_i subroutine hook_void_i(ctx) import :: run_loop_ctx_t class(run_loop_ctx_t), intent(inout) :: ctx end subroutine hook_void_i !> Cooperative progress-tick callback signature (moved verbatim from !! `solver_runtime`; re-exported there so existing consumers are !! unaffected). !! !! Bound by adapters that want lightweight per-iteration progress updates !! from inside the bounded step loop. Called every `every_steps` iterations !! or every `every_seconds` wall-clock seconds, whichever comes first. !! Behaviour is purely advisory: returning has no effect on the solver !! beyond the callback's own side effects. subroutine progress_callback_i(iter, sim_time, dt, residual, wallclock_s) import :: wp integer, intent(in) :: iter real(wp), intent(in) :: sim_time, dt, residual, wallclock_s end subroutine progress_callback_i end interface contains !> Default no-op hook body for the overridable bindings. subroutine hook_noop(ctx) class(run_loop_ctx_t), intent(inout) :: ctx associate (unused => ctx % iter); end associate ! intent kept; no work end subroutine hook_noop !> Default zero-residual hook body for `progress_residual`. function hook_zero(ctx) result(r) class(run_loop_ctx_t), intent(inout) :: ctx real(wp) :: r associate (unused => ctx % iter); end associate r = 0.0_wp end function hook_zero ! --------------------------------------------------------------------------- !> Convert a system_clock delta to seconds. !! !! Returns 0.0 when the rate is <= 0 (no real-time clock available or the !! clock wrapped to a non-positive rate). Avoids a division-by-zero FPE on !! platforms where system_clock does not provide a monotonic tick rate. !! !! @param[in] delta Clock-count difference (may be negative on wrap-around). !! @param[in] rate Ticks per second from system_clock count_rate. !! @result s Elapsed seconds, or 0.0 when rate <= 0. ! --------------------------------------------------------------------------- pure function tick_seconds(delta, rate) result(s) integer(int64), intent(in) :: delta integer(int64), intent(in) :: rate real(wp) :: s if (rate <= 0_int64) then s = 0.0_wp else s = real(delta, wp) / real(rate, wp) end if end function tick_seconds !> Advance ctx by at most max_steps iterations (see module header for the !! ordering contract). All cadence/exit arithmetic that was duplicated !! between the per-dim loops lives here and only here. !! Hooks must not mutate the cfg fields passed as cadence arguments !! (time_stop, max_iter, checkpoint_freq/print_freq/snapshot_freq are !! snapshotted at call time and alias the ctx). subroutine run_bounded_steps(ctx, max_steps, steps_taken, finished, & time_stop, max_iter, checkpoint_freq, print_freq, & snapshot_freq, max_iter_top_check, & on_progress, every_steps, every_seconds) class(run_loop_ctx_t), intent(inout) :: ctx integer, intent(in) :: max_steps integer, intent(out) :: steps_taken logical, intent(out) :: finished real(wp), intent(in) :: time_stop integer, intent(in) :: max_iter, checkpoint_freq, print_freq, snapshot_freq logical, intent(in) :: max_iter_top_check procedure(progress_callback_i), optional :: on_progress integer, intent(in), optional :: every_steps real(wp), intent(in), optional :: every_seconds real(wp) :: dt integer :: tick_every_steps real(wp) :: tick_every_seconds integer(int64) :: tick_count_rate, last_tick_count, now_count, t_start_count integer :: last_tick_iter real(wp) :: seconds_elapsed, wallclock_s steps_taken = 0 tick_every_steps = 100 if (present(every_steps)) tick_every_steps = every_steps tick_every_seconds = 1.0_wp if (present(every_seconds)) tick_every_seconds = every_seconds call system_clock(t_start_count, tick_count_rate) last_tick_count = t_start_count last_tick_iter = ctx % iter do while (steps_taken < max_steps .and. ctx % t < time_stop) if (max_iter_top_check .and. max_iter > 0 .and. ctx % iter >= max_iter) exit call ctx % begin_work() dt = ctx % raw_dt() if (ctx % t + dt > time_stop) then dt = time_stop - ctx % t call ctx % set_dt(dt) end if call ctx % step() ! Kahan-compensated time accumulation (F2/Q2b grouping — verbatim). block real(wp) :: y, t_new y = dt - ctx % t_comp t_new = ctx % t + y ctx % t_comp = (t_new - ctx % t) - y ctx % t = t_new end block ctx % iter = ctx % iter + 1 steps_taken = steps_taken + 1 call ctx % observe() if (print_freq > 0) then if (mod(ctx % iter, print_freq) == 0) call ctx % log_iteration_line() end if ! Keep compatibility side effects inside the bounded-step path so the CLI, ! desktop worker, and future service adapters all observe the same run. if (checkpoint_freq > 0) then if (mod(ctx % iter, checkpoint_freq) == 0) call ctx % write_checkpoint_now() end if if (snapshot_freq > 0) then if (mod(ctx % iter, snapshot_freq) == 0) call ctx % write_snapshot_now() end if ! Optional iteration cap: when max_iter > 0, exit as soon as the iteration ! counter reaches it, overriding the `time_stop` condition. Used by the ! Python MPI equivalence tests to capture state at fixed iteration counts. if (.not. max_iter_top_check .and. max_iter > 0 .and. ctx % iter >= max_iter) exit ! Cooperative progress tick: fires only when a callback is bound, so the ! headless path is byte-identical to runs without the callback. if (present(on_progress)) then call system_clock(now_count) seconds_elapsed = tick_seconds(now_count - last_tick_count, tick_count_rate) if (ctx % iter - last_tick_iter >= tick_every_steps .or. & seconds_elapsed >= tick_every_seconds) then wallclock_s = tick_seconds(now_count - t_start_count, tick_count_rate) call on_progress(ctx % iter, ctx % t, dt, ctx % progress_residual(), wallclock_s) last_tick_iter = ctx % iter last_tick_count = now_count end if end if end do finished = ctx % t >= time_stop .or. (max_iter > 0 .and. ctx % iter >= max_iter) if (finished .and. .not. ctx % run_complete) then if (ctx % iter > 0 .and. print_freq > 0) then if (mod(ctx % iter, print_freq) /= 0) call ctx % log_iteration_line() end if call ctx % finish_work() ctx % run_complete = .true. end if end subroutine run_bounded_steps end module run_step_engine