!> Solver execution lifecycle and I/O orchestration. !! !! This module centralises the solver lifecycle behind the thin !! `app/euler_1d.f90` program: CLI parsing, config loading, solver-state !! initialisation, adaptive-dt time loop, checkpoint/restart, live snapshots, !! iteration logging, and performance reporting. !! !! Typical call sequence: !! ```fortran !! call resolve_cli_namelist(ctx % nml_file) !! call read_config(ctx % nml_file, cfg) !! call initialize_runtime(ctx, cfg, ctx % nml_file) !! call run_solver(ctx) !! call finalize_runtime(ctx) !! call teardown_runtime(ctx) !! ``` module solver_runtime use precision, only: wp use config, only: config_t use option_registry, only: problem_sod, problem_lax, problem_woodward_colella, & problem_shu_osher, problem_acoustic_pulse, & problem_from_file, problem_udf use solver_state, only: solver_state_t, allocate_work_arrays, release_work_arrays, & init_from_config use euler_physics, only: init_flux_scheme, compute_max_wave_speed use reconstruction, only: init_recon_scheme use time_integration, only: stepper_iface, resolve_time_scheme use initial_conditions, only: apply_initial_condition use timer, only: timer_t, timer_start, timer_stop, timer_elapsed_s, & timer_elapsed_running_s, timer_reset, timer_report use checkpoint, only: write_checkpoint, read_checkpoint use logger, only: log_init, log_finalize, log_info, log_warn implicit none private public :: solver_run_context_t, resolve_cli_namelist public :: initialize_runtime, run_solver, run_solver_steps public :: finalize_runtime, report_performance_summary, teardown_runtime, copy_current_solution public :: write_solution_file !> Aggregate context bundling all state needed for a single solver run. !! !! One instance is owned by the driver and passed by reference through the !! entire lifecycle. Fields are populated in order by `resolve_cli_namelist`, !! `read_config`, and `initialize_runtime`. !! The authoritative runtime configuration is `state % cfg`; all config reads !! go through that field after `initialize_runtime` returns. type, public :: solver_run_context_t type(solver_state_t) :: state !< Solution arrays and scheme handles. type(timer_t) :: t_total !< Wall-clock timer for the entire run. type(timer_t) :: t_io !< Wall-clock timer for output I/O. type(timer_t) :: t_iter !< Wall-clock timer for a single step. integer :: iter = 0 !< Current iteration counter. integer :: print_freq = 50 !< Iteration interval between log lines. real(wp) :: t = 0.0_wp !< Current simulation time. [s] real(wp) :: t_comp = 0.0_wp !< Kahan compensation term for time updates. character(len=512) :: nml_file = 'input.nml' !< Path to the namelist file. procedure(stepper_iface), pointer, nopass :: stepper => null() !< Bound time integrator. logical :: timers_started = .false. !< True after starting the total timer. logical :: run_complete = .false. !< True after reaching `time_stop`. logical :: performance_reported = .false. !< True after printing timings. end type solver_run_context_t contains !> Read the namelist filename from the first command-line argument. !! Falls back to `'input.nml'` when no argument is supplied. !! @param nml_file On return: path to the namelist file. subroutine resolve_cli_namelist(nml_file) character(len=*), intent(out) :: nml_file integer :: arg_len, arg_stat call get_command_argument(1, nml_file, arg_len, arg_stat) if (arg_stat /= 0 .or. arg_len == 0) nml_file = 'input.nml' end subroutine resolve_cli_namelist !> Populate `ctx` and bring the solver to a ready-to-run state. !! !! Steps performed in order: copy config into context; initialise logger; !! allocate solver state from config; allocate work arrays; bind flux, recon, !! and time-integration scheme pointers; apply initial conditions; optionally !! load a restart checkpoint; log the effective configuration. !! !! @param ctx Context to initialise. !! @param cfg Configuration loaded via `read_config`. !! @param nml_file Optional namelist path stored in `ctx % nml_file`. subroutine initialize_runtime(ctx, cfg, nml_file, is_ok, message) type(solver_run_context_t), intent(inout) :: ctx type(config_t), intent(in) :: cfg character(len=*), intent(in), optional :: nml_file logical, intent(out), optional :: is_ok character(len=*), intent(out), optional :: message logical :: ok character(len=256) :: err if (present(is_ok)) is_ok = .true. if (present(message)) message = '' if (present(nml_file)) ctx % nml_file = nml_file call log_init(cfg % verbosity, cfg % log_file) call log_info('config: loaded "'//trim(ctx % nml_file)//'"') call init_from_config(ctx % state, cfg) call allocate_work_arrays(ctx % state) call init_flux_scheme(ctx % state, ctx % state % cfg % flux_scheme) call init_recon_scheme(ctx % state, ctx % state % cfg % recon_scheme, & ctx % state % cfg % char_proj, ctx % state % cfg % limiter) call resolve_time_scheme(ctx % stepper, ctx % state % cfg % time_scheme) call apply_initial_condition(ctx % state, ctx % state % cfg) ctx % print_freq = ctx % state % cfg % print_freq ctx % t = ctx % state % cfg % time_start ctx % t_comp = 0.0_wp ctx % iter = 0 call timer_reset(ctx % t_total) call timer_reset(ctx % t_io) call timer_reset(ctx % t_iter) ctx % timers_started = .false. ctx % run_complete = .false. ctx % performance_reported = .false. if (len_trim(ctx % state % cfg % restart_file) /= 0) then call read_checkpoint(ctx % state, ctx % state % cfg % restart_file, ctx % t, ctx % iter, ok, err) if (.not. ok) then if (present(is_ok)) is_ok = .false. if (present(message)) message = trim(err) if (.not. present(is_ok) .and. .not. present(message)) error stop trim(err) return end if end if call log_effective_config(ctx) end subroutine initialize_runtime !> Execute the main time-marching loop until `time_stop` is reached. !! !! Each iteration: optionally recomputes `dt` from the CFL condition; !! clips `dt` at the final time; calls `step`; advances time using !! Kahan compensated summation to minimise floating-point drift; !! writes checkpoints and live snapshots at the configured intervals. !! !! `initialize_runtime` must have been called before `run_solver`. !! On return from `initialize_runtime`, `ctx % t` and `ctx % iter` are !! already set correctly: `ctx % t` equals `time_start` for a fresh run or !! the checkpointed time for a restart; `ctx % iter` is 0 or the restored !! iteration count respectively. !! @param ctx Solver context; `ctx % t` and `ctx % iter` are updated in place. subroutine run_solver(ctx) type(solver_run_context_t), intent(inout) :: ctx integer :: steps_taken logical :: finished call run_solver_steps(ctx, huge(steps_taken), steps_taken, finished) end subroutine run_solver !> Advance the main time loop by at most `max_steps` iterations. !! !! This polling-friendly entry point preserves checkpointing and live-snapshot !! behaviour while allowing adapters to inspect the state between calls. !! Polling is the canonical live-update path for the library ABI; the !! snapshot-file writes below remain as a compatibility side channel. !! Lightweight iteration timing (`iter_s`, `elapsed_s`) is always tracked so !! log lines stay meaningful even when `do_timing` is `.false.`; the heavier !! end-of-run summary and fine-grained region timers remain opt-in. subroutine run_solver_steps(ctx, max_steps, steps_taken, finished, is_ok, message) type(solver_run_context_t), intent(inout) :: ctx integer, intent(in) :: max_steps integer, intent(out) :: steps_taken logical, intent(out) :: finished logical, intent(out), optional :: is_ok character(len=*), intent(out), optional :: message real(wp) :: cfl_num ! Default status: assume success unless an error is detected below. if (present(is_ok)) is_ok = .true. if (present(message)) message = '' if (ctx % run_complete) then steps_taken = 0 finished = .true. return end if if (.not. associated(ctx % stepper)) then steps_taken = 0 finished = .true. if (present(is_ok)) is_ok = .false. if (present(message)) message = 'solver_runtime: time integrator not initialised' return end if cfl_num = ctx % state % cfg % cfl steps_taken = 0 do while (steps_taken < max_steps .and. ctx % t < ctx % state % cfg % time_stop) ! Start total wall-time accounting only when real work is about to begin, ! so a zero-step polling call does not consume elapsed time. if (.not. ctx % timers_started) then call timer_start(ctx % t_total) ctx % timers_started = .true. end if if (cfl_num > 0.0_wp) then block real(wp) :: max_ws max_ws = compute_max_wave_speed(ctx % state) if (max_ws <= 0.0_wp) error stop 'solver_runtime: zero max wave speed; CFL dt undefined' ctx % state % dt = cfl_num * ctx % state % dx / max_ws end block end if if (ctx % t + ctx % state % dt > ctx % state % cfg % time_stop) then ctx % state % dt = ctx % state % cfg % time_stop - ctx % t end if call timer_reset(ctx % t_iter) call timer_start(ctx % t_iter) call ctx % stepper(ctx % state) call timer_stop(ctx % t_iter) block real(wp) :: y, t_new y = ctx % state % 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 if (mod(ctx % iter, ctx % print_freq) == 0) call log_iteration(ctx) ! Keep compatibility side effects inside the bounded-step path so the CLI, ! desktop worker, and future service adapters all observe the same run. if (ctx % state % cfg % checkpoint_freq > 0) then if (mod(ctx % iter, ctx % state % cfg % checkpoint_freq) == 0) then call write_checkpoint(ctx % state, ctx % state % cfg % checkpoint_file, ctx % t, ctx % iter) end if end if if (ctx % state % cfg % snapshot_freq > 0) then if (mod(ctx % iter, ctx % state % cfg % snapshot_freq) == 0) call write_snapshot(ctx) end if end do finished = ctx % t >= ctx % state % cfg % time_stop if (finished .and. .not. ctx % run_complete) then if (ctx % iter > 0 .and. mod(ctx % iter, ctx % print_freq) /= 0) call log_iteration(ctx) if (ctx % timers_started) call timer_stop(ctx % t_total) ctx % run_complete = .true. end if end subroutine run_solver_steps !> Write the final solution to the output file and print the performance table. !! !! Output format: four columns (x, ρ, u, p) in `ES20.12` notation, one row !! per interior cell. Must be called after `run_solver`. !! @param ctx Solver context (solution written from `ctx % state % ub`). subroutine finalize_runtime(ctx) type(solver_run_context_t), intent(inout) :: ctx call write_solution_file(ctx, trim(ctx % state % cfg % output_file)) call report_performance_summary(ctx) end subroutine finalize_runtime !> Print the end-of-run performance table once after a completed run. !! !! This wrapper keeps the policy in one place for the legacy runtime driver, !! the session API, and the C ABI: only completed runs emit the heavier !! summary, and only when `do_timing` explicitly enables it. !! @param ctx Solver context (read-only except for the once-only guard flag). subroutine report_performance_summary(ctx) type(solver_run_context_t), intent(inout) :: ctx if (ctx % run_complete .and. ctx % state % cfg % do_timing .and. .not. ctx % performance_reported) then call log_performance_summary(ctx) ctx % performance_reported = .true. end if end subroutine report_performance_summary !> Release all allocations held by `ctx` and finalise the logger. !! Must be the last call in the lifecycle; `ctx` is invalid afterwards. !! @param ctx Solver context to tear down. subroutine teardown_runtime(ctx) type(solver_run_context_t), intent(inout) :: ctx call release_work_arrays(ctx % state) call log_finalize() end subroutine teardown_runtime !> Write the current solution to a text file. !! @param ctx Solver context (solution written from `ctx % state % ub`). !! @param filename Output path to overwrite. subroutine write_solution_file(ctx, filename, is_ok, message) type(solver_run_context_t), intent(inout) :: ctx character(len=*), intent(in) :: filename logical, intent(out), optional :: is_ok character(len=*), intent(out), optional :: message integer :: ipt, io_unit, info real(wp) :: x if (present(is_ok)) is_ok = .true. if (present(message)) message = '' if (ctx % state % cfg % do_timing) call timer_start(ctx % t_io) open (newunit=io_unit, file=trim(filename), status='replace', action='write', iostat=info) if (info /= 0) then if (present(is_ok)) is_ok = .false. if (present(message)) message = 'solver_runtime: failed to open output file' if (.not. present(is_ok) .and. .not. present(message)) error stop 'solver_runtime: failed to open output file' return end if do ipt = 1, ctx % state % n_pt x = ctx % state % cfg % x_left + ctx % state % dx * real(ipt - 1, wp) call write_cell_row(io_unit, x, ctx % state % ub(:, ipt), ctx % state % cfg % gam) end do close (io_unit, iostat=info) if (info /= 0) then if (present(is_ok)) is_ok = .false. if (present(message)) message = 'solver_runtime: failed to close output file' if (.not. present(is_ok) .and. .not. present(message)) error stop 'solver_runtime: failed to close output file' return end if if (ctx % state % cfg % do_timing) call timer_stop(ctx % t_io) end subroutine write_solution_file !> Write a single row of primitive variables to `io_unit` in `'(4ES20.12)'` format. !! Shared by `finalize_runtime` and `write_snapshot` to avoid duplicating !! the conserved-to-primitive conversion. !! @param io_unit Fortran I/O unit (already open for writing). !! @param x Cell-centre coordinate. [m] !! @param ub_col Conserved-variable column: (rho, rho*u, rho*E). !! @param gam Ratio of specific heats γ. subroutine write_cell_row(io_unit, x, ub_col, gam) integer, intent(in) :: io_unit real(wp), intent(in) :: x real(wp), intent(in) :: ub_col(3) real(wp), intent(in) :: gam real(wp) :: rho, u_vel, p integer :: io_stat rho = ub_col(1) u_vel = ub_col(2) / rho p = (ub_col(3) - 0.5_wp * rho * u_vel**2) * (gam - 1.0_wp) write (io_unit, '(4ES20.12)', iostat=io_stat) x, rho, u_vel, p if (io_stat /= 0) error stop 'solver_runtime: write_cell_row: write error' end subroutine write_cell_row !> Copy the current solution into primitive-variable arrays. !! @param ctx Solver context (read-only). !! @param x Cell-centre coordinates. !! @param rho Density field. !! @param u Velocity field. !! @param p Pressure field. subroutine copy_current_solution(ctx, x, rho, u, p, is_ok, message) type(solver_run_context_t), intent(in) :: ctx real(wp), intent(out) :: x(:), rho(:), u(:), p(:) logical, intent(out), optional :: is_ok character(len=*), intent(out), optional :: message integer :: ipt real(wp) :: u_vel ! The session/C-ABI boundary requires exact-size caller-owned buffers. if (size(x) /= ctx % state % n_pt .or. size(rho) /= ctx % state % n_pt .or. & size(u) /= ctx % state % n_pt .or. size(p) /= ctx % state % n_pt) then if (present(is_ok)) is_ok = .false. if (present(message)) message = 'solver_runtime: copy_current_solution: array size mismatch' return end if if (present(is_ok)) is_ok = .true. if (present(message)) message = '' do ipt = 1, ctx % state % n_pt x(ipt) = ctx % state % cfg % x_left + ctx % state % dx * real(ipt - 1, wp) rho(ipt) = ctx % state % ub(1, ipt) u_vel = ctx % state % ub(2, ipt) / rho(ipt) u(ipt) = u_vel p(ipt) = (ctx % state % ub(3, ipt) - 0.5_wp * rho(ipt) * u_vel**2) * (ctx % state % cfg % gam - 1.0_wp) end do end subroutine copy_current_solution !> Log one iteration summary line (time, residual, per-iteration and elapsed wall time). !! The lightweight `iter_s` and `elapsed_s` fields are always populated. !! Called every `ctx % print_freq` iterations and once unconditionally after the loop. !! @param ctx Solver context (read-only). subroutine log_iteration(ctx) type(solver_run_context_t), intent(in) :: ctx character(len=256) :: msg write (msg, '(A,I6,A,ES12.5,A,ES12.5,A,ES10.3,A,ES10.3)') & 'iter=', ctx % iter, ' t=', ctx % t, ' residual=', ctx % state % resid_glob, & ' iter_s=', timer_elapsed_s(ctx % t_iter), & ' elapsed_s=', timer_elapsed_running_s(ctx % t_total) call log_info(trim(msg)) end subroutine log_iteration !> Print the wall-clock performance table after the run completes. !! Reports total time, I/O time, and the three hot-path timers !! (`compute_resid`, flux precompute, face loop) plus overall throughput. !! Only called when `ctx % state % cfg % do_timing` is `.true.`. !! @param ctx Solver context (read-only). subroutine log_performance_summary(ctx) type(solver_run_context_t), intent(in) :: ctx real(wp) :: elapsed, mcell_steps_per_s character(len=256) :: msg elapsed = real(timer_elapsed_s(ctx % t_total), wp) if (elapsed > 0.0_wp) then mcell_steps_per_s = real(ctx % state % n_pt, wp) * real(ctx % iter, wp) / elapsed / 1.0e6_wp else mcell_steps_per_s = 0.0_wp end if call log_info('') call log_info('=== Performance Summary ===') write (msg, '(A,I0,A)') 'grid : ', ctx % state % n_pt - 1, ' cells' call log_info(trim(msg)) write (msg, '(A,I0,A,ES10.3,A)') 'steps : ', ctx % iter, ' (t_final =', ctx % t, ' s)' call log_info(trim(msg)) call log_info('-----------------------------------------------') call timer_report(ctx % t_total, 'Total (wall)') call timer_report(ctx % t_io, 'Output I/O') call timer_report(ctx % state % perf % resid, 'compute_resid') call timer_report(ctx % state % perf % fluxsplit, 'flux precompute') call timer_report(ctx % state % perf % faceloop, 'face loop') call log_info('-----------------------------------------------') write (msg, '(A,ES9.3,A)') 'Throughput ', mcell_steps_per_s, ' M cell-steps/s' call log_info(trim(msg)) end subroutine log_performance_summary !> Write a live snapshot of the current solution to `snapshot_file`. !! The file is overwritten on each call. A header comment records the !! current iteration and time; subsequent rows are (x, ρ, u, p) via !! `write_cell_row`. Open/write failures are logged as warnings rather !! than fatal errors so that a snapshot glitch does not abort the run. !! This file path is retained for compatibility with legacy file-watching !! tooling; new integrations should prefer the polling session/API surface. !! @param ctx Solver context (read-only). subroutine write_snapshot(ctx) type(solver_run_context_t), intent(in) :: ctx integer :: u, ipt, io_stat real(wp) :: x open (newunit=u, file=trim(ctx % state % cfg % snapshot_file), status='replace', action='write', iostat=io_stat) if (io_stat /= 0) then call log_warn('snapshot: cannot open "'//trim(ctx % state % cfg % snapshot_file)//'"') return end if write (u, '(A,I0,A,ES20.12)') '# iter=', ctx % iter, ' t=', ctx % t do ipt = 1, ctx % state % n_pt x = ctx % state % cfg % x_left + ctx % state % dx * real(ipt - 1, wp) call write_cell_row(u, x, ctx % state % ub(:, ipt), ctx % state % cfg % gam) end do close (u) end subroutine write_snapshot !> Log the effective (post-promotion) configuration at startup. !! Reads from the authoritative copy `ctx % state % cfg`, which may differ !! from the original namelist values when BC promotions have been applied !! (e.g. smooth_wave → periodic, woodward_colella → reflecting). !! @param ctx Solver context (read-only). subroutine log_effective_config(ctx) type(solver_run_context_t), intent(in) :: ctx character(len=256) :: msg associate (cfg => ctx % state % cfg) call log_info('--- Effective Configuration ---') write (msg, '(A,I0,A,ES11.4,A,ES11.4,A,ES11.4)') & 'grid : n_cell=', cfg % n_cell, ' x=[', cfg % x_left, ', ', cfg % x_right, ']' call log_info(trim(msg)) write (msg, '(A,ES11.4)') ' dx=', ctx % state % dx call log_info(trim(msg)) write (msg, '(A,A,A,ES11.4,A,ES11.4)') & 'time : scheme=', trim(cfg % time_scheme), ' dt=', cfg % dt, ' cfl=', cfg % cfl call log_info(trim(msg)) write (msg, '(A,ES11.4,A,ES11.4,A)') & ' t=[', cfg % time_start, ', ', cfg % time_stop, ']' call log_info(trim(msg)) write (msg, '(A,A,A,A,A,L1)') & 'schemes : recon=', trim(cfg % recon_scheme), ' flux=', trim(cfg % flux_scheme), & ' char_proj=', ctx % state % use_char_proj call log_info(trim(msg)) write (msg, '(A,A,A,L1)') ' limiter=', trim(cfg % limiter), & ' positivity=', cfg % use_positivity_limiter call log_info(trim(msg)) if (trim(cfg % time_scheme) == 'bdf2') then write (msg, '(A,L1)') ' lapack_solver=', cfg % lapack_solver call log_info(trim(msg)) end if write (msg, '(A,A,A,A,A,A)') & 'ic/bc : problem=', trim(cfg % problem_type), ' bc_left=', trim(cfg % bc_left), & ' bc_right=', trim(cfg % bc_right) call log_info(trim(msg)) select case (trim(cfg % problem_type)) case (problem_sod, problem_lax, problem_woodward_colella, problem_shu_osher, problem_acoustic_pulse) write (msg, '(A,ES11.4,A,ES11.4,A,ES11.4)') & ' rho_L=', cfg % rho_left, ' u_L=', cfg % u_left, ' p_L=', cfg % p_left call log_info(trim(msg)) write (msg, '(A,ES11.4,A,ES11.4,A,ES11.4)') & ' rho_R=', cfg % rho_right, ' u_R=', cfg % u_right, ' p_R=', cfg % p_right call log_info(trim(msg)) case (problem_from_file) call log_info(' ic_file='//trim(cfg % ic_file)) case (problem_udf) call log_info(' ic_udf_src='//trim(cfg % ic_udf_src)) end select if (trim(cfg % bc_left) == 'nonreflecting' .or. trim(cfg % bc_right) == 'nonreflecting') then write (msg, '(A,ES11.4,A,ES11.4,A,ES11.4)') & ' sigma_nrbc=', cfg % sigma_nrbc, ' p_ref_L=', cfg % p_ref_left, & ' p_ref_R=', cfg % p_ref_right call log_info(trim(msg)) end if if (cfg % checkpoint_freq > 0 .or. len_trim(cfg % restart_file) > 0) then write (msg, '(A,I0,A,A)') & 'checkpoint: every ', cfg % checkpoint_freq, ' restart=', trim(cfg % restart_file) call log_info(trim(msg)) end if write (msg, '(A,F8.5)') 'physics : gamma=', cfg % gam call log_info(trim(msg)) call log_info('output : file='//trim(cfg % output_file)) call log_info('-------------------------------') end associate end subroutine log_effective_config end module solver_runtime