diff --git a/.claude/rules/common-pitfalls.md b/.claude/rules/common-pitfalls.md
index 71bf6e452f..8f9c6e658c 100644
--- a/.claude/rules/common-pitfalls.md
+++ b/.claude/rules/common-pitfalls.md
@@ -19,8 +19,37 @@ covered in `docs/documentation/contributing.md`.
`contxb`/`momxb` shorthands are gone. Index positions depend on `model_eqns` and
enabled features — changing either moves ALL indices; never hard-code one.
+## AMR levels (silent-index traps)
+
+- **A level-`l` block's fine extent is `amr_ref_ratio**l * (coarse-region width) - 1`, NOT
+ `amr_ref_ratio*width`.** The `amr_ref_ratio*width` form is correct only for the level-1 initial
+ block; nested boxes compound by `amr_ref_ratio` per level (`amr_ref_ratio**level`). Every
+ fine-extent computation uses `amr_ref_ratio**amr_block_level` — geometry
+ (`s_set_amr_fine_geometry`), the restart-reader extent check, load-weight, `fmul`.
+ Assuming `amr_ref_ratio*width` rejects level≥2 blocks as corrupt (the exact bug that bit the
+ multi-level restart reader).
+- **"coarse" in the AMR coupling routines means the block's PARENT level (`l-1`), not the
+ base grid (level 0).** For a level-1 block the parent IS L0; for level≥2 the block folds
+ to/from its parent block's fine array. `s_amr_gather_coarse_patch`,
+ `s_interpolate_coarse_to_fine`, and the restrict/reflux path all operate in the
+ parent-fine frame — assuming L0 silently corrupts level≥2 coupling.
+- **The fine advance SWAPS the coarse grid globals (`m/n/p`, `idwint/idwbuff`, coords,
+ `acoustic_source`, `ab_active`) to a fine block and restores them after — see the SWAP
+ CONTRACT block at the `sw_*` declarations in `m_amr.fpp`.** Any module-level variable
+ DERIVED from the grid that a kernel reads during the fine advance must be swapped there or
+ refreshed per fine call at its use site; if it is `GPU_DECLARE`'d, its DEVICE copy must be
+ refreshed too. A stale device copy of coarse bounds reads out of range on the fine grid
+ under **CCE OpenACC only** (NVHPC/CCE-omp evaluate bounds host-side) — this was the `ab_int`
+ regression, fixed by an unconditional `GPU_UPDATE` in `s_compute_rhs`. `amr_rvw` (cyl_coord
+ radius weights) is the next candidate, currently safe only via a `m_checker.fpp` gate.
+ A CPU-only or NVHPC-acc pass proves NOTHING here; this class is CCE-acc-specific.
+
## GPU
+- NEVER put a `GPU_PARALLEL_LOOP` inside a Fortran `block` construct: amdflang compiles
+ it clean but silently DROPS the region from the device image — the first launch dies
+ with `HSA_STATUS_ERROR_INVALID_SYMBOL_NAME` naming an `__omp_offloading_*` symbol.
+ Hoist the kernel into its own module subroutine.
- WARNING: do NOT wrap `GPU_LOOP` in `GPU_PARALLEL` for spatial loops — `GPU_LOOP` emits
empty directives on Cray and AMD, causing silent serial execution. Spatial loops always
use `GPU_PARALLEL_LOOP`/`END_GPU_PARALLEL_LOOP`. Macro API:
@@ -36,6 +65,15 @@ covered in `docs/documentation/contributing.md`.
- `@:ACC_SETUP_VFs(...)`/`@:ACC_SETUP_SFs(...)` GPU pointer setup compiles only under
Cray. Around MPI: `GPU_UPDATE(host=...)` before send, `GPU_UPDATE(device=...)` after
receive.
+- **Never `GPU_UPDATE` a NON-CONTIGUOUS array section.** `GPU_UPDATE(device='[q%sf(a:b,
+ c:d, e:f)]')` on a sub-box emits correct OpenMP, but AMD flang copies it as
+ `size(section)` CONTIGUOUS elements starting at the first: only the leading run lands
+ where it is named and the rest overwrites neighbouring cells with stale data — no error,
+ no warning. A leading section (`arr(1:n)`, or a fixed trailing index like
+ `freg(d)%lo(:,:,:,k)`) IS contiguous and safe; anything that strides is not. To move a
+ sub-box, pack/unpack it with a device kernel (`s_l0_pack_unpack_block`,
+ `s_amr_restrict_pack_device`) — that is why those exist. Measured: 10 of 60 covered
+ cells delivered in the AMR cross-rank restrict, mass off 1.4e-5 per regrid.
## Parameters
diff --git a/.github/scripts/check_coverage_map_health.py b/.github/scripts/check_coverage_map_health.py
index f4dddc9838..3ece379d31 100644
--- a/.github/scripts/check_coverage_map_health.py
+++ b/.github/scripts/check_coverage_map_health.py
@@ -1,5 +1,6 @@
"""Fail loudly if the committed coverage map is stale or under-covers. Used by coverage-health.yml."""
import datetime
+import os
import subprocess
import sys
from pathlib import Path
@@ -32,6 +33,18 @@
COVERAGE_RELEVANT_PATHS = [":(glob)src/**/*.fpp", "toolchain/mfc/test/cases.py"]
+def _git_env():
+ """The environment minus every GIT_* variable.
+
+ `cwd` is how callers select the repository here, but git honors an inherited GIT_DIR /
+ GIT_INDEX_FILE over the working directory -- and git exports both while running a hook.
+ MFC's pre-commit hook runs precheck, whose toolchain lint imports this script and calls
+ these functions against throwaway test repos; without the scrub those calls silently
+ answer for the developer's real repository instead.
+ """
+ return {k: v for k, v in os.environ.items() if not k.startswith("GIT_")}
+
+
def verified_sha(cwd=None):
"""Commit the last successful refresh verified the map against, or None if unknown.
@@ -40,7 +53,7 @@ def verified_sha(cwd=None):
caller must read that as undeterminable and fall back to the wall-clock age rule, not
as a failure -- an absent ref is not evidence of a broken refresh.
"""
- rev = subprocess.run(["git", "rev-parse", "--verify", "--quiet", f"{VERIFIED_REF}^{{commit}}"], capture_output=True, text=True, check=False, cwd=cwd)
+ rev = subprocess.run(["git", "rev-parse", "--verify", "--quiet", f"{VERIFIED_REF}^{{commit}}"], capture_output=True, text=True, check=False, cwd=cwd, env=_git_env())
return rev.stdout.strip() or None
@@ -53,10 +66,10 @@ def verified_after_last_change(git_sha, cwd=None):
"""
if not git_sha:
return None
- last = subprocess.run(["git", "log", "-1", "--format=%H", "--", *COVERAGE_RELEVANT_PATHS], capture_output=True, text=True, check=False, cwd=cwd)
+ last = subprocess.run(["git", "log", "-1", "--format=%H", "--", *COVERAGE_RELEVANT_PATHS], capture_output=True, text=True, check=False, cwd=cwd, env=_git_env())
if last.returncode != 0 or not last.stdout.strip():
return None # shallow clone or no such commit -> fall back to the age rule
- ancestor = subprocess.run(["git", "merge-base", "--is-ancestor", last.stdout.strip(), git_sha], capture_output=True, check=False, cwd=cwd)
+ ancestor = subprocess.run(["git", "merge-base", "--is-ancestor", last.stdout.strip(), git_sha], capture_output=True, check=False, cwd=cwd, env=_git_env())
return {0: True, 1: False}.get(ancestor.returncode) # anything else -> None (unknown sha, shallow history)
diff --git a/.lychee.toml b/.lychee.toml
index f703aa73cb..e084872a08 100644
--- a/.lychee.toml
+++ b/.lychee.toml
@@ -33,4 +33,5 @@ exclude = [
"https://code\\.visualstudio\\.com/?$", # Root page returns 403 to automated requests
"https://stackoverflow\\.com", # Returns 403 to automated requests
"https://marketplace\\.visualstudio\\.com", # Returns 503 to automated requests
+ "_8md\\.html$", # Doxygen auto-links backticked *.md filenames in prose to per-file pages it never generates for markdown inputs; the real md_*.html page links are still checked
]
diff --git a/.typos.toml b/.typos.toml
index 1c8eb909fb..ff1d40cee2 100644
--- a/.typos.toml
+++ b/.typos.toml
@@ -7,6 +7,9 @@ extend-ignore-identifiers-re = [
AttributeIDSupressMenu = "AttributeIDSupressMenu"
[default.extend-words]
+# Cray CCE spells it this way in the lib-4425 runtime error; quoted verbatim in the AMR ledger so the
+# message stays greppable against what the machine actually prints.
+Unitialized = "Unitialized"
INOUT = "INOUT"
WRONLY = "WRONLY"
nd = "nd"
@@ -22,6 +25,9 @@ TKE = "TKE"
HSA = "HSA"
infp = "infp"
Sur = "Sur"
+thi = "thi" # AMR clustering local: tagged-box hi index (tlo/thi)
+alo = "alo" # AMR clustering local: accepted-box lo array (alo/ahi)
+thr = "thr" # AMR clustering local: min-separation merge threshold
equil = "equil" # abbreviation for "equilibrium" (flamelet chemistry)
chioces = "chioces" # typo for "choices" - tests constraint key validation
reqires = "reqires" # typo for "requires" - tests dependency key validation
diff --git a/cmake/GPU.cmake b/cmake/GPU.cmake
index 44cda01cdc..506716dc04 100644
--- a/cmake/GPU.cmake
+++ b/cmake/GPU.cmake
@@ -90,9 +90,15 @@ elseif (CMAKE_Fortran_COMPILER_ID STREQUAL "Cray")
add_link_options("SHELL:-hkeepfiles")
if (CMAKE_BUILD_TYPE STREQUAL "Debug")
+ # -h bounds: array-bounds and pointer checking, the Cray equivalent of gfortran's
+ # -fcheck=bounds,pointer / Intel's -check bounds / NVHPC's -Mbounds, all of which the
+ # debug branches above already set. Cray was the ONLY compiler whose debug build had no
+ # bounds checking, so an out-of-bounds write showed up here only as a later, unrelated
+ # allocation failing with an uninitialised descriptor.
add_compile_options(
"SHELL:-h acc_model=auto_async_none"
"SHELL: -h acc_model=no_fast_addr"
+ "SHELL: -h bounds"
"SHELL: -K trap=fp" "SHELL: -g" "SHELL: -O0"
)
add_link_options("SHELL: -K trap=fp" "SHELL: -g" "SHELL: -O0")
diff --git a/cmake/MFCTargets.cmake b/cmake/MFCTargets.cmake
index 99fb7a154c..1668adbb05 100644
--- a/cmake/MFCTargets.cmake
+++ b/cmake/MFCTargets.cmake
@@ -203,7 +203,19 @@ exit 0
-fopenmp-assume-threads-oversubscription
-fopenmp-assume-teams-oversubscription
-fopenmp-assume-no-nested-parallelism)
- target_link_options(${a_target} PRIVATE -fopenmp --offload-arch=gfx90a -flto-partitions=${MFC_BUILD_JOBS})
+ # attributor-max-pi-accesses: amdflang generates device code for the WHOLE
+ # image at link time, and once the image carries enough target regions the
+ # device link's Attributor exceeds its AAPointerInfo access cap on a
+ # heavily-shared object. Pointer information then goes pessimistic and
+ # OpenMPOpt's __kmpc_parallel cleanup fails module-wide: UNTOUCHED kernels
+ # regenerate with 2.4-4.5x worse ISA (register spills, +512 B LDS in every
+ # kernel) whenever ANY kernel is added or removed anywhere in the code.
+ # Raising the cap restores full pointer precision for the whole image and
+ # makes kernel quality independent of unrelated edits, at the price of a
+ # longer device link. See docs/documentation/gpuParallelization.md
+ # ("AMD flang known issues") for the failure signature.
+ target_link_options(${a_target} PRIVATE -fopenmp --offload-arch=gfx90a -flto-partitions=${MFC_BUILD_JOBS}
+ "SHELL:-Xoffload-linker -mllvm -Xoffload-linker -attributor-max-pi-accesses=16384")
endif()
endif()
diff --git a/docs/documentation/amr.md b/docs/documentation/amr.md
new file mode 100644
index 0000000000..54672aae18
--- /dev/null
+++ b/docs/documentation/amr.md
@@ -0,0 +1,371 @@
+@page amr Adaptive Mesh Refinement
+
+# Adaptive Mesh Refinement
+
+> **Experimental.** AMR is off by default (`amr = F`) and requires explicit opt-in.
+> The physics support matrix is enforced at run time by the checker; unsupported
+> combinations abort with a clear message rather than producing silently wrong results.
+
+## Overview {#amr-overview}
+
+Block-structured adaptive mesh refinement (AMR) concentrates resolution where the flow
+demands it — around shocks, interfaces, and bubble clouds — while leaving the rest of the
+domain at the coarser base-grid resolution. MFC implements a multi-level block hierarchy: the
+unmodified base (level-0) solve runs as usual, and one or more refined rectangular blocks advance
+alongside it on a finer grid — nested recursively to `amr_max_level` levels when enabled.
+
+The fine blocks are dynamically repositioned every `amr_regrid_int` coarse steps using a
+gradient-based cell tagger and Berger–Rigoutsos block clustering, so they follow moving
+features automatically. When `amr_regrid_int = 0` the block is fixed at the initial
+`amr_block_beg`/`amr_block_end` position for the whole run.
+
+AMR lives entirely in the `simulation` executable (`src/simulation/m_amr.fpp` and
+`m_amr_registers.fpp`) and is the only part of MFC that modifies the solver's grid
+mid-run.
+
+---
+
+## The Block-Structured Model {#amr-model}
+
+The hierarchy spans levels `0` through `amr_max_level` (default `1`, i.e. two levels):
+
+- **Level 0** — the base grid with cell spacing `dx`, `dy`, `dz`. The ordinary MFC solver
+ advances this level every step.
+- **Level 1** — a list of up to `amr_max_blocks` rectangular refined blocks, each covering
+ a sub-region of the level-0 domain at `amr_ref_ratio`:1 refinement (`amr_ref_ratio` = 2 or 4;
+ the cell spacing shrinks by `amr_ref_ratio` in every active direction).
+- **Levels 2 … `amr_max_level`** — when `amr_max_level > 1`, blocks nest recursively: a
+ level-`l` block refines a region of its parent level-(`l-1`) block by a further
+ `amr_ref_ratio`, tracking a moving feature to arbitrary depth. Multi-level nesting requires
+ `amr_ref_ratio = 2`. See @ref amr_multilevel for the nesting and reflux details.
+
+Each block is described by its bounding box in level-0 cell-index space
+(`amr_block_beg(1:num_dims)` to `amr_block_end(1:num_dims)`). The initial (level-1)
+fine-block extents must satisfy:
+
+```
+amr_ref_ratio*(amr_block_end(i) - amr_block_beg(i) + 1) - 1 <= N_i
+```
+
+where `N_i` is the global cell count in direction `i`. This ensures the fine scratch
+(which is sized to the base grid) is never overflowed. A level-`l` block's fine extent
+grows as `amr_ref_ratio**l`, so the nested boxes are sized accordingly.
+
+**Slot storage.** Block slots are sized to the maximum possible block size (half the
+per-rank subdomain in each dimension), but their field arrays are allocated lazily and only
+for the blocks a rank actually owns, so a rank's fine memory tracks its share of the pool
+(roughly `1/num_procs` of it) rather than all `amr_max_blocks` slots. Regrid reuses the
+existing allocations by adjusting the active geometry metadata.
+
+---
+
+## Algorithm {#amr-algorithm}
+
+### Prolongation (coarse-to-fine interpolation) {#amr-prolongation}
+
+When a block is first created or moved by regrid, the fine solution is initialized from
+the coarse level by **conservative-linear prolongation**: a piecewise-linear fit to the
+coarse cell averages is evaluated at each fine cell centre, ensuring the fine-cell averages
+are consistent with the coarse parent to second order. Physics-specific closures
+are applied after prolongation:
+
+- **Multi-fluid**: volume fractions are renormalized so they sum to one on the fine level.
+- **Euler-Euler bubbles**: the radius moment is floored to a small positive fraction of
+ the parent so reconstructed radius and number density stay positive.
+- **Chemistry**: species partial densities are rescaled so `sum(Y_k) = 1` and `Y_k >= 0`
+ on the fine level by construction.
+
+### Per-block advance {#amr-advance}
+
+The fine block advances using the same WENO/Riemann/RK3 solver as the coarse level. The
+solver globals (`m`, `n`, `p`, `dx`, ...) are swapped to the block geometry before the
+advance and restored afterward. Ghost cells at the coarse/fine boundary are filled by
+conservative-linear prolongation from the current coarse solution (or time-interpolated
+between the coarse `t^n` and `t^{n+1}` states when subcycling is enabled).
+
+Without subcycling, the fine block takes one step at the case `dt` (same as the coarse
+step). With subcycling it takes two steps at `dt/2`.
+
+### Flux registers and refluxing {#amr-reflux}
+
+A **flux register** accumulates the fine-level face fluxes at every coarse/fine interface
+face during the fine advance. After the fine advance completes, the **reflux correction**
+replaces the corresponding coarse-level fluxes with the summed fine fluxes (Berger–Colella
+refluxing). This correction is what makes the scheme exactly conservative: the coarse and
+fine levels exchange mass, momentum, and energy at machine precision across the block
+boundary, regardless of the solution inside the block.
+
+Viscous stress and work enter as face-centred source fluxes of the same form as the
+advective flux, so they travel through the same registers. The reflux matches the full
+advective + viscous flux, and energy (including viscous work) is conserved.
+
+### Restriction (fine-to-coarse averaging) {#amr-restriction}
+
+After refluxing, the fine cell averages inside the block are **volume-averaged** back to
+the coarse level (each coarse cell equals the average of its 2^d fine children). This
+overwrites the coarse solution inside the block with the fine-level values. The coarse
+level outside the block is unchanged. On uniform Cartesian grids the children share a cell
+volume, so this is a plain arithmetic mean; under `cyl_coord` (2D axisymmetric) cell volume
+scales with radius, so the fold-back is weighted by each fine child's cell-center radius and
+the flux-register reflux area-weights the coarse/fine faces (radial faces by the outside
+cell's `r_face/r_cell`, axial faces by the covering fine faces' radii), keeping the
+radius-weighted conserved quantity exact to machine precision.
+
+### Dynamic regrid {#amr-regrid}
+
+Every `amr_regrid_int` coarse steps (when `amr_regrid_int > 0`):
+
+1. **Tag** every coarse cell whose normalized density gradient exceeds `amr_tag_eps`.
+2. **Cluster** the tagged cells using Berger–Rigoutsos recursive bisection into a list of
+ rectangular boxes, each grown by `amr_buf` coarse cells of buffer padding on each side.
+3. **Merge** boxes whose padded extents come within a ghost-cell buffer width of each
+ other (guaranteeing no fine–fine adjacency, which the solver does not support).
+4. **Split** each box further if its tag efficiency (tagged cells / total cells) has not
+ yet reached `amr_cluster_eff`. Stop splitting when the box count reaches
+ `amr_max_blocks`.
+5. **Prolongate** the new block geometry from the current coarse solution, then continue.
+
+Setting `amr_buf >= 1` and `amr_tag_eps > 0` is required when regridding is active.
+
+### Subcycling {#amr-subcycle}
+
+`amr_subcycle = T` enables Berger–Colella dt/2 subcycling:
+
+- The coarse level takes one step at the case `dt`.
+- The fine level takes two steps at `dt/2`.
+- Ghost values at the coarse/fine boundary are time-interpolated between the saved
+ `t^n` and `t^{n+1}` coarse states for each fine substep.
+- Accumulated fine fluxes are refluxed back to the coarse level after each coarse step.
+
+Subcycling improves temporal accuracy at the block boundary and is the recommended mode
+for production runs. It requires a fixed time step (`cfl_dt = F`).
+
+---
+
+## Conservation and Accuracy {#amr-conservation}
+
+**Exact conservation.** The flux-register reflux mechanism ensures per-fluid mass,
+momentum, and total energy are conserved to machine precision across the coarse/fine
+boundary. Defects are consistently ~1e-15 in validated runs (single-fluid, multi-fluid,
+viscous, bubble, chemistry, and phase-change cases).
+
+**Free-stream preservation.** A uniform-state run with AMR active (including
+subcycling and regrid) preserves the free stream to machine precision — no spurious
+velocities or pressure drift at the block boundary.
+
+**Element-exact multi-rank.** An `np=1` run and an `np=2` run with the block spanning
+the rank boundary produce bit-identical results (element-exact seam), confirming that
+the owner distribution and the coarse↔fine gather/scatter introduce no asymmetry.
+
+**Accuracy posture.** Inside the block the fine-level solution converges at WENO order.
+At the coarse/fine boundary the conservative-linear ghost fill is second order. The
+viscous seam carries a bounded (~1e-6) np-dependent error only at the *prolongation
+ghost* layer (the inherently-approximate coupling zone of any c/f boundary); bulk
+accuracy is unaffected. For viscous cases with strong shear or boundary layers, a static
+or generously buffered block is recommended (the density-gradient tagger does not sense
+shear well; error-estimator taggers are future work).
+
+---
+
+## Parallelism {#amr-parallel}
+
+### Multi-rank (MPI) {#amr-mpi}
+
+The fine level uses **single-owner block distribution**: each active block is assigned
+one owner rank by chains-on-chains balancing of fine-work weight (fine cell count) in
+Morton order of the block's low corner, recomputed at every regrid with state migration
+(`s_amr_assign_block_owners`). Nested refinement towers co-locate with their level-1
+anchor so parent↔child coupling stays rank-local. A block may span rank boundaries —
+the owner holds the whole fine block, and the coarse-side coupling (ghost sources,
+restriction targets, reflux faces) moves through point-to-point coarse↔fine
+gather/scatter between the owner and the ranks whose base subdomains the block
+overlaps. Same-level adjacent blocks (produced by tiling wide features) reconcile
+their shared-face ghosts with a fine-fine seam halo each stage, so both sides compute
+a matching seam flux.
+
+The fine block may cover at most about half of the global extent per dimension
+(`amr_maxc`), since the fine advance reuses the rank-local solver scratch (sized to
+the base subdomain); wider features are tiled into adjacent blocks.
+
+Restart with `parallel_io` repartitions the fine blocks across any rank count; the
+serial (per-rank-file) restart path requires the same rank count as the run that wrote
+the fine-level file and aborts otherwise (see the Restart section below).
+
+### Load-balance coupling {#amr-loadbalance}
+
+When `load_balance = T` (see the load-balance parameters in @ref case), the weighted
+Cartesian decomposition accounts for the extra work of the fine advance: cells inside
+the block footprint are given a higher weight, biasing the rank boundaries toward a
+balanced allocation of fine work. A deterministic feasibility clamp ensures the weighted
+split never violates the half-subdomain constraint.
+
+Fine-block ownership additionally weights each block by a measured cost model over its
+footprint (base cell cost, plus IB-marked cells and, when a load-weight diagnostic
+writer is on, phase-change iteration counts), so blocks concentrating expensive physics
+weigh more than equal-size quiescent ones at every regrid.
+
+The weighted Cartesian split itself is static after startup. Because
+`s_load_balance_rebalance` runs at every startup from the restart file, a long run can be
+**rebalanced by checkpoint-and-restart**: stop, then restart with `load_balance = T` — the
+split planes are recomputed from the saved state at the point of restart.
+
+For in-run rebalancing of the base grid there is a separate, opt-in mechanism: `l0_ntile`
+tiles the base grid into `l0_ntile**num_dims` refinement-ratio-1 blocks advanced through the
+same per-block solver as the fine overlay (byte-identical to the untiled run), and
+`l0_rebalance_interval > 0` periodically recomputes the SFC cut from measured per-tile cost
+and migrates tiles whose owner changed. Tiling composes with `amr` only for static,
+single-level, non-subcycled runs today; the checker names the unsupported combinations.
+
+### GPU {#amr-gpu}
+
+The fine-block field arrays (`q_cons`, `q_prim`, `rhs`, and the ghost-lerp sources) are
+device-resident from allocation onward. The ghost fill, per-block RHS/RK advance, and
+restriction are all performed on-device. GPU correctness has been validated on NVIDIA
+V100 (OpenACC / nvhpc) for all supported physics rungs: single-fluid, multi-fluid,
+viscous, bubbles, multi-block, phase-change, and chemistry.
+
+The GPU build uses `src/simulation/` OpenACC/OpenMP macros; see @ref gpuParallelization
+for the macro API.
+
+**Scaling note.** Within a rank, owned blocks advance sequentially: the fine advance
+swaps one block at a time into a single working slot (global grid state plus a shared
+coarse-patch scratch buffer), so per-rank wall time scales with the *sum* of its
+blocks' work. Cross-rank parallelism comes from distributing block ownership; strong
+scaling therefore saturates when ranks own many small blocks. Batching per-rank block
+advances (per-slot state instead of the global swap) is the known lever and is future
+work.
+
+---
+
+## Supported Physics {#amr-physics}
+
+The table below summarises what is and is not supported under AMR. The checker
+(`src/simulation/m_checker.fpp`) enforces every restriction at run time and aborts with
+a diagnostic message for unsupported combinations.
+
+| Physics | Status | Notes |
+| :--- | :---: | :--- |
+| Single-fluid Euler (`num_fluids = 1`) | Supported | Base configuration |
+| Multi-fluid Euler (`num_fluids > 1`) | Supported | Requires `mpp_lim = T`; volume fractions sum-preserved on prolongation |
+| Viscous (`viscous = T`) | Supported | Viscous fluxes refluxed; bounded seam error at prolongation ghost layer |
+| Euler-Euler bubbles (`bubbles_euler`; polytropic or non-polytropic; `nb >= 1`, polydisperse) | Supported | Moment realizability floor applied to all positive moments on prolongation |
+| Phase change / relaxation (`relax = T`) | Supported | Per-cell relaxation runs on the fine block before restriction |
+| Chemistry — reactions + advection + diffusion (`chemistry = T`) | Supported | Species sum/positivity closure on prolongation; temperature ghost exchanged at rank seams; diffusion fluxes refluxed like viscous |
+| Surface tension (`surface_tension = T`) | **Not supported** | The capillary force depends on the interface-normal direction; the prolonged fine ghost color cannot reproduce the coarse normal across a 2:1 boundary, producing a growing spurious seam current. See @ref case section 7.1. |
+| Hypoelasticity (`hypoelasticity = T`, incl. continuum damage) | Supported | Stress components prolong on the generic conservative path; the fine swap recomputes the spacing-dependent FD coefficients |
+| Hyperelasticity | **Not supported** | Gated (no upstream test coverage to validate against) |
+| MHD / RMHD, 1D | Supported | div(B) = d(Bx)/dx and 1D evolves only By/Bz (Bx is the uniform `Bx0` parameter), so div(B) = 0 by construction - the 2D/3D seam failure mode is structurally absent; By/Bz reflux and restrict as ordinary conserved scalars (HLL and HLLD; incl. relativistic) |
+| MHD, 2D/3D | **Not supported** | Attempted and measured: per-component B prolongation/reflux is not divergence-preserving - on a magnetized 2D Brio-Wu the coarse/fine seam is a continuous O(1) monopole source that GLM cleaning spreads but cannot remove (max abs div(B) 0.53 block-interior / 0.36 far-field vs the no-AMR 1.4e-3 cleaning background; HLLD, which has no GLM coupling, NaNs outright). Needs constrained-transport-class B prolongation and reflux |
+| QBMM bubbles (polytropic) | Supported | Bubble moments live in `q_cons`, injected piecewise-constant at prolongation to preserve CHyQMOM realizability |
+| QBMM bubbles (non-polytropic) | Supported | Each block carries its own `pb`/`mv` quadrature side-state: prolonged piecewise-constant (realizability), advanced with the block's own rhs scratch, restricted back with the moments; dynamic regrid and `amr_subcycle` are both supported (the side-state bounces through the regrid and time-lerps its ghost shell) |
+| Lagrangian bubbles (`bubbles_lagrange = T`) | Supported (cloud excluded from blocks) | Two-way coupling lives on the coarse grid: regrid suppresses tags and clips candidate boxes around the cloud's padded bbox (positions + `mapCells` smearing + stencil + drift margin, recomputed collectively each regrid), the fine advance skips the EL hooks, EL volume fractions prolong WITHOUT the sum-to-one closure (their sum is the local liquid fraction), and a per-stage guard aborts if the cloud reaches an active block |
+| Immersed boundaries (`ib = T`; one or more non-STL bodies, static or prescribed-motion `moving_ibm=1`) | Supported | Per-block fine-grid IB markers/ghost points, rebuilt each fine substage at the body's sub-time position for a moving body; non-conservative ghost-cell forcing at the body; with dynamic regrid candidate boxes expand to fully contain each body at its live position plus margin, the fine IB state rebuilds after every regrid, and a per-substage guard aborts if a moving body reaches its block boundary between regrids; force-driven (`moving_ibm=2`)/STL gated; a body spanning a rank seam is rejected at startup |
+| IGR solver (`igr = T`) | Supported (restriction-only coupling) | The fine block runs its own fixed-iteration sigma solve, seeded and Dirichlet-bounded by the converged coarse sigma (frozen ghost ring; the per-iteration BC populate is skipped); the coarse warm-start state is saved/restored across the fine advance. The Berger-Colella reflux is NOT captured from the fused IGR flux kernels, so seam conservation is truncation-order rather than exact; free-stream preservation is exact. `amr_subcycle` is gated |
+| 2D axisymmetric (`cyl_coord = T`, `p = 0`) | Supported (single level) | Geometric sources read the live (swapped) grid; the axis half-width cell's per-cell WENO coefficients are recomputed for each block on swap/restore; blocks stay `buff_size` off the axis (domain-edge clamp); the axis-singularity viscous treatment runs on the coarse pass only. Cell volume scales with radius, so the fold-back is radius-weighted (fine `y_cc`) and the reflux area-weights radial faces (`r_face/r_cell`) and axial fine-flux averages (fine-face radius) - conservation is exact to machine precision. Restricted to `amr_max_level = 1` and not combined with non-polytropic QBMM (their parent-frame / `pb`-`mv` fold-backs are not yet radius-weighted; both are checker-gated) |
+| 3D cylindrical (`cyl_coord = T`, `p > 0`) | **Not supported** | The per-stage azimuthal Fourier filter is a global operation incompatible with the block-local fine advance |
+| Grid stretching (`stretch_x[y,z] = T`) | Supported | Fine ghost-shell coordinates extend by exact parent-cell bisection, and the spacing-dependent WENO coefficients are recomputed for the active grid on every block swap/restore (`amr_weno_coef_recompute`, armed automatically when the grid is nonuniform); prolongation stays conservative but its slope estimate is first-order on nonuniform parents. Stretched grids do NOT combine with Lagrangian bubbles or dynamic regrid with immersed bodies (their position-to-cell-index conversions assume uniform spacing; init abort) |
+| Riemann-extrapolation BCs (`bc = -4`) | **Not supported** | Boundary-adjusted WENO coefficient rows cannot be inherited by interior blocks (checker gate) |
+| `active_box` | Supported (single-rank; `num_procs > 1` is rejected at input check) | Blocks must sit strictly inside the monotonically-growing active window (init abort + regrid clamp: the windowed coarse update would drop reflux corrections at faces outside it); the fine advance disables the coarse-indexed windowing and treats its whole block as active; the frozen exterior is valid ambient data for ghost prolongation |
+| `acoustic_source` | Supported | The source acts on the coarse grid only: its support must not overlap the initial block (startup abort), and dynamic regrid keeps its boxes clear of the support (tags suppressed, candidate boxes clipped); emitted waves enter blocks through the coarse/fine coupling |
+
+**Mandatory solver settings.**
+
+AMR requires:
+- WENO reconstruction (`recon_type = 1`, any order) or the IGR solver (`igr = T`)
+- SSP-RK3 time-stepping: `time_stepper = 3`
+- 5- or 6-equation model: `model_eqns = 2` or `3` (for 6-eq the per-stage pressure relaxation also runs on each fine block)
+
+---
+
+## Parameters {#amr-parameters}
+
+The table below summarises the AMR parameters. For the full parameter descriptions,
+default values, and cross-parameter constraints see @ref case section 7.1.
+
+| Parameter | Type | Default | Description |
+| :--- | :---: | :---: | :--- |
+| `amr` | Logical | F | Enable AMR (off by default) |
+| `amr_block_beg(i)` | Integer | 0 | Initial block start cell index in direction `i` (level-0 index space) |
+| `amr_block_end(i)` | Integer | 0 | Initial block end cell index in direction `i` (level-0 index space) |
+| `amr_regrid_int` | Integer | 0 | Coarse steps between regrid events; 0 = static block |
+| `amr_tag_eps` | Real | 0.1 | Normalized density-gradient threshold for refinement tagging; required `> 0` when `amr_regrid_int > 0` |
+| `amr_buf` | Integer | 3 | Coarse-cell padding around tagged cells; required `>= 1` when `amr_regrid_int > 0` |
+| `amr_subcycle` | Logical | F | Advance fine level at `dt/2` (two substeps per coarse step) with Berger-Colella refluxing |
+| `amr_max_blocks` | Integer | 4 | Number of fixed refined-block slots preallocated; each slot is max-block sized (~N times device memory for N slots) |
+| `amr_max_level` | Integer | 1 | Maximum refinement depth: `1` = single refined level, `> 1` = recursive multi-level nesting (needs `amr_max_blocks >= 2` and `amr_ref_ratio = 2`). See @ref amr_multilevel |
+| `amr_ref_ratio` | Integer | 2 | Cell-refinement ratio between adjacent levels; must be 2 or 4. `amr_ref_ratio = 4` is single-level only (no nesting, no subcycling) |
+| `amr_cluster_eff` | Real | 0.7 | Berger-Rigoutsos min tag efficiency a clustered box reaches before splitting stops; must satisfy `0 < amr_cluster_eff <= 1` |
+
+---
+
+## Usage Example {#amr-example}
+
+The minimal configuration for a 1D run with a static refined block spanning cells 16
+through 47 (level-0 index space):
+
+```python
+# case.py excerpt — 1D single-fluid AMR, static block
+{
+ # ... base grid, patch, time-stepping settings ...
+ 'recon_type' : 1, # WENO (required)
+ 'time_stepper' : 3, # SSP-RK3 (required)
+ 'model_eqns' : 2, # 5- or 6-equation model (2 or 3)
+
+ # AMR
+ 'amr' : 'T',
+ 'amr_block_beg(1)': 16,
+ 'amr_block_end(1)': 47,
+ 'amr_regrid_int' : 0, # static block; set > 0 for dynamic regrid
+}
+```
+
+For a dynamic run that tracks shocks, add:
+
+```python
+ 'amr_regrid_int' : 10, # regrid every 10 coarse steps
+ 'amr_tag_eps' : 0.1, # normalized density-gradient threshold
+ 'amr_buf' : 3, # 3-cell buffer padding
+ 'amr_subcycle' : 'T', # fine level at dt/2
+```
+
+For multi-fluid (5-equation), additionally set:
+
+```python
+ 'num_fluids' : 2,
+ 'mpp_lim' : 'T', # required for num_fluids > 1 under AMR
+```
+
+---
+
+## Limitations and Notes {#amr-limitations}
+
+- **Slot memory.** Slots are sized to the maximum block extent, but field arrays are
+ allocated lazily and only for the blocks a rank owns (`amr_slot_live`), so a rank's fine
+ memory is roughly `1/num_procs` of the pool rather than the whole of it. Right-sized
+ per-block pools (rather than max-extent slots) are still future work.
+- **Restart across rank counts.** `parallel_io` restart repartitions the fine blocks
+ across any `num_procs` (each block is one contiguous region under whole-block ownership).
+ The serial (per-rank-file) restart path requires the same `num_procs` and aborts with a
+ clear message otherwise.
+- **Half-subdomain limit.** Each block may span at most half of any rank's local subdomain
+ per dimension, because the fine advance reuses the rank-local solver scratch.
+- **Multi-level constraints.** Recursive multi-level nesting (`amr_max_level > 1`) requires
+ `amr_ref_ratio = 2`; with immersed boundaries it is single-rank only, and a moving body is
+ not yet supported. `amr_ref_ratio = 4` is single-level only.
+- **Output resolution.** Standard visualization output (HDF5/SILO) is written at level-0
+ resolution; the restricted fine solution is already folded into the coarse fields over the
+ block region, so existing visualization workflows are unchanged. Setting `amr = T` in the
+ post-process input additionally overlays the refined fine blocks as separate SILO domains
+ (default off), giving fine-resolution visualization where blocks are active.
+- **Unsupported physics.** See the [physics matrix](#amr-physics) above. The restrictions
+ are enforced by the checker and reflect the validation state at the time of writing.
+
+Page last updated: 2026-07-27
+
+## Design notes {#amr-design-notes}
+
+Internal design / implementation records (how the code works, not how to configure it):
+
+- @subpage amr_multilevel — multi-level nesting design and reflux
+- @subpage amr_fine_distribution — fine-block distribution across MPI ranks
+- @subpage amr_block_batching — measured per-block swap cost and the batching design it implies
diff --git a/docs/documentation/amr_action_plan.md b/docs/documentation/amr_action_plan.md
new file mode 100644
index 0000000000..53983ca1cf
--- /dev/null
+++ b/docs/documentation/amr_action_plan.md
@@ -0,0 +1,3521 @@
+# AMR performance plan (2026-08-19 — post-diagnosis execution plan)
+
+> **2026-08-20 RE-FOUNDING: read `amr_endstate.md` first.** The program is derived from the
+> end-state architecture (four pillars, weak-scaling invariants W1-W8), not from phase shares at
+> the matched point. This document is the evidence ledger and detailed work list; where its
+> sequencing conflicts with the endstate ladder (notably: the batched advance is REINSTATED as
+> Phase 2, the "kills batching-the-advance" reading was an operating-point artifact), the endstate
+> document wins.
+>
+> ## CURRENT STATE (2026-08-28 EOD) — read this before picking work
+>
+> This block supersedes everything above it. Ledgers 40-43 below record how these conclusions were
+> reached, including four that were WRONG when first written; read them for method, not for status.
+>
+> ### Landed 2026-08-28 (19 commits; every code one gated on the AMR suite, most 69/69)
+>
+> | commit | change |
+> |---|---|
+> | `b055b0db` | **Cray debug bounds checking** — the only compiler whose Debug build had none |
+> | `8e10b445` | device-declare the module allocatables `@:ALLOCATE` maps (consistency, NOT the CCE fix) |
+> | `fa20cbae` | **NVHPC build fix** — a `GPU_DECLARE` must follow every symbol it names |
+> | `eb6b…` | **B1** — canonical Morton merge order; the merge depends on the box SET, not traversal order |
+> | `58aa0867` | **S3.3** — level->=2 forest clustered per OWNER, tags exchanged point-to-point |
+> | `263730c9` | **W1a** — six per-stage loops iterate this rank's own blocks, not the global list |
+> | `cefd3176` | **Restart format v2** — per-block (owner, m, n, p), not a per-RANK extent vector |
+> | `4ade13c3` | **CCE `move_alloc`** — a bare module-scope derived-type allocatable aborts on CCE (`lib-4425`). This is why AMR had NEVER run on Frontier; 64/66 pass after |
+> | `a72c125b` | **B0b** — `amr_blocking_factor` default 1 -> 4, + 14 regenerated goldens |
+> | `79fe684b` | `override_tol=1e-11` on the two churn-growth goldens (CCE reassociation, not a parallel defect) |
+> | `e2cb6078` | **S3.2b** — a rank-local node skips its global reduction; only the owner descends |
+> | `299c3686` | **S3.3c** — level-2 nesting coverage from OWNED blocks + one `ALLREDUCE(LOR)`; O(P^2) -> O(P) |
+> | `4a2edfbd` | **S3.2b-2a** — LEVEL-ORDER descent: one reduction per tree DEPTH, not per node |
+> | `b865a9a0` | **S3.2b-2b** — a NARROW node reduces among the ranks it spans (p2p), not the whole machine |
+>
+> ### Measured, not argued
+>
+> | quantity | before | after |
+> |---|---|---|
+> | `gwin_bytes` (level>=2 gather) | 2.00x per np-doubling | **FLAT over 8x in P** |
+> | per-rank clustering work | 3,016 / 5,888 / 11,632 / 23,128 | **378 at all four rungs** |
+> | level-1 collectives per regrid | 3,038 -> 23,310 | **~130x fewer at every rung** |
+> | checkpoint header at 75k ranks | 7.4 GB | **128 KB** |
+> | `MPI_TAG_UB` headroom | *assumed* 28k ranks | **measured 7.2e6 ranks** (Cray MPICH 2**29 - 1) |
+>
+> ### The plan of attack
+>
+> | # | item | size | status |
+> |---|---|---|---|
+> | 1 | Restart format v2 | — | **DONE** `cefd3176` |
+> | 2 | B0b — `amr_blocking_factor` 1 -> 4 | 1 line | **DONE** `a72c125b`, 14 goldens moved |
+> | 3 | S3.2b — rank-local nodes skip the collective | ~50 LOC | **DONE** `e2cb6078` |
+> | 4 | S3.3c — `covered` from owned blocks | ~60 LOC | **DONE** `299c3686` |
+> | 6 | S3.2b-2 — depth-batch, then scope, the shared nodes | ~250 LOC | **DONE** `4a2edfbd` + `b865a9a0` |
+> | 5 | Subcycle — scoped below; the np>1 gate is ALREADY LIFTED | 2 parts | open, cheap |
+> | 7 | **W1's ~19 remaining PER-STEP global block scans** | mechanical | open — key the cache on `amr_mesh_epoch`, NOT the owner-only dirty flag |
+> | **P'** | **Tax + payoff RE-BASELINE, matched AND production physics** | machine time | **next; see below** |
+>
+> ### THE W4 GATE WAS BROKEN, and item P is RESTATED
+>
+> **`amr-bench/invariant_scorecard.py` computed its verdict from the `ntag` slope alone, with a
+> `max(lo, 1)` denominator. S3.1 deleted `ntag` to zero, so the ratio was `0/1 = 0.00x` on every arm and
+> the gate was PINNED TO MET — structurally incapable of reporting UNMET. Every post-S3.1 "W4 MET"
+> reading is void.** Fixed 2026-08-28: the verdict is now the worst of {`ntag`, `gwin`, `shr_nodes`,
+> `shr_bytes`}, a deleted term is excluded rather than scoring 0.00x, and the COLLECTIVE-COUNT axis is
+> read from `[amr-scope-r]`. General rule: *a gate whose verdict divides by a term the program is trying
+> to delete will report success the moment the work succeeds.*
+>
+> With it fixed, the shared level-1 path was UNMET on both axes — nodes 11/23/47/91 and bytes 2.20x/2.15x
+> per doubling, i.e. O(P) — which is what items 6a/6b then fixed.
+>
+> **Item P as written ("wall-time weak scaling 256-1024 ranks vs the AMReX 1.20x bar") is RETRACTED and
+> replaced by P'.** Two reasons, both from the docs themselves: `amr_endstate.md` section 3 records that
+> this program already lost five days to a wall-clock metric *structurally blind to W4*, and decision
+> D-node states weak-scaling validation is single-node-by-design. Wall time at np <= 8 cannot see the
+> terms items 3/4/6 removed. Sized: the shared-reduce term is 0.3 MB/rank/regrid at np64, 6 MB at np1024,
+> 29 MB at np4096 and only 740 MB at 75k — **it is irrelevant below ~4k ranks and targets full-machine
+> runs specifically.**
+>
+> **P' is the measurement that actually decides what comes next:** tax and payoff are 6.81x / 2.23x from
+> 08-22 and predate B1, S3.3, W1a, B0b, S3.2b and 2a/2b — and B0b DELIBERATELY MOVED THE BOX SET, so the
+> old number cannot be carried forward. `amr-bench/tax_rebaseline.sh` runs the same differenced protocol
+> at the matched point AND adds the production arms (WENO5+HLLC, int=20) the harness has described in a
+> comment since 08-21 without ever running — regrid frequency alone moves the tax ~3.8x, so the matched
+> point is not a proxy. **Note the trap it fixes: the original resolved the binary with
+> `ls -t .../bin/simulation | head -1`, which after a gate that also builds the chemistry variant selects
+> the CHEM binary — verified live.**
+>
+> ### THE ~1e7-BOX CEILING (recorded design limit, 2026-08-28)
+>
+> All ten regrid collectives sized at 1e5 ranks x 75 boxes/rank: the shared-signature reduction was the
+> largest at ~970 MB/rank/regrid (item 6 takes it to ~3.6 MB), after which **~390 MB remains in two
+> `ALLGATHERV`s of the box list** — `gbx(6, ntot)` at the clusterer's close and `gch(7, ntot_ch)` in the
+> nesting pass. Both are the *replicated box list* that `amr_endstate.md` deliberately KEEPS and calls
+> "tolerable to ~10^7 boxes". 1e5 ranks x 75 boxes IS 7.5M. **So the architecture has a ~10^7-box ceiling
+> and this program walks up to it, not through it.** That is parity with AMReX, which hits the same wall
+> from the other side (`TagBoxArray::collate` gathers every tagged cell to the I/O rank and hard-aborts
+> above INT_MAX tags). Going further is a re-founding of the box-list decision, not an increment.
+>
+> **The other half of the goal is untouched by all of the above.** Everything here is SCALING. Parity is
+> tax 6.81x against AMReX 3.13x on the same 15.2x geometric advantage — AMReX's AMR returns ~4.9x over
+> brute force where MFC's returns 2.23x. That gap is W2 (launch count), FLAT in P, and is paid on every
+> run at every rank count. Finishing the scaling program does NOT reach "at or near SOTA".
+>
+> **W5 is OFF the critical path** (measured tag headroom, above). Converting the remaining per-box tag
+> sites and dropping the `amr_max_blocks` base term stay worthwhile for the end state; they gate nothing.
+>
+> ### Subcycle, scoped (2026-08-28) — smaller than the plan assumed
+>
+> The plan carried subcycle as unsized and "checker-gated at np>1". Reading the code and the test
+> generator, that is out of date on the part that mattered:
+>
+> - **np>1 correctness is DONE.** Golden **(q) `AMR -> 1D -> multi-level dynamic subcycle wide L2 np=2`**
+> exists and passes. Its comment records that the checker gated this combination only *until*
+> `s_amr_advance_children` walked whole levels, and that it deliberately exercises a child owned by a
+> DIFFERENT rank than its parent -- the case where a missed P2P post is a deadlock rather than a
+> tolerance failure. So there is no gate to lift and no correctness work to do.
+> - **W1, cheap.** `s_amr_advance_fine_subcycle_all` has 3 x `do islot = 1, amr_num_blocks`. The
+> `amr_my_blk` list from W1a converts them the same way, once `s_amr_select_slot`'s side effect is
+> handled (it precedes the filter at these sites, which is exactly the case W1a left unconverted).
+> - **The real work: the per-box rendezvous.** `s_amr_subcycle_setup_block` is called once per block and
+> calls `s_amr_gather_coarse_patch` followed by a BLOCKING `s_amr_gather_send_flush`, twice per block
+> (`q_old` and `q_new`, plus the pbmv pair under QBMM). That is precisely the per-box gather this
+> ledger identifies as the original root cause, and the wave program already replaced it three times
+> on the lockstep path (I2a, I3, I5 -- all landed). **I8 is that conversion with three worked
+> precedents**, not new design. The wave routines' `@:ASSERT(.not. amr_subcycle)` marks the boundary.
+> - **It IS needed for the demonstration** (the subcycle path is required, user 2026-08-28): left as a
+> per-box rendezvous it would dominate at scale, exactly as F1/F2/F6 did before their waves.
+>
+> ### Deferred, deliberately
+>
+> - **W1 memory** — `amr_region_lo_all`/`hi_all`/`owns_all`/`block_level` are all sized `amr_max_blocks`,
+> so every rank holds every block: ~180 MB/rank at Frontier. Survivable on 64 GB. This is the real
+> end-state item (distribute the metadata, query through `f_amr_owner`) and it is what bounds W1 from
+> below -- W1a and S3.3c take the TIME to O(local), they cannot touch the MEMORY.
+> - The five W1a sites where `s_amr_select_slot(k)` precedes the owner filter (side effect on `amr_cur`).
+> - **W2** (batched advance) — flat in P, an efficiency item, not a scaling one.
+> - W3, W6, W7 — unchanged, behind the above.
+>
+> ### ITEM #1 (2026-08-28): AMR aborts on Frontier under CCE — see the section below the header
+>
+> Frontier BUILDS but every AMR test aborts at init with `lib-4425 ... Unitialized descriptor for
+> ALLOCATE statement argument`. **Bisected on the machine: pre-existing, NOT from today's commits**
+> (`dc27e4a6` fails identically). This outranks every scaling item in the table above.
+>
+> ### CCE on Frontier: ANSWERED 2026-08-28
+>
+> AMR aborted at init on Frontier under CCE (`lib-4425`, uninitialised descriptor) -- **pre-existing, not
+> from this work** (bisected: `dc27e4a6` failed identically). Root cause: CCE leaves a bare module-scope
+> derived-type allocatable's descriptor uninitialised, so a direct `allocate` aborts. **The workaround was
+> already in this file** for `amr_cg` (see the comment at its allocation): allocate a LOCAL, hand it over
+> with `move_alloc`, then map. Applied to `amr_scr_prim`, `amr_scr_rhs`, `amr_cons_br`.
+> **Result: 64 of 66 non-chemistry AMR tests PASS under CCE.** The two failures are tolerance only --
+> abs 1.04e-12 against a 1e-12 bound, agreeing to 13 significant digits, with np=2 and np=4 producing
+> IDENTICAL values (so compiler reassociation, not a decomposition-dependent defect). Both now carry
+> `override_tol=1e-11`. **This is the first evidence the AMR implementation is correct under a second
+> compiler and offload stack.**
+>
+> ### The remaining open input
+>
+> **Wall-time, not counts.** Everything measured today is a COUNT — collectives, bytes, tree nodes walked.
+> No wall-time comparison has been made since before this work began, and the goal metric is the AMReX bar
+> (1.20x/1.15x per np-doubling) against MFC's last-measured 6.81x tax. Item P is the measurement; until it
+> runs we do not know whether any of today's asymptotic wins translate into speed.
+>
+> **ANSWERED 2026-08-28: it builds and syscheck passes, but every AMR test aborts at runtime.** See
+> **RESOLVED** — see the CCE section above: `move_alloc` fixes it, 64/66 pass under CCE.
+>
+> ### Method rules earned today, each from a wrong conclusion
+>
+> 0. **A change touching GPU directives cannot be validated on one compiler.** The local bar is amdflang;
+> it is 1 of 4 CI-gated compilers. Today it passed 69/69 while carrying (a) a CCE runtime abort and
+> (b) an NVHPC BUILD BREAK introduced by a `GPU_DECLARE` placed above the symbol it names. Green here
+> is necessary and says nothing about the others.
+>
+> 1. **No growth exponent on fewer than three points.** Cost two retractions in one day.
+> 2. **Before believing a FLAT result, ask what limit was pinned.** "Level-1 is flat at 16,383" was
+> `2*8192-1`, a tree clipped by a fixed `amr_max_blocks` in every rung. A suspiciously round number is
+> the tell.
+> 3. **Compare final-to-final.** The counters are cumulative; a mid-run `nboxes` against a completed
+> run's last line looks exactly like a divergence.
+> 4. **Verify the artifact, not the exit code.** `RC=143` hid a link error; `RC=0` shipped no
+> `pre_process`; `run -t X -t Y` silently skipped a target; the sticky lock resolved an unbuilt variant.
+> 5. **Grep before asserting a property in a comment.** "s_amr_assign_block_owners is the sole authority
+> for ownership" was false (tiled L2 inherits, restart/migration assign) and the gate caught it.
+>
+> **Working practice (measured 2026-08-27):** `amr-bench/fcheck.sh` structurally checks one .fpp in
+> ~4 s versus ~18 min for a GPU build and catches what `ffmt`/`lint_source` pass. CPU verification builds
+> go in `mfc-amr-cpu`, **never in `mfc-amr`** — a `--no-gpu` build there flips the sticky lock and the next
+> `test` dies at a compiler feature probe. `amr-bench/cpu/ladder.sh` runs a np8-128 weak-scaling ladder on
+> one node; `amr-bench/cpu/roundtrip.sh` is the restart write-then-read gate the np<=2 goldens cannot give.
+
+
+### 2026-08-28: AMR DOES NOT RUN ON FRONTIER — pre-existing CCE runtime abort, and it is now item #1
+
+Measured on Frontier (`-c frontier`, Cray CCE, OpenMP offload, `cpe/25.03 rocm/6.3.1`):
+
+- **It BUILDS.** `pre_process`, `simulation` and `syscheck` all build and install; syscheck PASSES including
+ `omp_get_num_devices() > 0` and the MPI checks.
+- **Every AMR test aborts at runtime**, 12 of 12, immediately after AMR init and before any time step:
+
+```
+lib-4425 : UNRECOVERABLE library error
+ INTERNAL ERROR-Unitialized descriptor for ALLOCATE statement argument.
+srun: error: task 0: Aborted (core dumped) # exit 134
+```
+
+**It is NOT a regression from the 2026-08-28 work.** Bisected on the machine: `dc27e4a6` (the HEAD before
+B1 / S3.3 / W1a / restart-v2 landed) fails with the identical error on the same test. The simplest case
+fails too -- `21C71558 AMR -> 1D -> static block`, a 63-cell 1D case with `amr_regrid_int = 0` -- so the
+fault is in AMR INITIALISATION, not in the clustering, regrid or exchange paths.
+
+**Why nobody knew.** The local validation bar is amdflang OpenMP-offload correctness only; other compilers
+are CI's job, and the AMR suite is not run under CCE anywhere in this ledger. Every "69/69 goldens" in
+this document is amdflang. **A green local gate says nothing about Frontier.**
+
+**Hypothesis tried and DISCARDED:** allocatable/pointer components of `t_level` (`amr_slots` is
+`allocate`d as an array of a type holding `type(scalar_field)`/`type(pres_field)` members). Both of those
+types declare `real(stp), pointer, dimension(...) :: sf => null()`, i.e. they ARE default-initialised, so
+allocating through them is legal and this is not the cause. Do not re-try it.
+
+**Next step is localisation, not more speculation:** a CCE `--debug` build normally reports the failing
+source line for `lib-4425`; failing that, `ATP_ENABLED=1` gives a traceback. Until there is a line number
+this is unattributable from a non-CCE machine.
+
+**Consequence for the plan: this moves ahead of every scaling item.** No exascale demonstration is
+possible while AMR aborts on the target machine at 1 rank, and every increment below is being validated
+on a compiler that does not reproduce it. It also means the ladder should add a CCE arm as soon as one
+exists, or the same class of breakage will keep accumulating undetected.
+
+## 2026-08-28 (41) — np32 closes the sweep, and it REORDERS the program: the forest, not level 1, is the O(P) term
+
+Three points, per rank, weak-scaled (400^3 -> 800x400x400 -> 800x800x400):
+
+| | np8 | np16 | np32 | growth |
+|---|---|---|---|---|
+| **`gwin_bytes`** (level>=2 window `ALLGATHERV`) | 360 MB | 719 MB | **1,440 MB** | **1.997x, 2.001x = O(P)** |
+| level-1 global `ALLREDUCE`s / regrid | 16,383 | 16,383 | 16,383 | flat |
+| level-1 shared nodes / regrid | 7 | 11 | 15 | **+4 per doubling = O(log P)** |
+| level-1 shared bytes / regrid | 19 KB | 35 KB | 58 KB | 1.865x then 1.645x, i.e. ~O(log P) |
+| `shr_maxdep` (exchange rounds) | 3 | 5 | 7 | +2 per doubling = 2 log2 P - 3 |
+| forest nodes that are rank-local | 99.79% | 99.79% | 99.77% | **constant** |
+
+**`gwin_bytes` is an O(P) term in W4** (and, when this was written, believed to be the ONLY one --
+**CORRECTED by the Arm B verdict below: level 1 is O(P) too; the 'flat' reading was a pinned cap**).
+It is It is 1.44 GB per rank per run at np32 (~144 MB per
+rank per regrid) and it doubles exactly with P. Extrapolated to 1e5 ranks that is ~450 GB per rank per
+regrid. It is also LARGER than the 185 MB `ntag_bytes` gather S3.1 deleted -- S3.1 removed the smaller
+of the two per-cell gathers.
+
+**Level 1 is not the exascale wall.** Its collective COUNT is flat (cap-fixed at 16,383) and everything
+about its shared set grows logarithmically. It is a latency constant worth removing, not an exponent.
+
+**I made the two-point error again, and the third point caught it again.** Earlier this session I read
+shared nodes as "1.57x per doubling ~ P^0.65, the rank-boundary surface" from np8 and np16 alone, and
+extrapolated ~3,000 shared nodes per regrid at 1e5 ranks. With np32 the sequence is 7, 11, 15 --
+**linear in log2 P**, giving ~63 at 1e5 ranks. Same failure mode as the retracted `P^0.73`: a ratio
+between two points is not an exponent. The rule now is that no growth exponent enters this ledger on
+fewer than three points.
+
+**`shr_maxdep` came back 7** -- the value ledger 39 pre-registered as "the design needs rethinking".
+It does not, and ledger 40 demoted that statistic on mechanism grounds BEFORE this number existed
+(written while the np32 job was still running with zero scope lines in its log). The demotion stands
+on its own reasoning: 7 = 2 log2 P - 3 gives ~31 exchange ROUNDS at 1e5 ranks, and rounds are not
+volume.
+
+
+### CORRECTION 2026-08-28 — "level-1 collectives are FLAT in P" is a CAP ARTIFACT, not a property
+
+Prompted by "are you sure you're running the right input decks?", the decks were audited. **They are
+correct**, and the audit is worth recording because it validates every number above:
+
+- IC `hcid 306` is `1 + 4*exp(-(cos(pi x)^2 + cos(pi y)^2 + cos(pi z)^2)/0.15)` -- **periodic with period 1**,
+ so it is a BLOB LATTICE: 8 blobs at 2x2x2 (np8), 16 at 4x2x2 (np16), 32 at 4x4x2 (np32). The feature
+ count scales exactly with P.
+- Resolution is constant at 200 cells per unit length in all three rungs, and the final box count scales
+ with P: **594 / 1206 / 2405 = 2.03x, 1.99x.**
+- Restart decks match their rungs exactly: `lustre_0.dat` is 6 vars x cells x 8 B (3.07 / 6.14 / 12.29 GB),
+ and `x/y/z_cb` hold m+2 / n+2 / p+2 doubles. `simulation.inp` as-run confirms m/n/p, `t_step_stop = 200`,
+ `amr_regrid_int = 20` identical, and `amr_blocking_factor` 1 in all three.
+
+**But `amr_max_blocks = 8192` is held FIXED across the rungs, and the tree SATURATES it in every one:**
+`[amr-tree] lmax` is exactly 8192, the `capped` warning fires on 10 of 10 regrids, and the node count is
+**16,383 = 2 x 8192 - 1 -- exactly a full binary tree pinned by the cap.**
+
+**So level-1's collective count could not have grown with P in this experiment no matter what the
+algorithm does.** "Flat in P" above is measuring the cap, not the clusterer. The final box count DOES
+scale with P (594 -> 2405), so the natural uncapped tree is larger at np32 and is being clipped back to
+8192 leaves in every rung.
+
+**What this does and does not change.**
+- **`gwin_bytes` O(P) STANDS.** It is driven by tagged cells inside parent windows, which scale with the
+ blob lattice; the cap bounds BOXES, not tagged cells. Its 1.997x / 2.001x is genuine.
+- **The claim that level 1 is asymptotically harmless does NOT stand.** After B0b makes the recursion
+ self-terminating, level-1 node count should track the physics and grow with P -- which would make the
+ level-1 collectives O(P) too and weaken the argument for putting S3.3 ahead of S3.2b.
+- Ledger 41's "+4 per doubling" for SHARED nodes is a ratio between rungs whose trees are the same size
+ by construction, so it measures how the FIXED tree splits across more ranks. That is still the right
+ quantity for the shared/local split, but it is not evidence about how the tree itself scales.
+
+**FIRST RESULT IN (job 388669, np8, bf=4): B0b's premise CONFIRMED.** Zero `clustering capped`
+warnings against 10-of-10 at bf=1, and `lmax` 6872-7438 rather than pinned at 8192 -- **the recursion
+self-terminates at bf=4.** Level-1 nodes/regrid 13,825; boxes 576 vs bf=1's 594 (3%). Cross-check that
+matters: **`gwin_bytes` per regrid is ~40 MB at BOTH bf=1 and bf=4**, so the forest gather is insensitive
+to the blocking factor -- confirming it is driven by tagged cells, not by the tree or the cap, and that
+its O(P) is not a cap artifact.
+
+**Note the ordering decision is ROBUST to how this comes out.** Both S3.2b and S3.3 are required for W4;
+the experiment decides the JUSTIFICATION for doing S3.3 first, not the action. S3.3 removes a measured
+1.44 GB/rank term with a verified np>1 golden gate and a bounded design, so it is the right next code
+change whether or not level 1 also turns out to be O(P). Do not block S3.3 on these jobs.
+
+**Caveat on B0b at scale:** bf=4 gives `lmax` 7438 against a cap of 8192 at np8. If the tree scales with
+P, a fixed `amr_max_blocks = 8192` will bind again at np16/np32 -- `amr_max_blocks` is a user-set case
+parameter and is NOT auto-scaled. B0b makes the recursion self-terminating at the sizes the goldens and
+this benchmark use; it does not remove the need to size the cap with the problem.
+
+**ARM A CONFIRMS THE CONFOUND DIRECTLY (jobs 388669/388670).** At `bf=4` with the cap left at 8192:
+np8 gives 13,825 level-1 nodes/regrid and **0** capped warnings; np16 gives **16,383 and 5 capped
+warnings** -- it RE-SATURATED. So the level-1 tree genuinely grows with P (np8 sat below the cap, np16
+wanted more and was clipped back to exactly 2*8192-1), and `bf=4` alone does NOT keep the cap out of the
+way at larger P. **This is direct evidence that the earlier "flat in P" was the cap, not the clusterer.**
+Arm B (`amr_max_blocks = 65536`, jobs 388698/388699/388700) is therefore the only unconfounded arm and is
+the one to read for the growth rate.
+
+**Consequence for B0b:** raising the blocking factor makes the recursion self-terminating at a GIVEN
+problem size; it does not stop a fixed `amr_max_blocks` from binding as the problem grows. B0b remains
+correct and necessary (it is what makes `force` inert so S3.2b/S3.3 can be bit-identical at the sizes we
+test), but it is not a substitute for sizing the cap with the problem.
+
+**Settled by experiment, not argument:** jobs 388669/388670/388671 re-run np8/16/32 with
+`amr_blocking_factor = 4` (a RUNTIME namelist parameter -- no rebuild needed) on the pinned B1 binary
+`simulation-b1-54da9155`. If level-1 node count then scales with P, S3.2b returns to the critical path
+and the S3.3-first ordering must be re-argued on absolute size rather than on exponent.
+
+### The reordering
+
+The plan sequenced S3.2 (level 1) before S3.3 (forest) on the argument that "the forest performs zero
+collectives today, so converting it first would ADD ~22-28k collectives with no mechanism to scope
+them". That argument modelled S3.3 as *making the forest reduce-driven like level 1*. The measurement
+says the forest does not need that:
+
+- The forest is **99.8% rank-local, and the fraction is constant in P** (0.206%, 0.208%, 0.234%
+ shared). The `ALLGATHERV` exists only so that EVERY rank can cluster EVERY parent's window --
+ replicated global work whose input is gathered globally.
+- So the bulk of S3.3 is **"each rank clusters only the windows of the parents it owns"**, which adds
+ no collectives at all, deletes the gather for the 99.8% case, and deletes the replicated work with
+ it. Only the ~0.2% of windows that straddle ranks need the shallow mechanism.
+- Rank-invariance of the resulting box set then comes from **one `ALLGATHERV` of BOXES plus B1's
+ canonical order** -- which is why B1 was worth landing first, and is already written.
+
+**Caveat, stated so the reordering is not oversold: `gwin_bytes` is not today's wall-time bottleneck.**
+At np32 it is ~144 MB per rank per regrid, roughly 15 ms of wire time -- small against a 42 s regrid.
+Its phase (`rg:build`, 9.2% at np32) does not stand out, and regrid wall is not even monotone across
+the sweep (400 / 278 / 420 s), which is the MPI-wait variance this ledger has documented before. The
+case for S3.3 is **asymptotic**: 144 MB/rank/regrid doubling with every doubling of P reaches ~450 GB
+per rank per regrid at 1e5 ranks, and no other measured term does that. Prioritising it is a bet on
+the exascale goal, not a claim about the current operating point -- and it is the right bet only
+because the goal is the end-state architecture rather than the matched-point ladder.
+
+**Revised order: B1 -> B0b -> S3.3 (forest ownership split) -> S3.2b (level-1 depth batching).**
+S3.3 moves first because it carries a MEASURED O(P) term and, at 144 MB per rank per regrid, the largest
+absolute number on the board. S3.2b stays, demoted to a latency-constant fix. S3.3 also retires W1's
+regrid pass-2 loops (parents x global tagged cells), so it closes two invariants.
+
+## 2026-08-28 (40) — B1 landed, and W4's level-1 problem restated: it is COLLECTIVE COUNT, not volume
+
+**Per-regrid decomposition of the level-1 reducing path** (differencing consecutive `[amr-scope-r]`
+prints instead of reading the cumulative totals — the counters turn out to be near-constant regrid to
+regrid, 7,7,7,... at np8, so a 60-step run measures this as well as a 200-step one):
+
+| per regrid | np8 | np16 | ratio |
+|---|---|---|---|
+| global `MPI_ALLREDUCE`s | 16,383 | 16,383 | 1.00x |
+| ...on nodes spanning >1 rank | 7 | 11 | 1.57x |
+| local bytes | 1.39 M | 1.39 M | 1.00x |
+| shared bytes | 18,960 | 35,360 | 1.87x |
+| `shr_maxdep` | 3 | 5 | +2 |
+
+**99.93% of the level-1 global collectives are on nodes that lie wholly inside one rank.** That rank
+already holds every tag in the subtree, so the reduction changes nothing and costs a full-machine
+synchronisation. The count and the per-rank volume are both EXACTLY FLAT in P under weak scaling
+(16,376 -> 16,372 local nodes; 1.39 M -> 1.39 M bytes) because the level-1 tree is cap-limited.
+
+**This corrects how W4 was being scored.** The wall is not bytes — per-rank level-1 volume is already
+flat. It is ~16,383 global collectives per regrid, each synchronising all P ranks, so the cost grows
+as (fixed count) x (latency ~ log P). At 1e5 ranks that is ~1.6 s per regrid of pure synchronisation.
+The earlier `[amr-tree] rbytes` growth of 1.67x/1.83x per doubling that motivated "S3.1 is still O(P)"
+is real but lives entirely in the **level-2 forest**, which runs `reduce = .false.` and performs zero
+collectives today. Level 1 -- the only path that communicates -- is flat.
+
+**Consequence for the S3.2b gate.** The gate recorded below as "per-rank reduced bytes FLAT across
+np8/16/32" measures a quantity that is ALREADY flat and therefore cannot discriminate. **The gate is
+now: level-1 global collectives per regrid drop from 16,383 to the shared-node count (7/11/...), and
+those residual exchanges are sparse (only the overlapping ranks) rather than over MPI_COMM_WORLD.**
+Box-set identity and `[amr-tree] nodes` unchanged still stand as correctness gates.
+
+**`shr_maxdep` is DEMOTED, and this is a deliberate revision of a pre-registered rule.** Ledger 39
+pre-registered "np32 = 6 -> the log2 model holds and S3.2 proceeds; 7 -> the design needs rethinking".
+That rule treated `shr_maxdep` as a proxy for how much of the tree stays shared. It is not one: it is
+a MAXIMUM over a geometry-dependent quantity (a box straddling a rank boundary stays shared however
+small it gets), and in the sparse per-depth exchange it sets only the number of latency ROUNDS, since
+all shared nodes at one depth exchange concurrently. At 1e5 ranks, `log2 P` rounds is ~17 and
+`2 log2 P` is ~34; both are negligible against 16,383 global collectives. **So np32 = 7 would not
+collapse the design.** The revision is grounded in mechanism read out of the code (`s_amr_find_split_sig`
+scans a node's whole signature, so a participating rank needs the full 1D signature -- a box EXTENT,
+not a volume -- and depth-batching makes rounds = maxdep), not in the number being inconvenient; and
+it makes np32 LESS decisive rather than more. The statistic that does decide is per-rank
+participation, which ledger 40 instruments below.
+
+**S3.2a-2 (instrumentation, golden-neutral).** `amr_cl_me_nodes_r` / `amr_cl_me_rb_r` count the shared
+nodes whose box actually reaches into THIS rank's subdomain -- what the sparse exchange would cost a
+rank, as opposed to `shr_*_r` which prices the allreduce form where every shared node lands on every
+rank. Reduced with MAX across ranks (rank 0 owns a domain corner and understates it) and printed as
+`[amr-scope-me]`. **Pre-registered reading:** the design holds if `me_rb_max` grows at roughly the
+domain-extent rate (~1.26x/doubling = P^(1/3) in 3D) while `shr_rb_all` grows ~1.87x, i.e. the ratio
+me/all FALLS with P; it is in trouble if `me_rb_max` tracks `shr_rb_all`, meaning ranks participate in
+nearly every shared node and sparsity buys little.
+
+**What the golden suite can and cannot say about B1.** The 69 AMR goldens ran clean through B1 with no
+box-set movement. That is evidence B1 BREAKS nothing; it is NOT evidence the property is exercised. The
+merge's order-dependence needs ambiguous chains of too-close boxes, which need many boxes: the test cases
+carry a handful, the benchmark carries 594-2405. So the suite cannot distinguish B1 from a no-op, and the
+evidence that B1 is NEEDED remains the code reading of `nacc`'s three uses, not a test. Do not let a green
+suite be reported as validating the canonicalisation.
+
+**B1 (canonicalise the merge) implemented.** `s_amr_cluster` now sorts the accepted boxes by Morton of
+`lo` (a stable insertion sort; accepted boxes are disjoint so their `lo` corners are distinct) before
+the min-separation pass, and the pass removes a fused box by shifting down rather than swapping with
+the last entry. The merge therefore depends only on the box SET, not on the traversal order that
+produced it -- the precondition for S3.2 completing local subtrees in parallel. +34/-4 lines. **Moves
+the box set; goldens regenerated in the same commit and the diff explained.**
+
+## 2026-08-27 (39) — B0 + S3.2a: GOLDEN GATE CLOSED, and the np32 question that decides S3.2
+
+`320fe106` was committed with the caveat that the 69-test AMR suite had not finished before the node
+allocation expired. **It finished: 69 passed, 0 failed.** B0 (at the `bf = 1` default) and the S3.2a
+scope instrumentation are therefore gated by the full suite, not only by bit-identity. The caveat
+still stands for `bf > 1`, which no test exercises — that remains evidence-backed by the sweep only.
+
+**B0 priced (np8, per regrid):** `bf=1` 38,255 nodes / 594 boxes; `bf=8` 6,475 / 576; `bf=16`
+1,466 / 576. **26x fewer tree nodes produce the SAME answer**, and the cap-saturation warning stops
+at `bf >= 4`. But B0 is NOT a W4 lever: at np8 it cuts LOCAL (free) nodes 5x and leaves the SHARED
+set untouched (7 -> 8.8 nodes, 18,966 -> 21,547 B), because it prunes leaves and leaves are already
+rank-local. Its value is latency, plus making `force` inert so B1 and S3.2 can be gated.
+
+**THE OPEN QUESTION, and this machine can answer it.** `shr_maxdep` went 3 (np8) -> 5 (np16), i.e.
+**+2 per doubling, not the +1 that log2(P) predicts**. If that rate persists, at 1e5 ranks the shared
+phase would be ~31 levels — essentially the whole tree — and S3.2's premise collapses. np32
+(job 388355) discriminates: **6 means the log2 model holds and S3.2 proceeds as designed; 7 means +2
+is real and the design needs rethinking BEFORE it is written.**
+
+**Do NOT spend big-machine allocation yet.** The need for the scoping technique is already
+established here with a mechanism, not an extrapolation: the forest term grows 1.97x/1.99x (exactly
+P) while the cap-fixed level-1 term is constant, so S3.1 is asymptotically O(P). Frontier would
+refine WHERE it breaks, not WHETHER. The right moment for big-machine time is AFTER S3.2+S3.3, to
+demonstrate per-rank reduced bytes actually flat at 1-4k ranks — a short counters-only run. The one
+exception: if np32 returns `shr_maxdep = 7`, a small probe (np64-np256, minutes each) is the cheapest
+way to distinguish "+2 forever" from "+2 then flattening".
+
+## S3.2 DESIGN CONTRACT (2026-08-27) — scoping the clustering reductions
+
+Written after S3.1 measured asymptotically O(P). This is the next design contract; S3.3 then applies
+the same mechanism to the level-2 forest, which is the term that actually scales.
+
+### Depth-fusion alone FAILS — the arithmetic that kills the obvious design
+
+Fusing all nodes at tree depth d into one allreduce gives ~32 collectives per regrid instead of
+16k-127k, which fixes LATENCY and nothing else: **an allreduce delivers the whole buffer to every
+rank**, so per-rank volume is the TOTAL signature volume at that depth, `~3 * L * N^(2/3)`. At fixed
+per-rank work (`L ~ P^(1/3)`, `N ~ P`) that is **O(P) per rank — the slope S3.1 already has.**
+Recorded because it is the design the earlier "~17 fused collectives per regrid" note implies, and it
+would have failed its own gate only after being built.
+
+### The property that makes scoping possible
+
+A rank can hold tags only inside its own subdomain, so:
+
+1. near the root a node spans many ranks, but there are FEW such nodes (at most 2^d at depth d);
+2. **below roughly depth log2(P) a node's box fits inside ONE rank's subdomain**, that rank holds
+ every tag in the subtree, and **the whole remaining subtree needs ZERO communication** — it
+ recurses locally exactly as the serial code does today.
+
+At np32 that is ~5 shared levels against a measured `ldepth` of 32: **most of the tree should never
+touch MPI at all.**
+
+### The mechanism: sparse per-depth exchange, no communicator per node
+
+Within the shallow phase a rank needs the reduced signature only for nodes its subdomain overlaps —
+its own path down the tree, O(1) per depth, not all 2^d. So: **one sparse exchange per shared depth**
+(~log2 P per regrid), each rank contributing and receiving only its own nodes. Per-rank volume becomes
+`O(log P * local extent)` — **sublinear in P, which is what W4 requires.** Implement with
+`MPI_Neighbor_alltoallv` on a graph communicator built once per regrid, or point-to-point to the
+overlapping ranks; the overlap inversion already exists (`s_amr_ranks_overlapping`, `amr_ovl_gather`).
+**`MPI_Comm_split` is the wrong tool and is not needed anywhere** — that open question dissolves.
+
+### Assembling the box list
+
+No rank holds the whole set, so close with ONE `ALLGATHERV` of the resulting BOXES — per-box global
+data, which the endstate explicitly permits. Determinism needs a canonical sort key (Morton of `lo`,
+then level) so every rank builds an identically ordered list regardless of arrival order; `f_morton`
+is injective below 2^21 per dimension.
+
+### What this does NOT solve — stated up front
+
+- **`force` reads GLOBAL `nacc + nwork`** against the block cap, which a rank finishing a local
+ subtree cannot see. **B0 is the dependency:** if a minimum box size stops the bisection reaching the
+ cap, `force` never fires. If it does not, the cap needs a per-subtree budget, which moves the box
+ set and breaks bit-identity.
+- **Bit-identity is NOT free.** The serial recursion visits nodes in a deterministic LIFO order and
+ accept/force depend on `nacc`; local subtrees completing in parallel change that order. Whether the
+ box SET is identical must be PROVEN, and it is the gate.
+
+### PREREQUISITE FOUND 2026-08-27: the merge is ORDER-DEPENDENT, so S3.2 cannot be bit-identical
+
+Reading every use of `nacc` in `s_amr_cluster` — the state that carries traversal order into the
+result — finds three, and the third is fatal to the bit-identity plan:
+
+1. `force = (nacc + nwork + 1 >= cap)` — order-dependent, but **B0 makes it inert** by keeping the
+ bisection away from the cap.
+2. `if (nacc < cap)` — likewise inert once the cap is not approached.
+3. **the min-separation merge** — scans the accepted boxes IN INSERTION ORDER, fuses the FIRST
+ too-close pair, removes it by swapping with the last element, and restarts. If A-B and B-C are
+ both within `thr` the outcome depends on which is found first, and the swap-with-last removal
+ permutes the list every iteration.
+
+**So the merged box set is a function of the order boxes were accepted.** S3.2 completes local
+subtrees in parallel, changing that order. Bit-identity is therefore not merely unproven — it is
+**unachievable** while the merge consumes insertion order.
+
+**B1, its own increment, BEFORE S3.2.** Canonicalise the merge input: sort the accepted boxes by a
+deterministic key (Morton of `lo`, then extent) before the min-separation pass, and make removal
+order-preserving instead of swap-with-last. The merge then depends only on the box SET.
+**This moves the box set once and is NOT bit-identical**, so it lands alone with goldens regenerated
+and the diff explained. Folding it into S3.2 would confound "did the scoping break something" with
+"did canonicalisation move the boxes", and every S3 gate so far has relied on bit-identity being a
+clean signal.
+
+**Revised S3 order: B0 -> B1 -> S3.2a -> S3.2b -> S3.3.** B0 and B1 together remove every order
+dependence from the clusterer, which is what makes S3.2's gate mean anything.
+
+### PREREQUISITE FOUND 2026-08-28: at the DEFAULT `amr_blocking_factor = 1` the cap is load-bearing, so S3.2b cannot be bit-identical
+
+Ledger 39 priced B0 and noted the cap-saturation warning "stops at `bf >= 4`", but left the DEFAULT at
+`bf = 1`. Re-reading `s_amr_cluster` against the logs shows what that costs S3.2b:
+
+- `force = (nacc + nwork + 1 >= cap)` accepts a node unsplit to protect the `amr_max_blocks` array
+ bound. It reads **global** `nacc`, i.e. how many boxes the whole traversal has accepted so far.
+- At `bf = 1` the recursion does not converge on its own -- it splits until the cap stops it. The
+ np16 run emits `[amr] WARNING: tag clustering capped` on **10 of 10 regrids**, and `[amr-tree] lmax`
+ is exactly 8192 = `amr_max_blocks`. So `force` is live at the default, on every regrid.
+- S3.2b's deep phase is PRIVATE: a rank finishing its own subtree cannot see global `nacc`. Enforcing
+ the cap per rank is a different box set; ignoring it overflows.
+
+**So B0 is not optional and not merely a latency win: making the recursion self-terminating is a
+PRECONDITION for S3.2b's bit-identity gate to be meetable at all.** This was scoped wrongly in ledger 39,
+which treated B0 as "latency, plus making `force` inert" without noticing that the shipped default
+leaves it un-inert.
+
+**B0b, its own increment: change the `amr_blocking_factor` default from 1 to 4.** Ledger 39's sweep is
+the evidence -- saturation stops at `bf >= 4`, and `bf = 8` produces 576 boxes against `bf = 1`'s 594
+(a 0.7% change in the final box set) from 26x fewer tree nodes. **4 rather than 8 or 16** because the
+69 AMR goldens run on small grids (128^2 and below), where a minimum child extent of 8-16 cells would
+distort refinement; 4 is the smallest value the measurement supports.
+
+**Moves the box set, so it lands with goldens regenerated -- as its own commit, after B1.** Two
+regenerations rather than one bundled commit: B1 (Morton merge order) and B0b (minimum box size) move
+the boxes for unrelated reasons, and a combined diff could not be explained.
+
+**Revised S3 order: B0 -> B1 -> B0b -> S3.2a -> S3.2b -> S3.3.**
+
+### S3.3 DESIGN CONTRACT (written 2026-08-28, from reading the level->=2 block at m_amr_regrid.fpp:1118-1300)
+
+**What the code does today.** For each level >= 2, with `plo = 1, phi = nboxes` spanning EVERY box at the
+previous level globally:
+
+- **Pass 1** builds each parent's dense window `gwin`, tags it from old level-(lev-1) blocks, but
+ contributes only from blocks this rank owns (`if (amr_owns_all(ob))`), and packs those cells as
+ `(int8 linear index, parent kb)` pairs.
+- **One `MPI_ALLGATHERV` per level** sends every rank every parent's pairs. **This is `gwin_bytes`:
+ 360 / 719 / 1440 MB per rank at np8/16/32, exactly O(P).**
+- **Pass 2 runs on every rank for every parent**, and rebuilds each parent's window with
+ `do i = 1, ntot_g; if (gkb(i) /= kb) cycle`. That is a full scan of the GLOBAL pair list once per
+ parent: **O(parents x global tags) replicated work** -- ~2,400 parents x ~9 M pairs per regrid at np32.
+ This is exactly the "regrid pass-2 loops (parents x global tagged cells)" that W1 names.
+
+**The change: give each parent an OWNER and exchange point-to-point instead of gathering globally.**
+
+1. Assign parent `kb` to a rank deterministically and identically on every rank -- round-robin
+ `mod(kb - 1, num_procs)` both balances and needs no communication to agree on.
+2. Pass 1 packs as today, but buckets each pair by `owner(kb)` instead of appending to one list.
+3. Replace the `ALLGATHERV` with **`MPI_Alltoallv`**. Per-rank send volume becomes O(this rank's own
+ tagged cells) and receive volume O(the tags of the parents it was assigned) -- both O(local), which
+ is exactly what W4 asks for. The measurement says 99.8% of forest nodes are rank-local at a constant
+ fraction in P, so most of this traffic is self-to-self and never hits the wire.
+4. Pass 2 loops over **assigned parents only**. The `do i = 1, ntot_g` filter disappears with it: the
+ received buffer already contains only this rank's parents, so sorting it once by `kb` replaces the
+ per-parent rescan. **That retires W1's pass-2 term in the same change.**
+5. Close with **one `ALLGATHERV` of the resulting child BOXES** -- per-box global data, which the
+ endstate permits, ~24 B x 2,400 boxes = 58 KB against 144 MB today -- then B1's canonical Morton
+ order makes the assembled list identical on every rank regardless of arrival order.
+
+**Why this does not need S3.2b first.** Ledger 39 sequenced S3.2 ahead of S3.3 on the argument that the
+forest "performs zero collectives today, so converting it first would ADD ~22-28k collectives". That
+modelled S3.3 as making the forest reduce-driven per node. It is not: ownership plus one alltoallv adds
+NO per-node collectives, and the residual cross-rank windows are the same ~0.2% the scope instrument
+already measures.
+
+**SPLIT INTO TWO GATED INCREMENTS (2026-08-28), because you cannot target the exchange until you know
+who needs what:**
+
+- **S3.3a — pass 2 by ownership, keeping the `ALLGATHERV`.** Assign `powner(kb) = mod(kb - plo, num_procs)`
+ (a pure function of `kb`, so every rank agrees with no communication); pass 2 processes ONLY its own
+ parents. This deletes the per-parent rescan of the whole gathered pair list — `do i = 1, ntot_g` inside
+ `do kb = plo, phi`, i.e. **O(parents x global tags) on EVERY rank**, which is W1's pass-2 term — and the
+ replicated clustering with it. The global `nboxes + 1 > amr_max_fine` guard cannot be evaluated per rank
+ any more, so children are emitted uncapped into a local list and **replayed in (kb, emission) order**
+ after ONE `ALLGATHERV` of the child BOXES (7 ints each, ~67 KB against the 144 MB per-cell gather). Each
+ parent has exactly one owner emitting in order, so a stable counting sort by `kb` reproduces the serial
+ append order exactly — **same box list, same truncation, same `box_level`. Gate: bit-identity.**
+- **S3.3b — replace the pass-1 `ALLGATHERV` with `MPI_Alltoallv`.** Now that a rank only needs its own
+ parents' tags, bucket the packed pairs by `powner(skb(i))` (stable counting sort), exchange counts with
+ `MPI_Alltoall`, then `Alltoallv`. Send volume becomes O(this rank's tagged cells), receive volume
+ O(its assigned parents' tags). **`gwin_bytes` stops being O(P).** Pass 2's remaining per-parent scan
+ becomes O(parents/P x tags/P) = **O(1) per rank under weak scaling**, closing W1's term completely.
+
+
+
+
+
+
+### W5 SCOPED FROM THE CODE 2026-08-28: the wall is the tag BASE, not only the per-box sites
+
+Auditing every AMR point-to-point tag argument (continuations joined, 57 calls in `m_amr.fpp`):
+
+| tag form | calls | verdict |
+|---|---|---|
+| `tq = amr_tag_base(f) + mod(amr_mesh_epoch, 50 or 100)` | 22 | **already the end-state (family, epoch) form** |
+| `tp = amr_tag_base(3) + mod(...)` | 2 | same |
+| `amr_cur` (mesh slot index) | 11 | bounded by the slot pool, not the global block count |
+| `k`, `4400 + k`, `cblk`, `ks` | ~12 | per-object |
+
+The per-object sites are concentrated, not scattered: the **L0 tile family** --
+`s_l0_fill_tiles_from_coarse`, `s_l0_scatter_tiles_to_coarse`, `s_l0_add_reflux_to_tiles`,
+`s_l0_restrict_to_tiles` (2 calls each, and all four use BLOCKING `MPI_SEND`/`MPI_RECV`) -- plus the
+chunked gather (`s_amr_gather_chunk_post`/`_send`, `s_amr_gather_from_parent_field_*`).
+
+**But the binding constraint is the BASE, and this is the part worth internalising:**
+
+```
+amr_tag_base(f) = amr_max_blocks + 100*f ! m_amr.fpp:839
+@:ASSERT(amr_tag_base(size(amr_tag_base)) + 100 <= tag_ub, ...) ! :849, the tripwire
+```
+
+**Every family's tag base carries an `amr_max_blocks` offset**, reserving `[1..amr_max_blocks]` for the
+legacy per-box space while families convert. So even a FULLY converted family has a base that grows with
+the problem, and the `MPI_TAG_UB` assert caps global blocks near `2**21` ~ 2.1e6 -- **~28k ranks at the
+measured ~75 boxes/rank**, which is exactly the wall the module comment records.
+
+**So W5 is two steps, and only the second removes the wall:**
+1. Convert the remaining families off per-object tags -- and note this is NOT a tag rename: per-object
+ tags exist to match multiple messages between the same pair, so each family needs its messages
+ AGGREGATED per peer first, the same shape as I2a/I3/I5. The L0 tile family additionally needs its
+ blocking SEND/RECV pairs converted.
+2. **Then drop the `amr_max_blocks` term from `amr_tag_base`.** The module comment states the condition
+ exactly: "The amr_max_blocks term can only go once NO family uses per-box tags." After that the tag
+ space is O(families x epoch) = O(1) and the 28k-rank wall disappears.
+
+Step 2 is one line and is the whole point; step 1 is the work that unblocks it.
+
+
+
+### DE-RISK ANSWERS 2026-08-28 (user-confirmed) — one wall may not exist, one new item, one constraint
+
+**1. `MPI_TAG_UB` is NOT 2**21 on the MPI we have.** Measured on hpcfund Open MPI 4.1.8:
+**`MPI_TAG_UB = 2147483647` (2**31 - 1)**, so the assert
+`amr_tag_base(7) + 100 <= tag_ub` admits `amr_max_blocks` up to ~2.1e9 -- about **28 MILLION ranks** at
+75 blocks/rank, not the 28 thousand the module comment states. **That comment's "2**21 ~ 2.1e6, about 28k
+ranks" is an ASSUMED tag ceiling, not a measured one**, and the code has carried it as fact.
+
+Probe (verified locally, `cc` + `srun -n1`):
+
+```c
+#include
+#include
+int main(int c,char**v){int f;void*p;MPI_Init(&c,&v);MPI_Comm_get_attr(MPI_COMM_WORLD,MPI_TAG_UB,&p,&f);
+printf("MPI_TAG_UB = %d (flag=%d)\n",*(int*)p,f);MPI_Finalize();return 0;}
+```
+
+**MEASURED ON FRONTIER 2026-08-28: `MPI_TAG_UB = 536870911` (2**29 - 1), Cray MPICH.** That admits ~537e6
+global blocks, i.e. **~7.2 MILLION ranks** at ~75 boxes/rank, against Frontier's ~75,000 GCDs -- about
+**95x headroom**. **W5 IS OFF THE CRITICAL PATH.** The `2**21 / 28k ranks` figure was wrong by 256x and
+had been carried as fact in the module comment (now corrected in `m_amr.fpp`) and through this plan.
+Converting the remaining per-box tag sites and dropping the `amr_max_blocks` base term stay worthwhile
+for the end state -- they are what makes the tag space O(1) rather than O(global blocks) -- but they no
+longer gate the demonstration and no longer couple to the subcycle work.
+
+(Superseded text kept for the reasoning: If it also reports >= ~2**25, **W5 leaves the critical path**: the per-box tags and the `amr_max_blocks` base term remain worth cleaning up for the end state,
+but they stop being a hard abort and the demonstration does not wait on them. If Cray MPICH really is 2**21, W5 returns to its previous position.) **That number is now in: it is 2**29 - 1.**
+
+**2. Subcycling IS required for the demonstration (user, 2026-08-28).** That adds an item the ladder had
+deferred: subcycle + dynamic regrid at np>1 is CHECKER-GATED today, and the subcycle p2p sites are an
+explicit deferral to increment I8. So the demo needs the gate lifted and those sites converted -- and the
+I8 sites are per-box tagged, which couples this to W5 whichever way the tag probe lands. Treat as a
+sixth item, sized after the tag answer.
+
+**3. Old checkpoints MUST stay readable (user, 2026-08-28).** So the restart format fix (item 1) keeps a
+LEGACY READER PATH: version-stamp the new layout, read both, write only the new one. That raises its cost
+from "change the format" to "change the format and keep the old reader alive", but it is still bounded and
+it stays first -- it is the only item on the list whose failure mode is SILENT CORRUPTION of saved state
+rather than a crash.
+
+### DE-RISK 2026-08-28: a FOURTH wall, in the RESTART writer, and it is the worst one found so far
+
+Asked to de-risk the true challenges rather than keep incrementing, I audited the paths a real run needs
+but the benchmark does not exercise. The parallel-IO checkpoint writer
+(`m_amr_restart.fpp`, the `parallel_io` branch) contains:
+
+```
+allocate (myext_all(3*amr_num_blocks), wext_all(3*num_procs*amr_num_blocks))
+...
+call MPI_EXSCAN (my_cnt_vec, my_off_vec, amr_num_blocks, MPI_OFFSET, ...)
+call MPI_ALLREDUCE(my_cnt_vec, tot_cnt_vec, amr_num_blocks, MPI_OFFSET, ...)
+call MPI_ALLGATHER(myext_all, 3*amr_num_blocks, MPI_INTEGER, wext_all, 3*amr_num_blocks, ...)
+```
+
+**`wext_all` is `3 x num_procs x amr_num_blocks` integers, allocated PER RANK**, and the `ALLGATHER`
+that fills it moves that much to every rank. This is **O(P x global blocks) memory per rank** -- the only
+quadratic ALLOCATION found anywhere in the code, and strictly worse than the O(P) metadata replication
+that limits the rest of the system.
+
+| ranks | `amr_max_blocks` | `wext_all` per rank |
+|---|---|---|
+| 1,024 | 8,192 | 100 MB |
+| 8,192 | 8,192 | 805 MB |
+| 75,000 (Frontier) | 8,192 | **7.4 GB** |
+| 75,000 | 65,536 (uncapped, as the ladder needs) | **59 GB -- exceeds the GCD** |
+
+**Why it was invisible.** The AMR benchmark runs FROM a restart but never WRITES one at scale, and the
+goldens that exercise restart (`(h)` and the `(l-prime)` parallel_io case) run at np<=2. So no measurement in this ledger touches it.
+It would have surfaced for the first time at the Frontier demonstration, on the first checkpoint.
+
+**CORRECTION, 20 minutes later, on reading the consumer: it is WORSE than "a consistency check".**
+`wext` is not merely compared -- it is **WRITTEN INTO THE FILE**, once per block:
+
+```
+call MPI_FILE_WRITE_AT(ifile, disp0 + amr_restart_blk_hdr_ints*ibytes, wext, 3*num_procs, MPI_INTEGER, ...)
+```
+
+**So the CHECKPOINT FORMAT is O(global blocks x num_procs).** At 75k ranks x 8192 blocks that is
+3 x 75000 x 8192 x 4 B = **7.4 GB of header written into every checkpoint**, and the reader
+(`:396-401`) parses the same layout and aborts on mismatch. Both directions carry it, and the benchmark
+restarts from file every run, so the READ path is on the hot path already.
+
+**The array is almost entirely zeros**: only the OWNER of block k has a nonzero extent triple, so the
+information content is `(owner, m, n, p)` per block -- O(blocks x 4) rather than O(blocks x 3P). At
+Frontier scale that is a ~19,000x reduction.
+
+**But it is a FILE FORMAT change, not a local optimisation.** That is the part I got wrong the first
+time and it changes the cost: it needs a format version bump (`amr_restart_blk_hdr_ints` is already
+single-sourced in `m_constants`, so there is a place to put one), a reader that accepts both layouts, and
+the restart goldens ((h) multi-level restart, and the (l-prime) multi-level parallel_io restart) as the gate.
+Old checkpoints stay readable only if the reader keeps the legacy path.
+
+**Priority: this is the first thing to fix before any scale test**, because it is fatal on the first
+checkpoint AND on the first restart, and because getting it wrong silently corrupts saved state rather
+than crashing.
+
+**Added to the de-risk list, and it moves ahead of the W1 memory item:** a run that cannot checkpoint
+cannot be demonstrated, regardless of how well the step loop scales.
+
+### ARM B VERDICT 2026-08-28 (three points, cap raised to 65536 so it never binds): LEVEL 1 IS O(P)
+
+| per regrid | np8 | np16 | np32 | growth |
+|---|---|---|---|---|
+| level-1 tree nodes = **global `ALLREDUCE`s** | 13,825 | 27,537 | **54,961** | **1.992x, 1.996x = O(P)** |
+| level-1 SHARED nodes | 11 | 23 | **47** | 2.09x, 2.04x = **O(P)** |
+| `shr_maxdep` | 3 | 5 | 7 | +2 per doubling |
+| `capped` warnings | 0 | 0 | 0 | cap never binds |
+
+**This overturns TWO of my earlier readings, both of which were pure cap artifact:**
+
+1. "Level-1 collective count is FLAT in P (16,383)" -- it is **O(P)**. The 16,383 was `2 x 8192 - 1`, a
+ full binary tree pinned by `amr_max_blocks`, identical in every rung by construction.
+2. "The level-1 shared set grows as O(log P) (+4 per doubling: 7, 11, 15)" -- it is **O(P)** (11, 23, 47).
+ That sequence was measured on cap-pinned trees, so it was reporting how a FIXED tree splits across more
+ ranks, not how the tree grows.
+
+**Consequences.**
+- **S3.2b is not a latency constant.** It removes an O(P) count of global collectives -- 54,961 per regrid
+ at np32 and doubling with P. It is as important as S3.3, not a follow-on.
+- **The reordering argument in ledger 41 is dead.** It rested on "the forest is O(P) while level 1 is
+ flat". Both are O(P). S3.3 was still the right thing to land first -- it removed a *measured* 1.44 GB
+ per rank of O(P) volume with a bounded, bit-identical design -- but the justification is now absolute
+ size and readiness, not a difference in exponent.
+- **Depth-batching becomes essential rather than an optimisation.** With shared nodes O(P), an
+ un-batched sparse exchange would be O(P) collectives; batching by depth gives `shr_maxdep` (~2 log2 P,
+ so ~31 rounds at 1e5 ranks) regardless. The remaining question S3.2b must answer is the shared VOLUME
+ per rank, which `[amr-scope-me]` now instruments.
+- **B0b is more important than recorded.** At the shipped `bf = 1` the cap binds on every regrid, which is
+ precisely why this was invisible for so long.
+
+**Method note.** Three "flat in P" readings tonight were a pinned limit, and the tell each time was a
+round number (16,383 = 2 x 8192 - 1). Added to the three-point rule: before believing a flat result, ask
+whether a cap, pool or table was fixed across the sweep -- and check whether the value is suspiciously
+round.
+
+### W1 SIZED PROPERLY 2026-08-28: ~48 full scans of the GLOBAL block list PER STEP
+
+Following the replicated-metadata finding, an audit of every `do ... = 1, amr_num_blocks` in the AMR
+sources: **44 sites across 22 routines.** The ones that matter are on the RK stage path, called from
+`m_time_steppers.fpp` (`s_amr_stage_fill_wave` :579, `s_amr_parent_fill_wave` :581 per level,
+`s_amr_reflux_faces_wave` :633, `s_amr_freg_wave` :819), not in the regrid:
+
+| routine | scans | per |
+|---|---|---|
+| `s_amr_stage_fill_wave` | 2 | stage |
+| `s_amr_parent_fill_wave` | 2 | stage x (levels-1) |
+| `s_amr_reflux_faces_wave` | 3 | stage |
+| `s_amr_freg_wave` | 3 | stage |
+| `s_amr_restrict_l1_wave` | 3 | stage |
+| `s_amr_restrict_parent_wave` | 2 | stage |
+| `s_amr_convert_prim_batch` | 1 | stage |
+
+~16 scans per stage at `amr_max_level = 2`, so **~48 per step under RK3**. Every one walks the whole
+machine's block list and filters to this rank's own ~75:
+
+```
+do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ if (amr_block_owner(k) == proc_rank) cycle ! or /= , for the send side
+```
+
+At np32 that is ~2,500 blocks x 48 = 120 k predicate evaluations per step -- invisible. At 1e5 ranks with
+the measured 75 blocks/rank it is 7.5 M blocks x 48 = **~360 M evaluations per rank per step**, roughly
+0.4-0.7 s of pure metadata scanning per step, growing linearly in P while the real work stays fixed.
+**This is the direct W1 violation** -- "per-rank STEP cost = f(local cells, peers)" -- and it is a bigger
+practical problem than the regrid pass-1 O(P^2), because it runs every step rather than every 20th.
+
+**Two fixes, and the cheap one is mechanical.**
+
+- **W1a (cheap, no architecture change): an owned-block index list.** Maintain `amr_my_blocks(:)` /
+ `amr_n_my`, rebuilt once per regrid, and convert the ownership-filtered loops to
+ `do kk = 1, amr_n_my; k = amr_my_blocks(kk)`. **10 sites are directly convertible** (grep-verified:
+ reflux_faces_wave, freg_wave x3, restrict_l1_wave x2, stage_fill_wave, parent_fill_wave x2,
+ convert_prim_batch), plus `restrict_parent_wave` whose filter is written `proc_rank /= cowner`. The
+ RECEIVE-side loops (`amr_block_owner(k) == proc_rank` -> cycle) need the complementary list: the peer
+ blocks this rank participates in, which is exactly the "peers" W1 allows -- build it in the same pass.
+- **W1b (architectural): distribute the metadata itself.** See the root-cause section above. W1a takes
+ per-step cost to O(local + peers) but leaves the O(P) MEMORY; only W1b removes that.
+
+**Free win found in the same read:** `s_amr_reflux_faces_wave` BUILDS `amr_fw_rblk` inside its first
+global scan (`amr_fw_rblk(nhr) = k`, :2744) and then its SECOND global scan (:2870) walks the whole block
+list AGAIN purely to re-derive the same index order, asserting agreement
+(`@:ASSERT(amr_fw_rblk(j) == k, ...)`). The same shape repeats in `s_amr_freg_wave` (:2930 / :3042).
+**Those second scans are removable outright** -- iterate `j = 1, nhr` over `amr_fw_rblk` directly. That is
+4 of the ~48 scans deleted with no new data structure and no behaviour change.
+
+### W1's ROOT CAUSE, found 2026-08-28 while scoping S3.3c: the block metadata is REPLICATED GLOBALLY
+
+Scoping S3.3c sent me to `5ec798ed` (the seam all-pairs fix) for reusable machinery. It does not transfer
+-- that fix worked because `f_amr_seam`'s predicate FIXES the neighbour's `lo` corner exactly, making it a
+lookup rather than a search, whereas pass 1 needs a genuine range-overlap query. But reading it led
+somewhere more important:
+
+```
+allocate (amr_region_lo_all(3, amr_max_blocks), amr_region_hi_all(3, amr_max_blocks))
+allocate (amr_owns_all(amr_max_blocks))
+allocate (amr_block_level(amr_max_blocks))
+```
+
+**Every rank holds the geometry, ownership and level of EVERY block in the machine.** That is O(P) memory
+per rank by construction -- at 1e5 ranks with the measured ~75 blocks/rank, ~7.5 M blocks x 8 ints x 4 B
+is **~240 MB per rank of pure metadata**, before any of it is scanned. The O(P^2) pass-1 scan is a
+SYMPTOM of this: a loop over all blocks is only writable because all blocks are locally addressable.
+
+**So W1 cannot be fully met by restructuring loops.** Every "iterate `1, amr_num_blocks`" site in the
+regrid is bounded below by this array's existence. Closing W1 needs the metadata itself distributed --
+each rank holding its own blocks plus a halo of neighbours, with remote queries going through the
+existing owner map (`f_amr_owner`'s Morton cut-point search) instead of a local array read. That is an
+architectural increment on the scale of the store flattening, not a loop fix, and it should be scoped
+separately before any more W1 loop work is done.
+
+**Revised S3.3c (still worth doing, and small).** It takes the pass-1 scan from O(P^2) to O(P) without
+touching the metadata layout:
+- Compute `mine(kb)` -- does this rank hold data for parent `kb` -- by iterating this rank's OWNED blocks
+ only, which is O(local blocks) = O(1) per rank.
+- Compute `covered(kb)` the same way, then **one `MPI_ALLREDUCE(MPI_LOR)` over the parents array**
+ (~2,400 logicals, per-box global data, which the endstate permits) instead of every rank scanning every
+ block. This is the step that removes the O(P^2).
+- Guard the dense `gwin` allocation on `mine(kb)`, which removes the O(P) window-zeroing traffic for free.
+
+Residual after S3.3c is O(parents) per rank -- the loop over `plo:phi` itself -- which is exactly the
+replicated-metadata bound above and cannot go lower until that is fixed.
+
+### S3.3c FOUND 2026-08-28 (reviewing my own S3.3a/b diff): pass 1 is STILL fully replicated, and it is O(P^2)
+
+S3.3a/b fix the gather and pass 2. **They do not close W1.** Re-reading pass 1 after writing them, every
+rank still does this for EVERY parent, regardless of ownership or of whether it holds any relevant data:
+
+```
+do kb = plo, phi
+ allocate (gwin(mlo(1):mhi(1), mlo(2):mhi(2), mlo(3):mhi(3))) ! dense window, per parent, per rank
+ gwin = .false.
+ do ob = 1, amr_num_blocks ! the REPLICATED GLOBAL block list
+```
+
+Two residual terms, neither touched by S3.3a/b:
+
+1. **`allocate`+zero of a dense window per parent** -> O(parents x window volume) = **O(P)** memory traffic
+ per rank per regrid.
+2. **`do ob = 1, amr_num_blocks` inside `do kb = plo, phi`** -> O(parents x global blocks). Parents scale
+ with P and the global block list scales with P, so this is **O(P^2) per rank** -- asymptotically the
+ WORST term in the regrid, worse than the `gwin_bytes` gather S3.3b removes. It is only cheap today
+ because it is a metadata test (~5.8 M iterations per level per regrid at np32).
+
+**Why it cannot simply be skipped:** `covered(kb)` is replicated metadata -- every rank must agree on it --
+and it is set inside that same `ob` loop, so the loop cannot be made owner-only as written.
+
+**S3.3c, its own increment.** Two independent fixes:
+- **Invert the loop.** Iterate this rank's OWNED old blocks and tag the parents each one overlaps, instead
+ of iterating all parents x all blocks. Cost becomes O(owned blocks x parents touched).
+- **Compute `covered` once, spatially.** This is the same shape as the seam all-pairs scan that W1 records
+ as already FIXED (`5ec798ed`), so the binning machinery to do it exists and the precedent is set.
+- Then guard the `gwin` allocation on "this rank actually contributes", which removes term 1 for free.
+
+**Do not report S3.3 as closing W1 until S3.3c lands.** S3.3a removes W1's pass-2 rescan
+(O(parents x global TAGS)); the pass-1 terms above are what remain.
+
+**Two implementation details verified by reading the code, because both are easy to get wrong.**
+(1) The `Alltoallv` needs the pairs contiguous per destination, but `s_amr_pack_gwin_pairs` appends them
+grouped by `kb` in increasing order. A stable counting sort by `owner(skb(i))` fixes that in O(n) and is
+the only reordering needed. (2) **That reordering is safe**: pass 2 rebuilds a DENSE `gwin` from the
+pairs and re-extracts in `(k,j,i)` order, so `ctags` is already independent of the order pairs arrive in
+— the existing comment's "setting .true. once per gathered cell reproduces the old per-parent dedup" is
+exactly that property. So S3.3 does not perturb `ctags` and its box set should be bit-identical to the
+post-B1/B0b baseline, which makes the gate a clean signal.
+
+**Gate.** `gwin_bytes` falls from 1.44 GB to O(local) and stops doubling with P (the three-point sweep
+re-run is the proof); child box set bit-identical to the post-B1/B0b baseline; 69/69 AMR goldens; and the
+suite ALREADY carries the right np>1 gate — verified 2026-08-28 by reading `cases.py`: case (m)
+**"AMR -> 1D -> multi-level dynamic regrid np=2"** runs `amr_regrid_int=2, amr_max_level=2` at `ppn=2`,
+which is precisely the cross-rank dynamic nesting path that carries the `ALLGATHERV`. Cases (l), (l'),
+(n) and the `amr_max_level=3` case add static and 2D/3-level coverage at `ppn=2`. So S3.3 does NOT need
+a new test — a single-rank golden could not see a broken alltoallv, but these can.
+
+### S3.2b DESIGN, REVISED 2026-08-28 — depth-batched, and much smaller than the version above
+
+The measurement changes the design. With 99.93% of level-1 nodes rank-local and only 7-11 shared per
+regrid, the expensive part is not making the shared exchange sparse — it is *not doing the other
+16,372*. That splits the clusterer in two, and the shallow half can stay on `MPI_COMM_WORLD`:
+
+- **Shallow phase (`novr > 1`), replicated.** Every rank already agrees on this part of the tree: it
+ descends from the global bbox, and `s_amr_ranks_overlapping` is a pure function of the box and the
+ decomposition, so `novr` needs no communication to evaluate. Walk it **breadth-first by depth** and
+ issue **ONE fused `ALLREDUCE` per depth** carrying the concatenated signatures of every shared node
+ at that depth. All ranks hold identical shallow state, so they agree on the node list and hence on
+ the concatenation layout. Collectives per regrid become `shr_maxdep` — **3 at np8, 5 at np16** —
+ against 16,383 today.
+- **Deep phase (`novr == 1`), private.** The moment a node fits inside one rank, that rank holds every
+ tag in the subtree: it finishes the subtree alone with **zero communication**, and no other rank
+ descends into it at all.
+- **Close with one `ALLGATHERV` of the resulting BOXES** — per-box global data, which the endstate
+ explicitly permits, and which B1 makes order-independent.
+
+**What this drops from the earlier design.** No graph communicator, no `MPI_Neighbor_alltoallv`, no
+per-node sparsity. Those were aimed at making each shared node's exchange cheap; depth-batching instead
+makes the NUMBER of exchanges `O(shr_maxdep)` regardless, and the measured volume that has to move is
+~35 KB per regrid, which no amount of sparsity would meaningfully improve. Sparsity becomes a later
+refinement, not a prerequisite.
+
+**Why this survives growth.** Shared nodes grow ~1.57x per np-doubling (~P^0.65, the rank-boundary
+SURFACE, exactly as geometry predicts), so ~3,000 shared nodes per regrid at 1e5 ranks. Un-batched that
+would be 3,000 collectives; batched by depth it is `shr_maxdep` ~ 2 log2 P ~ **34**. This is why
+`shr_maxdep` still matters and why its growth rate is worth knowing -- but it sets the ROUND count, not
+the volume, and 34 rounds is not a wall.
+
+**Gate.** Level-1 global collectives per regrid = `shr_maxdep` (not 16,383); box set identical to the
+post-B1 baseline; `[amr-tree] nodes` unchanged; `[amr-scope-me]` confirming the deep phase is genuinely
+private. Bit-identity against post-B1 is achievable here because B0 made `force`/the cap inert and B1
+made the merge order-independent -- which is the whole reason those two landed first.
+
+### Increments
+
+- **S3.2a (next, cheap):** measure the depth at which nodes become rank-local, and the node/volume
+ split above versus below it. The depth instrumentation already exists. **This sizes the whole
+ design before any of it is written.**
+- **S3.2b:** shallow phase depth-batched, deep phase local — see "S3.2b DESIGN, REVISED 2026-08-28"
+ below, which supersedes the neighbour-communicator sketch above and the bytes-flat gate (level-1
+ per-rank bytes are ALREADY flat, so that gate cannot discriminate).
+- **S3.3:** the same mechanism on the level-2 forest.
+
+## 2026-08-27 (38) — S3.1 LANDED: THE LEVEL-1 W4 COLLECTIVE IS GONE, AND THE SCALING LAW MEASURED
+
+**S3.1.** `s_amr_union_gtag` and its ALLGATHERV are deleted, replaced by `s_amr_local_tags` (each
+rank scans only its own disjoint interior) plus ONE fused `MPI_ALLREDUCE` per tree node carrying the
+per-axis signatures. Reading all three routines showed one reduction suffices for trim, count AND
+split: `s_amr_trim_box` takes the per-axis MIN/MAX of contained tags, which IS the first/last nonzero
+of the signature, and its ok test IS sum > 0. Gated four ways: restart output byte-identical, tree
+reproduced exactly (`lmax 8192 ldepth 31 nodes 66354` in both arms), **`ntag_bytes` 185,241,240 -> 0**,
+and **69/69 AMR goldens** (which cover the 1D/2D, np=1 and multi-level paths the np8 probe cannot).
+
+**The scaling law (np8 -> np16, matched at 10 regrids).** ntag 92.77 -> 185.53 MB/rank/regrid =
+2.000x per doubling. rbytes 4.53 -> 7.53 MB = **1.660x = P^0.73**. nboxes 594 -> 1206. So S3 improves
+the COEFFICIENT (~20-25x) **and** the EXPONENT — better than the audit feared — but is **not flat, so
+W4 is not satisfied**. At 1e5 ranks: ntag would have been ~1.16 TB/rank/regrid, rbytes ~4.4 GB.
+Mechanism confirmed twice over: `rbytes ~ nboxes^(2/3)` predicts 1.60x against 1.66x measured.
+
+**THREE-POINT LADDER, and it OVERTURNS the two-point law.** np8/16/32 at matched 10 regrids:
+ntag 92.77 -> 185.53 -> 371.04 MB/rank/regrid (2.000x, 2.000x -- clean P^1.0). rbytes 4.53 -> 7.53
+-> 13.75 MB = **1.660x then 1.827x**, i.e. the implied exponent RISING 0.73 -> 0.87. Decomposing the
+node count settles why: the level-1 tree is CONSTANT at 16,383 nodes (cap-fixed at 8192 leaves) while
+the forest goes 28,308 -> 55,872 -> 111,112, i.e. **1.97x, 1.99x -- exactly proportional to P**. Total
+= constant + O(P), so the constant dilutes and the exponent climbs toward 1.0.
+
+**So S3.1 is asymptotically O(P): a COEFFICIENT cut (20.5x -> 24.7x -> 27.0x, growing slowly but
+converging), NOT an exponent improvement.** The earlier "P^0.73" was a small-np artifact of the
+cap-fixed level-1 term and is RETRACTED -- it was published on two points, and the third refuted it.
+The standing rule (>=3 points at fixed per-rank work before any asymptotic claim) is what caught it.
+
+**Consequence for S3.2/S3.3.** The forest is the term that grows, so it is where W4 is actually won;
+but it performs zero collectives today, so the split-communicator mechanism must still be PROVEN on
+the level-1 path first and then applied to the forest by S3.3. Both statements hold at once.
+
+**What `rbytes` actually measures, corrected.** `amr_cl_rb` is incremented OUTSIDE the `if (reduce)`
+guard, so it prices every tree node in BOTH paths -- but only the level-1 path reduces today. It is
+therefore a **projection of the fully distributed design (S3.1 + S3.3), not today's wire volume**.
+That is the right quantity for projecting W4 and the wrong one to call a measurement of current cost.
+Today's actual added collectives are the level-1 tree only: ~16,383 per regrid at cap 8192, not the
+44,691 total node count.
+
+**Three corrections to my own earlier claims, all from measurement:**
+1. **The unfused collective count is 44,691/regrid at np8 and 72,255 at np16** — the design estimate
+ was ~1,200, wrong by 50x. That is what makes S3.2 fusion mandatory rather than an optimisation.
+2. **S3's value is MEMORY, not wall.** `rg:clus` is 0.6 percent of wall; `regrid` is 53.7 percent but
+ `rg:build` is 37.8 percent of it. My guess that cap saturation might explain regrid's share is
+ **WRONG and retracted** — saturation drives node count, and node count lives in rg:clus.
+3. **The block cap is the WRONG KNOB.** Five caps at fixed domain: 16x cap gives 2.10x nodes and
+ 2.10x reduction bytes for a **3.7 percent** change in the box set (nboxes 598/598/598/594/576).
+ The cap bounds only the level-1 tree; the forest is parent-driven and cap-independent, measured
+ FLAT at ~21,800 nodes/regrid across all five caps. Absolute split at cap 8192: level-1 ~16,383
+ (43 percent), forest ~21,872 (57 percent) -- at cap 1024 the forest is 91 percent. **An earlier
+ "~85 percent" figure was a marginal-increment reading, not the absolute split; corrected.**
+
+**The clusterer saturates EVERY cap** (warning on every regrid at all five settings): with
+`amr_cluster_eff = 0.9` and no minimum box size the bisection never converges on its own, it splits
+until something stops it and the merge undoes most of it. `rg:clus` grows 13x across the sweep while
+nodes grow 2.1x — superlinear, consistent with the O(n^2) merge running at n = cap. **That is B0's
+case: not wall share, but waste and the lever on nboxes.**
+
+**AMReX does not solve W4 either** (read from source): `TagBoxArray::collate` Gathers every tagged
+cell to the I/O rank, `ClusterList::chop` runs SERIALLY there, and the BoxList is broadcast — with a
+hard `amrex::Abort` above INT_MAX tags, marked `xxxxx todo`, whose suggested mitigation is a larger
+blocking factor (i.e. S1). There is no distributed clustering in the SOTA to copy, and on this axis
+MFC was WORSE: every rank received what only AMReX's root did.
+
+**Deferred deliberately: the IB ownership gate.** It is correct and reduces `amr_gb_win`, but it
+lives behind `amr_max_level >= 2` and every case available runs at level 1, so no test could execute
+it. Shipping it unverified was the wrong trade; it goes with S3.3, which needs it. The new ppn=2
+AMR+IB case (`E4F6CE1E`) landed anyway — it is the only distributed AMR+IB coverage in the suite.
+
+**Process failures and the guards they bought.** (a) Two builds ran concurrently in one tree; the
+survivor was probably correct but not provably so. (b) A revert left unbalanced `end do`/`end block`
+that `ffmt` and `lint_source` BOTH passed — neither parses Fortran — so the compiler was the first
+thing that could say no, and the failing build still reported success to a wrapper. (c) My own
+binary-provenance guard passed a STALE artifact, because symbol presence is necessary and not
+sufficient; the discriminating question is "is this a different artifact than the last pin". Guards
+added: RUNBOOK 3b/3c, `format.sh` now surfaces ffmt stderr and fails on unmatched structure, and
+`amr-bench/fcheck.sh` structurally checks one .fpp in ~4 s versus ~18 min.
+
+## 2026-08-27 (37) — AUDIT OF THE S3 PLAN: A GATE THAT ONLY TESTED ONE DIRECTION, AND AN UNVERIFIED DEPTH ASSUMPTION
+
+**The gate on ledger (36)'s migration was one-sided.** 15/15 tests confirmed that VALID cases still
+run; nothing confirmed that INVALID cases are still rejected. Having deleted 53 checks, that is only
+half a gate: every one of them could have been a no-op and the suite would still be green.
+Negative-testing closes it - perturbing `examples/2D_amr_droplet` and running `./mfc.sh validate`:
+`time_stepper = 1` -> "amr requires time_stepper = 3" (the B8 fix); `cfl_const_dt = T` alongside
+`amr_subcycle` -> "amr_subcycle requires a fixed dt", **which is exactly the case the OLD validator
+let through and the solver aborted on** - the derived-`cfl_dt` fix is doing real work. A fourth
+probe (`amr_max_level = 3`) correctly reported nothing: the deleted check bounded STATIC AMR
+(`amr_regrid_int == 0`) and that example sets `amr_regrid_int = 10`, so three levels is legal.
+**STANDING RULE: deleting or relocating a check requires a negative test. A suite that only proves
+good cases still pass cannot distinguish a working check from a deleted one.**
+
+**S3's central performance claim is UNVERIFIED, and it is now the first increment.** The design
+argues fusion gives "~17 fused collectives per regrid" from tree depth being O(log nboxes). But
+Berger-Rigoutsos splits at signature holes and Laplacian inflections, not midpoints, so the tree is
+not balanced by construction; its worst case peels one box at a time, giving depth O(nboxes) and
+reinstating the latency blow-up fusion exists to prevent. **Nothing in this ledger measures BR tree
+depth.** So S3.0a is now instrumentation, not code: carry a depth per stack entry in `s_amr_cluster`,
+report max depth and node count per regrid, run it over the S0 arms. Pre-registered rule: depth
+within ~`4*log2(nboxes)` -> fusion proceeds as designed; depth growing like `nboxes` -> the design
+needs a different shape (cap the depth, batch sibling subtrees, or fall back to S1 as a coefficient
+stopgap). **Do not write S3.2 before that number exists.**
+
+**Also marked INFERRED rather than established:** the claim that S3 deletes the remaining W1
+quadratic (the regrid pass-2 loops over parents x global tagged cells). That was reasoned from their
+structure, not from reading them. Confirm at `m_amr_regrid.fpp:1118` and `:1130` before relying on
+it; if those loops need the global list for more than locating each parent's slice, W1 keeps a
+separate increment.
+
+**Ordering adopted:** S3.0a (depth measurement, go/no-go) -> S3.0b (emit reduced-buffer bytes) ->
+S3.1 (path 1 on reductions, judged on bit-identity ONLY, expected slower) -> S3.2 (fusion, blocked on
+S3.0a, watch the `amr_max_blocks` force path whose `nacc + nwork + 1` test means different things
+under a LIFO stack and a depth level) -> S3.3 (path 2 as a fused forest) -> S3.4 (delete the
+gathers). Then W5 (I7), W3 (F5), W2 (2b), W6/W7. The L0 deletion and the post-process reader fix are
+unblocked but not on the exascale path; the upstream `s_check_inputs_weno`/`_muscl` marker issue is
+to be reported, not patched here.
+
+**A tooling pattern worth naming, five instances in one day.** Each was a check that looked like
+verification while measuring something else: ``pgrep -fc 'a\|b'`` matching nothing (ERE, so `\|` is a
+literal pipe) read as "the job died"; two `grep -c` calls whose zero-match exit status read as
+"build failed"; a `-x` test performed before the `cd` that would invalidate the path; and a negative
+probe whose injected text broke Python syntax, so all four cases "failed validation" for the wrong
+reason. None were reasoning errors. **Rule: when a check misleads, harden the check - do not resolve
+to be more careful.** Done for `bitcmp_probe.sh` (absolute paths; "did not run" now distinguished
+from "differs") and for the scorecard (documents the per-rank and double-count traps, refuses
+mismatched arms). The counts themselves are never the evidence: print what matched.
+
+## 2026-08-27 (36) — THE HYGIENE BATCH: CHECKER MIGRATION, STACK AUTOMATICS, AND THE SEAM SCAN DE-QUADRATIFIED
+
+Four commits, all byte-identical or golden-holding, all gated.
+
+**`82dd12f5` - the merge regression fixed.** Upstream `55fb1b14` migrated input-only checks out of
+`m_checker` into `case_validator` and added a lint rule to enforce the split; our merge resolved the
+conflicted region as "ours", restoring 19 of them, then allowlisted `s_check_inputs` so the new rule
+could not fire. The 19 are deleted, with the now-unused `m_helper_basic` import and the already-dead
+`muscl_order_first_order` one. One of the 19 was doing real work the validator did not replicate:
+the Fortran `pign` check fires on the `dflt_real` SENTINEL while the validator fired only on an
+ABSENT key, so a case writing `rburn%%pign` as the sentinel passed `./mfc.sh validate` and then
+ignited everywhere from t=0. The validator now rejects any non-positive `pign`, matching the pattern
+`rburn%%k`/`rburn%%pref` already use - **that fix landed BEFORE the Fortran check was removed.**
+Gates: 10/10 (three reactive-burn + chemistry AMR), precheck.
+
+**`f702fb27` - AMR input constraints moved to Python** (user: "i like the AMR prohibits in the mfc
+toolchain (python) when possible"). 53 of the 57 prohibits in `s_check_inputs` deleted; the 4 that
+survive all read `num_procs` (MPI_Comm_size, invisible to the validator) and each carries a
+`! lint: runtime-check` marker. With only those left, `s_check_inputs` came OFF
+`RUNTIME_CHECKER_SUBROUTINES` - **upstream's rule is armed here for the first time**, so a new
+input-only check added Fortran-side is now flagged. Nine validator checks were corrected FIRST,
+because deleting their counterparts would otherwise have opened silent holes: `cfl_dt` and
+`bodyForces` are DERIVED in `s_read_input_file` (from `cfl_adap_dt`/`cfl_const_dt`, and from
+`bf_spatial_support`) while the validator read only the literal keys - so `amr_subcycle` with
+`cfl_const_dt` passed validation and aborted in the solver; `time_stepper`/`model_eqns` default to
+the `dflt_int` sentinel, which Fortran rejects and the validator skipped on an absent key; and
+`amr_tag_eps`/`amr_buf` were over-strict the other way, erroring on unset keys whose Fortran
+defaults are valid. **Trade recorded:** the validator runs on the `./mfc.sh run` path, so a built
+binary invoked directly against a hand-edited `simulation.inp` no longer gets these checks.
+**Also removed undefined behaviour:** `s_check_inputs` read `num_dims` - not assigned until
+`s_initialize_parallel_io_common` 25 lines later - and sliced `amr_block_beg(1:num_dims)` with it.
+Gates: 15/15 (AMR + active_box + coexist + load-balance + diagnostic writers), all examples valid.
+
+**`4e21d0f3` - W1, the crash half.** Twelve O(global boxes) AUTOMATIC arrays moved to the heap:
+seven in `s_amr_assign_block_owners` (~48 bytes/block between them, ~48 MB at 1e6 blocks) and five
+in `s_amr_regrid`. These OVERFLOW a default stack long before the box count itself becomes the
+bottleneck - a crash, not a slowdown. Gates: bitcmp byte-identical, AMR 10/10.
+
+**`5ec798ed` - W1, one of the two quadratic paths.** `s_amr_build_seam_pairs` ran two nested loops
+over `amr_num_blocks` per regrid (count then fill) = 2N^2 in the GLOBAL block count. **It was never
+a search:** `f_amr_seam` demands exact equality of region lo AND hi on both transverse dims plus
+`lo(d,yb) = hi(d,xb)+1`, and blocks are disjoint, so `(level, lo)` names a block uniquely and those
+conditions FIX the neighbour's lo corner given `xb` and `d`. Morton-sort the lo corners once (the
+stable merge sort `s_amr_sfc_cut` already uses - whose own comment makes exactly this O(n^2)
+argument about its predecessor), then binary-search the single candidate per (block, dim) and verify
+the predicate: **O(N log N)**. Emission order preserved exactly (xb ascending, each block's <=3
+matches insertion-sorted into ascending yb) because the list drives paired MPI_SENDRECVs - a
+reordered list DEADLOCKS rather than producing wrong numbers. Equal-key runs are rescanned against
+the full lo vector (f_morton keeps 21 bits/dim). Gates: bitcmp byte-identical; 17 AMR tests covering
+tiled seams, tiled L2, multi-block, three-level, np=2 multi-level, and the coexist set that
+exercises the l0 periodic-wrap branch.
+
+**Remaining in W1:** the regrid nesting loops (`m_amr_regrid.fpp`), whose pass 2 is parents x GLOBAL
+TAGGED CELLS - a worse shape than boxes x boxes. **Do not fix it standalone:** it iterates the global
+tag list that S3 deletes, so it is subsumed by the W4 work.
+
+**Upstream issue to file (NOT patched here):** `s_check_inputs_weno`/`_muscl` carry
+`! lint: runtime-check m/n/p are per-rank extents after MPI decomposition` markers, but they are
+called from `s_check_inputs` at `m_start_up.fpp:1070`, BEFORE
+`s_mpi_decompose_computational_domain` at `:1097` - so m/n/p are the GLOBAL case-file values there
+and those checks are input-only, not runtime. Upstream's checks, upstream's markers: report it,
+do not quietly change upstream checker semantics inside a merge branch. That is how the regression
+in the first paragraph happened.
+
+## 2026-08-27 (35) — THE LADDER IS NOT THE SCORECARD: W1/W2/W4/W7 UNMET; D-l0 = DELETE; D-phase2 = NOT NEXT
+
+**Retraction.** (34) concluded "declare the performance program done," reasoned from the six-rung
+matched-point ladder under a parity framing. The user has confirmed the goal is the end-state
+architecture and exascale scaling ("this is just the computer I have for you to use"). The ladder
+measures wall degradation per np-doubling on ONE node and does not measure any of W1-W7's defining
+quantities except W3/W4 - both of which the same jobs' counters show still growing. The scorecard is
+`amr_endstate.md` section 3.
+
+**Invariants re-audited against code (the section 3 "today" column was a week stale).** W1 **UNMET
+and worse than documented**: two O(global boxes^2) paths - `m_amr.fpp:6154-6170` (seam-pairs, nested
+`do xb`/`do yb` over `amr_num_blocks`, run twice per regrid) and `m_amr_regrid.fpp:1017,1033,1118,1130`
+(nesting; pass 2 is parents x global tagged cells) - plus per-stage O(global boxes) plan walks and
+O(boxes)/O(P) **automatic STACK** arrays (`m_amr_regrid.fpp:638-642`, `m_amr.fpp:3188-3190,2687-2689`)
+which overflow (crash) before anything merely slows. W2 **UNMET, structurally unchanged**: the advance
+is still one `s_compute_rhs` per box per stage; 2a is compiled but hard-gated (`amr_prim_batch = .false.`,
+`m_amr.fpp:437`). W4 **UNMET**: `s_amr_union_gtag` still ALLGATHERVs every tagged cell globally and
+allocates `allidx` at the GLOBAL count (`m_amr_regrid.fpp:438-444`). W5 **PARTIAL**: per-step families
+use (family, epoch) bases but the base is still offset by the global cap
+(`amr_tag_base(f) = amr_max_blocks + 100*f`, `m_amr.fpp:803-804`), with a loud init assert at ~2.1M
+blocks on Cray. W6 **PARTIAL**: store growth reverts to a full HOST round trip above 32 columns
+(`m_amr.fpp:7897`) and ranks hold 72-75 boxes, so the host path is the one that runs. W7 **UNMET**:
+weight is work-only, no migration term, no hysteresis. W3 **PARTIAL** (per-box WAITALL chain dead;
+F5 still per-(box,face,participant)). W8 holds through np32.
+
+**W4 is the top blocker on a STRUCTURAL argument, not a measured coefficient.** Each rank receives
+every rank's tagged cells, so at fixed per-rank work the received volume is O(P) per rank - derivable
+from the code, and the reason it cannot be tuned away. **NOW MEASURED INDEPENDENTLY AND CONFIRMED**, via the new
+`amr-bench/invariant_scorecard.py` on the matched np16/np32 arms of job 386892 (9 regrids each,
+cells/rank constant at 8M): ntag **39.29 -> 78.59 MiB per rank per regrid = 2.00x**, gwin
+8.60 -> 17.06 = 1.98x. Extrapolating the confirmed law from np32: **~240 GiB per rank per regrid at
+1e5 ranks.** Two traps the tool now documents, because both produced wrong readings during this
+audit: `amr_gb_tag` accumulates the GLOBAL tag list and is printed from rank 0, but every rank
+RECEIVES that list, so it is ALREADY per-rank - do not divide by np; and a `**/*.log` glob already
+matches `run.log`, so scanning both double-counts regrids. The tool refuses to compare arms with
+mismatched regrid counts rather than silently averaging them.
+
+**THE INVERSION.** Phase 2b - "the largest single investment in the program" - addresses W2, which is
+FLAT in P (75 boxes/rank at np8/16/32 alike). It is a ~173x launch constant: a permanent efficiency
+tax at every scale, but not what fails at 1e5 ranks. **Corrected order: W4 -> W1 (de-quadratify + heap the stack
+automatics) -> W5 (I7) -> W3 (F5) -> W2 (2b) -> W6/W7.**
+
+**CORRECTION to this entry's first draft: S1 is NOT the W4 fix.** W4 requires the tag exchange be
+O(local + peers). Block-lattice coarsening shrinks each rank's contribution but leaves the
+ALLGATHERV in place - every rank still receives every rank's tags, so received volume stays O(P).
+It moves the curve down ~512x (about nine doublings of headroom, reaching ~1e4 ranks from np32);
+it does not change the slope. Its own pre-registered gate - "judged on ntag bytes/rank going flat"
+(line ~1464) - is therefore UNSATISFIABLE by it: under weak scaling the domain grows with P, so a
+coarsened lattice grows with P too. Nobody noticed because S1 was never attempted.
+**The genuine W4 fix is architectural, and the code says why.** `s_amr_union_gtag`
+(`m_amr_regrid.fpp:408-412`) all-gathers so that "every rank decodes the same gathered index set
+into the same list, so the bisection is rank-invariant" - the collective buys RANK-INVARIANCE of
+the box decomposition, which the goldens depend on. A neighbor-scoped exchange breaks that
+property outright: each rank would cluster from a different tag subset. The fix is therefore
+**S3 (local clustering + boundary reconciliation), already scheduled in endstate Phase 3** - pull
+it forward, with determinism as its hardest requirement, not as an afterthought.
+**Recommendation: SKIP S1 and go straight to S3.** Coarsening the tag lattice changes which cells
+are tagged, hence the box set, hence the goldens; S3 changes the box set too. Doing both means two
+golden churns for one architectural outcome. S1 remains available as a stopgap ONLY if a deadline
+demands headroom before S3 is ready, and must then be labelled a coefficient fix with an explicit
+headroom number. D-phase2 resolves: 2b stays on the roadmap
+as the parity item, NOT as the next increment. Ordering it later is a claim about *when*, not about
+whether it is needed.
+
+**Why 2b is so large (scoped):** the per-box advance SWAPS module-global grid state -
+`s_amr_swap_to_fine` (`m_amr.fpp:5270`, 17 call sites) replaces m/n/p, idwint, idwbuff, the whole
+x_cb/x_cc/dx family, and feature flags - then calls the ordinary `s_compute_rhs`. So ~270 GPU parallel
+regions across ~10,500 lines read grid extents from module globals. The swap is also a CORRECTNESS
+contract (it disables coarse-indexed `acoustic_source`/`ab_active` and depth-guards nesting) that any
+box-indexed rewrite must reproduce explicitly. Ledger (27)'s 2a bridge-load regression IS that swap
+boundary appearing as runtime cost - so any increment batching kernels WITHOUT removing the swap will
+regress.
+
+**D-l0 = DELETE.** MFC's level 0 is balanced BY CONSTRUCTION: a Cartesian decomposition hands every
+rank one equal-sized chunk. AMReX boxes level 0 only because there boxes ARE the decomposition, which
+is also why the literature's ">=4 boxes/rank" floor does not transfer - MFC meets its intent with one
+*exactly equal* box per rank. Tiling costs 28-35% wall (three reps) and rebalancing recovers 0.6%,
+inside noise. Every surveyed framework ships base-level rebalancing off or slow, and over-decomposition
+is expensive on GPUs. **Correction to the study that produced this: its claim that coexist computes the
+level-0 RHS twice is WRONG** - `m_amr.fpp:8569` states the monolithic L0 RHS is skipped for
+`l0_ntile>0` (which is exactly why the spike aborts on `run_time_info`/`probe_wrt`). The conclusion
+survives without that pillar. **RE-ENTRY CONDITION, and it is live rather than hypothetical:** a
+measured level-0 work imbalance above ~10% on an IB, chemistry, or Lagrangian-bubble case, with
+`[amr-balance]` extended to level 0. MFC's own fine-block cost model already carries `K_ib`/`K_pc`
+terms - the code encodes that per-cell cost is NOT uniform once those physics are on; level 0 simply
+gets no equivalent treatment. Before deleting, check what the 12 L0/coexist tests cover incidentally.
+Consequence: the L0 restart-writer filter is DROPPED - do not fix save/restart for machinery being
+removed.
+
+**Landed here: the last stage ifdefs are gone from src/common (`caabd06d`).** `load_weight_wrt` and
+`sfc_partition_wrt` are registered for all three targets with their default in
+`s_assign_common_defaults`; `amr_in_fine_advance` is declared in `m_global_parameters_common`. `src/`
+now has ZERO `MFC_PRE_PROCESS`/`MFC_SIMULATION`/`MFC_POST_PROCESS`, matching master. Net -4 LOC. Also
+fixes a latent gap where post_process declared both flags with no initializer and no default. Gates:
+all three targets build clean (pre_process is the real gate), 71/71 (AMR-68 + diagnostic writers
+`4D5E2869` + load-balance + SFC), precheck clean.
+
+**Folded in, per the standing rule that a pending verification lands with the next change: the np8
+wall-neutrality A/B for participation-local registers is RESOLVED and NEUTRAL.** Differenced 240-40
+arms on k004-005: reglocal 7.836 s/step vs mergereplay 7.652, +2.4% - inside the ~5% noise floor. The
+`[amr-xa]` exchange audit is byte-identical between arms (same msgs, same words, at both step counts),
+so the change is comms-neutral as designed. Its payoff was never np8 wall; it was the ~16 GiB that
+unblocked np32 (ledger 31).
+
+**A REASONING-ERROR CLASS, recorded because we made it twice.** Ledger (15) "I6 plan caching REFUTED -
+the plan walks are free" was correct at 600-2400 boxes and wrong as a SCALING conclusion: those walks
+are `do k = 1, amr_num_blocks` per family per stage. (34)'s "performance program complete" is the same
+error at larger scale. **Rule: a measurement at the current operating point can retire a COST, never an
+ASYMPTOTE.** Asymptotic claims need a law measured over >=3 points at fixed per-rank work, or an
+analytical argument with a measured coefficient. Corollary adopted this session: no agent-sourced or
+tool-sourced specific enters this ledger, a commit message, or a decision without independent
+verification of that exact claim - two of six audit agents today returned confident load-bearing
+claims that were false, and both were caught only by spot-checking.
+
+**Verification limit on this machine.** S0 sweeps ranks at fixed per-rank work on ONE node: it exposes
+O(boxes) and O(P) terms but cannot exercise inter-node collectives, network topology, or the tag
+ceiling. W4's law is measurable here; W5's ceiling is not reachable here at all. Decide per invariant
+what "done" means before starting it.
+
+## 2026-08-27 (34) — MERGE AUDIT + STRATEGY SHIFT: THE PERFORMANCE PROGRAM IS COMPLETE; WHAT REMAINS IS CORRECTNESS AND MERGE HYGIENE
+
+> **STRATEGY SECTION RETRACTED by (35).** The merge-audit and coverage findings below stand. The
+> strategy did not: it declared the performance program complete on a *benchmark-parity* framing.
+> The goal is the END-STATE ARCHITECTURE and exascale scaling, on which the matched-point ladder is
+> a waypoint. See (35) for the invariant scorecard and the corrected work order.
+
+**Strategy.** The scaling ladder is finished. Six rungs: 1.594 -> 1.544 -> 1.368 -> 1.343 ->
+1.241 -> 1.274. Five sit at or below the AMReX bar, and the third doubling (np16->np32, 1.274 vs
+AMReX's own 1.278) degrades slightly LESS than AMReX. Exactly one rung is above a bar: np8->np16
+at 1.241 vs 1.192, a 4.1% excess, addressed only by the optional rf:wait overlap increment
+(option B, `notes/rfwait_overlap_design.md`). That excess is smaller than the ~5% single-run
+noise floor these runs have historically shown; the rungs use a tighter differenced within-job
+pairwise design so it is not pure noise, but it is close enough to the floor that chasing it
+spends effort without producing evidence. **Recommendation adopted: declare the performance
+program done and spend the remaining effort on correctness and merge hygiene.** The claim to
+carry into review is "at SOTA on the third doubling, within 4% on the second."
+
+**Merge audit of `5312e834` (base `0c9a1d43`, master `d74cc378`).** Structure is sound: every
+upstream commit is a true ancestor of HEAD, all 8 master-deleted files are gone, all master-added
+files present. Of 33 files both sides modified, an automated two-way scan (master deletions that
+reappear at HEAD / master additions missing at HEAD) flagged 14; three clusters were then audited
+individually and cleared. The Riemann 4-way split is intact (all six modules, `hypo_hlld` differs
+from master by one line, every hat_R buffer allocated under renamed `_alloc` bounds, no duplicated
+solver bodies); `model_eqns_4eq` removal fully honored and the symbol appears nowhere in src/ or
+toolchain/; `qbmm_idx`, `m_variables_conversion`, IB neighborhood (`f5d2b4cc` + `b7d78838` both
+intact), `module_categories.json` (a 4->2 space reindent, all 83 modules present), and the
+HardcodedIC `pRef` casing fix all survive. Scan false-positive modes, for future reuse: line-level
+matching against code master RELOCATED, and a whole-file reindent making an unchanged file look
+rewritten.
+
+**ONE CONFIRMED REGRESSION.** Master `55fb1b14` (#1717) migrated ~120 `@:PROHIBIT` lines out of
+`src/simulation/m_checker.fpp` into `case_validator.py` AND added a lint rule
+(`check_checker_input_constraints`) that fails precheck on any `@:PROHIBIT` in `m_checker*.fpp`
+unless allowlisted or marked `! lint: runtime-check`. Our merge resolved the conflicted region as
+"ours", restoring 21 of them (`m_checker.fpp:39-59, :230-231, :235-258`) — `reactive_burn` count
+is 0 at master, 21 at HEAD, plus 16 in the validator — and then added `"s_check_inputs"` to
+`RUNTIME_CHECKER_SUBROUTINES`, silencing the guard master built for exactly this. That exemption
+sits directly beneath the INHERITED docstring stating such mixed subroutines are "deliberately NOT
+listed" because allowlisting one "would have let its replacement back in unnoticed." It is a
+disabled alarm, not static debt: it already admitted two new prohibits of our own
+(`m_checker.fpp:92` active_box+synthetic turbulence, `:129` AMR+CBC, both from `c5b461f9`, both
+input-only and both duplicated into the validator). Two of the duplicated pairs have already
+drifted, in both cases with the validator STRICTER than the solver: `reactive_burn` gamma/pi_inf
+uses `f_approx_equal` (|a-b|/(|a|+|b|)) in Fortran vs `math.isclose` (rel_tol) in Python, ~2x
+different, so a case in the 1e-10..2e-10 relative band is rejected by `validate` yet accepted by
+the solver; and `rburn%%pign` fires on the `dflt_real` sentinel in Fortran but only on an ABSENT
+key in the validator, so a case writing `rburn%%pign: -1e6` passes `./mfc.sh validate` and then
+aborts at runtime. `muscl_order_first_order` is imported at `m_checker.fpp:15` and used nowhere —
+the fingerprint of an import hunk resolved as "ours" without rechecking uses.
+
+**Stage guards in src/common (pre-existing, NOT merge damage).** Master carries ZERO
+`MFC_PRE_PROCESS`/`MFC_SIMULATION`/`MFC_POST_PROCESS` anywhere under src/; we carry three
+(`m_phase_change.fpp:99, :203`; `m_boundary_common.fpp:99`). Provenance traced: the count was 4 at
+the pre-merge tip `c5abe1b9`, 4 through the merge, 3 after `c5b461f9` — our own additions, never a
+merge conflict. Not a silent-else bug: the build still defines `MFC_`
+(`cmake/MFCTargets.cmake:88-92`). They exist because `load_weight_wrt`/`sfc_partition_wrt` are
+generated for simulation and post_process but NOT pre_process, which also compiles
+`src/common/m_phase_change.fpp`. Fix is a choice: register those two params for pre_process (one
+line in `definitions.py`, collapses two of the three) or thread arguments as
+`s_initialize_phasechange_module` now does. `amr_in_fine_advance` (simulation-only,
+`m_global_parameters.fpp:330`) needs the argument/policy route regardless.
+
+**COVERAGE GAP: the post_process AMR reader has no value-level regression coverage.** Under `-a`,
+post_process does run per test with `parallel_io = T`, but its output is only written to
+`out_post.txt` and passed through `_process_silo_file` (`test.py:692-706`) — it is NEVER compared
+against a golden; goldens hold simulation `D/*.dat` only. So the `-a` lane catches crashes and
+non-zero exits and is structurally blind to wrong values. A clean pre-fix baseline over the six
+np=2 AMR cases (27DEC5B6, 4644A339, 78314D65, ADA042A2, 2C46C59A, F57C3A5B) is 6/6 GREEN, which
+therefore proves only that the ownership bug's spurious-abort half does not fire in those configs
+— its silent halves (stream desync, displaced block coordinates) could never have been caught by
+that suite at any np. **Consequence for the post-reader fix: do not gate it on the suite.** Gate
+it on a direct np=2 A/B of the actual silo overlay values and block coordinates, pre- and
+post-fix, and say plainly in the commit message that the reader has no value-level coverage.
+Worth an upstream issue independent of this PR.
+
+**Work order adopted.** (1) The checker/lint regression: verify per-check that the validator
+covers each of the 21, delete them plus the two now-dead imports, remove `"s_check_inputs"` from
+the allowlist and mark the genuinely-runtime AMR prohibits with `! lint: runtime-check`, and move
+our own two input-only prohibits to validator-only — the re-armed lint rule is itself the gate,
+plus AMR-68 and a bitcmp (startup-path only, expect byte-identical). (2) Audit the newer merge
+`9c9e0a75` with the same method while it is fresh. (3) Post-reader ownership fix, gated as above
+(patch drafted, `notes/postreader_final.md`). (4) L0 restart-writer filter (`notes/l0filter_patch.md`)
+— the one item here with a real discriminator, since coexist tests under `-a` should hit post's
+`lvl < 1` abort today, and a crash is precisely what that lane CAN catch. Two open decisions for
+the user: whether to upstream the branch-local `damage_energy_cutoff` gate (ours since `91a6f6b4`,
+living inside master's own `s_compute_hypoelastic_interface_energy`, which already damage-scales G
+— a silent numerical divergence inside an upstream routine is how the NEXT merge gets resolved
+wrong), and which stage-guard route to take.
+
+**Method note.** Two `./mfc.sh test` sweeps ran concurrently on this tree for ~20 minutes because
+``pgrep -fc 'mfc\|flang\|ld.lld'`` matched nothing — pgrep patterns are EREs, so `\|` is a literal
+pipe — and the resulting "no processes" reading was taken as "the job died with the node." Both
+sweeps shared the build/staging dir, the `tests//` dirs, and (via `>`) one log path; both
+results were discarded and the baseline rerun alone. Same class as the HypoShearContact
+cross-contamination in ledger (33). Standing rules added: never conclude a process died from a
+count alone (print the matches, `pgrep -fa`), one sweep at a time per tree, and a distinct log
+path per run so a second writer is self-evident.
+
+## 2026-08-27 (33) — ELASTIC-GATE PER-SIDE FIX LANDED; ONE REVIEW PROHIBIT RETRACTED AS WRONG
+
+The elastic-gate fix (review finding #10) landed: `s_compute_hypoelastic_interface_energy` now
+gates each side's elastic energy on its own state — E_L on `G_L > verysmall` and the left damage
+cutoff, E_R on `G_R > verysmall` and the right damage cutoff. The old hybrid joint-gated E_L on
+BOTH sides (a damage-collapsed or fluid right state suppressed the left side's stored energy) and
+gave E_R no damage cutoff at all (a collapsed right modulus kept contributing energy — the NaN
+mechanism the cutoff exists to prevent). One golden moved, exactly the test that exercises the
+changed regime: AMR 1D hypoelastic static block with `cont_damage` (D731AB7A), deltas
+concentrated in the stress and damage fields near the damaged region (worst rel 2.3e-3 on the
+stress trace; densities at O(1e-6)). Regenerated with that delta analysis as justification.
+
+**Retraction:** the batch (32) prohibit on HLLD-hypoelasticity + CBC is REMOVED. Its gate run
+blocked an UPSTREAM test (#1414's "CBC uniform preservation", 2274CB4E) whose own comment records
+that a pre-fix version of the case drifted O(1e-3) in five steps — proof the CBC path is live and
+consequential under HLLD, which the review finding's "corrections silently dropped" reading said
+was impossible. Fresh code walk: the claim is only half-true. The conservative rows DO read the
+separately-stored `flux_n` (finalized before `s_cbc` corrects `flux_rsx_vf`), but the
+advection-source path consumes the s_cbc-corrected `flux_src_rsx_vf`, and #1414 deliberately
+supports, fixed, and tests the combination with documented usage limits ("characteristic
+boundaries are limited to fluid regions"). Outlawing an upstream-shipped configuration on a
+partial static reading was wrong for this PR; the conservative-flux question is an upstream
+discussion. The two prohibits covering THIS PR's own findings — AMR + CBC (the interior
+fine-block-edge pollution proven by the 9640CE7F golden forensics) and active_box + synthetic
+turbulence — stand untouched. LESSON (pairs with (32)'s): a prohibit that trips an existing
+green test indicts the golden OR the prohibit — this time it was the prohibit, and the
+discriminator was the same both times: read what the test's own history and comments claim,
+then verify the mechanism end-to-end, not just the half that supports the finding.
+
+**Suite forensics:** the 131-test gate run (hypo-65 + AMR-68) had two more failures, both false:
+the HypoShearContact convergence pair (26660584 HLLD, D0AC8751 HLLC) ran concurrently under
+`-j`, and their sweeps — both staged from `examples/2D_hypo_shear_contact/` — cross-contaminated:
+each log held the OTHER test's Linf values (one value bit-identical across both logs was the
+tell). Rerun solo: HLLD fits order 2.000 (needs 2.0±0.1), HLLC 0.998 (needs 1.0±0.2). Same class
+as the known chemistry-test example-cache clobbering; convergence tests sharing an example
+directory must not run concurrently — rerun solo before believing a convergence failure.
+
+Gates: S0 np8 bitcmp vs the accepted binary **byte-identical** (pinned
+`bins/simulation-elasticgate-22c01bd7`; the retraction is validator-Python only, no binary
+change); hypo-65 + AMR-68 all green after triage (127 direct + D731AB7A on the regenerated
+golden + 2274CB4E unblocked + the two convergence tests solo); precheck clean.
+
+## 2026-08-27 (32) — FULL-PR REVIEW: NINE CONFIRMED FINDINGS FIXED, GATED, AND LANDED (c5b461f9)
+
+A full adversarially-verified review of PR #1628's diff produced 12 confirmed findings; the 9
+pure correctness/hardening ones landed in one batch (the elastic-gate per-side fix, the
+post-process reader ownership fix, and the restart-writer level-0 filter have banked designs in
+`amr-bench/notes/mrhs_merge_plan.md` and land separately with their own gates). The batch:
+
+- **`_alloc` widening**: four dual-pass/`nc_iface` allocations in `m_riemann_solvers.fpp` and
+ three UVM host-pinned fallbacks in `m_igr.fpp` were sized to `m/n/p` — under AMR's fine-grid
+ swap those are ONE block's dims at allocation time, an out-of-bounds write for any later,
+ larger block. Now sized to `m_alloc/n_alloc/p_alloc` (`idwbuff_alloc` where the buffered range
+ is indexed).
+- **Phase-change stage independence**: `s_initialize_phasechange_module` takes its allocation
+ upper bound as an explicit argument (sim passes the `_alloc` maxima when load-balance/SFC
+ output can reshape the grid, `[-1,-1,-1]` otherwise), removing a stage `#ifdef` from
+ `src/common/`.
+- **Moving-IB `num_gps` device refresh**; **coexist-safe acoustic overlap check** (skip
+ `amr_block_level(kb) == 0` tiles); **64-bit regrid clustering arithmetic** (volume accumulator
+ and two `jrem` linearized-index sites).
+- **Three prohibits** (Fortran checker + `case_validator.py` mirrors): AMR + CBC (`bc = -5..-12`)
+ — `s_cbc` is gated only on the GLOBAL bc codes with no `amr_in_fine_advance` guard, so the
+ fine-block advance fires it at interior block edges; `active_box` + `synthetic_turbulence`;
+ HLLD-hypoelasticity + CBC (the dual pass reads the pre-CBC Riemann fluxes).
+
+The AMR+CBC prohibit caught one of our own tests: `AMR -> 2D -> axisymmetric` (9640CE7F) used
+`bc_y%%end = -6` while its header claims machine-zero conservation "on a closed axisymmetric box"
+— the nonreflecting buffer contradicted the test's own documented intent. Outer BC switched to
+reflective; the regenerated golden CONFIRMS the diagnosis: every worst-case delta clusters at one
+location (the static fine block's upper y-edge), where the old golden held density 0.9947 in a
+should-be-uniform field, spurious radial momentum -7.1e-3 (now 6.7e-4), and an unphysical volume
+fraction 1.00135 > 1 (now 0.99998) — the interior-edge CBC pollution, removed.
+
+Gates: build clean; S0 np8 bitcmp vs `reglocal2-66ee40c7` BYTE-IDENTICAL (the batch touches no
+golden-path code); AMR-68 = 68/68 after the axisymmetric BC fix; precheck clean. Pinned binary:
+`bins/simulation-reviewfix-67bf6bf3`.
+
+## 2026-08-27 (31) — SIXTH RUNG: np16->np32 = 1.274x vs THE AMReX np32 BAR 1.278x — AT SOTA; np32 UNBLOCKED
+
+Acceptance job 386892 (reglocal binary via its byte-identical pre-format twin, k004-[002-003,
+007-008]): ALL FOUR ARMS rc=0. np16 differenced (1385.551-138.608)/100 = **12.47 s/step**;
+np32 (1752.075-163.192)/100 = **15.89** -> rung = **1.274x** vs AMReX's own np16->np32
+degradation **1.278x** (job 385522) - **excess 0.997x, AT the bar on the third doubling.**
+LADDER: 1.594 -> 1.544 -> 1.368 -> 1.343 -> 1.241 (np8->np16, excess 1.041) -> 1.274
+(np16->np32, excess 0.997). Caveat: 140-step arms ((140-40)/100), not the 240-step
+ledger-grade form; within-job pairwise design as always; cadence tags match the 386617
+baseline runs EXACTLY (55,650,766 np16/140; 111,298,856 np32/140; escaped 0) so the physics
+trajectory is identical. VRAM PLATEAU CONFIRMED: np32/140 ends at mean 37-44 / max 44.7-47.8
+GiB and FLATTENS over its final 20 min (np16-plateau shape) vs the baseline's 63.9/64 crash
+(rc=137). ~16 GiB reclaimed - far above the ~3.5 GB static register estimate, which
+retro-explains the baseline's discrete +12 GiB jump events: they were REG_GROW device-staged
+capacity doublings toward the GLOBAL count, a growth class the participation-local map
+deletes outright. The np32 memory blocker is CLOSED; the residual-term worry (ledger 29) is
+retired. Cross-node wall observations (np16/140 -16.6%, np32/40 -11.7% vs baseline) are
+DIRECTIONAL (different node set); the same-node np8 A/B (reglocal 7.84 s/step, mergereplay
+arm in flight on k004-005) is the honest neutrality read. Remaining above a bar: ONLY the
+second doubling (1.241 vs 1.192); the rf:wait overlap increment (option B,
+notes/rfwait_overlap_design.md) is the one candidate left, and it is optional.
+
+## 2026-08-27 (30) — PARTICIPATION-LOCAL REGISTERS LANDED; THE ONE RED CI TEST WAS A RUNNER SLOT CAP
+
+Register locality landed `0acad7bd` (all gates: S0 np8 bitcmp byte-identical; [amr-xa]
+families identical; debug/NaN-poison rc=0; AMR-68 68/68; formatted-tree rebuild twin-bitcmp'd
+byte-identical, so the queued acceptance evidence transfers). The 12 creg/freg arrays now
+index by a dense participation-local slot (own / parent-owned / reflux-face-participate) with
+a mesh-epoch-keyed lazy rebuild (s_amr_reg_prepare) and dense kernel sweeps; the mesh epoch
+moved to m_global_parameters (m_amr re-exports). DESIGN CATCH during the site audit: both
+freg exchange paths gate receives on f_amr_reflux_participates' UNCLIPPED formula (no seam
+clip), so the map's clause (c) copies that formula - the seam-clipped flags predicate would
+have under-covered a seam-only participant (an IRECV into dense slot 0). ACCEPTANCE = job
+386892 (np32_accept.sbatch, np32/140 must plateau like np16), queued; pre-fix baseline:
+np32/140 rc=137 at 63.9/64 GiB (386617, trajectory in notes/reg_locality_design.md).
+np8 wall-neutrality pair (reglocal vs mergereplay, k004-005) in flight.
+
+CI: #1628's first cycle reduced to ONE failing test - D127EC91 (AMR churn np=4, the suite's
+only np=4 case; upstream has none) - ROOT-CAUSED as an Open MPI slot cap on 2-core GitHub
+runners: syscheck's `mpirun -np 4` is refused before MFC runs ("not enough slots"), on every
+GNU/Intel/NVHPC-cpu lane, both opt levels. NOT a code bug: the test passes on the local
+gfortran CPU lane. Fix `60b931f2`: the default template passes --oversubscribe when the
+launcher is Open MPI (MPICH has no slot cap and no such flag), validated locally through the
+mpirun path. Teardown fix f81239a3 confirmed clearing the other 4 CPU crashes in CI.
+Build & Verify green on #1628 (the lychee exclusion held). Frontier lanes still the site
+outage. Upstream moved (#1763 Phoenix CI infra; merged into up/mega and the probe by the
+user mid-evening - both my commits rebased on top cleanly).
+
+## 2026-08-27 (29) — MASTER MERGED INTO up/mega: PR #1628 IS CI-LIVE
+
+Merge `5312e834` (upstream master `d74cc378`, unchanged since the probe) reuses the
+resolution proven on CI probe PR #1765: flat standard sweep keeps our rs arrays/AMR
+capture/active-box; master's dual-pass HLLD dispatches from m_rhs on its own vf fields;
+master's 4-way hypoelastic split is the only implementation; s_check_inputs_time_stepping
+follows master's deletion. Beyond the probe: the 2a prim-batch m_rhs guards re-applied; the
+hllc `extraOmpArgs map(alloc:)` workaround re-grafted onto BOTH dual-emission call sites
+(the probe had silently dropped it); D731AB7A golden regenerated for master's #1414
+numerics; `s_check_inputs` added to the runtime-checker lint list (validator migration =
+standing merge debt). Two root-caused fixes ride along: (a) the probe's --no-verify mystery
+— master's check_coverage_map_health.py ran git with the hook-inherited
+GIT_DIR/GIT_INDEX_FILE, so under the pre-commit hook its unit tests queried the real repo
+instead of their throwaway repos; a GIT_* scrub in the script fixes it (hook-env lint
+470/470; candidate upstream PR); (b) the docs Build & Verify lane — all 41 lychee errors
+are Doxygen auto-linking backticked `*.md` prose mentions to `*_8md.html` file pages it
+never generates; one `.lychee.toml` exclusion (`1f38c02f`). Merge-mechanics lesson: git's
+auto-merge of m_riemann_solvers/hypo_hlld silently took master's versions, which do not
+compile against our one-arg s_initialize_riemann_solver — the probe's hand-edits to those
+NON-conflicted files were required; a probe resolution is more than its conflict set, so
+the gate was a whole-tree diff against the probe (result: working tree == probe content +
+post-fork commits exactly, per file). Gates: precheck standalone AND hook-env; amdflang GPU
+build; S0 np8 bitcmp byte-identical vs cdefer2-591fe7dc — and the lustre_5.dat hash equals
+the probe-era bitcmp's, one identical output across cdefer2, the probe merge, and the
+replayed merge; AMR-68 68/68. Binary pinned bins/simulation-mergereplay-71cd6f77.
+VRAM probe 386617 (same day): np16/140 plateaus (mean ~46-51 GiB/GCD, max 57.7, flat 20
+min); np32/140 climbs through that plateau in discrete regrid-event jumps to 63.9/64 GiB —
+the O(global boxes) growth signature; analysis appended to notes/reg_locality_design.md,
+whose acceptance test (np32/140 plateauing like np16) is unchanged.
+
+## 2026-08-26 (28) — FIFTH RUNG (cdefer): 1.241x — WITHIN 4% OF THE AMReX BAR
+
+Job 386573 (cdefer2-591fe7dc = 44edcc5b's code, node set k004-[001,008]): np8 differenced
+(1979.970-119.175)/200 = **9.30 s/step**, np16 (2471.288-161.901)/200 = **11.55** -> rung =
+**1.241x** (ladder 1.594 -> 1.544 -> 1.368 -> 1.343 -> 1.241; bar 1.192x; excess **1.041x**).
+The coarse deferral did what the (27) design predicted: np16 -8.5% at flat np8; the coarse
+phase's growth fell +0.76 -> +0.59 and its imbalance 1.58 -> 1.29 (absolute np16 cost 1.32 ->
+1.13 s/step). Residual growth 2.24 s/step and fully DIFFUSE: coarse +0.59, restr +0.43
+(rs:rest +0.22, rs:wave +0.20), rf:wait +0.33, regrid +0.32, gather +0.27, halo +0.16 - no
+family holds more than 27%. The remaining ~1 s/step of wait/comm growth is the
+overlap/skew-class program (options drafted in the bench notes); with it and the
+register-locality np32 unblock, bar parity at 2 and 4 nodes is the near-term close-out.
+
+Same day, the CI-exposure lane (probe PR #1765) caught and fixed three latent defects:
+allocated() on a pointer member (c37dea4c), a stale AMR-hypo golden vs upstream #1414, and
+grouped wave-scratch deallocates crashing every non-qbmm np>1 CPU teardown (f81239a3;
+amdflang silently tolerated all three). The master merge is fully resolved, compile-verified,
+byte-identical on S0, and exonerated of all CI failures - the replay onto up/mega is next.
+
+## 2026-08-26 (27) — 2a PRICED AND GATED OFF; the coarse call deferred; np32 is MEMORY-BLOCKED
+
+**Phase 2a's mandate was pricing, and it priced decisively.** Landed 3ed9f573 (batched cons->prim,
+one launch/stage, all gates green: bitcmp byte-identical, per-rank convert launches 387 -> 30 in
+the 5-step probe, AMR-68), then the pricing pair caught a ~4x WALL regression (40-arm 458.9 s vs
+~118 baseline) while total DEVICE kernel time IMPROVED (8.79 -> 6.65 s/5-step; batch kernel 0.5 s).
+Root-caused by discrimination probe: a flag-off build with the kernel still compiled in prices at
+baseline (112.2 s) -> NOT the amdflang Attributor/codegen class; the cost is the RUNTIME host
+launch/mapping burden of the per-block PRIM BRIDGE-LOADS (both the scalar_field-array-dummy form
+and the per-var plain-array form are catastrophic). Those bridge loads are exactly what
+store-native 2b deletes — **partial batching through a bridge is NEGATIVE value on this backend;
+the finding is 2b's strongest argument, per the pre-registered decision rule.** Verdict landed
+70fea5e6: gate defaults OFF, machinery kept for the 2b experiment.
+
+**Coarse deferral landed 44edcc5b** (from the (26) wait-cluster program): the coexist L0 coarse
+RHS moves past the fine advance — its rhs values are discarded and its only external products are
+the creg captures phase 4 reads + a self-contained prim ghost fill (m_amr.fpp:338-341: the fine
+fill prolongs from CONS ghosts via its OWN exchange), so it now absorbs stage skew where ranks are
+best synchronized (rhs imb 1.14) instead of the stage top (coarse imb 1.58 at np16). bitcmp
+byte-identical; AMR-68 68/68; np16 price rides the next rung. The OTHER coarse fix class
+(shell-restricted L0 RHS) is DEAD BY ARITHMETIC at cap 64: a block's stencil-widened surface
+bands are ~84% of its volume, so the sweep cannot shrink meaningfully — the np8 coarse base is
+not reducible this way at this operating point.
+
+**np32 is memory-blocked, not harness-blocked**: both the 240-step and 140-step np32 arms die
+rc=137 (HSA_STATUS_ERROR_OUT_OF_RESOURCES, device OOM) between step 40 and 140, while per-rank
+live blocks match np16 (~75-84) — something in the allocation path grows with GLOBAL box count
+past a GCD at np32. The endstate's O(boxes)/O(boxes x ranks) allocation class (Phase-3 I7/S4)
+is now a measured 4-node blocker, not just an audit finding. np16 probe arm: 13.7 s/step
+(140-40 differenced, probe grade). The np32 ladder point waits on that fix.
+
+Toolchain lesson recorded: mfc.sh prints "Terminated" + exit 143 on BUILD FAILURE — three
+"mystery SIGTERMs" were one link error hidden by tail windows; always capture the full log.
+
+## 2026-08-25 (26) — FOURTH RUNG (f7wave): 1.343x; THE CHAIN IS DEAD; residual growth is DIFFUSE wait
+
+Job 385918, node set k004-[005-006], f7wave binary (bc91de59): np8 differenced
+(1997.589-118.606)/200 = **9.40 s/step**, np16 (2680.162-156.279)/200 = **12.62** ->
+rung = **1.343x** (ladder 1.594 -> 1.544 -> 1.368 -> 1.343; bar 1.192x; excess
+**1.127x**). **The F7 wave verdict: restr np8 1.70 -> 0.53 (-69%), np16 3.74 -> 0.98
+(-74%); rs:rest growth +1.69 -> +0.18 — the per-global-box chain is dead.** Same-day
+k004-001 pair (lpair-k1-f7wave): reps {10.40, 9.48} vs f5asel {10.41, 9.92} — np8
+~-4.5% rep-matched there; the rung-to-rung np8 delta (11.67 -> 9.40 on k004-005) mixes
+the F7 gain (restr -1.18 + reflux -0.48 by phase) with day/conditions — within-job
+ratios remain the honest ladder.
+
+Residual growth (np16-np8 = 3.22 s/step): coarse +0.76 (ratio 2.35, imb 1.58, #1 as
+the coarse draft predicted), rf:wait +0.65 (imb 1.51), restr +0.46 (of which rs:wave
++0.27 at imb 2.02 — the freg-wave rendezvous absorbing advance skew; rs:rest +0.18;
+rs:rfp flat), gather +0.33, regrid +0.32, seam +0.24, rhs +0.24 (ratio 1.05 — physics
+at the bar), halo +0.19. **No single dominator: the wait cluster (coarse-wait +
+rf:wait + rs:wave ~ 1.7 of 3.22) is the top pool — the stage-skew/overlap class
+re-emerges as the #1 design now that the chains are gone**, with the coarse increment
+(amr-bench/notes/coarse_design_draft.md: shell-restricted L0 RHS for the np8 base,
+overlap/reorder for the np16 wait) as its first concrete piece. np32 rung 385968
+(f7wave, 4-node, mirrors the AMReX (4,4,2) bar 1.278x) queued the same night.
+
+## 2026-08-25 (25) — THIRD RUNG (f5asel): 1.368x; restr growth is the F7 PER-BOX CHAIN, not skew
+
+Job 385698, same pairwise design, node set k004-[005,008] (NOT the (24) set — cross-rung
+phase deltas are directional only; the within-job ratio is the honest number): np8
+differenced (2452.939-119.330)/200 = **11.67 s/step**, np16 (3355.078-163.324)/200 =
+**15.96 s/step** -> rung = **1.368x** (ladder: 1.594x -> 1.544x -> 1.368x; bar 1.192x;
+excess **1.147x**, was 1.30x). F5a moved np16 -10.4% while np8 stayed flat (+1.1%,
+noise) — the wire-cuts-pay-more-inter-node rule now proven twice.
+
+**The rs:\* verdict (the (24) design gate) REDIRECTS the program.** Differenced growth
+np16-np8: restr +2.04 of which **rs:rest +1.69 (ratio 2.20, imbalance 1.13)**,
+rs:wave +0.35 (imb 1.82), rs:rfp +0.00; coarse +1.02 (imb 1.76); rf:wait +0.31;
+regrid +0.26; gather +0.24; halo +0.17; seam +0.13; rhs +0.12 (ratio 1.03 — physics
+scales BELOW the bar). Closure exact (restr = rs:rest+rs:wave+rs:rfp = 3.742).
+Low imbalance right after the synchronizing freg wave means rs:rest growth is genuine
+per-rank cost, not skew — and per-rank restrict WORK is weak-scaling-constant, so the
+cost that doubles is the **fold loop's per-global-box serialized P2P chain**
+(s_restrict_fine_to_coarse: owner ISEND+WAITALL per box, receivers blocking RECV per
+box, every rank walking ALL global slots in order — the per-box-rendezvous root cause
+surviving in the F7 family). The assumed ~4.7 s/step "stage-skew pool" was really
+~0.65 of wait (rs:wave + rf:wait) + a chain that the wave discipline already knows how
+to kill. **Stage-skew/overlap mega-design DEMOTED; next increment = I5b F7 restrict
+wave (design ready: amr-bench/notes/i5b_f7_design.md, its ladder gate now satisfied).**
+coarse (+1.02, imb 1.76, wait INSIDE the L0 s_compute_rhs) is #2 and stays skew-class.
+
+Same-day k004-001 anchor (user-held node, lpair-k1floor-f5asel-0825_1808, f5asel
+binary): reps 9.92 / 10.90 -> **floor 10.41 s/step**, rep spread 9.9% (2x the historic
+noise floor; both reps ran beside the rung job — cross-job lustre/fabric contention.
+A/B probes on this node must run arms back-to-back). Node-era spread is large: same
+binary measures np8 = 9.92-10.90 (k004-001) vs 11.67 (k004-005) — same-node A/B only.
+
+## 2026-08-25 (24) — SECOND INTER-NODE RUNG (f2clip): 1.544x per doubling; the clip pays MORE inter-node
+
+Job 385612, same self-contained pairwise design as (21), node set k004-[006-007]:
+np8 differenced (2428.241-120.665)/200 = **11.54 s/step**, np16 weak-scaled
+(3724.576-162.293)/200 = **17.81 s/step** -> rung = **1.544x** (was 1.594x on the
+clip16k binary; bar 1.192x; excess 1.30x, was 1.34x). The F2 clip cut np8 -6.1% but
+np16 **-9.0%** (19.57 -> 17.81): halved parent-fill wire buys more where inter-node
+bandwidth is the scarce resource — every remaining wire cut is worth MORE at scale
+than its np8 price suggests. Growth decomposition (np16-np8, s/step, vs the (21)
+table): restr +2.41 (was +2.84, still #1), coarse +1.30 (was +1.53), rf:wait +0.95
+(unchanged — F5 untouched in this binary), regrid +0.46, gather +0.32 (was +0.44),
+seam +0.26, halo +0.25; rhs ratio 1.063 (physics is BELOW the bar). The three
+wait/skew families (restr + coarse + rf:wait) are 4.7 of the 6.27 s/step growth ->
+the stage-skew/overlap increment stays the #1 major target; the rs:* sub-brackets
+riding the f5-complete rung (job 385698, SAME node set, queued behind this one) will
+decompose restr into wave/restrict/reflux-to-parent at np16 before that design is
+committed.
+
+## 2026-08-25 (23) — F5a FACE-SELECTIVE MULTICAST: F5 halves again (-49.5%), day total F5 -58%
+
+The L1 reflux-faces wave multicast ALL SIX full faces of every rank-boundary block to
+every participating rank, but a participant applies only the faces whose outside
+coarse layer it owns minus fine-fine seams (own_lo/own_hi + f_amr_face_is_seam in
+s_amr_reflux_face_flags) - typically 1-2 of 6. New s_amr_reflux_faces_for(r) mirrors
+the apply's gates term for term, parameterized by rank from the replicated
+decomposition; the owner ships exactly each participant's apply set and each
+participant posts exactly its own (identical derivation both sides, fixed order, so
+the shared-tag pairing is exact). The device->host pull now covers only the UNION of
+shipped faces (previously EVERY owned L1 block pulled all six faces every stage,
+participants or not); the consume pushes only received faces; unreceived faces are
+NaN-flooded in debug. GATES: byte-identical (bitcmp), F5 547.4M -> 276.6M words
+(-49.5%, msgs 5568 -> 2814), poison probe rc=0, AMR-75. Day total for F5 (seam clip +
+face-selectivity): 659.4M -> 276.6M = -58%. Third rung (f5-complete binary) to queue
+behind 385612 for the pairwise ladder: clip16k -> f2clip -> f5-complete.
+
+## 2026-08-25 (22) — F5b SEAM-CLIPPED + restr SUB-BRACKETS; k004-004 ERA FLOOR = 10.48
+
+The freg wave (F5b) shipped ALL SIX faces of every split level>=2 child to its
+parent's owner, but the parent-side apply (s_amr_reflux_to_parent) multiplies
+sibling-seam faces by weight 0 — dead wire. The weight computation is extracted into
+s_amr_sibling_face_weights (replicated metadata only) and BOTH wave sides now derive
+the identical skip from it: skipped faces post no send/recv, skip their PCIe
+pulls/pushes, and are NaN-flooded in debug so any hidden consumer aborts. GATES:
+byte-identical (bitcmp), F5 words -17% on the 5-step probe (msgs drop with words —
+whole faces), poison probe rc=0, AMR-75 75/75. The modest probe cut says F5a (the L1
+face multicast) dominates F5 -> the next comm increment is F5a FACE-SELECTIVE
+multicast (scoping: notes/overnight_0825_pricing.md — each participant applies only
+the 1-2 of 6 faces whose outside coarse layer it owns; predicates pure+replicated).
+
+Also in this batch: restr sub-brackets rs:wave/rs:rest/rs:rfp (the np16 rung made
+restr the largest inter-node growth; instrument-before-optimize). And the k004-004
+held-node era FLOOR (aggressive-progress protocol): np8 differenced 10.588/10.376 ->
+**10.48 s/step** on the f2clip HEAD — prediction 10.3-10.8 CONFIRMED; trajectory
+14.15 -> 11.64 -> 10.48. Profile: rhs 42%, restr 1.61 + rf:wait 1.42 = the top pool,
+rg:build 0.12 (the rebuild pipeline is done), gather 0.79 post-F2-clip.
+
+## 2026-08-25 (21) — THE FIRST INTER-NODE RUNG: 1.594x per doubling vs bar 1.192x
+
+Job 385465 (2 nodes, clip16k binary = HEAD-before-F2-clip + pi16k), weak-scaled S0
+family, all four arms rc=0, cadence clean: np8 differenced 12.28 s/step -> np16 19.58
+= **1.594x per weak doubling across the node boundary**, vs the AMReX bar's measured
+inter-node 1.192x (384936). Excess 1.34x — BETTER than the intra-node np4->np8 excess
+(1.44x): crossing the fabric did not blow up. Full phase accounting (sums match walls):
+the +7.29 s/step decomposes as restr +2.84 (2.56x — the NEW #1: the freg wave/
+restriction), coarse +1.53 (2.96x, imb 1.67 — the L0 RHS's internal halo absorbs
+inter-node skew; the shell-restricted-L0-RHS candidate is hereby PROMOTED), rf:wait
++0.94, regrid +0.48 (rb:gath 2.4x), gather +0.44, halo +0.31. rhs = 1.09x — the
+physics weak-scales nearly perfectly. Wire: every family grows 2.3-2.5x per doubling;
+F2 alone is 504 G-words at np16 (~half of ALL wire) — the just-landed F2 clip (-54%)
+is not in this measurement; a rung rerun with the f2clip binary is queued (385612).
+
+## 2026-08-25 (20) — F2 RING-CLIPPED: the LARGEST wire family cut -54%, byte-identical
+
+The parent-fill wave (F2, 215 G-words at np8/240 — 3.3x F1 pre-clip) ships the padded
+parent patch whose runtime consumer is the SAME amr_cg ghost fill the stepfill clip's
+dead-byte proof covers (`amr_stepfill_ring_clip.md` is about the READ side of amr_cg,
+independent of which family filled it; the wave's consume calls only
+s_amr_fill_fine_ghosts_*, with prolong-feeding init/regrid gathers on their own
+unclipped paths and the subcycle asserted away). Each child's one full-patch transfer
+becomes its shell-slab list — derived by ONE shared function (s_amr_parent_shell) that
+the send walk, recv walk, and consume all call, so the wire layout cannot drift between
+sides; the pbmv contract keeps the full patch exactly as F1 does. Three bounded
+kernels (pack/unpack/local-copy over a patch-local sub-box) subsume the full-patch
+case, so the wave has one uniform path. The co-located parent copy is shell-only too,
+under the same debug NaN-poison arm.
+
+GATES: F2 words 1,628,915,568 -> 746,280,528 (-54.2%) with msgs unchanged (524) and
+every other family byte-identical; step-5 output BYTE-IDENTICAL (bitcmp); debug poison
+probe rc=0 with headers live on every transfer (int=2, so the untouched regrid F2 path
+ran too); AMR-75. The seeded-bug arm is deliberately omitted: it probes two-sided
+plan-derivation drift, which the single shared derivation function structurally
+excludes, and the live debug headers still verify every transfer's bounds on the wire.
+
+## 2026-08-25 (19) — REG_GROW GOES DEVICE-NATIVE (the store-grow twin)
+
+`s_amr_reg_reserve`'s REG_GROW macro was the last growth path that round-tripped device
+data over PCIe: every register doubling pulled the WHOLE array (all 12 creg/freg
+arrays, ~1.4 MB/slot) to the host, restaged, and pushed back. It now mirrors
+s_amr_st_reserve exactly: below a 512-slot transient threshold (byte-equivalent of the
+store's 32-column cap) growth stages through a device temporary (copy/restore/zero
+kernels, no PCIe); above it the old host round trip remains as the OOM-safe path. The
+registers were already device-authoritative — every host consumer pulls its slot with
+GPU_UPDATE(host=...) immediately before reading (audited: m_amr.fpp wave/exchange
+paths, no whole-array host assignments exist) — so the host mirror coming out of a
+device-path growth undefined is the store's existing contract. The 5-step probe
+exercises the device branch on every rank (floor 64 -> immediate growth to the global
+block count at startup). GATES: bitcmp PASS vs the clip16k binary (byte-identical),
+AMR-75 75/75.
+
+## 2026-08-25 (18) — THE OVERNIGHT PAIRS PRICED THE ATTRIBUTOR CLIFF; WORKAROUND ADOPTED IN-TREE
+
+The three k004-008 np8 pairs (differenced 240-40, 2 reps each) priced the 2026-08-24
+commits: rbatch (5ac7b6fa) 11.79 s/step — wall-neutral vs the 11.64 post-wave floor
+(its win is calls/rank 759->15, which pays at higher np); devmig (62bf3e11) 16.69
+(+43%!); clip HEAD (34296def) 16.37. The regression decomposes entirely into phases
+the commits NEVER touched — rhs +3.05 s/step (+70%), rk +222%, restr +52% — while
+every phase they DID touch improved (rg:mig -0.45, mg:unpk 74->11 ms/call, rg:build
+-0.51, rb:gath -47%, pg:recv -70%). Diagnosis: the migration kernels crossed the
+amdflang Attributor AAPointerInfo cap and the WHOLE image recompiled to slow ISA (the
+known link-time instability, MFlowCode/MFC#1759); none of the overnight binaries
+carried the pi16k flag (verified in every staging link.txt). Full table:
+`amr-bench/notes/overnight_0825_pricing.md`.
+
+ACTION: the workaround is adopted in-tree (`cmake/MFCTargets.cmake`, LLVMFlang link
+line, mirror of PR #1759) so every future build is immune. Fresh-configure rebuild of
+HEAD: flag on the link line, step-5 output BYTE-IDENTICAL to the unflagged clip binary
+(the flag is optimization-only). Repriced pair + the repaired np16 rung (the 384728
+failure was staging — ic/rung_np*/ lacked simulation.inp) submitted on the pinned
+`bins/simulation-clip16k-f066397c`. AMReX 2-node bar measured meanwhile: np8->np16
+weak-scaling 36.85 -> 43.93 s = 1.192x per doubling ACROSS THE NODE BOUNDARY — the bar
+holds inter-node and is what the MFC np16 rung reports against.
+
+## 2026-08-24 (17) — RING CLIP RE-LANDED ON THE WAVES: F1 wire -61%, output byte-identical
+
+The reverted clip (proven correct, killed by the amdflang codegen bug, root-caused and
+workaround-verified since) is reimplemented on the wave plan walks: after each pair's
+box intersection, the slab is clipped against the patch's hollow shell (open core
+[region_lo+1, region_hi-1] is provably dead — `amr_stepfill_ring_clip.md` survived the
+revert and carries the proof), yielding up to 6 sub-slab transfers derived identically
+on both sides from replicated metadata. The primitives (`s_amr_shell_slabs`,
+`s_amr_shell_clip`, the debug NaN-poison arm, the shell-only own-box copy) are lifted
+VERBATIM from the reverted implementation; pack/unpack/consume were already generic
+over (bl, bh), so sub-slabs are just more transfers. The pbmv gather keeps its
+full-box wire contract (qbmm+non-polytropic runs stay unclipped, as the original
+deliberately did). Messages stay at the per-peer count (381); only payload drops.
+
+GATES: F1 words 1,071,084,168 -> 416,141,172 (-61%) with msgs unchanged and every
+other family byte-identical; step-5 output BYTE-IDENTICAL (the dead-byte proof holds
+on the waves); debug probe with the NaN-poison arm LIVE (any consumer read of an
+unshipped cell aborts); seeded header arm; AMR-75; wall not in the slow codegen class
+(the original blocker); the wall pair queues behind the fix/feature pairs.
+
+## 2026-08-24 (16) — THE ADVERSARIAL REVIEW ROUND: three findings on the day's four commits, all fixed
+
+The four rapid increments got their overdue adversarial review; it returned one
+corruption-class, one crash-class, and one contract-gap finding (migration and prolong
+came back clean against every attack): (1) the IB path re-breaks the merge invariant
+the batched reflux apply relies on — `s_amr_expand_box_over_bodies` runs after
+clustering and the follow-up merge fused only OVERLAPPING pairs, so two boxes left
+with a 1-cell gap have COINCIDENT outside coarse cells -> an unsynchronized
+read-modify-write inside one batched kernel (amr+ib configs only; no gate exercises
+them). FIX: the IB merge now fuses pairs closer than a 2-cell gap, restoring the
+separation the clusterer guarantees everywhere else. (2) the device-native grow
+transiently held old + tmp = 2x the array on device, at exactly the memory high-water
+mark — a measured OOM class. FIX: device-native staging only up to 32 old columns
+(the startup/early events where the -57% short-run win lives); above that, the old
+host round trip (device peak max(old, new)). (3) restart pushes full padded columns
+after writing only interiors, and the host pad bytes are undefined since the
+device-native grow. FIX: zero the host column before each restart read.
+
+## 2026-08-24 (15) — I6 (plan caching) REFUTED BY MEASUREMENT: the plan walks are free
+
+New gw:plan/gw:pack/gw:wait sub-brackets inside the stage-fill wave (this commit).
+Probe verdict: gw:plan = 0.01 ms/call — the replicated-list walks that I6 proposed to
+cache cost NOTHING; there is nothing to cache. The wave's real residue is the pack
+copyouts (12.4 ms/call) and the WAITALL (15.9 ms/call), plus the other PH_GATHER
+paths (the parent-fill wave shares the bracket). I6 is REMOVED from the T1 list. The
+evidence now points at RING-CLIP-ON-WAVES as the next comm increment: clipping the
+71%-dead stepfill bytes out of the wave slabs shrinks pack, wire, and wait together,
+and the compiler blocker that reverted the original clip is workaround-verified.
+
+## 2026-08-24 (14) — STORE GROWTH GOES DEVICE-NATIVE: -57% probe wall; the last host-staged store operation is gone
+
+`s_amr_st_reserve` grew the store by round-tripping the ENTIRE store over PCIe — full
+device->host pull, host realloc, full push, for each of up to four arrays per growth
+event. The round trip's one remaining justification (carrying the migration stash's
+host writes across a growth) died with (12), so growth now stages through a
+DEVICE-side temporary: two on-device copies, zero PCIe. The host mirror comes out of a
+growth UNDEFINED — within the existing contract (every host reader pulls its slot
+first; compaction already leaves the host stale by design). The 5-step np8 probe fell
+100.8 -> 43.4 s (-57%!) with BYTE-IDENTICAL output — the growth round trips were a
+huge UNTIMED cost in every short run (all earlier probe comparisons stand: both arms
+carried it equally). Honest expectation for the operating point: much smaller (int=20
+reaches its high-water early; late growth is rare) — the win concentrates in short
+runs, tests (suite -1.3 min), regrid-heavy transients, and restart spin-up.
+mg:slot 3.72 -> 0.60 s on the probe (-84%). Follow-up: the registers' REG_GROW macro
+keeps the same pull/push pattern (smaller arrays; same fix applies).
+
+GATES: step-5 output BYTE-IDENTICAL (np8 probe, sha256); AMR-75 75/75. Its wall pair
+joins the queue when a QOS slot frees.
+
+## 2026-08-24 (13) — PROLONG GOES DEVICE-SIDE: the rebuild now builds every slot where the store lives
+
+The last host stage of the rebuild: `s_prolong_one_var` and the two closure prolongs
+(alphas sum-to-one, species realizability) were host loops writing the cons host mirror,
+forcing a full-slot H2D push per built box at THREE call sites (the rebuild, the startup
+populate, the persistent-L2 build). All three are now GPU kernels (minmod was already
+GPU_ROUTINE-decorated; the shared alpha limiter switch is inlined and its helper
+deleted): the gathered patch's device mirror is pushed once per dispatch (patch-sized,
+8x smaller than the slot pushes it replaces; redundant-but-harmless for level>=2 where
+the patch is device-produced), the slot is built in place, and every full-slot push is
+deleted. With (12), the ENTIRE rebuild data path — stash, migration pack/unpack,
+prolong, overlap carry-forward — runs device-side: the "realloc stages through the
+HOST" structural gap vs AMReX identified in the store-fix analysis is closed for the
+data plane. CPU builds compile the kernels to the identical plain loops, so CPU results
+are unchanged; GPU arithmetic moves device-side (not bit-comparable to the host prolong
+by construction) and gates on golden tolerance.
+
+GATES: np8 S0 probe rc=0 with the [amr-xa] table byte-exact vs the landed baseline
+(slice touches no MPI); AMR-75 75/75; wall 100.1 s (parity-class). Wall pair queued
+when a QOS slot frees (the two pairs ahead of it price (11) and (12)).
+
+## 2026-08-24 (12) — MIGRATION GOES DEVICE-SIDE: the stash chain stops staging through the host
+
+The regrid budget's migration half (rg:mig, 0.80 s/step at np8) was host-staged end to
+end: full-slot D2H + host copy + full-slot H2D per owned old block (stash creation),
+serial host cast loops for the MPI pack/unpack (74 ms/block unpack), a full-slot H2D
+push per received replica, and a host overlap carry-forward. All four now run where the
+store is authoritative: a device cons->stor stash kernel (both full-slot transfers
+deleted), device pack/unpack kernels whose copyin/copyout stage EXACTLY the packed
+interior (wire layout byte-identical, so the message set and [amr-xa] F4 totals are
+unchanged), and a device overlap kernel — with the per-box prolong push HOISTED ahead
+of it (the prolong is still a host loop; same final device state). The stash never
+touches the host mirror any more, which also retires the two grow-hazard push sites and
+their footguns (s_amr_st_reserve's device->host round trip now preserves the stash by
+construction).
+
+GATES: step-5 full-state output BYTE-IDENTICAL to the batched-apply binary (np8 S0
+probe); [amr-xa] byte-identical; probe rg:mig 9.66 -> 5.65 s (-41%), mg:unpk 74 -> 11
+ms/call; local AMR-75 goldens 75/75 (CPU) + the GPU dynamic-regrid case direct. The
+differenced wall pair is queued behind the batched-apply pair on the floor node.
+
+FOUND EN ROUTE (new compiler trap, banked in .claude/rules/common-pitfalls.md):
+amdflang SILENTLY DROPS target regions nested inside Fortran BLOCK constructs from the
+device image — the host registers them and the first launch dies with
+HSA_STATUS_ERROR_INVALID_SYMBOL_NAME naming the missing __omp_offloading_* symbol.
+Kernels must live in ordinary (module) subroutines.
+
+## 2026-08-24 (11) — REFLUX APPLY BATCHED: one kernel per face direction, 759 -> 15 calls/rank on the probe
+
+The verdict below ranked the reflux APPLY loop (10.4% of the np8 step — the exchange is
+the wave since I5, what remained was the per-box form's up-to-3 tiny face kernels per
+block per step) as the #2 overhead. `s_amr_apply_reflux` is now BATCHED: a host
+precompute walks the level-1 slots with the SAME select_slot + face-flags logic the
+per-box form used, fills per-slot descriptor arrays, and ONE kernel per face direction
+corrects the coarse rhs for every block — the exact mirror of the capture-side batching
+(`s_amr_capture_creg_dense_batch`) that has served the creg fill since the flat store
+landed. The per-box form is DELETED (single call site); the subcycle path's
+`s_amr_apply_reflux_state` is untouched. Legality: block corrections are disjoint (the
+merge invariant keeps blocks >= buff_size apart) and a block's x/y/z outside layers are
+distinct cells, so the per-direction regrouping preserves every read-modify-write —
+per-(face, eq, cell) arithmetic and child-sum order are IDENTICAL.
+
+GATES: step-5 full-state output BYTE-IDENTICAL to the pre-batch binary (np8 S0 probe,
+parallel-IO restart compared by sha256); [amr-xa] byte-identical (no MPI touched);
+reflux calls/rank 759 -> 15 on the 5-step probe, phase mean 2.844 -> 2.486 s
+(directional; the operating-point wall pair is queued); local AMR-75 goldens 75/75.
+
+## 2026-08-24 (10) — THE POST-WAVE VERDICT: np8 -17.7%, top rung 1.99x -> 1.65x; rhs is now the largest phase
+
+The differenced 240-40 measurement of the full wave stack (I2a+I3+I5, pinned binary at
+this commit's parent, jobs 383882/383883): **np8 on the floor node = 11.174/12.105 ->
+mean 11.64 s/step vs the pre-wave 14.15 floor (-17.7%, clearing the 7.7% spread).**
+Ladder: np2 5.29 (unchanged, -1.3%), np4 7.04 (-5.6%) — gains concentrate at high rank
+counts, the comm-wave signature. Doublings vs the AMReX bar (1.20x/1.15x): np2->np4
+1.331x (was 1.392x), np4->np8 1.653x (was 1.993x); top-rung excess over the bar 1.73x
+-> 1.44x. Caveat: np8 on k004-008, np2/np4 on k004-001 (the historical ladder's node
+shape); the np8 pair is the hard claim.
+
+The np8 240-step phase budget re-ranks the program: **rhs 37.9% — physics is the
+largest share for the first time.** Overheads: regrid 17.2% (build 9.1% incl. the
+rebuild gather 4.5%; migration 7.2%), reflux 10.4% (the per-box APPLY loop — the
+exchange is now the wave), gather 6.5%, coarse halo 5.2%, seam 3.6% (imbalance 1.465 —
+residual skew parks there), ~13% residual. Next by size: (1) regrid build+migration,
+(2) reflux apply, (3) I6 plan caching for the per-stage plan rebuilds, (4) I5b/F7 is
+too small to appear — deprioritized (design note kept in amr-bench/notes/).
+
+## 2026-08-23 (9) — I5-F5 LANDED: reflux faces + split-ownership freg as waves; message count unchanged BY DESIGN
+
+F5 was the last per-box rendezvous chain: the level-1 face exchange posted and WAITALLed
+once PER BOX on both sides (`s_amr_p2p_reflux_faces`), and the level>=2 split-ownership
+freg handoff did the same inside `s_amr_reflux_to_parent`. Both are now single waves:
+`s_amr_reflux_faces_wave` (F5a, per stage-final step) posts every receive ZERO-COPY into
+the freg register host mirrors — each box owns a register slot, so no pool or unpack
+exists to aggregate into — then the owner D2H + multicast ISENDs, ONE WAITALL, receivers
+push H2D. `s_amr_freg_wave` (F5b) does the cowner->powner freg pairs the same way before
+the reverse apply fold. `s_amr_reflux_to_parent` takes `do_xchg` (subcycle keeps its
+per-box exchange, `.true.` at the dt_sub site; the lock-step driver passes `.false.`
+because the wave already ran). The MESSAGE COUNT IS UNCHANGED (6708) by design — what the
+wave removes is the O(boxes) chain of separate rendezvous, the same structure I2a/I3
+removed for the fills. `s_amr_reg_reserve` hoists ahead of both waves (the apply can
+REALLOCATE the registers under it — the map finding).
+
+GATES: [amr-xa] F5 payload words EXACT vs baseline (659,423,232), msgs 6708 unchanged BY
+DESIGN; F1/F2/F4/F6/F7 byte-identical (F6 at its landed 378); zero-copy means headers
+cannot prefix the payload, so under MFC_DEBUG each transfer gets a COMPANION 8-word
+message ([site, blk, ...]; never s_xa_rec'd, keeping family words comparable) plus
+per-message MPI_Get_count length asserts, clean rc=0; seeded blk-shift arm aborts at the
+companion check (site 39); adversarial review of the F5+F6 pair; local AMR-75 goldens
+75/75. The owner-side multicast membership is the conjunction cand(region+-1 overlap)
+AND f_amr_reflux_participates — reproduced exactly, header-verified.
+
+## 2026-08-23 (8) — I5-F6 LANDED: the seam halo's cross-rank pairs as one wave; shared seam buffers DELETED
+
+The cross-rank branch of `s_amr_fine_fine_halo` — one blocking MPI_SENDRECV per pair in
+pair-list order through two shared buffers, the chain that ABSORBED the skew the fill
+waves freed (I2a probe: seam 2.34 -> 3.47 s while gather fell) — is now one aggregated
+message per (peer, direction) per call: every pair contributes one send and one recv
+transfer on each owner, both ranks walk the SAME replicated pair list ascending, and the
+per-peer offsets agree with no metadata exchange (the property the paired SENDRECVs
+relied on positionally, made explicit and header-verified). Same-rank pairs keep the
+batched device kernel. Converting INSIDE the routine covers all four call sites — the
+per-stage driver, both subcycle sites (shape-preserving, so the I8 scope stands), and
+the L0-advance coexist site the I5 row required. The two shared seam buffers and their
+tile-grow reconciliation block became dead and are DELETED (net +110 LOC). Wire stays
+wp with the stp cast on unpack (F6 converts; F5 must NOT — kept separate).
+
+GATES: [amr-xa] F6 payload words EXACT vs baseline (380,849,184), msgs 2646 -> 378
+(-86%, the largest collapse of the program); F1/F2/F4/F5/F7 byte-identical; debug live
+headers ([site, sending slot, (d, dlo, dhi), (cnt,0,0)]) + per-message length asserts,
+clean rc=0; seeded offset-shift arm aborts at the header check (site 37); adversarial
+review: all ten invariants clean, three cleanliness fixes applied (orphaned comment,
+stale sizing note, the pre-existing dead ym compute); local AMR-75 goldens. F5 (faces +
+freg) remains per-box - next: faces need debug-only companion header messages to keep
+the zero-copy recv-into-register design, and s_amr_reg_reserve must hoist ahead of any
+wave that posts into freg (the apply can REALLOCATE the registers - map finding).
+
+## 2026-08-23 (7) — I3 LANDED: level>=2 parent gathers as per-level F2 waves; per-box stage fill DELETED
+
+`s_amr_parent_fill_wave(lev)` (m_amr.fpp) converts the per-step level>=2 F2 parent
+gather — previously one pooled ISEND + one BLOCKING MPI_RECV per box, per stage, on the
+majority of boxes — to one aggregated message per (parent-owner -> child-owner) pair per
+level per RK stage, levels ascending (preserving the parent-before-child guarantee).
+Each split child is exactly one transfer, so the plan is a pair list derived on all
+ranks from replicated metadata only (f_amr_parent_block + s_amr_parent_foot +
+amr_block_owner — never the lagging per-owner mirrors). Reuses the I2a wave's scratch
+arrays and helpers (the two waves never overlap in time); zero new device kernels.
+`s_amr_fine_stage_fill` lost its last caller and is DELETED (net +155 LOC for the
+increment). Regrid keeps the chunked F2 path; subcycle keeps its per-box sites (I8);
+init/static keep per-box. Two defects found and fixed before any gate ran: (1) restart
+left `amr_num_levels` at its default 1 until the first regrid — the old per-box loop
+keyed on per-slot levels and was immune, the new per-level driver would have silently
+skipped every level>=2 fill; fixed in s_read_amr_restart (and exercised by the
+multi-level-restart np=2 golden). (2) The architecture doc's timestep diagram cited the
+deleted routine (review finding); updated to the wave structure.
+
+GATES: [amr-xa] F2 payload words EXACT vs baseline (1,628,915,568), msgs 1646 -> 524
+(the per-step per-box portion collapsed; remainder = regrid chunked + init), F1
+unchanged from I2a (381 msgs, words exact), F4-F7 byte-identical; debug live headers on
+every F2W transfer + per-message length asserts, clean rc=0; seeded one-word offset
+shift aborts at the header check; adversarial review: all ten checked invariants clean,
+no correctness findings; local AMR-75 goldens. Directional: the 5-step np=8 probe wall
+dropped 130.6 -> 100.9 s vs the I2a-only binary (transient-dominated, n=1 — the honest
+number is the differenced steady pair at the operating point).
+
+## 2026-08-23 (6) — I2a LANDED: the level-1 stage-fill WAVE (plan-based exchange, first payoff increment)
+
+`s_amr_stage_fill_wave` (m_amr.fpp) replaces the per-box rendezvous chain of the
+non-subcycle level-1 per-stage fill — owner IRECV+WAITALL per box, contributor
+pack+ISEND+flush per box, F3 blocking MPI_SEND per box — with ONE wave per RK stage:
+transfer plans derived on every rank from the replicated caches (identical enumeration
+order on both sides, so offsets agree with no metadata exchange), one aggregated message
+per (peer, family) on the runtime tag bases (`amr_tag_base` + epoch fold), all IRECVs
+posted first, device packs into contiguous host pool slices via the EXISTING per-box
+kernels, all ISENDs, one WAITALL, then box-major consume through the single `amr_cg`.
+Level>=2 keeps the per-box F2 path (I3); subcycle keeps its sites (I8). The driver's
+parent-before-child order is strictly refined (all level-1 fills before any level>=2
+gather — legal per the design doc's inset-children argument).
+
+SCOPE DEVIATION from the I2 row, recorded: per-owned-box patch storage + `amr_cpat_off`
+threading is NOT needed for the wave itself — box-major consume after the WAITALL reuses
+the single patch buffer. The storage restructure only buys cross-box batched unpack
+kernels (launch-count reduction) and is deferred to **I2b, contingent** on the post-I2a
+phase budget showing launch/map overhead (not wait) left in the gather share. Zero new
+device kernels — the amdflang codegen-lottery rule is not triggered.
+
+GATES: (1) `[amr-xa]` exactness — F1 payload words EXACT vs baseline (1,071,084,168),
+msgs 858 -> 381 (the per-step per-box messages collapsed to peer aggregates; the
+remainder is the untouched regrid-chunked + init path), F2/F4/F5/F6/F7 byte-identical
+in msgs AND words; (2) debug live headers on every wave transfer + per-message
+MPI_Get_count length asserts, clean probe rc=0, family totals identical to production;
+(3) seeded-bug arm — one-word shift of a consume offset aborted with "header mismatch:
+expected site 31" (XA_F1W_SND), seed reverted; (3b) the F3 twin's wave path — never
+exercised by the S0 probes (no QBMM) and goldens compile headers out — ran the np=2
+QBMM-nonpolytropic case (test DDD79C8B's case) on the DEBUG binary with the [amr-xa]
+report enabled: F3 38 msgs / 2,736 words send==recv exact, live headers on every
+transfer, rc=0; (4) adversarial review — ONE critical
+finding (the high-water grow helpers discarded already-appended transfers on growth;
+invisible at S0 scale, corrupting beyond 64 transfers/rank) — fixed with copy-preserving
+move_alloc BEFORE any gate ran; every other checked invariant clean; (5) goldens: the local AMR-75 subset 75/75 on k004-004 AND the FULL 708-test suite
+708/708, zero failures (job 383666, mi2101x, baseline worktree at e531d354+diff) —
+committed as bdb00d5d with 383666 recorded outstanding, now CLOSED; (6) wall:
+2x differenced np=8 int=20 pairs with the PINNED COPY binary on k004-008 (job 383667),
+priced against the SAME-NODE 3-repeat floor from job 383518: steady s/step
+14.817 / 13.730 / 13.892 (mean 14.15, spread 7.7% — WIDER than the historic 5.3%; wall
+claims on this case must clear it).
+
+Ops lessons banked to memory: install-dir mtime is NOT binary freshness (a stale Aug-21
+binary got probed first — pick by file mtime or explicit path); batch jobs must pin a
+COPY of the binary, never a build-tree path (383518 pinned the path I overwrote mid-job;
+all reps exec'd before the overwrite, so the floor is clean, but only by minutes).
+
+## 2026-08-23 (5) — I1b-gather LANDED: identity headers live on F1/F2/F3, tripwire proven
+
+Per the binding in amr_plan_based_exchange.md: `XA_NH` (8 under MFC_DEBUG, else 0) +
+`s_xa_hdr_pack`/`s_xa_hdr_check` in m_amr_xchg_audit; every gather-trio wire site
+prepends [site, blk, bl, bh] to its payload and the receiver verifies before unpacking.
+Device pack/unpack kernels are UNTOUCHED (offset via argument slices) — no codegen-lottery
+exposure; production arithmetic adds +0 everywhere. `[amr-xa]` records payload words only,
+so its baselines stay comparable across debug/production.
+
+GATES, all passed: (1) production build 75/75 AMR goldens; (2) debug live-header probe —
+5-step np=8 S0, headers verified on all 858 F1 + 1646 F2 messages, zero mismatches,
+[amr-xa] send==recv exact in every family; (3) SEEDED-BUG counterfactual — consume order
+reversed locally, headers aborted with the full diagnostic (expected-vs-got slab), seed
+reverted. The tiling assert (I1b's other half) needs the plan builder's periodic-wrap
+analysis first and rides with I2 prep. Remaining families get headers with their
+conversion increments (F5/F6 with I5, F7 with I5b). Ops note: a fresh build VARIANT
+configured without FC bakes gfortran into its CMakeCache and every retry reuses it
+(rc=143, looks like a SIGTERM race) — purge build/staging/ and verify FC inline.
+
+**I2 (F1+F3 plans, ~600 LOC) is now unblocked and next.**
+
+## 2026-08-23 (4) — T1 RE-PRICED AT int=20: I2 is the program's highest-value increment
+
+Against the int=20 np=8 steady budget, the plan-based-exchange ladder re-prices as:
+**I2 (F1+F3 gather plans) targets 23% of wall scaling 3.84x/doubling — first**; I5
+(reflux+seam, 20%, worst rung 6.84x) and I5b (restr, 10.8%) behind it; I3 small; I4's
+"parallelise the pack" item is REFUTED (see (2) below) and its right-sizing half already
+landed as I4a. Already complete from the ladder's prerequisites: I0, I1a, the mandatory
+ppn=4 dynamic-regrid case, I4a, I4b-a. **NEXT SESSION: I1b-gather (headers on F1/F2/F3 +
+tiling assert + seeded-bug counterfactual — the gate I2's validation requires), then I2.**
+Implementation binding with line numbers: amr_plan_based_exchange.md "I1b implementation
+binding". Overnight: 3-repeat np=8 int=20 pairs queued (job 383518) for the variance floor
+at the new operating point.
+
+## 2026-08-23 (3) — CADENCE MOVE VALIDATED: int=20 cuts 41% of wall; gather is the new front
+
+**The operating point moves: amr_regrid_int 2 → 20 (amr_buf stays 4), certified and adopted**
+(user approval on record). S0's feature speed ~1 at fine-CFL ~0.05 means <1 fine cell of
+travel per 20-step interval, and `[amr-cad]` certifies containment at BOTH the transient
+(40-step arm: 4.6M tags escaped 0) and steady state (240-step arm: 51.0M tags over 12
+regrids, escaped 0). Steady box count identical to int=2 (594).
+
+**Measurement protocol note (the transient trap):** a 40-step arm at int=20 regrids only at
+steps 20/40, so the mesh is coarse for half the run — its 156.8 s wall is the
+hierarchy-population transient, NOT a budget. The honest number is DIFFERENCED from-scratch
+arms (240-step minus 40-step = 200 steady steps), the measure-the-step-loop instrument.
+Checkpoint-restart is not used (it froze the hierarchy historically).
+
+**np=8 steady result (k004-009, post-I4b-a binary, logs/cad20{,b}-0823_*):
+14.86 s/step at int=20 vs 25.2 s/step at int=2 = −41% wall.** Cross-check: the regrid
+family was ~44% of int=2 wall; amortizing ~90% of it predicts 15.2 s/step — matches.
+Steady top-level budget at int=20: rhs 29.3%, gather 20.2%, reflux 14.2% (rf:p2p ≈ all of
+it, rf:wait 8.5%), regrid 12.0%, restr 10.8%, seam 5.7%, coarse 3.0% (sums ~99.5%).
+
+Consequences:
+- **I4b-b and rb:slot are DEAD at the operating point** (mg:unpk 1.6%, mg:slot 0.8% of
+ steady wall) — the deferral rule fired exactly as designed.
+- **The ring clip's value ~doubles**: gather is now the #1 overhead and the parked clip
+ removes 64–72% of gather wire words. The AMD compiler-bug report is the gate.
+- **restr (10.8%) enters the target list** — the per-step restrict-to-parent chain,
+ never optimized, same per-box blocking P2P shape as reflux.
+- **AMReX bar protocol**: AMReX stays at ITS operating point (int=2, n_error_buf=1 at
+ CFL 0.7 — an int=20 AMReX arm would need ~14-cell buffers, a different code); the
+ 1.20x/1.15x doubling bar is internal to each code, so it stands unchanged. MFC's
+ np=2/np=4 int=20 differenced ladder gives our side (s0cad sweep).
+
+**THE LADDER AT int=20 (s0cad-0823_1225 + cad20{,b}, all differenced 240−40, all
+escaped=0, 72 boxes/rank at every np): steady s/step 5.36 (np2) / 7.46 (np4) / 14.86
+(np8) → doubling ratios 1.392x (np2→4) and 1.993x (np4→8), vs 1.598x/2.63x at int=2 and
+the AMReX 1.20x/1.15x bar.** Per-phase rungs (np4→np8): rhs 1.11x (AT the bar; physics
+5.3 s/step and near-flat), gather 3.84x (3.01 s/step at np8 — the largest overhead),
+reflux 6.84x, regrid 3.17x, seam 3.12x, restr 2.39x. Attribution complete (phase sums
+match walls to 0.3%). **If the five comm families scaled at 1.2x the np4→8 rung would be
+1.15x — the remaining program IS the exchange scaling: T1 waves + plan-based exchange +
+the parked ring clip.** The cadence win grows with np (−15%/−26%/−41% at np2/4/8),
+confirming regrid was the worst-scaling family.
+
+Audit notes on the numbers: (a) per-step cross-check passes for gather (3.49 int=2 vs
+3.01 int=20 s/step) but **reflux RISES 1.34 → 2.10 s/step (+57%, rf:wait 1.26 of it) —
+frequent regrids were acting as skew synchronizers; at int=20 the skew accumulates across
+20 steps and the per-step P2P families absorb it.** Already included in the −41%; it is
+T1's mechanism, now visible per-step. (b) The int=2 comparator (25.2 s/step) includes its
+cheap early transient, so steady int=2 is slightly higher and −41% is conservative.
+(c) Cadence also relieves memory: store caps 77 at int=20 vs 125–189 at int=2 (fewer
+migration waves → the replica ratchet barely engages).
+
+## 2026-08-23 (2) — I4b PRICED AND HALF-RETIRED: store growth was the cost, not the pack
+
+The I4a note below left I4b as "pack parallelization, blocked on the host-macro question."
+The pricing measurement (new `mg:slot/pack/unpk/push` brackets splitting `rg:move`; np=8 S0
+on k004-009, budgets in amr-bench/logs/i4b-price-0823_{1011,1106}) REFUTED that framing:
+the pack (27.2 s) and unpack (44.3 s) are secondary — the dominant term was **mg:slot =
+57.9 s mean / 90.2 s max (imbalance 1.56)**: each migration wave's replica-slot allocs grew
+the shared store in 8–16-slot increments, and every growth event restages the WHOLE store
+(both arrays, ~30 GiB at end-of-run caps) through the host in `s_amr_st_reserve`
+(D2H + three host passes + H2D), ~12 events on the worst rank.
+
+**I4b-a LANDED (`180cdf17`, +26 LOC, zero new device code):** `s_amr_prereserve_stash`
+does one exact-target reserve per wave (at most ONE restage), and `s_amr_st_reserve` zeroes
+only the NEW columns. Same-day A/B: mg:slot 57.9→14.2 s (−75%), **mg:wait 53.8→15.6 s
+(−71%: the growth events were desynchronizing ranks and charging the delay to MPI waits)**,
+rg:mig 206.2→126.0 s (−39%), wall 1048.9→1006.0 s (−4.1%, phase deltas far outside the 4%
+noise floor). Gate: step-40 outputs BIT-IDENTICAL (coarse + 30 GB AMR hierarchy),
+`[amr-scale]` trajectory identical, `[amr-cad]` tag-for-tag identical (87,993,659 /
+escaped 0), 75/75 AMR goldens. Caps drop slightly (122–182 vs 125–189), live identical.
+
+**I4b-b (pack/unpack, 71.5 s combined) is DEFERRED behind the cadence move**: those shares
+are int=2 shares, and at int≈20 the whole migration family amortizes ~10x — decide at the
+new operating point before building host-threading machinery. The rebuild's `rb:slot`
+(25.5 s, same growth mechanism, interleaved frees make the pre-count harder) is likewise
+deferred to the post-cadence budget.
+
+## 2026-08-23 — T1/I4a LANDED: migration pools right-sized
+
+`s_amr_regrid_stash_migrate`'s pools were sized for the worst case times every old block:
+`spack/rpack(maxcnt, old_np)` (GBs per regrid at production counts, nearly all columns
+unused) and `rq(old_np*num_procs)` — the O(boxes x ranks) array the endstate's W-invariants
+forbid. Now sized to the blocks actually sent/received (dense column maps from a pre-pass
+that reuses the send loop's own destination criterion) and the exact request count.
+Message set/sizes/tags/order UNCHANGED — gated on exact `[amr-xa]` F4 equality
+(39 msgs / 417,682,080 words both directions on the S0 5-step probe), identical
+`[amr-cad]` counts, fast-class rhs (22.1 ms/call), and the 75-case AMR golden subset.
+Remaining I4: pack parallelization (I4b) — blocked on the host-threading-macro question
+(raw `!$omp` is lint-forbidden; a device pack would need the ISA-stat probe per the
+codegen-instability rule) and priced by a pack-time baseline still to be measured.
+
+## 2026-08-22 (final) — RING CLIP PARKED: an amdflang whole-image codegen regression
+
+**VERDICT: the clip is REVERTED (this commit) and PARKED pending a toolchain fix — the
+wall regression is NOT the clip's algorithm, it is the compiler.** Root cause, proven via
+rocprofv3 per-dispatch ISA records (logs/rcab3-k009): amdflang (AFAR 23.2.1) generates all
+device ISA in a whole-image link (`-flto-partitions`, cmake/MFCTargets.cmake), and adding
+the clip's 7 target regions deterministically degraded UNTOUCHED kernels' code — weno
+scratch 28→140 B (5x spill), the riemann solver's register file flipped into accumulation
+AGPRs (VGPR 128→40, AccVGPR 8→136), LDS 2048→2560 image-wide — making every compute
+kernel 2.4–4.5x slower (rhs 22.1→41 ms/call; np=4 wall 407→553 s). Reproduced
+deterministically in a second tree; partition-count-independent (`-flto-partitions=1`
+identical); constant from step one; both nodes. This is the same AGPR-blowup family as
+`~/work/software/weno-agpr-repro` (which fixed the SLICE variant in 23.2.1) — a NEW
+trigger in the same pipeline. Same-day diagnostics eliminated: node drift, map churn,
+mapping aliasing, DPM clocks, GPU sharing, MFC_DEBUG poison, amr_shl.
+
+**What survives the revert:** the clip's correctness is fully proven (output bit-identity
+at np=4 AND np=8 incl. hierarchy files, zero transport-assert trips, wire words −64 to
+−72%, gather family −33% at np=8) and the two-reviewer design (`amr_stepfill_ring_clip.md`)
+is implementation-complete at commits dc6d4129+bd85c792+a7970743 (this revert's parents).
+**Return trigger:** a toolchain drop whose 3-minute 5-step probe (dirs in
+logs/rcab2-0822 + rcab3-k009; HEAD rhs ≈ 22 ms/call bar) plus per-dispatch ISA stats
+(scratch/VGPR/LDS unchanged for untouched kernels) come back clean — then re-land the
+three commits and rerun the validation ladder (bit-identity, goldens, np=1 arm, MFC_DEBUG
+poison sweep, same-day A/B vs the 1.2x AMReX bar). Measurement rule from this episode,
+standing: any increment that adds/removes GPU kernels must include the ISA-stat probe —
+a wall A/B alone cannot distinguish algorithm cost from codegen lottery.
+
+## 2026-08-22 (late, superseded by the verdict above) — RING CLIP LANDED, CORRECT, AND WALL-REGRESSED (open hunt)
+
+**The ring clip (dc6d4129 + bd85c792 + a7970743) implements `amr_stepfill_ring_clip.md` in
+full and is CORRECT**: output bit-identity at np=4 AND np=8 vs the pre-clip binary
+(logs/rcgate-0822_1516, including the 14/31 GB hierarchy files), zero trips of the always-on
+transport/coverage/frame asserts, message set unchanged, wire words F1 −72/−68% and
+F2 −68/−64% (np4/np8), gather family −33% at np=8 (185.8→124.9 s).
+
+**BUT the clip binary carries a constant ~1.7–1.9x per-launch tax on EVERY compute kernel**
+(rhs 22.1→37–42 ms/call, rk ~3x, restrict ~1.8x — same call counts, bit-identical data,
+phases the clip never touches), making np=4 wall 553 s vs HEAD-same-day 407 s. Refuted by
+same-day A/B (all in logs/rcab*-*): node drift (HEAD reruns at 407/22.1 on BOTH k004-001 and
+k004-009), per-launch metadata-map churn (bd85c792 removed all such maps — no change),
+exact-width slice aliasing (a7970743 + the tax is constant from step one), the MFC_DEBUG
+poison (verified off in flags), amr_shl itself (predated by the 556 s measurement). The DPM
+clock theory is REOPENED (the 2-s SCLK sampling that "refuted" it cannot see ms-scale ramp).
+**A 3-minute discriminator exists**: the 5-step np=4 probe (HEAD rhs 22.1 ms/call, clip
+37–42; dirs under logs/rcab2-0822 and rcab3-k009). Current step: rocprofv3 kernel-trace on
+both arms to split the tax into in-kernel device time vs launch-gap time, then a targeted
+fix — or, if irreducible on this stack, REVERT the clip (delivered wall is the metric; the
+design, proof, and gate evidence stay banked for after the launch-path tax is fixed).
+Still queued behind the verdict: goldens, np=1 bit-identity (HEAD binary prebuilt in
+mfc-amr-baseline), the MFC_DEBUG poison sweep, np=8 same-day A/B.
+
+## 2026-08-22 — STEP 2 LANDED + THE EXPERT-AUDIT RE-AIM (read this before picking new work)
+
+**Gather-batching step 2 (chunked plan-then-execute, both families) LANDED 01cc4318 + 3de4724e
+and is FULLY VALIDATED** — the complete verdict, including the correctness evidence (output
+bit-identity at np=4 AND np=8 across binaries), the on-node differenced walls (np=4 -1.9%,
+np=8 -0.8%), the `pg:recv`-is-dataflow attribution correction, and the k004-001-GCD6 node
+confound, lives in `amr_regrid_gather_batching.md` "STEP-2 VERDICT". The load-bearing
+conclusion for THIS ledger: **the parent-gather wait is a dataflow dependency created by the
+rebuild itself — no further MPI protocol work on that family can pay.** The rendezvous share
+of `rb:gath` was ~20 s at np=8, and step 2 already collected it.
+
+**Expert audit (2 independent reviewers: MPI internals + AMR architecture, both verified
+against source) re-aims the increment ladder:**
+
+1. **DONE same day (7b7ae5c9, logs/p1gate-0822_1259) — THE RULE FIRED: promote clipping
+ ahead of T1.** Measured at np=8: stepfill 67.65e9 words/run **71.2% dead**, rb-L1
+ 1.48e9 words **67.9% dead**, rb-L2 4.90e9 words live-by-construction; np=4 agrees
+ (70.9%/55.6%). stepfill is 91% of all gather-family words (~590 GB of host-DRAM traffic
+ per 40-step np=8 run, 71% dead). Both families clear the pre-registered 50% bar ->
+ **next code increment = ring-clip the step fill** (gather only the margin + one interior
+ cell per face), then coverage-clip rb-L1; T1 re-ranks after. Same sweep: first
+ production run of the hcid dicts (clean), and np=8 wall 1186.4 vs 1235.6 s across
+ back-to-back identical runs = 4% run-to-run variance on k004-001 - never quote
+ single-run walls here. Original design note follows.
+ **`[amr-cov]` dead-byte counter FIRST (~40 LOC, deterministic, piggybacks any S0 run).**
+ VERIFIED in code: `s_amr_fine_stage_fill` (m_amr.fpp:4982) gathers the FULL coarse patch
+ every RK stage while the consumer prolongs only the ghost shell — the interior of every
+ message in the 14.3%-of-np=8-wall gather family is never read. Rebuild side: the
+ carry-forward overwrite is level-1-only (m_amr_regrid.fpp:1498), so the rebuild-clip
+ claim covers F1 (~5% of wall) — level-2 parent bytes stay live until detail-preserving
+ L2 carry-forward exists. PRE-REGISTERED RULE: dead fraction > 50% on either family
+ promotes ring/coverage clipping AHEAD of T1 (clipping est. 8-15% of wall for ~300-500
+ LOC and it COMPOUNDS with T1; T1's floor is 8-12% for ~3100 LOC).
+2. **G-B CLOSED same day (logs/amrexs0-0822_1330, amrex_s0.sh; Advection_AmrCore's IC
+ replaced with the SAME periodic-blob field as S0): THE BAR IS 1.20x (np2->4) / 1.15x
+ (np4->8) per doubling** at fixed per-rank work — and the comparison is unusually clean:
+ AMReX's per-rank advance is EXACTLY flat (76.8M cells/rank/step at every np) and nearly
+ equals MFC's S0 per-rank fine work (77.1M/rank). MFC's ratios: 1.598x (np2->4) and
+ 2.63x (np4->8) -> excess 1.33x and ~2.3x. AMReX does this carrying 27.6k boxes at np=8
+ (46x MFC's block count) with regrid_int=2, no subcycle, reflux on, max_grid_size 32
+ (its own practice). Caveats: one linear scalar vs 6-var multiphase (ratio is internal,
+ physics mostly cancels — and heavier compute HIDES comm, so MFC's worse ratio is more
+ damning, not less); single runs (ratios sit far outside the 4% node variance). Axis-2
+ "done" is now defined: MFC's np-doubling must fall from 2.63x toward ~1.15-1.2x.
+3. **Regrid cadence is a benchmark-definition question.** Production AMR regrids every
+ ~8-16 finest steps; our int=2 operating point inflates the exact phase being optimized
+ (tax 27.2x at int=2 vs 7.2x at int=20 while AMReX barely moves). Before moving the
+ operating point: land the validity coupling (validator rule `amr_buf >= CFL x interval`
+ per level + a regrid-time containment assert, ~30 LOC) and re-baseline box counts (TRAP:
+ `amr_buf` also feeds merge topology via `thr = buff_size + 2*amr_buf`,
+ m_amr_regrid.fpp:596).
+4. **T1 migration waves re-ranked after (1) prices clipping.** rg:mig is 213-218 s at np=8
+ — still the largest single family — but clipping may be cheaper per saved second.
+5. The `amr_gcr_*` chunk machinery is scaffolding for the v2 plan-based exchange (I2/I6
+ cached per-peer schedules): absorb and delete it when I2 lands — two parallel exchange
+ frameworks is the D2 failure mode as code.
+
+**Matched-tax rung at HEAD (logs/tax-0822_1154, tax_analyze.py protocol-exact,
+stationarity 229.6 blocks/step in window): TAX 7.06x -> 6.81x, payoff 2.15x -> 2.23x,
+excess over AMReX's 3.13x now 2.18x.** Ladder: 23.92 -> 11.03 -> 7.06 -> 6.81x. The new
+rung was measured on k004-001 (the slow-GCD6 node) so it is conservative; the differenced
+L2 window fell 332.0 -> 302.8 s (-8.8%) despite the node. Uniform-denominator caveat
+carries: honest range ~6.8-7.8x.
+
+Still open and unchanged: the uniform-denominator re-run (13% tax error bar), the P2 idle
+re-decomposition (gates the Phase-2 contract), and I1b.
+
+## 2026-08-21 — PHASE 0 MEASUREMENTS (endstate ladder): three verdicts in one night
+
+**M2 mechanism split — THE IDLE IS LOCAL; P2 (batched advance) confirmed as the parity lever.**
+Arm A = 200^3 at np=1 (zero MPI, same coarse cells/GCD as the matched 400^3 np=8 arm B).
+The discriminator could not be cleaner: **rhs per-call is IDENTICAL with and without MPI —
+17.10 ms (np=1) vs 17.48 ms (np=8)**. The advance's cost does not contain MPI; it is the local
+launch path, exactly as the swap-overhead and mapped-entity measurements said. Arm A still spends
+68.1% of wall in rhs and 16.7% in regrid with no MPI at all. Meanwhile regrid per-call is 5.45x
+more expensive at np=8 (1737.6 -> 9472.8 ms) — that excess is the MPI/aggregation share, P3's
+target. Each pillar's lever confirmed by the arm that isolates it. (Per the design: no tax is
+quoted from arm A — its block structure differs.)
+
+**CMA-off transport control — waits did NOT balloon; the skew/bandwidth mechanism is confirmed.**
+Two-copy vader (sender-progress-gated) raises per-call waits only ~15-18% (gather 1.53 -> 1.77 ms,
+rb:wait 583.5 -> 670.6 ms, mg:wait 3227 -> 3822 ms) and wall to 877.2 s vs the 782.9-825.5 band.
+A sender-progress-dominated wait would have multiplied, not added 15%. The reflux waits moved
+NOT AT ALL (rf:recv 12.56 -> 11.71 ms, rf:wait 14.72 -> 13.43 — slightly lower, i.e. noise), so
+the transport term lives only in the large-payload gather/migration families and even there is
+small. Production (CMA-on) waits are NOT sender-progress: mechanism (a) posting-order skew is
+minor, (b) pack/arrival skew + (c) node-bandwidth dominate — the v2 design's corrected mechanism
+section stands, and its payoff floor framing (8-12% for T1) is calibrated, not pessimistic.
+
+**S0 weak-scaling harness — first data ever; the W4 violation is now a measured number.**
+Fixed 200^3 cells/rank, one blob per unit cell, periodic. boxes/rank exactly flat at 72 (the
+construction works). Per-rank per-regrid collective volume: **ntag 0 -> 176.9 MiB and gwin
+0 -> 72.4 MiB going just np=1 -> np=2** (the global tag set is replicated to every rank; grows
+~np). cost bytes 1288 -> 2568 (tracks global boxes — S2's target). Wall 215.1 -> 232.2 s = weak
+efficiency **0.926 at np=2** at fixed per-rank work. S1/S3/S2 now have exact baselines and a pass
+bar (flat per-rank bytes). Harness: `amr-bench/s0_sweep.sh` + `s0_report.py`.
+
+**np=4 arm DIAGNOSED + the v2 sweep MEASURED IT (2026-08-21): device OOM from a NEW weak-scaling
+violation — per-GCD memory GROWS with np at fixed per-rank work.** Ranks land on distinct GCDs
+(binding fine); the OOM presents as srun task Killed/Aborted, not an OOM message. The v2 sweep
+(one periodic cos(pi*x)**2 IC — v1's per-arm distinct analytic ICs each forced a FULL solver
+rebuild mid-sweep, since analytic ICs compile into the binary):
+
+| np | boxes | boxes/rank | fine_work/rank | ntag MiB/rank/regrid | wall s | peak GiB/GCD |
+|---|---|---|---|---|---|---|
+| 1 | 72 | 72 | 76.6M | 0 | 227.8 | **49.9** |
+| 2 | 144 | 72 | 76.9M (imb 1.004) | 375.4 | 263.0 (eff 0.866) | **56.4** |
+| 4 | ~288 | 72 | — | — | **device OOM** | **>=60 (ceiling)** |
+| 8 | — | — | — | — | **device OOM** | >=58 (uneven, died mid-spike) |
+
+**POST-W8-FIX (2026-08-21, commit 9bcc9865, node k004-008 — the first complete weak-scaling
+pair in the project's history):**
+
+| np | boxes (last regrid) | ntag MiB/rank/regrid | gwin MiB | cost B | wall s (step loop) | peak GiB/GCD |
+|---|---|---|---|---|---|---|
+| 2 | 144 | 393.6 | 160.7 | 3720 | 255.6 | 55.3 flat |
+| 4 | 288 | 787.3 | 320.0 | 7432 | **662.3** | 63.6 flat (hot card) |
+
+Same build, same case family, same 40 steps at fixed 200^3 cells/rank. np=1 was not re-run on
+this build; the np=8 arm has NEVER run post-fix and is the next S0 gate. Three readings:
+1. **MEMORY weak scaling now holds.** Per-rank live boxes 72 at BOTH np (nboxes doubles exactly
+ with np), VRAM plateaus dead flat mid-run at both, and the fix is wall-neutral at np=2
+ (255.6 vs the 249-263 s band across all variants). W8: from violated to holding.
+2. **TIME weak scaling is now the measured blocker: wall 2.59x per np-doubling at fixed
+ per-rank work.** This was invisible before today — the np=4 arm always died. The doubling
+ global entity counts are the prime suspects (regrid's O(global boxes) loops, the replicated
+ collectives below, the migration storm) but the split is UNMEASURED — the phase brackets
+ exist; running the np=2/np=4 pair with a phase-budget diff is the first S0 follow-up.
+3. **W4/S2 baselines at np=4 are exact:** ntag and gwin and cost all double per np-doubling
+ (787.3 MiB/rank/regrid of replicated tag volume at np=4 — S1's lattice tags target), final
+ regrid migration 938.7 MB. Every S-track item now has a two-point scaling curve to beat.
+
+Per-rank fine work is np-INVARIANT (1.004), so the ~6.5 GiB per np-doubling is replicated
+per-GLOBAL-entity device memory. **ATTRIBUTED (code audit + VRAM-trace corroboration + exact
+arithmetic): it is the STORE-CAPACITY RATCHET in its weak-scaling form.** Slot indices are
+GLOBAL (f_l0_slot over the global box list); at np>=2 a rank's owned set is a shifting SFC
+WINDOW of that index space, and migration allocates received non-owned slots too — so
+amr_loc_n (a high-water that never decrements) grows toward the union of the windows, far
+above the live count. Each capacity step costs **210.6 MiB per slot** (amr_cons_st AND
+amr_stor_st at 132^3 x sys_size x 8 B each), and Fix B's compaction never fires here (gate
+cap > 3*nlive = 216; cap only reaches ~107). The VRAM traces are dispositive: np=1 sits FLAT
+at 49.9 GiB from startup (owned window static, ratchet inert), np=2 ratchets mid-run
+50.30 -> 55.47 -> 56.33 in steps matching the A' growth trajectory exactly. At np=1 the
+ratchet cannot engage at all — which is why a month of single-rank-window measurements never
+saw this term. CORRECTION to the previous revision: freg/creg's np-delta is only ~90 MiB
+(they were pre-over-provisioned to 128 slots by their own doubling), not "the ~1 GiB class of
+the growth". Separate real find, host-side: the migration pack buffers spack/rpack are
+allocated at (per-block bytes x GLOBAL old block count) = ~29 GB virtual at np=2 — the I4
+right-sizing item, confirmed.
+
+**Consequence — the W8 fix is ALREADY DESIGNED and is hereby PROMOTED: P1's device-side store
+remap (kills the host round trip that forces the loose 3x/2x hysteresis, letting compaction
+run at every reconcile to cap = nlive) plus local-index derivation (the index space IS the
+live set; amr_loc_n stops existing). Those two items are the np>=4 unblocker and the first
+S-track increment in practice.**
+
+**W8 FIX LANDED (2026-08-21, same day): the S0 np=4 arm COMPLETES (rc=0, step loop 662.3 s,
+nboxes 288 = exactly 2x np=2's 144 — per-rank boxes flat, the weak-scaling construction holds).**
+What landed differs instructively from the promoted design. The full device-side remake
+(gather to a staging array + realloc) was built first and REFUTED by its own gate: holding
+old + staging on device is a store-sized transient, and the np=4 arm OOMed in init on exactly
+that; worse, the rebuild's overlap carry-forward host-reads `amr_stor_st` WITHOUT pulling,
+relying on the old growth's device->host round trip for coherence — reverting that contract
+NaN'd BOTH churn goldens (27DEC5B6/D127EC91 caught it; the np>2 golden mandate paid off the
+day after it landed). The fix that survived is four smaller mechanisms, each forced by a
+measurement:
+1. **In-place index re-densification every reconcile** (`s_amr_st_move_slot` + rewritten
+ `s_amr_compact_store`): ascending-source-order device moves, no realloc, no staging. Kills
+ the ratchet — np=2 AND np=4 VRAM plateau dead flat, per-rank live 72 at both (the W8
+ invariant measured true for the first time). The allocation plateaus at the rebuild-transient
+ high-water instead of growing run-long.
+2. **Capped growth increment** (`min(oldcap/4, 16)` slots): the proportional +25% growth was
+ itself store-scaled — one late-run growth event's +67-slot transient is what tipped a
+ 59.5 GiB card over 64.
+3. **Early-free of consumed old slots** in the rebuild loop (`last_use` per old block, freed
+ once the last covering new box is built): replicas held until reconcile peaked the transient
+ union; this cut the np=4 plateau 57.3 -> 51.9 GiB. Freed dense indices recycle into the very
+ next allocs.
+4. **Stash-only replica slots** (`s_amr_alloc_slot_stash` + in-place upgrade in
+ `s_amr_alloc_slot`): a received replica only ever touches its `amr_stor_st` half, but the
+ full alloc gave it device-resident q_prim/rhs too (~doubling per-slot cost) across the
+ np-scaled migration storm of the first dynamic regrid. This was found by the new
+ `[amr-cap]` instrument (rank_time_wrt-gated live/cap line at every reconcile), which
+ REFUTED the "store is the hog" theory: the store was already flat at 77 slots ~ 16 GiB;
+ the other ~35 GiB was solver base + per-slot q_prim/rhs.
+Validation: churn goldens 27DEC5B6 (np=2) + D127EC91 (np=4) pass, AMR subset 67/67, S0 gate
+np=2 rc=0 (peak 55.3) and np=4 rc=0 (peak 63.6). **Margin note: np=4's hot card peaks at
+63.6 of 64 GiB — the gate passes but with ~0.4 GiB headroom. The next memory term is per-slot
+q_prim/rhs pooling (P1 proper) and stor-only stashes; do not grow this operating point without
+them.** Still OPEN from the promoted design: local-index DERIVATION (deleting
+amr_loc_free/amr_loc_nfree as concepts) — the re-densification makes the recycle stack
+short-lived rather than gone; it remains a cleanliness increment, no longer a memory one.
+
+**What the W8 arc changes about the ladder (2026-08-21):**
+- **The weak-scaling blocker moves from MEMORY to TIME.** With np=4 completing, wall 2.59x per
+ np-doubling at fixed per-rank work is now the measured gap (table above). That is the
+ constitution's predicted per-global-entity anti-scaling, finally on a curve. First follow-up
+ is cheap: re-run the np=2/np=4 pair with the phase-budget diff to split the 2.59x among
+ regrid's O(global) loops, the replicated collectives, and migration — BEFORE building
+ anything. Do not repeat the phase-share mistake of optimizing the unmeasured.
+- **P1's q_prim/rhs pooling is promoted to the next MEMORY lever.** The [amr-cap] instrument
+ showed the flat store is only ~16 of the ~52 GiB plateau; per-slot q_prim/rhs is a second
+ store-sized term, and the np=4 hot card sits 0.4 GiB from the ceiling. Any operating-point
+ growth (np=8, deeper levels, bigger blocks) needs it first. It is the same code motion P2's
+ batched advance needs anyway — the two pillars now share their first concrete increment.
+- **I1 (exchange validator) remains next in P3** — unchanged by today; the inventory
+ corrections stand. The migration path gained two facts I1 should encode: replicas are
+ stash-only slots now (an invariant the validator can assert), and the first dynamic regrid
+ is a migration STORM (init ownership vs first SFC balance) — any plan-based migration wave
+ design must budget for it, not for the steady-state trickle.
+- **S0 harness upgrades owed:** np=8 arm post-fix (the next W8-class gate), np=1 re-run on the
+ current build (table hygiene), and promote `[amr-cap]` reading into `s0_report.py` so cap
+ flatness is asserted by the harness, not eyeballed from VRAM CSVs.
+- **Test-capital lesson, now policy:** the churn goldens (27DEC5B6/D127EC91) caught BOTH wrong
+ designs same-day — a store-transient OOM and a host-coherence NaN — and the np>2 mandate
+ paid off one day after landing. Every future slot/stash/exchange change runs them FIRST
+ (they are ~2 min each), before any gate sweep.
+
+## PHASE 1 ATTACK PLAN (2026-08-21) — the operational sequence, pre-registered
+
+Written the day the W8 gate passed, per the constitution's just-in-time rule (one phase ahead,
+decision rules pre-registered BEFORE the measurements that trigger them). The architecture is
+`amr_endstate.md`; this section is only the order of operations and its gates.
+
+### M3 — attribution of the 2.59x: ALREADY DONE (the gate logs carried full phase budgets)
+
+np=2 -> np=4 step-loop delta = +413.3 s (387.1 accounted; both arms same build 9bcc9865,
+identical per-rank work, 40 steps, 20 regrids):
+
+| family | phases | delta | share | reading |
+|---|---|---|---|---|
+| **wait/skew** | reflux +104.8 (imb 1.81, 0.18 -> 28.8 ms/call = pure wait), coarse +44.4 (imb 2.85), seam +8.2 | **+157** | **38%** | the "reflux is the sink" pattern is BACK at np=4 — skew originates elsewhere and drains here. Do NOT optimize reflux. |
+| **rhs per-call** | rhs +110.5 — ms/call 17.29 -> 31.34 (x1.81 in the MEAN, not a straggler), imb 1.009 -> 1.465 | **+110** | **27%** | mechanism OPEN — see M4a. M2 said rhs per-call is np-invariant at the matched 400^3 point, so this is either topology or case-specific. |
+| **regrid scaling** | regrid +91.8 (mig +42.7, build +37.8 incl. rb:gath +17.2, clus +5.1), gather +18.9 | **+111** | **27%** | the P3/P4 targets, now with exact per-sub-phase numbers. |
+
+### AUDIT of the attribution (2026-08-21 evening, mid-M4) — what the existing instruments settle
+
+Re-derived with the same-build pair (both arms of gate 1156): rhs 17.87 -> 31.34 ms/call, x1.75 —
+the families stand. Deeper reads that CHANGE the interpretation:
+
+1. **The rhs bracket is pure local advance** (`br_load + s_compute_rhs + br_store`, no MPI), and
+ the phase brackets are disjoint (per-arm phase sums = 95-97% of wall), so the rhs growth is
+ neither nested-wait contamination nor exchange time.
+2. **The `[phase-rank]` instrument (it existed all along) decomposes the family: a FIXED straggler
+ plus a uniform floor.** np=4 per-rank rhs = [212, 206, **362**, 207] (gate) and
+ [188, 196, **353**, 192] (M4 armA) — rank 2 both times. Reflux waiters are exactly ranks 1
+ and 3 (~170-190 s each; rank 0 ~0.4 s — no cross-rank reflux pairs by topology): the
+ wait/skew family is the straggler's SHADOW plus the np-scaled cross-rank pair count (reflux
+ calls/rank double at 2x2). Non-straggler ranks still run ~24.4 ms/call vs np=2's 17.9 — a
+ uniform +36% floor remains after the straggler.
+3. **Refuted by existing data** (each by a measurement, not an argument): GCD-occupancy contention
+ (M2's matched np=8 ran ALL EIGHT GCDs at 17.48 ms/call — verified from budget_full.txt);
+ VRAM fullness as a monotone cause (np=2 plateaus HIGHER than np=4, 56.5 vs 51.9 GiB, and is
+ fast); host-thread oversubscription (1 host thread/rank, unbound over 128 idle cores,
+ observed live); work imbalance (fine_work imb 1.004, [amr-balance]); store capacity
+ ([amr-cap] equal, 77 slots every rank).
+4. **The rank->GCD map is NOT identity and is load-bearing:** np=2's ranks light rocm-smi cards
+ 2,3 — a HIP-vs-rocm-smi renumbering. Under the natural PCI/HSA permutation (0->2, 1->3,
+ 2->0, 3->1), straggler rank 2 sits on card0 — the GCD pinned at 63.3-63.6 GiB (98-99% full)
+ for the WHOLE run in both runs — and np=2 is fast because it happens to sit on the two
+ comfortable GCDs. Leading hypotheses, discriminated inside M4: (a) a near-ceiling ROCm
+ allocator cliff on that one GCD (rank-asymmetric replicas/transients put it there);
+ (b) a degraded physical GCD on this node (the node-identity confound). Arm B's vram.csv
+ reveals the permutation directly (RVD={0,1,4,5}: whichever cards light up define the map);
+ arm D relocates ranks across GCDs (straggler follows the GCD => hardware; follows the rank
+ or vanishes with headroom => memory cliff).
+5. **Consequence if either holds: the "rhs np-scaling family" is NOT an intrinsic scaling law**
+ — it is a per-GCD asymmetry that np=4 exposes — and the honest time-weak-scaling gap
+ shrinks toward the wait/skew shadow + the regrid family. P1 pooling gains a third
+ justification: headroom removes near-ceiling operation entirely.
+6. **Protocol lessons, standing:** benchmark harnesses must run a PINNED binary — `mfc.sh run`
+ auto-rebuilds from the live tree, so code edits during a sweep leak into later arms (armA ran
+ pre-I1a code, arms B onward compile the I1a counters; negligible here — integer adds — but
+ the class is dangerous). And: read the instruments you already have before designing new
+ runs — [phase-rank] and [amr-balance] answered M4b for free, and M3 itself cost zero runs.
+
+### M4 — three cheap discriminators BEFORE any building (one allocation session)
+
+- **M4a (rhs doubling — hardware or code?):** np=2 pinned to the two GCDs of ONE physical
+ MI250X vs two GCDs on DIFFERENT cards (HIP_VISIBLE_DEVICES pinning, same case). If the
+ same-card pair reproduces ~31 ms/call -> the growth is HBM/Infinity-Fabric contention, i.e.
+ a hardware property of dense occupancy: the weak-scaling BASELINE must be defined at full-node
+ occupancy and the 2.59x shrinks accordingly. If not -> code-side; profile one np=4 rank's rhs
+ before touching anything. **Rule: no rhs-side work is scheduled until M4a lands.**
+- **M4b (whose skew?):** per-rank fine_work + per-level block counts at np=4 (load_weight_wrt
+ already on). If L2 ownership is imbalanced -> the cost-model/balancer item (S2, migration-aware
+ LB) moves up. If work is flat but waits are big -> arrival skew, T1's calibrated territory
+ (floor 8-12%). **Rule: balancer work is gated on M4b showing work imbalance > 1.15.**
+- **M4c (table completion):** np=8 arm post-fix + np=1 on the current build. **Rule: np=8
+ device-OOM promotes P1 pooling from "next memory lever" to "immediately before anything
+ else"; np=8 completing parks pooling after I1.**
+
+### M4 VERDICTS (2026-08-21 night, sweep m4-0821_1839; armA ran the committed W8 binary,
+### arms B/D/np1/np8 the same + uncommitted I1a counters — physics-neutral, marked in PIN)
+
+- **M4a: hardware is INERT.** Three GCD arrangements (0,1,2,3 / 0,1,4,5 spread-NUMA / 0,2,4,6
+ one-per-MCM): walls 593/605/581 s, rhs 29.5/30.0/29.1 ms/call, the SAME rank-2 straggler
+ (353/357/358 s) every time, and each rank's VRAM fingerprint (56.1 / 62.5 / 63.3-63.6 /
+ 58.3 GiB) reproduced on whatever GCD it landed on. No sick silicon, no NUMA effect, no MCM
+ pairing. The straggler is rank-attached software state.
+- **The cliff is sharp and now bounded:** rank 1 at 62.5 GiB is FAST, rank 2 at 63.0-63.6 is
+ 1.84x slow — the slow path engages between 97.7% and 98.4% device-full. Standing hypothesis
+ (probe `m4mem.sh`, pre-registered): cumulative per-slot q_prim/rhs alloc/free churn (rank 2 =
+ SFC-middle churns most) ratchets the OpenMP runtime's RETAINED device pool to the ceiling;
+ under ~1 GiB free, every target region's transient allocation hits the allocator slow path.
+ Zero-code knobs found IN OUR RUNTIME BINARY: LIBOMPTARGET_MEMORY_MANAGER_THRESHOLD=0 and
+ OMPX_AMD_MEMORY_MANAGER_THRESHOLD_EXP_2.
+- **M4c: np=1 re-run matches history exactly** (228.5 s, rhs 18.46 ms/call, 49.9 GiB): the
+ same-code curve is 18.5 -> 17.9 -> 29-31 ms/call at np=1/2/4. **np=8 FAILS (rc=143) with ALL
+ EIGHT cards pinned at 62.3-63.7 GiB** — at 2x2x2 every rank is churn-heavy, so the ratchet
+ that singles out rank 2 at np=4 hits everyone, exactly as churn-retention predicts. **The
+ pre-registered rule fires: P1 q_prim/rhs pooling is promoted to IMMEDIATE** (it removes the
+ per-slot alloc/free churn categorically, not just the footprint).
+- Sequencing consequence: I1a lands first (in flight), then `m4mem.sh` (5-min mechanism proof
+ from a clean tree), then P1 pooling as the next code increment. S-track/exchange fronts wait
+ for the post-P1 re-baseline: if the straggler+shadow (~half the 2.59x) falls with P1, the
+ remaining honest gap is the regrid family + the unexplained uniform +36% rhs floor
+ (np-attached, all np=4 arms, unexplained by every hypothesis tested today — named open
+ question, do not hand-wave it).
+
+### The increment sequence (each = one landed permanent piece, one commit, goldens-first)
+
+1. **I1 exchange validator** (P3, ~500 LOC) — starts now, gated on nothing: it is pure code,
+ prerequisite to every exchange conversion, and M4 cannot change its scope. v2 contract + the
+ inventory corrections (F1/F2 shared pool). New asserts earned this week: replicas are
+ stash-only slots; `[amr-cap]` flatness (promote into `s0_report.py`). Verification includes
+ the I0 lesson: seed a deliberate staleness bug and confirm the validator TRIPS.
+2. **P1 q_prim/rhs pooling — REDESIGNED by the pre-increment audit (consumer-lifetime sweep,
+ 2026-08-21 night; full report: amr-bench/qprim_rhs_lifetime_audit.md).** The sweep established: fine-block
+ `rhs` is single-block scratch (fused per-block compute+update, `m_amr.fpp:4910`; reflux
+ never reads slot rhs on that path) but **L0 tiles need per-slot rhs** across the
+ MPI-synchronized reflux point (`m_time_steppers.fpp:635-637`); `q_prim` is written only
+ under `run_time_info|probe_wrt|ib|bubbles_lagrange` (`m_rhs.fpp:849`) and read only by IB
+ correction + the hyper_cleaning term.
+ **Before-increment re-audit (2026-08-21, this session) verified the shape in source and
+ sharpened it:**
+ - Every fine slot's q_prim/rhs is allocated at the SAME uniform `mbuf*` extents
+ (`s_amr_alloc_slot`) — a shared scratch is a drop-in, no per-block reshaping. The module
+ already carries this exact pattern: `amr_rhs_pb_f`/`amr_rhs_mv_f` and `amr_cg` are shared
+ scratch by design (docstring at m_amr.fpp:5484), and `amr_cons_br` (5625) is the
+ batch-folded precedent; `amr_br_batch = 1` today, so slot-shaped scratch IS batch-shaped
+ until P2 widens it.
+ - The tile path calls the SAME stage routines (`s_amr_select_slot` + `s_amr_fine_stage_rhs/rk`
+ at 7052/7073). Caller list is COMPLETE and verified: fused fine advance 4910-4911,
+ subtree advance 5165/5168/5176, tile loops 7052/7073, m_time_steppers:581. So the
+ increment's shape is a thin dispatcher: stage bodies take q_prim/rhs as dummies; tile
+ callers pass `amr_slots(k)%...`, fine callers pass the scratch. `s_amr_ib_correct_fine`
+ (3325/3327) gets the arrays the same way.
+ - Tile slots allocate through the SAME `s_amr_alloc_slot` (tile-geometry mbuf at call time,
+ per the reconcile skip-comment at 5851) — the alloc site needs the tile discriminator
+ (`islot <= l0_slot_off .or. .not. amr`): tiles keep per-slot rhs; fine slots allocate
+ neither.
+ - q_prim gate SHARPENED: the only reader of a SLOT q_prim is `s_ibm_correct_state` — so
+ per-slot q_prim exists only for TILE slots under `ib` (the RK-pass read spans other
+ tiles' RHS work); every other configuration shares the scratch (a gated copy-out into
+ scratch nobody reads is harmless). QBMM `pb_f/mv_f/pb_stor/mv_stor` are persistent
+ per-block side-state and stay per-slot.
+ - The three `allocated(q_prim)` discriminators (alloc-entry upgrade check 5746, free-path
+ teardown guard, reconcile stash assert 5879) move to `allocated(x_cb)` — grid arrays are
+ allocated for every full slot (tile or fine) and absent on stash-only slots; the free
+ path's teardown guards become per-array (q_prim/rhs/QBMM independently).
+ - Verify during implementation: `s_amr_copy_fine_fields` (s==1 backup) touches only the
+ store, not q_prim/rhs.
+ Expected ~15 GiB/rank saved at the S0 point (72 slots x ~2x105 MiB). Same gate as before
+ (goldens + subset + S0 np=4 peak >= 10 GiB lower; np=8 after). The carry-forward device
+ conversion + device-side growth remain bundled. **Bug candidate RESOLVED for our path: `m_rhs.fpp:772` reads q_prim(psi)
+ before the gated copy-out, but amr+hyper_cleaning is transitively unreachable (amr+mhd is
+ 1D-only per m_checker.fpp:136; hyper_cleaning forbids 1D per case_validator.py:1158). On
+ the MONOLITHIC path the read may see stage-stale psi when none of the gate flags is set —
+ an upstream accuracy question, filed as a candidate for an upstream issue, not on our
+ critical path.**
+
+**Config decision closed (P4 arm): threshold=2^20 measured IDENTICAL to =0** (rhs
+[145.0, 140.0, 147.4, 149.7] vs [145.4, 146.5, 152.3, 142.8]) — hoarding of the big freed
+blocks was the entire story; descriptor caching adds nothing. **=0 is the STANDING DEFAULT,
+exported in amr-bench/env.sh (dated note there); every benchmark from 2026-08-21 on runs with
+it, and any runtime upgrade must re-verify it.** The peak-vs-plateau distinction from the P4
+VRAM trace (rank 2 still spikes to 62.4 at the migration storm — LIVE transient,
+knob-independent — while performance tracks the retention plateau) is the shape memory work
+is judged on from now on. **Before quoting any S-track/regrid share: re-baseline the S0
+np=2/np=4 pair WITH the knob** — the 2.59x table above is the pre-knob world; the post-knob
+gap (~1.59x per doubling) is the one the remaining fronts compete over.
+
+**S0 POST-KNOB RE-BASELINE — DONE (2026-08-21, logs/s0knob-0821_2057 np=2 + m4mem-0821_1959/P1
+np=4; same build 9751e479, knob on both, k004-004).** np=2 wall 253.7 s (knob inert below the
+cliff: peaks 43.3/43.7 GiB; pre-knob np=2 was 255.6 on the pre-I1a binary). np=4 wall 405.4 s
+= **1.598x per doubling, gap +151.7 s**, and the split is decisive:
+regrid +86.6 s (57%% of the gap: rg:mig 12.4->54.1 = +41.7; rb:gath 1.7->18.1 = +16.4 at
+5.5x/call; rb:tail 1.9->23.6 = +21.7 with imb 2.44; rg:clus +4.5) + exchange-wait families
++42.7 (gather +17.5 at 3.7x/call, reflux +11.0 pure wait, coarse +8.2 imb 2.17, seam +6.0)
++ rhs only +7.8 (per-call 17.64->18.63 ms = +5.6%%: the allocator fix fully retired the rhs
+story). rb:slot and rb:ovl FLAT (-1.7/+0.2). **Post-P1 front CONFIRMED: the per-box gather
+(rb:gath + its rb:tail shadow) and migration (rg:mig, T1 waves) own the remaining scaling
+excess; every S-track share quoted from here on uses THIS pair, not the 2.59x table.**
+3. **Third increment — SELECTED by the post-knob re-baseline (2026-08-21, supersedes the
+ M4-directed menu below): rb:gath + rb:tail (per-box gather batching), scope SHARPENED by
+ the np=8 sub-brackets: rb:gath = pg:recv 99.2 s (level>=2 parent gather's BLOCKING per-box
+ MPI_RECV — the unconverted half of R1) + rb:wait 58.9 s (level-1 WAITALL); pack/unpack/
+ alloc all ~0. BOTH families go through one chunked plan-then-execute (design:
+ amr_regrid_gather_batching.md, updated with the S0 evidence — its old level-1-only scope
+ was matched-point-specific).** Judged on rb:gath ms/call flattening across np and the
+ rb:tail/reflux/seam wait shadows shrinking with it; increment 1 (plan reproduces today's
+ message set, asserted via the I1a XA counters) is the safety net before any batching. **Fourth: T1 migration waves**
+ (rg:mig +41.7 s, the largest single item; design v2 reviewed, floor 8-12%%). The old menu
+ (S1 lattice tags / I2-I3 waves / S2 balancer) stays written below as the fallback rules if
+ either increment's gate fails.
+ Original menu: S1 block-lattice tags (if regrid/collective scaling is the
+ chosen front — kills the measured ntag doubling; judged on ntag bytes/rank going flat), OR
+ I2-I3 exchange waves (if wait/skew traces to per-box exchange arrival), OR the S2/T1
+ balancer path (only if M4b's rule fires). One front at a time; the other rules stay written
+ so the choice is a lookup, not a debate.
+
+**P1 LANDED (f5f99337) AND GATED (2026-08-21 night, logs/p1gate-0821_2144, pin e964b45f):**
+subset 67/67 incl. both churn goldens. **np=4 peaks 30.2-39.5 GiB vs 63.6 pre-P1 (~27 GiB
+drop; gate was >=10). np=8 COMPLETED FOR THE FIRST TIME EVER: rc=0, peaks 39.0-51.3 GiB
+(predicted ~48), live 72-75 boxes/rank — the MEMORY axis (W8) now holds through np=8 at
+fixed 200^3/rank.** First np=8 phase budget (wall 1106.0 s = 2.63x over np=4): regrid 48.1%%
+(rg:mig 204.8 s over 11 migration events vs 4 at np=4; rg:build 287.9 with rb:gath 168.5 s =
+15.2%% of wall at 6104 calls, 27.6 ms/call) + gather 14.3%% (2.42 ms/call, 3.2x np=4) +
+reflux 5.3%% + seam 4.5%%; rhs healthy at 15.7%% (21.3 ms/call). **The np=8 wall IS the
+per-box gather + migration — increments 3 (rb:gath) and 4 (T1) confirmed with force.**
+Two predictions corrected, honestly: rb:slot did NOT collapse (21.1 s at np=4, unchanged —
+that bracket is dominated by host-staged store growth, not the removed per-slot allocs), and
+np=4 wall came out 421.2 s vs 405.4 pre-P1 (+3.9%%) — **ADJUDICATED AS VARIANCE by a repeat
+arm (410.7 s, rhs 18.88 ms/call vs 18.63 pre-P1 / 19.65 first run; VRAM peaks byte-identical
+across both post-P1 runs). P1 is wall-neutral at np=4, as the mapped-entity law predicts
+(same dummy count per region, different backing). Post-P1 np=4 wall band: 410.7-421.2 s.**
+- **G-A: CLOSED same night (logs/tax-0821_2241, tax_matched_p1.out; the analyzer reproduces
+ the historical 11.03x on the old file — protocol-exact, stationarity verified at 229.6
+ blocks/step in BOTH windows). MATCHED TAX 11.03x -> 7.06x; PAYOFF vs uniform-at-finest
+ 1.38x -> 2.15x; excess over AMReX's 3.13x: 3.52x -> 2.26x.** Delta between the pairs =
+ knob + P1 only (zero solver-algorithm change): the differenced L2 window fell 489.0 ->
+ 332.0 s (-32.1%%) at identical fine_work; the uniform window is stable (10.51 -> 11.16 s).
+ Carry-forward caveat: the uniform denominator is still the one flagged 13%% high (open
+ row: uniform re-run at cc59ad38) — honest tax range ~7.0-8.0x. P2's old 14.91x idle
+ factor is now UNMEASURED at the matched point (that decomposition predates both fixes) —
+ re-decompose before ranking P2 against increments 3/4.
+- **G-B: "no performance tax over SOTA" has NO weak-scaling bar.** We compare AMReX at one
+ operating point but judge scaling only against ourselves (1.598x/doubling). Run the
+ AMReX S0-equivalent at np=2/4/8 on this node (amrex_tax.sh is most of the harness) to
+ define the target our np-doubling ratio must meet. Until it exists, axis-2 "done" is
+ undefined.
+4. **Phase-2 (P2 batched advance) contract is WRITTEN during increment 2-3** per the
+ constitution — seeded by the 2a prototype (batch convert_conservative_to_primitive) and
+ M2's verdict; it does not start until its contract passes the audit ritual.
+
+### Re-audit cadence (user directive 2026-08-21: "reaudit things as needed regularly")
+
+An evidence audit is a ZERO-RUN activity — re-read the instruments, re-check same-build/
+same-node provenance (the PIN files), re-derive the headline ratios from the raw tables — and
+the 2026-08-21 audit overturned two working theories and found the straggler without a single
+new run. It is now scheduled, not occasional:
+
+- **Before starting any increment:** does the evidence still support its premise? (The device-
+ remake increment failed exactly this check in hindsight — its premise ignored a measured
+ transient.)
+- **After every sweep:** do the new data change any pre-registered rule's input? Read
+ [phase-rank]/[amr-balance]/[amr-cap]/[amr-xa] per rank, not just the means.
+- **At phase boundaries:** a full re-derivation of the operating picture against the
+ constitution's invariants, with anything refuted banner-marked in the docs AND memory.
+- **Confound checklist at each audit:** build identity (PIN), node identity (PIN), bracket
+ nesting (phase-sum vs wall), cumulative-vs-stationary phenomena (rule 16), rank->device
+ permutation (rule 6).
+
+### Standing constraints for this phase (the do-not list)
+
+- Do not optimize reflux (it is the sink, not the source — twice-confirmed).
+- Do not grow the operating point (np=8, deeper levels, bigger blocks) before P1 pooling.
+- Do not re-litigate P2's position (constitution D-phase2: full commitment, after Phase 1).
+- No multi-node work until single-node np=8 weak scaling is clean (D-node).
+- Every slot/stash/exchange change: churn goldens FIRST, then subset, then gates; wall claims
+ only from from-scratch same-build pairs; counters over wall wherever a counter exists.
+- Watch CI on 9bcc9865/7ca673a0: `s_amr_st_move_slot` + stash-only slots are new device code
+ paths for the other three compilers (local gate is amdflang-only by standing rule).
+
+**Mission: drive the AMR infrastructure tax toward zero.** Physics (`rhs`, `coarse`, `rk`) is
+untouchable; everything else is overhead to be removed. This version supersedes the 2026-08-18
+rewrite (git history) now that the WHY is established — the findings live in
+`amr_slowness_analysis.md` (causal model, five-reviewer panel) and `amr_tax_review.md` (measurement
+audit); this document is only the work list, its gates, and its decision rules.
+
+## 2026-08-20 EVENING — WHAT THE MEASUREMENTS DID TO THE PLAN
+
+Four items closed or downgraded in one session. **Read this before acting on the ladder below.**
+
+| item | status | evidence |
+|---|---|---|
+| T0a non-blocking reflux recv | **correct but 0% measured** | -2.0% wall, inside a 5.3% floor; a later same-config run came in HIGHER than baseline |
+| M4 t8code guard | **no-op, already exists** | `rr /= proc_rank` at the send loop already excludes the only rank holding the block |
+| T0b send aggregation | **dead** | fan-out measured **1.048** — each moved block has one destination |
+| T0b SFC hysteresis | **alive but marginal** | `rg:move` is 50% wait / 50% volume; payoff 4.7-8.4% against a 5.3% floor |
+
+**THE NOISE FLOOR IS 5.3%**, from four runs of the identical configuration (782.856 / 799.022 /
+818.498 / 825.481). Every remaining T0 item is a 4-8% candidate. **T0 will not produce a defensible
+multiplier**, and the earlier 11.03 -> 8.54x ladder projection is withdrawn.
+
+### The one good methodological find
+
+`[amr-mig] ... bytes 10748501376` was **identical to the digit** across two runs. Migration volume is
+deterministic, so a hysteresis A/B can be judged on **bytes moved** — exact, zero noise — instead of
+wall time. Confirm the volume cut first; spend a timed run only if it lands. Apply this pattern
+wherever a fix targets a deterministic quantity: it converts a 5.3%-noise experiment into an exact one.
+
+### Where the effort should go
+
+Infrastructure is 78.2% of wall against a 6.6% parity budget (11.9x reduction needed). Nibbling
+single-digit percentages cannot get there. **T1 (per-block -> per-level conversion) is the only item
+that touches the 78.2%, and it is the same refactor as S4 (distributed box metadata).** That is the
+program; T0 is not.
+
+## TWO PROGRAMS: TAX (T) and SCALING (S)
+
+Written 2026-08-20 after the full budget. These have **different success metrics and must not be
+measured against each other** — the scaling fixes score ~0 on the matched benchmark, and the tax
+fixes do nothing for O(N) growth.
+
+| | Track T — tax | Track S — scaling |
+|---|---|---|
+| goal | matched tax 11.03x -> 3.13x (AMReX) | per-rank memory and collective volume O(1) or O(log P) in box count |
+| metric | ns per cell-step, matched point | per-rank bytes + bytes-per-collective as f(problem size) |
+| harness | exists (`tax_matched.sh`) | **does not exist** - S0 below |
+| current | 11.03x, infra 78.2%% of wall | `union_gtag` is **64 GiB/rank at 4096^3** |
+
+### THE KEY STRUCTURAL POINT: the two tracks CONVERGE at the top
+
+T's big item (convert per-box operations to per-level plan-then-execute) and S's big item (stop
+replicating global box metadata) **are the same refactor**. A per-level plan only needs *this rank's
+boxes plus its neighbours*; building it is what makes the global tables unnecessary. Doing them
+separately would mean writing the same code twice and merging conflicts. **Co-design T1 and S4.**
+
+The cheap items on both tracks are genuinely independent and can proceed in any order.
+
+### Track T — tax
+
+| id | item | LOC | expected |
+|---|---|---|---|
+| T0a | non-blocking reflux receives (`rf:recv` 6.3%%) | ~30 | 11.03 -> 10.5x |
+| T0b | migration volume: t8code guard + SFC hysteresis (`rg:move` 12.4%%) | ~50 | -> 9.9x |
+| T0c | chunked gather batching (`rb:wait` 9.0%% + the skew sinks it feeds) | ~300 | -> 8.8x |
+| T0d | flatten `q_prim`/`rhs` per-slot allocs (`rb:slot` 3.4%%) | ~150 | -> 8.5x |
+| **T1** | **per-level plan-then-execute throughout** | months | **-> ~4-5x** |
+| T2 | fused advance; attacks the 2.41x per-cell inefficiency | months | -> ~3.5x |
+
+**T0 as a whole is worth ~1.3x and does NOT reach AMReX.** Infrastructure is 78.2%% of wall and the
+parity budget is 6.6%% - an 11.9x reduction. T0 delivers ~1.4x of that. Do T0 because it is cheap and
+de-risks measurement, but the parity claim rests entirely on T1.
+
+### Track S — scaling
+
+| id | item | LOC | why |
+|---|---|---|---|
+| S0 | **weak-scaling harness** | ~150 | Track S has no metric today. Report per-rank peak bytes and per-collective volume vs problem size. Without it S1-S4 are unfalsifiable. |
+| S1 | coarsen tags to a block lattice before `union_gtag` | ~60 | **512x volume cut at 8^3.** 491 MiB/rank -> 0.96 MiB now; 64 GiB -> 0.12 GiB at 4096^3. AMReX `blocking_factor`, Uintah region lattice. |
+| S2 | `MPI_SCAN` prefix weights instead of `ALLREDUCE(cost, nboxes)` | ~40 | Carries **8 B/rank regardless of box count**, O(log P). p4est's approach. |
+| S3 | local clustering + boundary reconciliation (SAMRAI) | ~400 | Removes the global tag set entirely rather than shrinking it. |
+| **S4** | **distributed box metadata** | months | `amr_block_owner`/`amr_slots`/`amr_region_*_all` are sized `1:amr_max_blocks` on EVERY rank, and the rebuild loops `do k = 1, nboxes` globally. O(N) memory and O(N) trip count per rank. **Co-design with T1.** |
+
+### The three global collectives, measured
+
+| site | carries | current | at 4096^3 |
+|---|---|---|---|
+| `s_amr_union_gtag` ALLGATHERV | tagged **cell** indices | 491 MiB/rank, 1.53 GiB/regrid | **64 GiB/rank** |
+| `s_amr_pack_gwin_pairs` 2x ALLGATHERV | window pairs | same class | same class |
+| `s_amr_block_cost` ALLREDUCE | `cost(amr_num_blocks)` | 1.8 KiB/rank | 1.8 MiB/rank |
+
+**Warning for whoever measures S1/S2:** they cost ~0 on the matched benchmark (`rg:clus` 2.2%%,
+`rg:tag` 0.5%%). Judging them by wall time at 400^3 will make them look worthless. Judge them by S0's
+metrics.
+
+## THE LEDGER — every idea, its status, and what would move it
+
+Audited 2026-08-20. This is the index; the chronological evidence is below. **Read this section
+first and do not re-open a CLOSED row without new evidence** — several have been re-proposed more
+than once.
+
+### The frame: what the tax actually decomposes into
+
+The matched head-to-head gives **23.92x = 1.60x ARITHMETIC x 14.91x IDLE**. The arithmetic factor is
+benign (MFC does real multiphysics against a linear-advection benchmark). **The excess is idle**, and
+its shape is explained by launch count: ~224 blocks x 3 RK stages x ~21 kernels ~= 14,100, against a
+measured 14,091/step versus AMReX's 81. AMReX launches once per *level* because a MultiFab kernel
+spans every box; **we launch once per block**.
+
+Every alive item below attacks one of five idle sources:
+
+| # | idle source | measured share | attacked by |
+|---|---|---|---|
+| I1 | per-block kernel launches (not fused) | 173x launch ratio | B1, B2, B4 |
+| I2 | MPI progress spinning (np=8) | ~51% of host CPU | C1, C2, C3 |
+| I3 | per-region GPU map/descriptor cost | 2.00 copies per mapped array | **IRREDUCIBLE — see closed** |
+| I4 | per-box gather in regrid | 16.9% of wall | R2, R3 |
+| I5 | regrid frequency | 37% of wall at int=2 | R1, R4, R5 |
+
+**Unresolved conflict that gates I1 vs I2**: `PH_RHS` is 54-57% GPU-busy at `int=20` but overall busy
+is 5.4% at the matched `int=2` point. Different operating points. Until reconciled, we do not know
+whether fusing the advance (I1) or cutting regrid (I5) is the larger lever. **M2 below settles it.**
+
+### CLOSED — landed
+
+| id | item | result |
+|---|---|---|
+| L1 | Level-2 parent-gather ISEND pool | -17 to -22% wall, regrid -39.3%, 76/76 |
+| L2 | Loop-invariant coarse-halo hoist | ~2.4x on its path |
+| L3 | **Store: bounded growth + compaction** | **2.32x** (1.80x compact x 1.29x growth) |
+| L4 | Flat store is authoritative for q_cons | prerequisite for all batching |
+| L5 | max_grid_size heap corruption | fixed + golden |
+| L6 | Multi-level + subcycle + np>1 PROHIBIT lift | covered by C45DBB52 |
+
+### CLOSED — refuted, with the evidence that killed each
+
+| id | item | killed by |
+|---|---|---|
+| X1 | Packed super-grid / block packing | even-split tiler leaves blocks exactly slot-sized |
+| X2 | Cost-weighted balancer | work balanced to 1.4%; imbalance 1.015-1.027 all run |
+| X3 | Straggler = gather ownership / co-location | gather barrier 29.6 s vs 0.185 s exchange (160:1) |
+| X4 | L0-sourcing of coarse patches | gather never skewed to the sick rank (argmax rank 6) |
+| X5 | Churn causes the straggler | ranks 4/5: identical churn, 0.998x vs 1.089x rhs |
+| X6 | "Cost grows with sim time" is intrinsic | 3.68x pre-fix vs **1.17x post-fix** |
+| X7 | Batch-convert remaining blocking calls | hoisting the step gather drain made wall WORSE |
+| X8 | Bigger blocks (cap > 64) | cap 96 +18%/cell; cap 128 device-OOM on per-block size |
+| X9 | Reducing per-region GPU map cost | **7 mechanisms measured, ALL fail** — treat as a floor |
+| X10 | Optimising reflux | 99.6% comms, and it is the SINK not the source |
+| X11 | rocprof-sys-causal profiling | rejects MFC's .text FUNCs as ineligible |
+
+### ALIVE — ranked by (value x confidence) / cost
+
+**Tier 1 — cheap, high confidence, do regardless of pending measurements**
+
+| id | item | LOC | why |
+|---|---|---|---|
+| S1 | **Device-side store remap** | ~80 | Removes the host round trip that forces compaction's 3x/2x hysteresis. Steady state 2-3x live -> **1x**. AMReX `RemakeLevel` does exactly this. Given L3 measured that *carrying* capacity costs 1.29x on its own, this is directly valuable. |
+| S2 | Derive the local index, delete the recycle stack | ~40 | AMReX `localindex` = binary search over the owned-box list; Parthenon `lid = n - nbs`. Index space *is* the live set, so the ratchet cannot return. Mostly redundant with S1 but deletes the bug class. |
+| A10 | Migration phase bracket | ~10 | We cannot currently price migration at all — regrid and redistribute are fused (see M3). Uintah's separate brackets are what found their scaling limiter. |
+| R5 | Grid-identity early-out | exists | Already have the `same` check; verify it covers the level set too. |
+
+**Tier 2 — the main line, gated on M2**
+
+| id | item | LOC | why |
+|---|---|---|---|
+| B1 | **Device-resident descriptor array + one fused kernel** | weeks | Parthenon's `BndInfo`/SparsePack shape. *Fully compatible with our contiguous store* — each descriptor degenerates to an integer slot index. This is the direct attack on I1. |
+| B2 | Rebuild-descriptors-only-on-invalidation | ~30 | Parthenon rebuilds packs only at remesh. Prevents the fused path re-acquiring per-step host cost. |
+| R2 | **Batch the per-block regrid data motion** | weeks | SAMRAI fills a whole level with ONE RefineSchedule; Chombo with ONE copyTo. We do one `s_amr_gather_coarse_patch` per block (16.9% of wall). Converts churn from O(blocks) to O(1) plans. |
+| R3 | Plan-then-execute for the parent gather | ~200 | Narrower version of R2 targeting the level>=2 path specifically. |
+
+**Tier 3 — load balance; cheap but no longer aimed at a known problem**
+
+| id | item | LOC | why / caveat |
+|---|---|---|---|
+| A1 | Per-block constant in `s_amr_block_cost` | ~10 | Uintah ships `patchCost = 16` cells; SAMRAI added `minimum_patch_load` for exactly our regime. **Caveat: work is already balanced to 1.4%, so this buys little today.** |
+| A7 | SFC-cut hysteresis (gain threshold) | ~40 | Uintah `gainThreshold` 0.05; WarpX measured optimum 10%. Zero correctness risk. |
+| A2 | Fit cost coefficients to measured per-block time | ~100 | Uintah `ModelLS`. **Heed A4**: Uintah's own dissertation found measured filters *worse* than the fitted model immediately after a regrid — and LB always follows a regrid. |
+| M3 | `vsize` migration-cost companion to block cost | ~30 | Every scheme in the literature needs work AND redistribution cost; we model only work. Cheap and exact for us: `sys_size x fine cells`. |
+| M4 | t8code guard: don't send a block to a rank that already has it | ~10 | `s_amr_regrid_stash_migrate` has no such guard. |
+| M5 | Decouple adapt from repartition (p4est Principle 2.1) | ~200 | We fuse them, so we pay the expensive half every time we want the cheap half — and cannot price them separately. **Prerequisite for measuring migration at all.** |
+
+**Tier 4 — worth trying, low effort, independent**
+
+| id | item | why |
+|---|---|---|
+| C1 | Ranks per GCD (MPS-analogue) | Parthenon Table 1: ~1.8-2x independently, near-zero code change |
+| C4 | Per-thread-block scratch instead of per-block | Parthenon-VIBE: 8.858 GB -> 0.138 GB (modeled, not end-to-end) |
+| T1 | `amr_tag_eps` per-level thresholds | a single threshold populates exactly ONE level on smooth features |
+| F1 | Delete the flux families | in progress; its own premise was wrong (delete, don't flatten) |
+
+### BLOCKED — needs a measurement before it can be ranked
+
+| id | question | experiment | status |
+|---|---|---|---|
+| M1 | What is the tax NOW, post-store-fix? | matched arm, differenced 40->80 | **RUNNING** |
+| M2 | Is the excess launch-bound (I1) or MPI-bound (I2)? | **np=1 run of the MATCHED case** | designed, never run — the single highest-value open experiment |
+| M6 | Why is rank 5 slow when rank 4 has the same capacity? | per-rank `hipMemGetInfo` at each regrid | ~10 LOC |
+| M7 | Does slot size vary enough to justify per-box sizing? | max/mean box-volume ratio | derivable from a log |
+
+### M2 DESIGN — separating local launch cost from MPI progress
+
+The two idle findings (85% survives at np=1 with zero MPI; host 51% busy in MPI progress at np=8)
+were measured on different cases and have never been reconciled. The obvious experiment — run the
+matched case at np=1 — **does not work, and it is worth recording why** so it is not attempted again:
+
+- The matched case is 400^3. At np=8 we measured 44-64 GiB in use *per GCD*. Halving the rank count
+ doubles per-GCD memory, so np=4 needs ~88-128 GiB against a 64 GiB device. **np<8 on this domain
+ OOMs immediately**; np=1 is off by 8x.
+
+**The design that does work: hold per-GCD work constant instead of holding the domain constant.**
+
+| arm | domain | ranks | cells/GCD | MPI |
+|---|---|---|---|---|
+| A | 200^3 | 1 | same as B | **none** |
+| B | 400^3 | 8 | same as A | yes |
+
+200^3 at np=1 puts exactly the same number of cells on one GCD as 400^3 at np=8. Compare
+**ns per fine-cell-step** between the arms:
+
+- A ~= B -> the idle is **local** (launch path / descriptor mapping). Fusing kernels (B1) is the lever.
+- A << B -> the idle is **MPI progress**. The convoy work (C-tier) is the lever, and fusing the
+ advance would be aimed at the wrong term.
+
+This needs no rocprof: ns/fine-cell-step is already the reported quantity, and the phase brackets
+carry `GPU_WAIT` on both ends so they measure completed device work.
+
+**Known imperfection, stated up front:** a 200^3 domain does not produce the same AMR block
+*structure* as 400^3 (fewer blocks, different boundary fraction), so this is a controlled comparison
+of the idle *mechanism*, not of the tax. Do not quote a tax from arm A.
+
+### THE STRATEGIC FACT nobody should lose sight of
+
+**AMR payoff is currently < 1 at single-node scale — uniform refinement beats our AMR by 4-5x.** Every
+item above is about making AMR *cost less*, not about whether it currently *pays*. The tax must fall
+by roughly an order of magnitude before AMR is the right choice on one node; the case for it is
+multi-node, where uniform refinement does not fit in memory. **Do not let a local win obscure that
+the headline payoff is still negative.**
+
+
+## Where we stand
+
+- **Landed:** R1 (level-2 gather blocking-SEND -> ISEND pool): **-17%/-22% wall**, regrid -39%,
+ goldens 76/76. Phase instrumentation: 44 brackets, call counts, per-rank output; zero cost when
+ `rank_time_wrt` is off.
+- **Measured taxes:** matched point 6.30x -> **5.21x** post-R1. Production point: **not a number** —
+ 4.02x in the 40-80 step window growing to 12.14x in 80-160 at constant mesh; the growth costs
+ ~61% of a 160-step run. Long runs at `regrid_int=2` **OOM by regrid count** (40 regrids dies).
+- **Store fix A' applied** (one line, growth policy): the OOM mechanism is diagnosed as a plateau
+ overshot by doubling, not a leak - Phase 1. Verification in flight on the case that dies today.
+- **The causal model** (`amr_slowness_analysis.md` sec. 3): regrid churn -> rank-local grow-only
+ store ratchet -> (a) OOM at the 64->128 doubling, (b) VRAM pressure -> slow per-launch alloc path
+ -> rank-local rhs divergence -> **convoy amplification** through the per-box blocking lattice.
+ Link (b) is the leading hypothesis (E-H1), under adjudication now.
+- **Two laws that gate every fix below:** (1) a per-box rendezvous is also a BARRIER — deferral
+ without a downstream sync relocates cost (measured, twice); aggregation removes it. (2) Code-read
+ attributions run ~2-for-11 here — every fix is gated on a bracket or counter, never on a reading.
+
+## Phase 0 — finish the adjudication (hours, in flight)
+
+| item | action | decides |
+|---|---|---|
+| 0.1 | Read RK_160 per-rank data (running) against pre-registered signatures: rhs bimodal at flat fine_work + same slow ranks = E-H1; rhs tracks block/L2 count = composition; rotating slow ranks = thermal | which Phase-1 premise holds |
+| 0.2 | `map(alloc:)` revert A/B at 160 steps (2 lines, temporary) | E-H1 (VRAM-pressure alloc path) vs heap fragmentation |
+| 0.3 | Land trip-wire (stderr: `amr_loc_n`, `amr_st_cap`, live slots per rank per regrid) + `PH_RESTR` bracket on the post-stage restrict/reflux chain (~15 LOC) | makes the ratchet and the invisible 4-6% observable |
+| 0.4 | Commit the verified instrumentation (reflux + per-rank brackets, goldens green) | keeps the tree honest |
+
+## Phase 1 — the store fix: DIAGNOSED, A' APPLIED, verification in flight
+
+### What the counters actually showed (2026-08-19, `logs/recon-0819_1351`)
+```
+rank 5 live 29 loc_n 48 freed 19 stack_in 0 stack_out 19
+rank 5 live 32 loc_n 89 freed 57 stack_in 0 stack_out 57
+rank 5 live 29 loc_n 89 freed 60 stack_in 0 stack_out 60
+rank 0 live 26 loc_n 31 freed 4 stack_in 1 stack_out 5
+```
+**RETRACTION: it is not an index leak.** `loc_n = live + stack_out` EXACTLY on every line - nothing is
+lost. It is a **PLATEAU**: `stack_in` is 0 every time because the rebuild drains the whole recycle
+stack then needs more, since frees happen AFTER allocs. `loc_n` settles at ~3x live (29 live + 60
+parked); the floor with this ordering is ~2x, old and new being concurrently live during a rebuild.
+
+**The OOM comes from DOUBLING overshooting the plateau**, not the plateau itself: `loc_n` tops at 89,
+`newcap = max(2*oldcap, nloc)` jumps 64 -> **128** = 28.3 GB of store holding 6.4 GB of live data,
+total 60.4 GB of 68.7.
+
+**THE ASYMMETRY IS CHURN, NOT WORK:** rank 0 frees 4-5 slots/regrid, rank 5 frees **57-60** - 12x, at
+identical `fine_work`. Which subdomain the feature migrates through is a deterministic geometric fact
+and **nothing balances churn**. Rank 5 is also the 4x `rhs` straggler in both per-rank runs.
+
+### FIX A' — applied, one line — FAILED ALONE, still in tree (see the attribution caveat above)
+`newcap = max(oldcap + max(oldcap/4, 8), nloc)`. Trajectory 8,16,24,32,40,50,62,77,**96** (~21 GB,
+total ~53 GB) instead of 16,32,64,**128**. Growth POLICY only - slot lifetime, index assignment and
+the device-authoritative contract untouched, so it cannot produce a wrong answer, only a different
+allocation trajectory. Checked: `newcap >= nloc` always (never undersized), `newcap > oldcap` always
+(cannot stall).
+
+**A' RESULT: FAILED (2026-08-19, `logs/fixA-0819_1456`).** The case still aborts, same
+`HSA_STATUS_ERROR_OUT_OF_RESOURCES` on rank 5, never reaching the step loop. A' worked as designed -
+cap 128 -> 120, lower ranks 64 -> 50-77 - but that reclaims only 1.8 GB. TWO errors in the projection:
+(a) `loc_n` does NOT plateau at 89; that was measured over 20 regrids and over 40 it reaches **103**,
+so growth policy alone cannot bound it; (b) the non-store footprint was estimated at 32.1 GB from one
+historical figure, while the VRAM sampler measured **63.9 GB peak**, back-solving to ~35.6 GB. At cap
+120: 35.6 + 26.5 = **62.1 GB** against an effective ceiling near 64 - it dies by a nose. A' is kept
+(strictly better than doubling, safe, one line) but is NOT sufficient. **Fix B is therefore required,
+not optional**, and is under test now.
+
+**PASS BAR:** the 80-step / 40-regrid matched case - which aborts today with
+`HSA_STATUS_ERROR_OUT_OF_RESOURCES` - must COMPLETE with zero OOM strings; then goldens 76/76.
+Live evidence mid-run: ranks at `nloc` 56-63 sit at cap 62 where doubling would have forced 128; only
+the two churniest reached 96; **no rank has requested 128**; and `nloc` 89 on rank 5 reproduces the
+plateau measured independently in the reconcile run.
+
+**If it passes**, three things unlock together: long runs at realistic regrid intervals, the
+differenced matched-tax measurement that was never possible, and a genuine test of whether relieving
+capacity pressure touches the rank-5 straggler (E-H1's real prediction, still untested).
+
+### FIX B — APPLIED AND VERIFIED ON THE OOM CASE (2026-08-19)
+
+`s_amr_compact_store(nlive)`: dense renumber of `amr_loc_of` + shrink realloc of all four store
+arrays, called at the end of `s_amr_reconcile_slots`. Trigger `amr_st_cap > 3*nlive`, target
+`2*nlive`.
+
+**Result: the case that reliably OOMs today COMPLETED, rc=0, 814.570 s step-loop wall, and the
+full suite is 76/76.** Compaction fires as designed (`loc_n 96 -> 29, cap 58`).
+
+> **CORRECTION (2026-08-19): the OOM case is NOT the cap-96 case.** It is
+> `regrid_int=2` / `amr_max_grid_size=64` / `weno_order=1` / `riemann_solver=5` / 80 steps — a
+> deliberate high-CHURN stress case (40 regrids) with a cheap scheme so store churn dominates the
+> run. "cap 96 OOMs" is a **separate, independent** finding from a different experiment. An earlier
+> revision of this document conflated the two; whether Fix B unblocks cap 96 is **untested**.
+
+> **ATTRIBUTION CAVEAT — the verified configuration is A' + B TOGETHER, not B alone.** Fix A'
+> (1.25x growth, `m_amr.fpp` `s_amr_st_reserve`) was left in the tree when B was built and tested.
+> What is established: A' *alone* does not prevent the OOM; A'+B does. **B alone is untested.**
+> Do not claim "compaction fixes the OOM" without either running B-alone or keeping both. The two
+> are plausibly complementary — A' limits overshoot on the way up, B reclaims on the way down —
+> but A' also makes reallocs *more frequent*, and each one is a multi-GB host round trip, so A'
+> may be a net time cost once B exists. Resolve this by measurement, not reasoning.
+
+Peak local indices still reach `nloc 103 / cap 112` on the hot rank, so the plateau is *reduced,
+not removed* — expected, since the trigger is deliberately hysteretic (see next block for why, and
+for the fix that removes the hysteresis).
+
+### The hysteresis is an artifact of a host round trip — external review (2026-08-19)
+
+Reviewers on AMReX, Parthenon/Athena++ and Chombo/SAMRAI converge on the same two points, and both
+are actionable:
+
+1. **Our compaction and growth both stage the whole store through the host**
+ (`GPU_UPDATE(host)` -> `tmp = store` -> realloc -> `GPU_UPDATE(device)`). Multi-GB over PCIe, so
+ we cannot afford to run it often — hence the 3x trigger and the 2x target. AMReX's
+ `RemakeLevel` fills the new `MultiFab` **device-side** from the still-live old one. Making our
+ remap a device-to-device gather lets compaction run unconditionally at `newcap = nlive`, taking
+ steady state from 2-3x live to **1x**, with a transient peak of 2x *live* rather than today's
+ 2x *cap* — cheaper than the current peak even before the steady-state win.
+2. **Neither AMReX nor Parthenon allocates a local index at all.** AMReX's `localindex` is a binary
+ search over the sorted owned-box list; Parthenon's `lid = n - nbs` is recomputed contiguous every
+ regrid. The index space *is* the live set by construction, so it cannot ratchet. This is Option 1
+ (stable slot identity), and it deletes `amr_loc_free`/`amr_loc_nfree`/`amr_loc_n` as concepts
+ rather than mitigating them.
+
+Do (1) then (2): (1) is the larger memory win and is local to two routines; (2) removes the bug
+class. Together they reproduce AMReX's invariant — *storage size == live working set, every regrid,
+with no memory of the past* — while keeping the one contiguous device array the offload result
+requires.
+
+Two caveats banked from the same review, against over-claiming the batching payoff:
+
+- Parthenon's headline 82x packing win is **launch-latency-bound buffer fill** (kernels copying ~8
+ numbers). MFC's blocks are ~2.3M cells; a per-block kernel runs for milliseconds and cannot be
+ launch-latency-bound. Our overhead is a *different* mechanism (offload descriptor mapping), so
+ that number does not transfer.
+- Parthenon-VIBE, on a code that already has full pack fusion, still measures **4.4% GPU-busy** on
+ a 3-level AMR case — worse than ours. Kernel fusion removes one term; it does not fix host-side
+ mesh bookkeeping.
+
+### FIX B — original deferred plan (superseded by the block above)
+Compact post-reconcile so `loc_n` returns to `live` (peak ~2x not ~3x): recovers ~15.5 GB against
+A''s ~7.3 GB. Safe in principle (post-reconcile all readers are done) but it MOVES LIVE DATA - the
+silent-corruption class. Price only after A' is measured; it may not be needed.
+
+### REFUTED — kept as a warning
+"Free stale slots BEFORE the rebuild's alloc loop" (~20 LOC) was this phase's original fix. Its
+premise - stale slots have no readers by rebuild time - is FALSE: the overlap carry-forward reads
+`amr_stor_st(..., amr_loc_of(kks))` for OLD blocks (m_amr_regrid.fpp ~1422) while the stash is
+WRITTEN at those same old local indices (~1221), and `s_amr_free_slot` zeroes `amr_loc_of` and
+recycles the index. Silent wrong answers. Patch parked at `amr-bench/phase1_patch.py` (raises on
+execution). **Caught by tracing runtime reads, not by the anchor check - the eleventh code-read
+attribution refuted, and the first caught before burning a build.**
+
+## THE RUN QUEUE (2026-08-19, one node / 8 GCDs, serial)
+
+Ordering is the scarce resource: one node means one timing arm at a time, and the overlap policy
+forbids building during a timing arm. So the queue is ordered by **how much of the remaining plan
+each run invalidates**, not by how promising each idea is.
+
+Every entry names the decision it changes. A run that cannot change a decision does not belong here.
+
+| # | run | cost | decides |
+|---|---|---|---|
+| **R1** | **A5 discriminator** (RUNNING) | build + 80 + 160 steps, ~40 min | **Whether the balancer track exists at all** |
+| **R2** | **Cap sweep 64 / 96 / 128** | 3 runs, ~45 min | Whether Fix B unlocked a faster operating point |
+| R3a | A7 SFC-cut hysteresis A/B | 40-60 LOC + build + 2 runs | *gated on R1* |
+| R3b | A1 per-block cost constant | ~10 LOC + build + 2 runs | *gated on R1* |
+| R4 | Fix B alone vs A'+B | build + 1 run, ~30 min | One line (`s_amr_st_reserve` growth factor) |
+| R5 | Device-side store remap | days | Independent; steady-state store 2-3x live -> 1x |
+
+### R1 — the gate (running)
+
+Reads per-rank `gather` against per-rank `rhs` at 80 and 160 steps, so the discriminator is read on
+the **onset difference** rather than one endpoint (at 80 steps there is no straggler at all).
+
+- `gather` skews with `rhs` -> **L0-sourcing**: the sick rank sources its coarse gathers from a
+ *static* L0 subdomain. No fine-block balancer can move that work. **A1/A7 are dead**; go to A6.
+- `gather` flat while `rhs` is 4x -> L0-sourcing is out; the churn correlation survives; A7/A1 live.
+
+The binary also prints per-rank `[amr-recon]` churn and `[amr-store]` peaks, which supply the
+reviewer's *blocks-arrived/departed* counter for free. The one thing still missing is
+*coarse-gather bytes sourced*; add it only if R1 comes back ambiguous.
+
+**Why this must be read carefully:** the apparent refutation of L0-sourcing (`rhs` 2.91 vs `gather`
+1.127) compares numbers from **two different cases** — 2.91 is cap-64 production at 160 steps, 1.127
+is the cap-32 matched case over a 10-warm-step window. R1 measures both on one case in one run,
+which is the only reason its answer is worth anything.
+
+### R1 + R1b RESULT — SETTLED: the straggler is a STORE-CAPACITY artifact
+
+Same node (k004-004), same case, **byte-identical `fine_work` sequence**, the only difference being
+Fix A' + Fix B:
+
+| | wall | ns/fine-cell-step | rhs max/mean | rank-5 rhs | max cap |
+|---|---|---|---|---|---|
+| pre-fix (reverted) | 1693.195 s | 56.80 | **2.694** | 923.6 s | **128** |
+| post-fix (A'+B) | **712.032 s** | **23.89** | **1.069** | 221.3 s | **77** |
+
+**2.378x wall at identical work.** The straggler returns when the fix is removed and vanishes when
+it is restored, on the same hardware. Mechanism: caps of 128 drove two GCDs to **63.8 / 62.5 GiB of
+64 (97-99%)**; ungoverned store growth exhausts VRAM and pushes onto a slow path. It is
+state-dependent — the first 80 steps match across nodes to 0.6%, and all divergence is in 80->160.
+
+**Consequences for this plan:**
+- **L0-sourcing REFUTED.** `gather` never skewed to rank 5 (argmax was rank 6). The gate that was
+ blocking A1/A7 is lifted — but see below, because the *reason* to do them has changed.
+- **"Cost grows with sim time" is not intrinsic**: 3.68x pre-fix, **1.17x post-fix** (linear).
+- **The balancer track is deprioritised on its merits, not by the gate.** Work was balanced to 1.4%
+ throughout and the straggler had nothing to do with partitioning. A1/A7 remain cheap and
+ defensible, but they are no longer aimed at a known 2.4x problem.
+- **The device-side remap (R5) is promoted.** If capacity is what costs 2.378x, then getting steady
+ state from 2-3x live down to 1x live is the highest-value remaining store item.
+
+**Still unexplained, do not paper over:** ranks 4 and 5 both reach cap 128 pre-fix but only rank 5
+is slow (294 s vs 924 s). Capacity is necessary, not sufficient. One run with a per-rank VRAM print
+would close it.
+
+### R1 — PRE-REGISTERED READ (written before the 160-step arm returned)
+
+Recorded in advance because the failure mode of this campaign has been fitting a story to numbers
+after seeing them. The 80-step baseline is in: `rhs` imbalance **1.089** (pathology absent), and
+per-rank `gather` **56.86 on rank 5 against a 52.14 mean** — mildly above, but the argmax is rank 6.
+
+**The direction of the gather skew is the discriminator, not its magnitude.** `gather` contains MPI,
+so a slow rank makes *other* ranks wait inside it. The two hypotheses therefore predict opposite
+signs, which is a far stronger test than "is gather skewed":
+
+| | rank 5's `gather` | other ranks' `gather` |
+|---|---|---|
+| **L0-sourcing** (rank 5 does the work) | **HIGH** | low |
+| **Consequence of `rhs` skew** (others wait on rank 5) | **LOW** | high |
+
+The `reflux` column already shows what a pure wait-sink looks like: rank 5 is the **lowest** (20.87
+vs 31.83 mean, 0.656x) precisely because it is the one computing while everyone else waits. So if
+`gather` were only absorbing rank 5's lateness, rank 5 would be *lowest* there too. **At 80 steps it
+is not — it is above the mean.** That is a genuine, if weak, point against pure wait-artifact.
+
+Decision rule, fixed now:
+
+- **L0-sourcing CONFIRMED** — at 160 steps rank 5's `gather`/mean rises materially from 1.09 *and*
+ rank 5 is the argmax. Balancer track (A1/A7) is dead; go to A6.
+- **L0-sourcing REFUTED** — `gather` imbalance stays near 1.1-1.2 or its argmax is another rank,
+ while `rhs` imbalance reaches ~2.9. Note this outcome does **not** confirm the churn hypothesis;
+ the rank-4/rank-5 control pair below already damages that independently.
+- **AMBIGUOUS** — `gather` rises to roughly 1.3-1.5, or rank 5 goes *below* mean (wait-artifact
+ contaminating the signal). Then the *coarse-gather bytes sourced* counter is required, and no
+ balancer work starts until it is run.
+
+**The control pair, which stands regardless of the above.** At 80 steps ranks 4 and 5 carry
+near-identical churn (91 vs 88) and store high-water (nloc 65 vs 64) but `rhs` of 0.998x vs 1.089x
+mean. **Churn does not determine `rhs` time.** This reproduces, within a single run, the anomaly
+previously noted across two ("rank 4 also reaches cap 128 and is NOT slow") and materially weakens
+the churn/store-plateau mechanism as a *cause* of the straggler.
+
+**Do not quote the 80-step correlations** (churn-rhs +0.54, gather-rhs +0.47, churn-gather +0.77).
+With n=8 and a 1.089x signal they are not distinguishable from noise; they are recorded only as a
+baseline for the 80 -> 160 change.
+
+### R4 RESULT — both store fixes are load-bearing; they fix TWO different costs
+
+| config | wall | ns/fine-cell-step | rhs imbalance | max cap |
+|---|---|---|---|---|
+| neither | 1693.2 s | 56.80 | **2.694** | 128 |
+| **B alone** | 941.8 s | 31.59 | **1.106** | **128** |
+| A'+B (2 runs) | **729.7 s** | 24.5 | 1.06 | **77** |
+
+**B alone 1.80x | A' on top 1.29x | combined 2.32x.** All four at byte-identical `fine_work`.
+Dropping A' costs **29.1%**, far outside the 4.96% noise floor. **Commit both.**
+
+The mechanism was predicted before the run and confirmed: compaction fires at `cap > 3*nlive`
+(trigger ~87), and 2x growth doubles 64 -> 128 in one step straight past it — so B alone overshoots
+to cap 128/116 and cleans up afterward (5 compaction events), while A' prevents the overshoot.
+
+**The non-obvious result: these are two separate costs.** B alone already removes the straggler
+(2.694 -> 1.106) yet remains 29% slow. So (1) the capacity *cliff* causes the straggler and
+compaction fixes it, and (2) *carrying* excess capacity costs a further 1.29x with no straggler
+involved. "Just add compaction" would have left a third of the win unclaimed.
+
+### R2 RESULT — cap 64 is an interior optimum; stop sweeping upward
+
+| cap | wall | ns/fine-cell-step | work imbalance | outcome |
+|---|---|---|---|---|
+| 64 | 747.333 s | **25.07** | 1.027 | **best** |
+| 96 | 888.174 s | 29.58 (+18%) | 1.140 (max 1.237) | runs |
+| 128 | - | - | - | **device OOM** |
+
+Work matched to +0.7% between 64 and 96, so the 18% is overhead, not less useful work. With the
+prior cap 32 -> 64 result (2.26x), the curve is worse-below / best-at-64 / worse-above /
+infeasible-beyond.
+
+**Three results, one of them a refutation of my own premise:**
+
+1. **Fix B generalizes.** cap 96 completes (rc=0) where it previously OOMed twice. Fix B was
+ verified on the `regrid_int=2` churn case; this is independent confirmation.
+2. **THE NOISE FLOOR IS 4.96%.** The cap-64 arm re-ran the exact configuration measured at
+ 712.032 s and returned 747.333 s. This is the first run-to-run spread for this case. It licenses
+ the 2.378x store result (far outside it) and is now the yardstick: **anything under ~5% is not a
+ result.**
+3. **cap 128's OOM is a DIFFERENT failure from the pre-Fix-B ones.** `HSA_STATUS_ERROR_OUT_OF_
+ RESOURCES` at **nloc 16, cap 16** - immediately, at a tiny slot count. A cap-128 level-1 block
+ spans 256^3 fine cells, so a few slots plus the stash exhaust 64 GiB. This is the raw per-block
+ working set, **not** the capacity ratchet, and Fix B cannot help. Do not conflate the two.
+
+**My premise for R2 was wrong and the direction is closed.** I ranked it "most likely to produce an
+outright win" on WarpX's measured optimum of ~9 boxes/GPU. It does not transfer: at cap 96 we sit
+near their optimum and are measurably worse, because larger blocks degrade partitioning granularity
+(1.027 -> 1.140) faster than they save per-block overhead. Different code, different per-block cost
+structure.
+
+**Caveat on box counts:** the parser's `est blocks = fine_work/cap^3` gives 711 at cap 64 against
+~224 recorded elsewhere. It scales correctly across arms (711 -> 212) so it is internally
+consistent, but its absolute value disagrees - `fine_work` may not be plain fine-cell count.
+Compare caps on ns/fine-cell-step, which needs no box count.
+
+### R2 — original premise (superseded by the result above)
+
+**Premise, stated correctly.** `amr_max_grid_size = 96` OOMed in an earlier, separate experiment.
+Fix B was verified on a *different* case (the `regrid_int=2` churn stress case) — so **whether Fix B
+unblocks cap 96 is exactly what R2 tests**, not something it assumes. If cap 96 still OOMs, that is
+itself the result, and it says compaction's 3x/2x hysteresis is too loose for that configuration.
+
+External evidence says block count matters more than any balancer change:
+
+- WarpX measured 150 boxes/GPU giving *better* load-balance efficiency but *worse* walltime than 9
+ boxes/GPU (1040 s vs 896 s) — "the overhead associated with a greater number of boxes outweighs
+ the performance benefit of improved load balance efficiency". Their optimum was **9 boxes/GPU**.
+- Three independent sources converge on **boxes per rank >= 3-4** as the parameter that actually
+ governs balance quality in Chombo/BoxLib-family codes.
+- **We currently run ~224 blocks over 8 ranks = ~28 boxes/GCD** — far above WarpX's optimum and far
+ above the 3-4 floor. Every per-block overhead we have measured is multiplied by that count.
+- Our own prior A/B: cap 32 -> 64 gave 4.9x fewer boxes, lower memory, and **2.26x less wall**.
+
+So the direction is established and the next step up was blocked only by the OOM that Fix B just
+removed. Sweep 64 / 96 / 128 at the production point, matched on everything else, and report
+wall + per-rank phases + box count.
+
+**Caveat to apply when reading it:** larger blocks refine more volume than the tags require, so
+arithmetic work rises even as overhead falls. Report **wall AND fine-cell count**, and compare
+ns/cell, not wall alone — otherwise a cap that wins on wall by doing less useful work will look
+like a free win. This is the same denominator error that produced the retracted 1.57x tax.
+
+### Gating logic, stated once
+
+R3a/R3b are **not** queued behind R1 as a formality — if R1 says L0-sourcing, the cost model and the
+cut hysteresis both operate on a quantity that is not the bottleneck, and running them would produce
+two clean null results that teach nothing. R4 and R5 are independent of R1 and can fill any gap.
+
+## Migration cost is a SECOND quantity we do not model (external review, 2026-08-19)
+
+Reviewers on p4est/Dendro/GAMER/Enzo-E, Zoltan/ParMETIS and Chombo/SAMRAI/Uintah converge on a
+result we have no analogue for. Three independent groups, three decades, same order of magnitude:
+
+| study | migration reduction | cut-quality cost |
+|---|---|---|
+| Schloegel/Karypis/Kumar (JPDC 1997), multilevel diffusion vs from-scratch | >10x total, >3.3x max-rank | within 5% |
+| Walshaw (JOSTLE), 9 successive adaptive meshes | 20-100x (0.54-3.76% vs ~94% migrated) | within ~8% |
+| Zheng/Bhatele/Meneses/Kale (IJHPCA 2011), Charm++ RefineLB vs GreedyLB | 16-30x, and it GROWS with scale | - |
+
+And the blunt one, Bak et al. CCGrid 2018: **"GreedyLB doesn't work well even compared to execution
+runs without load balancing."** Unconditional optimal remapping is a *net loss*.
+
+**The concrete gap: ParMETIS carries TWO per-object arrays — `vwgt` (work, the balance constraint)
+and `vsize` (redistribution cost). `s_amr_block_cost` has only the `vwgt` analogue.** Every scheme
+in this literature needs both. For MFC the second is cheap and exact: a block's migration cost is
+`sys_size x fine cells`, known from its region and level.
+
+Two structural rules we violate, both nearly free to adopt:
+
+- **t8code**: "only send a local tree to a process p if this tree is not already local on p."
+ `s_amr_regrid_stash_migrate` has no such guard.
+- **p4est/t8code, stated as a named design rule** — *Principle 2.1 (Complementarity principle)*:
+ "A collective mesh operation shall either change the local element sizes within the existing
+ partition boundary, or change the partition boundary and keep the elements the same, **but not
+ both**." Its stated payoff is exactly our problem: it "simplifies the projection and transfer of
+ simulation data" — interpolation runs processor-local because the partition has not moved yet,
+ and the subsequent partition step transfers data without further changing the refinement pattern.
+ **`s_amr_regrid_stash_migrate` does both at once**: it changes the box set, reassigns owners, and
+ moves data in a single pass.
+
+### Reconciling "partition is cheap" with "migration is expensive"
+
+The two reviews appear to contradict each other. p4est says partitioning is "usually negligible in
+terms of execution time, so we suggest to call it whenever load balance is desirable"; ParMETIS and
+Charm++ say migration must be actively penalized or it costs more than it saves.
+
+**Both are right, and the complementarity principle is why.** p4est's cheap operation is the SFC cut
+over a forest of *elements* — pure topology, no field data. The *transfer* is a separate, explicitly
+invoked step. So "the cut is cheap" and "the transfer is expensive" are statements about two
+different operations that p4est keeps apart and MFC runs together. Fusing them means we pay the
+expensive one every time we want the cheap one, and we cannot price them separately because no
+instrumentation boundary separates them. Splitting the two is therefore a prerequisite for
+*measuring* the migration cost, not merely a tidiness argument.
+
+### COMPETING HYPOTHESIS for the sick rank — and the run that settles it
+
+A reviewer on SAMRAI/Chombo/Uintah proposes a mechanism that would **invalidate the entire
+load-balancer track**, so it must be tested before any balancer work:
+
+> Cells balanced to 1.4% with one rank 4x slower is more consistent with *intrinsic* churn — the
+> feature crosses that rank's **level-0 coarse subdomain**, so it sources all the per-block coarse
+> gathers and migration packs — than with partitioner-induced ownership flipping. **The L0
+> decomposition is static, so no fine-block ownership balancer can move that work.**
+
+**Status: not yet discriminated, and our existing data does not settle it.** The competing
+predictions differ in *which phase* carries the skew:
+
+| hypothesis | predicts skew in |
+|---|---|
+| Reviewer's L0-sourcing | `gather` (and regrid migration) |
+| Our churn/store correlation | `rhs` |
+
+The phase budget shows `rhs` imbalance **2.91** against `gather` **1.127**, which looks like a clean
+refutation of the reviewer — **but it is not**, and claiming so would repeat a mistake we have
+already made twice. The 1.127 comes from a 10-warm-step window; the rank-5 pathology **develops
+between steps 80 and 160** (at 80 steps `rhs` imbalance is 1.06 and there is no straggler). The two
+numbers describe different regimes and cannot be compared.
+
+**The settling run is cheap and the instrument already exists.** The per-rank gather reporting added
+this session (`PR_ID = [PH_RHS, PH_REFLUX, PH_GATHER, PH_SEAM]` in `m_phase_timing.fpp`) prints
+per-rank `gather` alongside per-rank `rhs`. A single 160-step run with the current binary answers it:
+if rank 5's `gather` is flat while its `rhs` is 4x, the L0-sourcing mechanism is out; if `gather`
+skews with it, the balancer track is dead and A6/B-class fixes are the ones that pay.
+
+Add the two counters the reviewer suggests to make it unambiguous: per rank per regrid,
+**blocks-arrived/blocks-departed** (partitioner churn) versus **coarse-gather bytes sourced**
+(subdomain churn).
+
+### Earlier hypothesis (SUPERSEDED by the above — keep for the reasoning, not the conclusion)
+
+We have measured, at *identical* `fine_work`: rank 5 spends 976 s in `rhs` vs ~245 s for the other
+seven, and separately that rank 0 frees 4-5 slots/regrid while rank 5 frees 57-60 — **12x the
+churn**. Rank 5 is also the highest-`nloc` rank. The literature above says churn is a first-class
+cost, which makes "the sick rank is the high-churn rank" a candidate mechanism rather than a
+coincidence. It is currently only a correlation across two separately-measured quantities; the test
+is to plot per-rank churn against per-rank `rhs` time in a single run. See
+[[amr-one-sick-rank]] and [[amr-reflux-is-the-sink-not-the-source]].
+
+### Corrections to earlier reading
+
+- **Zoltan's `LB_APPROACH` applies only to `GRAPH`/`HYPERGRAPH`** — there is no migration-vs-quality
+ dial for RCB/RIB/HSFC. The geometric equivalent is `RCB_REUSE` (default 0), which has no
+ published payoff.
+- The ITR dial's real useful range is **~2x**, not orders of magnitude: sweeping it over six
+ decades buys 2.33x worse cut for 2.0x less redistribution, with the knee between 0.1 and 1.
+- **Enzo-E has no measured load-balancing result anywhere**; its "cello" balancer is three lines of
+ equal-count SFC cut. Its architectural claims should not be cited as measurements.
+- **`GreedyRefine` semantic trap**: the old `+LBPercentMoves` was a *migration* budget; the current
+ TreeLB `tolerance` is an *imbalance* budget (default 1). Cite the old parameter if citing it as
+ prior art for a migration budget.
+
+**Caveat to carry**: Walshaw also finds that when load changes *dramatically*, repartitioning from
+scratch can win outright. This is a regime question, and our regrids are frequent and incremental —
+which is the regime where diffusion wins — but that should be checked, not assumed.
+
+What is genuinely absent from the literature is an end-to-end **wall-clock** attribution on a GPU
+AMR code. MFC would be producing that datum, not reproducing it.
+
+## Ranked items from the SAMRAI/Chombo/Uintah review (2026-08-19)
+
+**The reframing:** none of SAMRAI, Chombo or Uintah puts migration cost in the partitioning
+objective — all three balancers are pure `(boxes, weights) -> owners` with no `previous_owner`
+input. `s_amr_sfc_cut` has the same signature shape. **MFC is not doing anything unusual; it is
+missing the compensating mechanisms**, which live elsewhere: metadata-only movement, a gain
+threshold, and anti-churn logic in the *regridder* rather than the balancer.
+
+| # | item | LOC | confidence |
+|---|---|---|---|
+| A7 | **Hysteresis on the SFC cut.** Keep the previous `amr_fine_cut(:,lev)`, adopt the new one only if it improves max-rank load past a threshold. This is Uintah's `gainThreshold` (0.05) and WarpX's ratio threshold (**measured optimum 10%**; 5% churns too much, 15% too little). No correctness risk — any owner map is valid. | 30-50 | high |
+| A1 | **Per-block constant term in `s_amr_block_cost`.** Uintah ships `patchCost = 16` cells; SAMRAI added `minimum_patch_load` for exactly the regime "uniformity in patch count matters more than in cell count". Our per-block constant is almost certainly large given the measured per-region overhead. | ~10 | high |
+| A10 | **A dedicated migration phase bracket.** Uintah instruments regrid / LB / schedule / migrate separately, and that separation is what let them identify migration as the AMR-ICE scaling limiter. Makes the A5 question answerable in one run. | ~10 | high |
+| A2 | **Fit the cost coefficients to measured per-block time** (Uintah `ModelLS`: regress time on `[cells, ib_cells, pc_iters, 1]`, Cholesky on the normal equations, smooth the *coefficients* with `alpha = 2/(min(iter,T)+1)`, T~20). Yields A1's constant automatically and is far more robust than using raw per-block times as weights. | 80-120 | medium |
+| A6 | **Batch the per-block regrid data motion.** SAMRAI fills a whole new level with **one `RefineSchedule`**; Chombo with **one `copyTo` + one `Copier`**. We do one `s_amr_gather_coarse_patch` per block with its own allocs and P2P set. *"SAMRAI can afford a churn-blind partitioner precisely because moving load meant moving only metadata, not voluminous mesh data."* Converts churn from O(blocks) to O(1) plans. | weeks | high value |
+| B3 | **Free each old slot as its overlap contribution is consumed**, rather than all of them after. Drops the peak toward `max(live_old, live_new)` instead of the sum. A reordering, not a redesign — but see sec. 9.2: the stash is read at old indices throughout the rebuild, so this needs per-block liveness, not a bulk move. | ~30 | medium |
+
+**A4 — the negative result to heed before investing in measured cost.** Uintah's dissertation found
+the measured filters *"perform worse than the model immediately following a regrid... and load
+balancing will always occur immediately following a regrid."* WarpX's tuned optimum used the
+**heuristic**, not the measured GPU clock, and CUPTI-based measurement made their run **2x slower**.
+If we regrid every 2 steps, a fitted algorithmic model (A2) is defensible; direct per-block timing as
+the weight is the risky one.
+
+**A3 — keep cost keyed to SPACE, not block identity. We already do this and should not stop.**
+Uintah deliberately profiles on a fixed lattice of regions, *"so the patch set can change without
+needing to migrate forecasting data between the changing patch sets."* Our footprint-integral
+formulation is right. Seed new blocks with the **domain-average** weight, as Uintah does.
+
+**A relevant measured counterpoint to more/smaller blocks (WarpX):** 150 boxes/GPU gave *better*
+load-balance efficiency but *worse* walltime than 9 boxes/GPU (1040 s vs 896 s), "because the
+overhead associated with a greater number of boxes outweighs the performance benefit." Three
+independent sources converge on **boxes per rank >= 3-4** as the parameter that actually governs
+balance quality.
+
+### Two source cautions
+
+- **Chombo's design document does not describe the code that ships.** It says `LoadBalance` uses
+ Kernighan-Lin knapsack; the KL knapsack has **zero callers outside a unit test**. The shipping path
+ is single-pass greedy bin-fill, and the Morton sort its comment assumes is a separate function the
+ application must call and the flagship examples do not. Do not cite Chombo as knapsack prior art.
+- **Chombo's petascale numbers are not evidence about load balancing** — the 196K-core run
+ *replaced* the balancer with lexicographic assignment. IPDPS'09 measured that load balance and
+ communication volume were *"the lowest priority"* impediments.
+
+## Phase 2 — the convoy pilot (days; ~40-60 LOC)
+
+freg pre-post: post ALL participant IRECVs at stage start with per-block tags (buffers are already
+per-block: `freg(D)%%lo(:,:,:,amr_cur)`), one WAITALL before the apply loop; owner hoists its
+per-block WAITALL identically. Keep the subcycle twin (`m_time_steppers.fpp:793`) blocking — the R1
+lesson: grep every generated/secondary call site, not the wrapper.
+
+Gate on counts + per-call time: reflux ms/call at 160 steps should collapse toward its 80-step
+value if the convoy mechanism is real. **This pilot is the go/no-go for the whole aggregation
+family (Phase 3). If it is null, STOP and re-diagnose before spending Phase 3's ~500 LOC.**
+
+## Phase 3 — per-level aggregation family (weeks; conditional on Phase 2)
+
+In value/risk order, re-priced against post-Phase-1 budgets before each:
+
+| item | today's share | LOC | risk |
+|---|---|---|---|
+| 3.1 L1 gather recv batching (`rb:wait`) | ~5% | 60-100 | medium |
+| 3.2 post-stage restrict/freg chain (bracket first via 0.3) | ~4-6% + kills the step-to-step skew feedback | 100-150 | med-high |
+| 3.3 fill-gather aggregation (per-block `amr_cg` patches, ~0.5 GB; cached overlap lists exist) | gather 13-17% | 150-300 | high |
+| 3.4 seam halo aggregation | 2.5-4% | 60-100 | medium |
+
+All four share Phase 2's pattern: post-all, per-block tags, one drain, cached lists, aggregation
+WITH a sync point (never bare deferral).
+
+## Phase 4 — regrid modernisation (weeks)
+
+4.1 Device-side rebuild (prolong + stash on device): `rg:mig` 6.7% + `rb:ovl/slot` ~6%; ~120-200
+LOC; HIGH risk — the documented history (device kernels silently not emitted in large routines,
+the 3-change NaN). Piecewise, probe-first, one change per A/B. 4.2 capture-sweep precompute (~40
+LOC, low-med) when rhs's non-busy share is re-measured post-Phase-1.
+
+## Phase 5 — endgame (after the tax is stationary)
+
+5.1 Cost-weighted balancer (AMReX `makeKnapSack` shape; infra exists in `m_load_weight`) — ONLY if
+per-rank data still shows skew after Phases 1-3; under convoys it is absorbed, and after the ratchet
+fix there may be nothing left to balance. 5.2 The honest AMReX head-to-head: matched cap 64, same
+regrid_int, DIFFERENCED protocol both sides, `amr_buf` scaled with interval and matched `fine_work`
+as an iterated gate — meaningful only once MFC's tax is a number again. 5.3 Multi-node scaling
+(the per-box lattice anti-scales; Phase 3 is what changes that slope).
+
+## Standing rules (the short list; canon in `amr_tax_review.md` sec. 8 and the memory index)
+
+- Bracket before believing; counts before wall; one clock per ratio; never compose across runs.
+- Every number carries its operating point AND its time window.
+- From-scratch runs; VRAM settle gate between GPU runs; stderr for anything that must survive an
+ abort; `gate_phases.py` before every build; grep generated twins for every touched call site.
+- np=2 dynamic-regrid is the minimum correctness bar for anything touching slots, stash, or
+ exchanges — np=1 and single-rank goldens prove nothing about this code.
+
+## Expected trajectory (estimates, not promises)
+
+Phase 1: production tax becomes a NUMBER again (~4x static at int=20) and long runs work.
+Phases 2-3: the ~27% static per-box communication share compresses -> ~2.5-3x. Phase 4: regrid's
+residual halves -> ~2-2.5x, at or below AMReX's 3.40x on its own protocol. Floor: the physics is
+already at parity (per-cell arithmetic 0.96x uniform at cap 64) — everything above 1.0x is
+infrastructure, and every line of it is now attributed.
diff --git a/docs/documentation/amr_block_batching.md b/docs/documentation/amr_block_batching.md
new file mode 100644
index 0000000000..780d6963c0
--- /dev/null
+++ b/docs/documentation/amr_block_batching.md
@@ -0,0 +1,2169 @@
+@page amr_block_batching AMR per-rank block batching
+
+# AMR per-rank block batching (design note)
+
+> **Design record / implementation note.** This documents the measured cost of the swap-based
+> per-block advance and the design it implies. For user-facing behavior and parameters, see
+> @ref amr. For the fine-level distribution across ranks, see @ref amr_fine_distribution.
+
+Status: **not implemented.** This note records the measurement, the state inventory, and the
+increment plan, so the work can be picked up without re-deriving any of it.
+
+## Problem
+
+Within a rank, owned blocks advance **sequentially**: `s_amr_swap_to_fine` overwrites the
+solver's global grid state with one block's, the block advances, `s_amr_restore_coarse` puts
+the coarse state back, and the next block repeats. Per-rank wall time therefore scales with
+the *sum* of its blocks' work, so strong scaling saturates exactly when the fine-level
+distribution succeeds at giving ranks many small blocks.
+
+## Measurement
+
+`l0_ntile` tiles the base grid into `l0_ntile**d` blocks advanced through the *same*
+swap-based per-block solver, with a correctness bar of byte-identical to `l0_ntile = 0`.
+Grid, flops, and answer are fixed; only the number of swap/advance cycles varies. So
+`cost(ntile) - cost(monolithic)` isolates the per-block overhead exactly.
+
+Measured on MI250X (amdflang AFAR 23.2.0, OpenMP offload), 2D uniform grid, np=1, 30 steps.
+Byte-identity verified at every point (restart md5 identical across tile counts).
+
+| `l0_ntile` | blocks | TimeAvg (s) | vs monolithic |
+|---|---|---|---|
+| 0 | monolithic | 0.04502 | 1.00x |
+| 1 | 1 | 0.04527 | 1.01x |
+| 2 | 4 | 0.19811 | 4.40x |
+| 4 | 16 | 0.75420 | 16.75x |
+
+cost/blocks = 1.01, 1.10, 1.05: **linear in block count, each block advance costing about as
+much as advancing the whole grid** while holding 1/16 the cells.
+
+It does not amortize with problem size:
+
+| N | monolithic (s) | 16 blocks (s) | ratio |
+|---|---|---|---|
+| 128^2 | 0.0427 | 0.7675 | 17.96x |
+| 256^2 | 0.0450 | 0.7542 | 16.75x |
+| 512^2 | 0.0511 | 0.7843 | 15.36x |
+
+The 16-block time is flat (~0.77 s) across a 16x increase in cells, and so is the monolithic
+time. Both are fixed-overhead bound at these sizes; the GPU is far from saturated. The
+penalty is still 15x at 512^2.
+
+**Conclusion: per-block cost is independent of block size.** It is fixed overhead per block
+per RK stage, not work — dominated by per-block kernel launch count plus the per-swap device
+syncs, none of which shrink as blocks shrink.
+
+**Confirmed 2026-08-02 with AMR ACTIVE (the sweeps above are uniform-only / one fine block).**
+2D 4096x2048, np=2, corner-refined so each rank already advances 16 fine blocks, varying only
+`l0_ntile`. The right independent variable is TOTAL block advances per rank, \f$I = 16 + T\f$
+with \f$T = \texttt{l0\_ntile}^{2}\f$ — not the tile count alone:
+
+| `l0_ntile` | \f$T\f$ | advances \f$I\f$ | \f$I/I(1)\f$ | measured | agreement |
+|---|---|---|---|---|---|
+| 0 | 1 | 17 | 1.000 | 1.000 | — |
+| 2 | 4 | 20 | 1.176 | 1.362 | +16% |
+| 3 | 9 | 25 | 1.471 | 1.610 | +9% |
+| 4 | 16 | 32 | **1.882** | **1.932** | **+3%** |
+
+Cost tracks total block advances, converging to 3% at the largest point. The excess at small
+\f$T\f$ is expected: an L0 tile starts far larger than a fine block and costs more per advance,
+converging as it shrinks toward fine-block size — i.e. per-advance cost is *weakly* size-dependent,
+not perfectly flat.
+
+> **Recorded because I got it wrong.** Fitting the same law on \f$T\f$ ALONE — ignoring the 16
+> fine-block advances already in the step — predicts 2.77x at \f$T=16\f$ against 1.932x measured, a
+> 30% overprediction, and briefly looked like a falsification of the per-block floor itself. The floor
+> is real; the fit used the wrong variable. Any future sweep of this kind must count EVERY block advance
+> in the step, not just the ones being varied.
+
+> **SCOPE LIMIT added 2026-08-01: the launch-count premise below holds only at LOW block counts.**
+> Profiling a 320-block 3D case (`rocprofv3`, kernels + memory copies, np=2) puts kernel execution at
+> 8.5% of the span, device-to-device copies at 23.5% (2937729 of them, 20.5 per kernel), and the GPU
+> idle ~68%. Mean kernel duration is 69 us, and 143k launches at 10 us each is ~1.4 s against ~82 s of
+> idle - launch count is not in the top two cost terms at that scale. The measurements in this section
+> were taken on a 16-tile / 1-fine-block case and remain valid there, but **ranking increments by
+> "launches removed" does not generalize to the many-block regime this arc exists to fix.** See
+> @ref amr_per_level_distribution, queue item 14, including its sizing caveat.
+
+## Direct confirmation: the cost is kernel launch count
+
+Counted with `rocprofv3 --kernel-trace` (2D 128^2, 6 steps, np=1, under `srun`):
+
+| | monolithic | 16 blocks (`l0_ntile=4`) | ratio |
+|---|---|---|---|
+| GPU kernel launches | 381 | 7619 | **20.0x** |
+| wall time (256^2 sweep) | — | — | 16.75x |
+
+Launch count scales 20x with block count while wall time scales 16.75x, so the per-block
+cost tracks launches directly. This is measured, not inferred: combined with the refuted
+hoist below (removing swap traffic changed nothing), it closes the argument that the fixed
+per-block cost IS the launch count. Note each tile advance issues ~450 launches against the
+monolithic step's 381 — the per-block path adds its own ghost fills and halo work on top of
+the same RHS kernel sequence.
+
+### Where the launches go, and what rides on them
+
+Repeated at 2048x1024 with dynamic regrid (6 steps, np=1), tracing memory copies as well —
+note `--kernel-trace` **alone leaves the copy table empty**, so pass `--memory-copy-trace`
+too or the transfers below are invisible:
+
+| | uniform | AMR | ratio |
+|---|---|---|---|
+| kernel launches | 381 | 4619 | 12.1x |
+| device-to-device copies | 7,094 | 88,667 | 12.5x |
+| kernel busy time | 297 ms | 601 ms | 2.0x |
+| wall span | 716 ms | 4264 ms | **10.9x** |
+
+Wall time tracks launches (12.1x vs 10.9x), not kernel work (2.0x): about 86% of the AMR span
+is GPU idle between kernels. Splitting AMR's launches by whether the kernel also appears in
+the uniform run:
+
+- **shared-solver kernels** — the per-block `s_compute_rhs` re-invocation — **3165 launches,
+ 565 ms: 69% of launches and 94% of kernel time**;
+- AMR-only kernels (ghost fills, seam halo, RK update, flux capture, reflux): 1454 launches
+ but only 36 ms, **6%** of kernel time.
+
+So further fusion of the AMR-side kernels is worth much less than its launch share suggests.
+The lever is reducing `s_compute_rhs` invocations.
+
+The ~89k copies are **not** a separable AMR inefficiency: normalised per launch they are 18.6
+(uniform) and 19.2 (AMR) — kernel-argument marshalling that the uniform solver pays too.
+There is nothing to batch there. This reconciles the refuted hoist below rather than
+contradicting it: transfers are not independently expensive, they are the mechanism by which
+launch count costs time. Cutting `s_compute_rhs` calls cuts launches and their copy traffic
+together.
+
+### Regrid is 7-10% of runtime, not half
+
+An earlier revision of this note inferred "regrid costs about half the runtime, roughly one
+time step per regrid" from an A/B on `amr_regrid_int` (0.2974 s -> 0.1525 s per step at np=4
+going from every-2-steps to every-10). **That inference is wrong and is retracted.** Varying
+`amr_regrid_int` does not hold the block set fixed: regridding less often leaves staler,
+generally smaller boxes, so the A/B prices the blocks a regrid *produces* together with the
+regrid itself. Per-phase `system_clock` instrumentation inside `s_amr_regrid` measures the
+cost directly (2048x1024, 20 steps, `amr_regrid_int=2`, so 10 regrid calls):
+
+| | np=1 | np=4 | np=8 |
+|---|---|---|---|
+| full rebuilds / early-outs | 2 / 8 | 2 / 8 | 2 / 8 |
+| total regrid time | 0.955 s | 0.459 s | 0.602 s |
+| total run time | 13.0 s | 5.8 s | 6.2 s |
+| **regrid share of runtime** | **7.3%** | **7.9%** | **9.7%** |
+
+Most regrid calls are cheap: 8 of 10 find the box set unchanged and return after tagging
+(~0.028 s at np=1, ~0.007 s at np=8), so only the two full rebuilds cost anything. Regrid is
+therefore **not** comparable to the block advance, which remains the dominant lever rather than
+one of two equal halves. (This sentence originally named the *packed super-grid* as that lever.
+Packing is DISPROVED below - the lever is the per-invocation cost of the advance itself, which
+packing cannot remove.)
+
+Where a full rebuild's time actually goes differs with rank count:
+
+- **np=1** is the host round trip of fine block state: pulling each old block to the host and
+ bouncing it through `q_cons_stor` (0.159 s), the host-side `s_interpolate_coarse_to_fine`
+ (0.042-0.091 s) and overlap copy (0.066 s), and pushing the new state back (0.043-0.146 s).
+ All of it is serial host work on data that is already resident on the device.
+- **np>=4** is dominated by *per-box synchronization*, not by any collective's own cost. The
+ per-box `MPI_ALLREDUCE` at the end of `s_set_amr_fine_geometry` measures 7.4 ms (np=4) to
+ 13 ms (np=8) per call, ~700x a real one-integer allreduce — because it is absorbing the
+ spread in the owner-only `s_amr_alloc_slot` work that precedes it. Inserting an
+ `MPI_BARRIER` at the top of the rebuild loop collapses that phase from 0.089 s to 0.0011 s
+ (np=4) and 0.119 s to 0.0001 s (np=8), with the barrier picking up the difference.
+ **Batching those allreduces into one buys nothing AT THIS BOX COUNT** (14-21 boxes, np<=8):
+ the time is the wait, not the reduction, so hoisting only moves the rendezvous. The rebuild
+ loop would have to stop synchronizing per box at all to help here.
+
+ **That conclusion is regime-limited and does not carry to scale.** With `nboxes` collectives the
+ cost has a floor of `nboxes x latency` independent of any imbalance - at 10^5 boxes that is ~0.5 s
+ of pure rendezvous per regrid, before a single byte of imbalance. The reduction was hoisted anyway
+ (@ref amr_per_level_distribution, "What actually blocks exascale") because it removes an O(nboxes)
+ term from the assignment; **expect no measurable change at the sizes benchmarked in this note**,
+ which is what this paragraph predicts.
+
+### The box set is not rank-invariant
+
+Same case, same steps, varying only rank count: the regrid produces 14 boxes at np=1, 2, and
+4, but **21 at np=8**. `amr_maxc_fit` is the min over ranks of the local half-extent, so more
+ranks shrink the cap until boxes that fit at np<=4 must be tiled. Total boxes rise 50% while
+per-rank boxes fall only 25% (3.5 -> 2.6), and every per-box collective in the rebuild loop
+runs over *all* boxes on *all* ranks. This is a concrete, previously unattributed mechanism
+for the np=8 turnover, and it ties that turnover to the same base-subdomain scratch cap — not to
+MPI collective volume. (Originally "the cap the packed super-grid has to address"; packing is
+DISPROVED below, and the cap was instead addressed directly by pinning `amr_max_grid_size`, which
+is what the "Resolved" note immediately following records.)
+
+**Resolved (2026-08-01): that was the DERIVED cap, and with `amr_max_grid_size` pinned the AMR
+machinery is exactly rank-invariant.** Measured on a 3D sharp-interface case (128^3, two slabs at
+a density ratio of 8, cap 32) at np = 1, 2, 4, 8: the level-1 tag sets are **byte-identical** —
+31752 tags, zero symmetric difference in the tagged cell coordinates — and that carries through to
+16 level-1 boxes and `fine_work` = 691200 at every rank count. The tagger, the `MPI_ALLGATHERV` tag
+union, the coarse-CONS halo exchange, and the signature clusterer are all rank-invariant as designed,
+including at np=1 where active-box windowing is active.
+
+**But a badly conditioned CASE will still make the box set look rank-dependent, and that is not a
+code defect.** The 2D benchmark pair (`hg8_*`, `sc_*`) uses the `hcid 299` multi-mode analytic
+perturbation, which leaves a large fraction of cells sitting marginally at `amr_tag_eps` = 0.02.
+Any floating-point-level difference then flips them wholesale: at np = 1/2/4/8 the level-1 tag
+counts were 26849 / 37674 / 53924 / 61924 and the tag SETS were nearly disjoint (np=2 vs np=8 shared
+**zero** cells; np=1 vs np=2 shared 77 of ~27000). Only 1.5–6.7% of tags lay on internal rank-seam
+planes, so seam effects were a minor contributor — the bulk was threshold marginality across the
+whole domain. Consequence: `fine_work` varied 5.4x with rank count (35.0M at np=1 to 188.8M at np=8),
+which makes any AMR strong-scaling number from that case meaningless.
+
+**Benchmark rule that follows.** An AMR scaling case must be verified rank-invariant BEFORE it is
+timed — compare `fine_work` and the per-level box counts across the rank counts to be used, and
+reject the case if they move. Prefer a sharp discontinuity (unambiguous tagging) over a smooth
+perturbation. The literature is explicit that AMR strong scaling is hard to interpret for exactly
+this reason (Athena++: work "is highly variable and depends on the refinement criteria"; PLUTO:
+strong scaling is "difficult to interpret in the case of AMR computations"), and the standard metric
+is zone-cycles/s — cell-updates summed over ALL levels, divided by wall time — which is what
+`fine_work` + base cells provides here. A second, complementary option is to freeze the hierarchy
+(`amr_regrid_int = 0`, valid up to `amr_max_level = 2`), which holds work constant by construction
+and isolates solver and halo scaling from AMR-decision variability.
+
+## What this rules out
+
+@ref amr says "per-slot state instead of the global swap" is the lever. That is necessary but
+**not sufficient**: it removes the per-swap state traffic, not the per-block launch count.
+Two specific traps:
+
+- Caching the swap-recomputed coefficient tables per slot removes the *host* recompute but
+ **not** the device transfers, because the WENO kernels read module-global arrays. Removing
+ the transfers requires the device-side arrays to be per-slot and the kernels to index by
+ slot.
+- Running K blocks concurrently in separate lanes multiplies the O(N^d) working set by K
+ without reducing launch count.
+
+The lever is **batching many blocks into single kernel launches over a block list**, not
+per-lane duplication.
+
+## State inventory
+
+Per-block *data* is already per-slot (`t_level`: `region`, `m/n/p`, `buff_size`, `idwbuff`,
+the nine coordinate arrays, `q_cons`, `q_cons_stor`, `q_prim`, `rhs`, `q_ghost_a/b`, and the
+QBMM side-state). What is still global, and must be indexed by block for a batched kernel:
+
+| Category | Items |
+|---|---|
+| Solver geometry (the SWAP CONTRACT) | `m/n/p`, `idwint`, `idwbuff`, nine coordinate arrays, `acoustic_source`, `ab_active` |
+| Derived per-grid tables | WENO coefficients (`poly_coef_*`, `d_cb*`, `beta_coef_*`), hypoelastic FD coefficients, IGR `jac`/`jac_old` (bounced via `sw_jac`) |
+| Scratch justified by sequential advance | `amr_cg` + `amr_cpat_off/hi`, `amr_rvw`, `amr_rhs_pb_f`/`amr_rhs_mv_f` (the last is explicitly commented "shared across slots (slots advance sequentially)") |
+| RHS working set | module allocatables across `m_weno`, `m_rhs` (including its `vector_field` set, which dominates), and `m_riemann_solvers`, all sized to the base subdomain. `m_viscous` holds no volumetric scratch and does not contribute. |
+
+The RHS working set being base-subdomain-sized is also why a block is capped at about half the
+subdomain per dimension: the fine advance borrows the rank-local solver scratch. The enforced
+cap is `amr_maxc_fit` (min over ranks of the local half-extent), **not** `amr_maxc` — the
+latter is the global half and is read nowhere outside its own computation. For non-IB a box
+exceeding the cap is **tiled**, not rejected; that tiling is one of the ways the many-blocks
+regime this note addresses is produced. Only IB, which must own a body's block whole and
+un-tiled, aborts.
+
+## Why this gates the other arcs
+
+The same cap is what blocks multi-level coexist: relaxing the `amr_max_level > 1` clause of
+the `m_checker.fpp` `l0_ntile > 0 .and. amr` gate produces
+`the nested level-2 block exceeds the per-rank scratch cap (2*L0-extent > amr_maxc_fit);
+static multi-level does not tile the level-2 block`. So the coexist gate and this note's
+redesign are blocked on the same single-working-slot architecture, not on independent work.
+Sequencing the batching arc *after* the unification arc therefore risks reworking it.
+
+## Strong-scaling baseline (the "before" curve)
+
+Track 3's evidence artifact is a strong-scaling curve. The baseline, measured on the same
+machine, 2D 256^2, static single-level AMR, 20 steps:
+
+| np | compact block (32x32 coarse) | wide block (128x32 coarse) |
+|---|---|---|
+| 1 | 0.1009 s (1.00x) | 0.1009 s (1.00x) |
+| 2 | 0.0980 s (1.03x) | 0.1190 s (0.85x) |
+| 4 | 0.0983 s (1.03x) | 0.1267 s (**0.80x**) |
+
+**AMR does not strong-scale, and wide blocks anti-scale.** Both cases hold exactly one fine
+block (a static block cannot exceed `amr_maxc_fit`, so tiling never triggers), and single-owner
+distribution puts all of its work on one rank whatever `np` is. The compact case is
+therefore flat: extra ranks only split the coarse grid, which is not the bottleneck. The
+wide case is worse than flat because the block spans more ranks' coarse subdomains, so each
+added rank buys more coarse<->fine P2P gather/scatter with no fine parallelism to offset it.
+
+Caveat: this measures the single-block regime. It does not test multi-block distribution —
+reaching several blocks needs dynamic regrid, since a static block is capped at
+`amr_maxc_fit`.
+
+### The multi-block curve
+
+Measured with dynamic regrid and many disjoint tag clusters, 2D 2048x1024, 20 steps, median
+of the solver's steady `Time/step` (**not** `Time Avg`, which is a running mean still
+carrying startup and therefore a function of run length):
+
+| np | AMR | speedup | uniform control | speedup |
+|---|---|---|---|---|
+| 1 | 0.6634 s | 1.00x | 0.0611 s | 1.00x |
+| 2 | 0.3971 s | 1.67x (84%) | 0.0509 s | 1.20x (60%) |
+| 4 | 0.2974 s | 2.23x (56%) | 0.0463 s | 1.32x (33%) |
+| 8 | 0.3720 s | 1.78x (22%) | 0.0427 s | 1.43x (18%) |
+
+This **supersedes the single-block conclusion above**: with several blocks to distribute, AMR
+does strong-scale, and scales better than the uniform control through np=4. It then turns
+over at np=8, a 25% regression the uniform arm does not show.
+
+The number batching must move is the np=1 column: **AMR costs 10.9x the uniform solver on the
+same grid**, and the ratio grows with problem size (5.7x at 256x128). That is the per-block
+serial advance.
+
+Two cautions for anyone repeating this. Run the **uniform control** arm — without it a rising
+AMR curve cannot be told apart from a problem too small to scale, and at 256x128 AMR appears
+to *anti*-scale (+65% from np=1 to np=8) purely because fixed per-step overhead dominates a
+32k-cell workload. And measure at a realistic size: the small case gives a qualitatively
+wrong answer.
+
+## Swap topology (and what blocks the obvious optimization)
+
+The hot path has exactly **one `s_amr_swap_to_fine` / `s_amr_restore_coarse` pair per block
+per RK stage**, wrapping `s_compute_rhs` in `s_amr_fine_stage_rhs` (and its subcycle twin).
+The RK pass (`s_amr_fine_stage_rk`) does not swap — it works on slot arrays at slot extents.
+The fill phase does not swap either; it reads the gathered patch `amr_cg` and slot arrays.
+So a timestep costs `3 * nblocks` swap round-trips, each carrying
+`s_amr_sync_grid_state_to_device` plus, on nonuniform grids, `s_amr_recompute_weno_coefs`.
+
+The obvious cheap win — hoist the restore, letting consecutive blocks swap fine->fine and
+restoring once per phase — has **two** blockers, not one.
+
+1. *Reflux in the coarse frame.* `m_time_steppers` called `s_amr_p2p_reflux_faces` and
+ `s_amr_apply_reflux` between blocks inside the advance loop, both operating on the coarse
+ `rhs_vf` at coarse indices. **Resolved:** the advance and reflux loops are now split
+ (phase 3 advances all blocks, phase 4 refluxes), so the reflux runs in the coarse frame
+ after the advances rather than interleaved with them.
+2. *Nested swap sites inside the RK pass.* Still open, and the larger of the two.
+ `s_amr_fine_stage_rk` reads no grid globals itself (slot arrays plus `dt` and feature
+ flags), but it calls `s_amr_pressure_relax_fine`, `s_amr_ib_correct_fine`, and
+ `s_amr_update_mib_fine`, and **each opens its own `s_amr_swap_to_fine` /
+ `s_amr_restore_coarse` pair**. They assume the coarse frame on entry. With the restore
+ deferred they would swap while already swapped and trip
+ `@:ASSERT(.not. amr_swapped, "nested s_amr_swap_to_fine (swap/restore must pair)")`.
+
+ **Resolved:** the swap is now depth-counted and re-entrant — only the outermost swap
+ saves into the `sw_*` bounce buffers, only the outermost restore puts them back, and an
+ inner swap re-installs the same slot idempotently. No nesting occurs yet, so depth never
+ exceeds 1 and behavior is unchanged.
+3. *The IGR sigma bounce is save-and-seed in one routine.* Still open. `s_amr_swap_to_fine`
+ ends with `if (igr) call s_amr_igr_swap_sigma()`, which BOTH saves the coarse
+ `jac`/`jac_old` into `sw_jac`/`sw_jac_old` AND seeds the block's sigma from the parent —
+ and it reads `sw_idwbuff` for the coarse extent. Once nesting is actually used, an inner
+ swap would re-run it and overwrite `sw_jac` with fine state.
+ **Resolved:** the save loop is depth-guarded, the seed loop is not. The seed reads
+ `sw_jac`, which still holds the coarse state, so every nested block seeds from the correct
+ parent — guarding only the save is both necessary and sufficient.
+
+ Note this routine already caused an OpenACC-only crash (its own comment: the `sw_*`
+ host-only module state "makes OpenACC's present lookup fail (OpenMP's implicit map(to)
+ tolerates it, which is why only acc lanes crashed)"). It is a worked example of why an
+ OpenMP-offload pass does not validate this area, and it is the reason the Frontier acc
+ lane is the real gate for anything that changes how this routine nests.
+
+With all three resolved, hoisting the restore became a small change, and it was **built,
+measured, and abandoned**. Record of that, so it is not retried:
+
+A `s_amr_swap_hold` entry point (save the coarse state without installing a slot) was added
+and the per-tile RHS loop in `s_l0_advance_stage_rhs` was bracketed with it, so consecutive
+tiles went fine->fine with one coarse restore after the loop instead of one per tile. Output
+stayed byte-identical. The `l0_ntile` sweep, 2D 256^2, np=1:
+
+| `l0_ntile` | tiles | with hoist | without |
+|---|---|---|---|
+| 0 | monolithic | 1.00x | 1.00x |
+| 1 | 1 | 1.01x | 1.01x |
+| 2 | 4 | 4.32x | 4.40x |
+| 4 | 16 | **16.87x** | **16.75x** |
+
+**No effect.** The coarse round trip between blocks — its `sw_*` copies, its device sync, its
+WENO/FD coefficient rebuild — is not a measurable share of the per-block cost, even at 16
+blocks where the total penalty is ~17x. The change was reverted rather than carried as
+unused machinery.
+
+This sharpens the conclusion above: the per-block cost really is **kernel launch count**
+inside `s_compute_rhs`, not swap traffic. Reducing swap traffic in any form (per-slot
+coefficient tables, per-slot device grid state, hoisted restores) should be expected to do
+nothing on its own. Only increment 3 — one launch over a block list instead of one launch
+set per block — addresses the measured cost.
+
+The three prerequisites remain resolved in the code, so a future batching attempt does not
+have to redo them; note they currently have no caller and are unused generality.
+
+Note the SWAP CONTRACT warning in `.claude/rules/common-pitfalls.md`: a stale device copy of
+coarse bounds reads out of range on the fine grid under **CCE OpenACC only**. A CPU-only or
+NVHPC-acc pass proves nothing for this class, so any swap-contract change needs a Cray GPU
+run before it can be trusted.
+
+## Increments
+
+### 0. Same-rank seam exchange — LANDED (`2e7151fa`)
+
+`s_amr_fine_seam_exchange` replaced the four `s_amr_fine_slice` calls in the same-rank branch of
+`s_amr_fine_fine_halo` with ONE fused device kernel doing both directions. Byte-identical.
+Measured (2D 64x32, `l0_ntile=4` = 16 tiles / 24 seam pairs, MI250X): launches 10561 -> 7969
+(`rocprofv3`), Time Avg 0.8179 -> 0.7121 s, n=3 per arm, **ranges disjoint**; run-to-run variance
+also collapsed 3.3% -> 0.5%.
+
+**Two rules this increment established, which govern everything below:**
+
+- **Rank increments by LAUNCHES REMOVED. Credit transfer savings at zero.** The intermediate step
+ (device-to-device but still 2 kernels/pair) was worth **+0.03%** — removing four blocking
+ device<->host round trips per pair per stage bought *nothing*, while going 2 -> 1 kernels bought
+ 13%. On this machine launch count is the cost and small-slab PCIe traffic is free.
+- **Measure with `rocprofv3 --kernel-trace`, not wall time.** Back-to-back runs scatter 0.17%; runs
+ separated in time scatter 3%+. A 1.7% "win" was once reported here that was pure noise.
+
+### Why this arc is now the main line
+
+Per-level distribution is done and its cost model is fixed (@ref amr_per_level_distribution, steps
+4-7). Measured imbalance is now 1.012 at np=4 — 98.8% of perfect — while parallel efficiency on the
+same run is only 62%. **Balance has been eliminated as the limiter by fixing it**, and the residual
+is the per-block fixed overhead measured below. This arc is what remains.
+
+### DISPROVED (2026-08-01): the packed super-grid cannot work, because blocks are already slot-sized
+
+The packed super-grid — lay \f$P\f$ same-level blocks contiguously along x in one slot and call the
+unmodified `s_compute_rhs` once — is **arithmetically impossible for tiled blocks**, at every level
+and every rank count. It is not a scheduling or memory-budget problem; there is no \f$P>1\f$ to reach.
+
+Each packed block keeps its full buffered extent, so \f$P\f$ blocks of fine extent \f$f\f$ need
+\f$P(f + 2\,\texttt{buff\_size}) - 2\,\texttt{buff\_size} \le \texttt{max\_f1} + 1\f$. Writing the
+block's coarse extent as \f$b_c\f$ and the cap as \f$C\f$ (so \f$\texttt{max\_f1}+1 = 2C\f$):
+
+\f[ P_{\max} = \left\lfloor \frac{C - b_c}{b_c + \texttt{buff\_size}} \right\rfloor + 1 \f]
+
+so \f$P>1\f$ requires \f$b_c \lesssim C/2\f$. But `s_amr_tile_box` splits **evenly**:
+\f$n_{tl} = \lceil e/t_c \rceil\f$ then \f$s = \lceil e/n_{tl}\rceil\f$, which for \f$n_{tl}\ge 2\f$
+gives \f$s > t_c(1 - 1/n_{tl}) \ge t_c/2\f$. **Every tiled block therefore exceeds half the tile
+size, and \f$P_{\max} = 1\f$ identically.** The tiler's purpose is to make blocks as large as the
+slot permits, so a slot sized to hold one maximal block can never hold two.
+
+Measured on the 75.5M case (2D, np=8, `amr_max_blocks` = 4096) with a temporary probe printing each
+level's block extents against `max_f1` — level-1 blocks come out *exactly* slot-sized at every cap:
+
+| `amr_max_grid_size` | `max_f1` | level-1 `fx_min`/`fx_max` | \f$P\f$ | blocks packable 2-up |
+|---|---|---|---|---|
+| 128 | 255 | 240 / 256 | 1 | 0 of 4096 |
+| 256 | 511 | 496 / 512 | 1 | 0 of 1152 |
+| 512 | 1023 | 1008 / 1024 | 1 | 0 of 288 |
+| 1024 | 2047 | 2032 / 2048 | 1 | 0 of 72 |
+
+Level 2 leaves 2–3 blocks per run small enough to pack, out of 128–1156 — under 0.3%.
+
+This also retires the "packing is 7x at np=1 but collapses to ~2x at np>=4" table. That table was
+never about rank count in the way it read: it came from a case (2047x1023, 7 stripes) whose blocks
+were 108 coarse cells against a 1024 cap, i.e. *untiled* clustered boxes far below the cap — a
+regime that does not survive a pinned cap at production scale. Separately, the rank-dependence it
+worried about is genuinely gone: `amr_max_grid_size > 0` makes both the pack slot
+(`amr_maxc_fit(d) = min(amr_maxc(d), amr_max_grid_size)`) and the solver scratch
+(`idwbuff_alloc`, `m/n/p_alloc`) independent of the decomposition. \f$P_{\max}=1\f$ regardless.
+
+Reviving packing would require a pack buffer and solver scratch sized \f$P\times\f$ a maximal block —
+a genuinely new allocation, which is exactly the cost the design's "no new allocation is needed"
+scope cut claimed to avoid. That cut relied on the np=1 coincidence \f$\texttt{max\_f1} = m_{glb}\f$,
+which the pinned cap removes by construction.
+
+### The lever that does exist: block size, bounded by device memory
+
+Since per-block cost is near-fixed, the way to spend it on fewer blocks is to make each block bigger —
+which is the `amr_max_grid_size` parameter, not new code. Same case and ranks, varying only the cap
+(@ref amr_per_level_distribution, "The per-block floor"): 70.3 s/step at cap 128 versus 8.5–9.5 at
+cap 1024, a ~20x span, *while the cap-1024 arm advances 2.8x more cells*.
+
+That does not extend indefinitely. Per-rank scratch is \f$O(C^{\,\texttt{num\_dims}})\f$, and at cap
+2048 this case aborts inside `__tgt_target_data_begin_mapper` — device out of memory — before
+completing a single step. The failure mode is worth knowing: one rank core-dumps and the rest block
+until the job is killed, so it presents as a hang. **The efficient regime is the largest cap that
+fits device memory**, which for this case at np=8 in 2D lies between 1024 and 2048.
+
+Even at the best measured cap the residual is ~7.3x uniform per cell (11.4 vs 1.55 ns/cell-update),
+so per-block overhead remains the target — but it must be attacked by making each block's advance
+cheaper (launch fusion, increments 1–3 below), not by combining blocks.
+
+### MEASURED 2026-08-02: the per-block tax is DUMMY ARGUMENTS, not launch count or descriptors
+
+Attributing 337,431 device copies to 16,698 dispatches (rocprofv3, temporal attribution, np=1 2D AMR):
+
+| kernel | dispatches | copies/dispatch |
+|---|---|---|
+| `m_amr::fine_rk_update` | 678 | 54.0 |
+| `m_riemann_solver_hllc` | 696 | 44.0 |
+| `m_rhs::compute_rhs` | 696 | 37.7 |
+| **`m_amr_registers::capture_boundary_flux`** | **1356** | **0.0** |
+| **`m_amr_registers::apply_reflux`** | 240 | **0.0** |
+
+Kernels reading MODULE-LEVEL `GPU_DECLARE`'d state (`freg`/`creg`, `m_amr_registers.fpp:56-57`) pay
+ZERO; kernels taking fields as DUMMY ARGUMENTS pay 33-54. Copy count matches the deep-member count
+exactly (`3*sys_size + q_T_sf + bc_type(2,2)` = 20 at `sys_size=5`, measured 20.2/dispatch). Total copy
+time 2.0 s against ~1.5 s of kernel time - a first-order cost.
+
+A 4-translation-unit reproducer (`amr-bench/attach/mtu/`) isolates the penalty at **4.3-4.7x per
+region**, including per-advance re-attach, and confirms cross-TU `declare target` residency, runtime
+slot indexing on device, and alternating attach targets all work.
+
+**Two hypotheses this KILLS.** Flattening the `scalar_field` interface (3,840 `%%sf` sites across
+`common/`) buys nothing - flat-array dummies measure the same as deep-allocatable ones. And batching
+attacks dispatch COUNT while the tax is per-dispatch argument mapping.
+
+**Conversion attempted on `s_amr_fine_rk_update` and REVERTED at 74/76.** Four failures, in order:
+`GPU_EXIT_DATA(detach=)` emitted `map(always,from:)` (copies back, drops residency -> NaNs);
+`GPU_ENTER_DATA(attach=)` emitted `map(always,to:)` (clobbers live device state with stale host values
+-> wrong answers); allocating the views behind `.not. amr` (pure-L0 reaches the routine via
+`s_l0_advance_stage_rk` -> segfault). The first two were real MFC bugs in clauses with ZERO in-tree
+users, now fixed to `map(always,alloc:)` / `map(release:)`.
+
+**THE OPEN BLOCKER, isolated by a control experiment: there is no correct ATTACH primitive for this
+backend.** Keeping the attach calls but reverting the kernel to read its dummy arguments fails
+*byte-identically* (`icfl Inf` on `00EB793A`, `8.357478479233075E+22` on `EF58E377`), so the kernel
+change is innocent and **the attach operation itself corrupts the slot's device data**:
+
+- `map(always,to:)` copies the STALE HOST array over live device state.
+- `map(always,alloc:)` forces a fresh, uninitialised device allocation, orphaning the live data.
+
+A device-side probe comparing the view against the dummy inside one kernel reads exactly zero
+difference, which is consistent rather than contradictory: both resolve to the same *wrong* buffer.
+That probe is worth keeping in mind - "the view resolves correctly" and "the view resolves to the right
+memory" are different questions.
+
+Only the multi-level cases fail because they regrid *and* advance most often; the static multi-level
+np=2 golden `09E0D257` passes. A standalone 6-phase reproducer
+(`amr-bench/attach/mtu/f_lifetime.f90`: attach-only, attach+detach, slot recycling, varying extents,
+realloc-at-new-extent) passes every phase, so this is an INTEGRATION property, not a property of the
+technique - an MWE de-risks the mechanism, not the integration.
+
+Before retrying: establish an attach primitive that neither copies nor reallocates on already-present
+data (candidates: `map(to:)` / `map(alloc:)` WITHOUT `always`, or `omp_target_associate_ptr`), and
+validate it against `00EB793A` specifically. Note `GPU_ENTER_DATA(attach=)` has 8 existing users in
+`m_rhs.fpp`/`m_igr.fpp`, so its expansion cannot be changed casually - they currently rely on the
+`always,to` behaviour.
+
+### HOW THE FIELD SOLVES THIS, and the plan to match it (2026-08-03)
+
+This is a named, solved problem elsewhere, and the consensus answer is the one this note originally
+proposed as increment 3.
+
+- **AMReX** fuses across boxes: *"If there are 512 patches of 32^3 cells each, only one GPU kernel is
+ launched to work on all 512 patches, which enables it to achieve similar performance as if operating
+ on a single patch of 256^3 cells."* They quantify the problem on OUR hardware: *"a simple kernel
+ running on an AMD MI250X will only achieve ~10% of its peak memory bandwidth on small boxes of 32^3
+ cells."* They apply the same fusion to halo pack/unpack, where *"the dominant cost was kernel launch
+ latency"*, reducing it to ONE launch per rank. (arXiv 2403.12179)
+- **Parthenon** does the same via `MeshBlockPack`, with the pack size *"hardware and problem dependent,
+ and so may be set at runtime."* (arXiv 2202.12309)
+- **Castro/AMReX gridding guidance**: *"Best performance is obtained with bigger boxes, so setting
+ `amr.max_grid_size = 128` and `amr.blocking_factor = 32` can give good performance"*; *"too small
+ max_grid_size may ruin the code performance."* This independently corroborates the cap finding.
+- **OpenMP offload specifically** carries higher per-region overhead than CUDA/HIP because of its device
+ runtime layer; LLVM offers a reduced "bare-metal" kernel mode. MFC pays more per operation than an
+ equivalent HIP code would, which raises the value of reducing operation COUNT.
+
+**MEASURED HERE (`amr-bench/attach/serial/batch.f90`), the same mechanism, same arithmetic, 64 blocks:**
+
+| | span | operations | copies/kernel |
+|---|---|---|---|
+| one launch PER BLOCK (MFC today) | 433.5 ms | 15370 | 0.0 |
+| one launch over ALL BLOCKS (AMReX/Parthenon) | **35.0 ms** | **250** | 0.0 |
+
+**12.4x, with byte-identical results.** Note BOTH rows show 0 copies per kernel because the store is a
+PLAIN CONTIGUOUS ARRAY. That resolves a contradiction earlier in this note: the per-region map traffic
+is not about module-scope versus dummy argument, it is about **plain array versus derived type with a
+pointer component**. Module-scope `scalar_field` measured 32.8 copies/kernel; a plain module array
+measures 0. AMReX's MultiFab is precisely the plain-contiguous-across-boxes layout.
+
+**PLAN TO MATCH THEM.** Three pieces, in dependency order, each golden-gated:
+
+1. **Flat contiguous backing store** - `real(stp) :: store(cell, var, block)` for the per-block field
+ families, replacing per-slot `scalar_field` allocations. This is the enabler for 2 and it removes
+ the descriptor traffic by itself. Sizing must come from max live blocks per rank, NOT
+ `amr_max_blocks` (1024 would OOM) - **step 1a landed this as `amr_loc_of`/`amr_loc_n`, byte-identical
+ across 76 goldens (`905e9d7c`)**.
+
+ **SCOPING CONSTRAINT, found by attempting it: a field family cannot be migrated independently if it
+ shares a consumer routine with a family that is not migrating.** `q_ghost_a`/`q_ghost_b` look like
+ the smallest possible first conversion - 9 references, one file, two consumers - but
+ `s_amr_fill_fine_ghosts` is not ghost-specific: it is a general prolong-coarse-into-fine routine
+ whose THIRD caller targets `q_cons` (`m_amr.fpp:4597`). Branching inside the routine does not help,
+ because a dummy referenced in ANY branch of a target region is still mapped, so the migrated path
+ would keep paying the tax and the conversion would buy nothing. **The natural conversion unit is
+ therefore `{q_cons, q_ghost_a, q_ghost_b}` together.** Counting references to a family NAME
+ understates its blast radius; count the consumers and then the consumers' other targets.
+
+ Separately confirmed while scoping: `q_ghost_a/b` are allocated UNCONDITIONALLY while their only
+ consumers sit on subcycle-only paths (`s_amr_subcycle_setup_block`, `s_amr_advance_fine_subcycle_all`,
+ `s_amr_advance_children`), and their `pb`/`mv` twins already carry an `if (amr_subcycle)` guard.
+ Adding the matching guard frees roughly `2 x sys_size x mbuf x live_slots` of device memory on every
+ non-subcycle run - memory that competes directly with `amr_max_grid_size`, the ~20x lever.
+2. **Batched block kernels** - one launch over the block list instead of per block, for the RHS and RK
+ paths. This is the 12.4x above and it is what `amr_max_grid_size` is currently substituting for.
+3. **Fused halo pack/unpack** - AMReX reduced this to one launch per rank; MFC's seam/ghost fills are
+ the same shape of work.
+
+Target, from the 60%-of-GCD profile: busy is 8.2 s of a 28.4 s span, so eliminating serialization is
+worth **~3.5x on that case** before counting the bandwidth gain AMReX reports from larger effective
+kernels. Expect more where blocks are smaller, since the penalty scales with block count.
+
+**RETRACTION.** Earlier in this session I wrote that batching "attacks dispatch count, not the
+per-dispatch tax" and set it aside. The profile then showed dispatch count IS the governing quantity,
+and AMReX and Parthenon both converge on exactly this mechanism. Increment 3 below was right and the
+dismissal was wrong. Note the separate "packing is disproved" result concerns MFC's SLOT-based packing
+into one working slot - a different mechanism from cross-block fusion, and only the former is dead.
+
+### THE GOVERNING LAW (2026-08-03, profiled): wall time is set by GPU OPERATION COUNT
+
+Gap analysis of a real AMR run (`rocprofv3`, kernel + copy traces, np=1 2D, 6 steps):
+
+| | |
+|---|---|
+| span | 13516.7 ms |
+| kernel busy | 1823.3 ms (13.5%) |
+| copy busy | 2000.4 ms (14.8%) |
+| union busy | 3823.6 ms (28.3%) |
+| **GPU IDLE** | **9693.0 ms (71.7%)** |
+
+The idle is not a few big stalls - it is ~354,000 operations each separated by a **~15 us median gap**:
+261k gaps under 20 us (27.6% of span), 89k between 20-100 us (21.1%), and only 143 gaps over 1 ms
+(16.7%, worth attributing separately). **95% of those operations are COPIES** (337k of 354k), so the
+map traffic costs ~2.0 s of transfer PLUS ~5 s of serialization - closer to half the span than the 15%
+a busy-time reading suggests.
+
+A faithful reproducer (`amr-bench/attach/serial/`) matches the signature - 81.6% idle, 18.7 us median
+gap against MFC's 71.7% / 15.4 us - and a clean sweep holding work and arrays fixed while varying only
+how many regions the work is split into gives:
+
+| regions fused | operations | span |
+|---|---|---|
+| 1 | 6555 | 202.4 ms |
+| 2 | 3315 | 120.2 ms |
+| 4 | 1695 | 73.8 ms |
+| 8 | 885 | 56.0 ms |
+| 24 | 345 | **37.6 ms** |
+
+Net of ~29 ms fixed startup the variable time falls **20x for a 19x reduction in operations**, and the
+median gap is ~18 us at every point. So:
+
+> **span = busy + (operations x ~18 us).** The per-operation gap is irreducible; the COUNT moves, and
+> so does the WORK each operation carries.
+
+**The count is only half of it - WORK PER KERNEL decides which regime you are in.** Holding the operation
+count fixed at 721 kernels / 5834 copies and varying only kernel duration:
+
+| mean kernel | busy % | regime |
+|---|---|---|
+| 14 us | 20.5 | latency-bound |
+| 16 us | 21.1 | latency-bound |
+| 37 us | 25.6 | latency-bound |
+| **201 us** | **51.2** | **crossover** |
+| 763 us | 77.4 | work-bound |
+
+Crossover is ~200 us of kernel work per ~8 copies. Scaled to MFC's ~20 copies per kernel that is
+**~500 us**, and MFC's mean kernel is **109 us** - so MFC runs **4-5x below** the point where work
+begins to dominate latency. Separately, raising work per region 256x at small sizes (16 -> 4096 cells)
+changed the span by 5%: down in that regime the work is free and only the operation count matters.
+
+**CHECKED AT PRODUCTION OCCUPANCY - the regime does NOT change with problem size.** Every measurement
+above ran at ~15% of one GCD, so the obvious objection is that short kernels are an artifact of a toy
+problem. Re-profiled at 4x the cells (8.4M -> 33.6M, ~60% of a 64 GB GCD):
+
+| | 15% of GCD | 60% of GCD |
+|---|---|---|
+| span | 13516.7 ms | 28389.8 ms |
+| busy | 28.3% | **28.9%** |
+| GPU idle | 71.7% | **71.1%** |
+| operations | 354,129 | 639,276 |
+| median gap | 15.4 us | **15.5 us** |
+| copies/kernel | 20.2 | 21.8 |
+
+Busy fraction and per-operation gap are INVARIANT to problem size. The reason matters: under AMR the
+work per kernel is set by `amr_max_grid_size`, **not** by the global grid - a larger domain yields MORE
+BLOCKS OF THE SAME SIZE, so it moves along the operation-count axis while leaving work-per-kernel
+untouched. Scaling up does not walk you out of the latency-bound regime; only raising the cap does.
+(The 60% run exited 134 on the same `getTargetPointer returned null` mapping abort seen at 15% after
+producing 28 s of trace; the ratios match the smaller run, but that abort is worth chasing on its own.)
+
+So the governing relation is two-dimensional:
+
+> **efficiency = kernel work / (kernel work + operations x ~21 us)**
+
+This is why `amr_max_grid_size` is worth ~20x (70.3 s/step at cap 128 versus 8.5-9.5 at cap 1024) and
+it is not a mysterious constant: a larger cap puts more cells under each kernel, moving the solver from
+the latency-bound regime toward the work-bound one. It also upgrades kernel fusion, which improves BOTH
+terms at once - a fused region carries more work and costs fewer operations.
+
+**`nowait` is REFUTED as a lever.** Enqueuing the same dependent regions with `nowait` + `depend` and one
+`taskwait` per advance measured 213 ms against 202 ms baseline, with the median gap unchanged (18.6 vs
+18.4 us). Asynchronous enqueue does not collapse the serialization.
+
+**Consequences, in priority order.**
+1. **Fewer block advances** - `amr_max_grid_size`. Every advance multiplies the whole operation count.
+ Already measured ~20x and already shipped with runtime advisories. Still the largest available win.
+2. **Kernel fusion inside `s_compute_rhs`** (16 direct regions). The sweep above is the evidence that
+ this pays, and it pays on BOTH factors: a fused region removes its own gap and its maps together.
+ Note fusing raises copies-per-kernel slightly (8.1 -> 10.1 measured) because a fused region touches
+ more arrays; total operations still fell 19x, so the trade is strongly favourable.
+3. **The 143 stalls over 1 ms** (2253 ms, 16.7% of span, one of 543 ms) are host-side and unattributed.
+ Cheap to investigate and potentially a large easy win.
+
+What this retires: anything that reduces the COST of an operation rather than the NUMBER of them. See
+the retraction below - seven such mechanisms were measured and all failed.
+
+### RETRACTED 2026-08-03: the promotion plan below is DEAD, and so is its premise
+
+**The premise was an attribution artifact.** "Dummy-argument kernels pay 33-54 maps per dispatch while
+module-level `GPU_DECLARE`'d kernels pay 0" came from TEMPORAL attribution: correlation ids do not match
+between the kernel and copy traces, so each copy was assigned to the next dispatch by timestamp. Copies
+CLUSTER - 11.5% of inter-dispatch intervals contain zero copies and one contains 2893 - so a kernel
+dispatched in a burst shows "0" whether or not it needs maps. The `m_amr_registers` kernels that
+measured 0 are ~8% of dispatches, squarely inside that zero-interval share. The MEDIAN of 20 copies per
+interval is real and matches the deep-member count, so the ~20 maps/dispatch AVERAGE stands; the
+per-kernel split does not.
+
+**Every mechanism was then measured directly by COPY COUNT** (`amr-bench/attach/clauses/`, one variant
+per process under `rocprofv3`, no attribution needed, immune to the launch-time noise floor):
+
+| mechanism | copies/kernel | verdict |
+|---|---|---|
+| deep-type dummies (MFC today) | 9.4 | baseline |
+| flat-array dummies (no derived type) | 9.4 | no gain - retires "flatten the interface" for good |
+| pointer dummies | 9.1 | no gain |
+| `defaultmap(present:aggregate)` | 9.1 | no effect |
+| `map(present,alloc:)` | 9.1 | no effect |
+| `!$omp declare mapper` | 39.1 | **4x WORSE** |
+| module state - static, allocatable, or the exact `freg` pattern | 32.8 | **3.5x WORSE** |
+
+**Per-region map traffic is irreducible by any interface or clause change on this compiler, and moving
+fields to module scope makes it worse.** That kills promotion, flattening, and the view/attach design
+together. It also explains why `freg`-style code looked free: it was never measured, only attributed.
+
+**What survives.** The tax itself is real and first-order (2.0 s of copy time against ~1.5 s of kernel
+time). Since it cannot be reduced PER REGION, the only remaining levers are fewer regions and fewer
+block advances:
+
+1. **Fewer block advances** - `amr_max_grid_size`. Already measured at ~20x (70.3 s/step at cap 128
+ versus 8.5-9.5 at cap 1024) and already shipped as a default plus runtime advisories. This remains
+ by far the largest available win and needs no code.
+2. **Fewer regions per advance** - kernel fusion inside `s_compute_rhs` (16 direct regions). Untested,
+ touches numerics-adjacent code, and is the only untried lever left.
+
+Do not re-attempt promotion, flattening, mapper, or attach without first re-measuring the table above;
+all seven were tested on 2026-08-03 and all seven failed.
+
+### PLAN (2026-08-03): promote the RHS working set from dummy arguments to module scope
+
+**The insight that removes the blocker.** The attach hunt was solving the wrong problem. The tax is not
+"pointers are slow" - it is that *fields arrive as dummy arguments*, so every target region re-maps their
+deep members. Nothing needs to be aliased, attached, or flattened: the fields simply need to BE module
+state. `m_rhs` already declares ~12 module-scope `GPU_DECLARE`'d derived-type arrays (`q_cons_qp`,
+`q_prim_qp`, `flux_n`, `flux_src_n`, `qL_prim`/`qR_prim`, `tau_Re_vf`) and those kernels measure ZERO
+maps per dispatch. Only `q_cons_vf`, `q_prim_vf`, `rhs_vf` arrive as dummies - exactly the ones taxed.
+
+**The change, per routine: declarations and call sites only. Loop bodies are untouched.** Promote the
+dummy to a module variable OF THE SAME NAME, so `q_cons_vf(i)%%sf(j,k,l)` still resolves - now to module
+state. This is what makes the change tractable and what makes it safe for a bit-identical requirement:
+the arithmetic is not edited at all. (Contrast the flat-store design, which threads a slot index through
+every reference - a genuine 500-loop rewrite.)
+
+**How AMR then feeds it.** The monolithic path pays NOTHING: the module arrays simply are its arrays.
+The AMR path copies block *k*'s fields into them before the advance and `rhs` back after -
+device-to-device, ~1.3 MB for a 128^2 2D block at `sys_size=5`, about **1.3 us**, against the measured
+**~2.9 ms** of argument mapping per `s_compute_rhs` invocation (2.0 s / 696). Roughly a 2000:1 trade.
+This is the `s_amr_swap_to_fine` idiom already used for grid state, extended from geometry to fields.
+
+**Re-entrancy: VERIFIED SAFE, and it was the risk that could have killed the design.** Module-scope state
+is only sound if no two block advances overlap. `s_amr_advance_children` is `recursive`, but the
+recursion sits OUTSIDE the stage loop - every level-`clev` block completes all three stages, and only
+then does the routine recurse into level `clev+1`. `s_l0_advance_stage_rhs` and the fine-advance loops
+are likewise serial over blocks. No nesting, so no working-set stack is required.
+
+#### MEASURED 2026-08-03, AFTER step 1a landed: where the operations actually are
+
+Step 1a (`905e9d7c`) and the flat store itself (`cacc14ec`) are in. Before converting 78 call sites, the
+per-module split was read out of four independent `rocprofv3` kernel-stats profiles
+(`amr-bench/scratch/{l0p-hVcToX/p0,l0p-hVcToX/p2,att-dQ6b8U,sat2-UvUxRt}`). The two metrics disagree, and
+which one governs is the whole question:
+
+| | kernel TIME | LAUNCH count |
+|---|---|---|
+| `s_compute_rhs` tree (`m_variables_conversion`, `m_weno`, `m_riemann_solver_hllc`, `m_riemann_state`, `m_rhs`) | 88.7 - 91.1% | 60.6 - 66.7% |
+| AMR-local (`m_amr`, `m_amr_registers`) | 5.1 - 10.1% | 32.7 - 38.2% |
+
+**Launch count governs**, because the regime is latency-bound (cost proportional to operations, 71.7%
+idle) - so the AMR-local kernels this plan set out to batch are worth about **one third of the operation
+budget**, not the ~8% their kernel time suggests. That third is real and worth taking. The other two
+thirds are inside the RHS tree and this plan does not reach them.
+
+**THE BLOCKER, and it is an interface problem, not a mechanism problem.** Splitting the 78
+`amr_slots(...)%%q_cons` references by what consumes them:
+
+| kind | count | can the interface change? |
+|---|---|---|
+| element access `%%q_cons(i)%%sf(a,b,c)` | 15 | yes - free |
+| whole-array pass to an AMR-local callee | 40 | yes - the callee is ours |
+| whole-array pass to a SHARED solver routine | 8 | **no** |
+
+The 8 are `s_compute_rhs` (x4), `s_ibm_correct_state` (x2), `s_pressure_relaxation_procedure`, and
+`s_infinite_relaxation_k` - the last living in `src/common/`, shared by all three executables. All take
+`type(scalar_field), dimension(sys_size)` and all are used by the MONOLITHIC path too, so their signatures
+cannot follow `q_cons` into a flat store without dragging `q_cons_ts(i)%%vf` and the whole of `m_rhs` with
+them. The pointer-view bridge that would avoid this (a `scalar_field` whose `%%sf` points into the store)
+is the MWE's variant D1/D2, already shown to fail silently on this backend - the device sees a descriptor
+holding a host address.
+
+**Consequence for the plan below: sub-steps 4 and 5 as written are not reachable.** `q_cons` cannot
+migrate while those 8 sites exist. And because `s_amr_lerp_fine_ghosts` and the 4579 `s_amr_fill_fine_ghosts`
+call both terminate in a `q_cons` write, even the ghost-only migration stops short of a batchable path.
+The remaining forks are recorded below; do not restart sub-step 4 without picking one.
+
+#### DECISION + STATE (2026-08-03): fork 1 chosen - AMR-local migration behind a copy bridge
+
+Of the three forks above the choice was **fork 1**: migrate the AMR-local sites to the flat store and
+copy device-to-device around the 8 shared-solver call sites, leaving `s_compute_rhs` and friends with
+their `scalar_field` interfaces untouched.
+
+**Landed and golden-clean (76/76 each):**
+
+| commit | what |
+|---|---|
+| `905e9d7c` | step 1a - dense local index |
+| `cacc14ec` | the flat store + `s_amr_st_reserve` (device-preserving geometric growth) + `s_amr_st_finalize` |
+| `bbf8ec8e` | **2a - the subcycle ghost sources migrated**; first change where data really flows through the store |
+
+2a is +10 net lines because `s_amr_fill_fine_ghosts` is now generated for three targets (`_sf`, `_gsta`,
+`_gstb`) from ONE source body using a Fypp accessor lambda -
+``#:set QF = (lambda ix: ...) if TGT == '' else (lambda ix: ...)`` - the idiom `m_riemann_solver_hlld`
+already uses for its per-direction stencil variants. Branching on the target inside a single region is
+not an option: a dummy referenced in ANY branch is still mapped.
+
+**2b - `q_cons` + the copy bridge. LANDED (see the results subsection below). It was ATOMIC and bigger than the original plan said.**
+
+- **70 code sites** (not 59), across `m_amr.fpp` 47, `m_amr_regrid.fpp` 17, `m_amr_restart.fpp` 6,
+ `m_time_steppers.fpp` 1.
+- They cascade into **~17 AMR-local callee signatures**: `f_amr_rho_tot`, `s_l0_pack_unpack_block`,
+ `s_amr_fine_slice`, `s_l0_edge_bc_tile`, `s_l0_copy_block`, `s_amr_restrict_pack_device`,
+ `s_amr_gather_from_parent_field`, `s_amr_fine_rk_update`, `s_amr_copy_fine_fields`,
+ `s_prolong_species_closure`, `s_prolong_one_var`, `s_prolong_alphas_closure`,
+ `s_l0_fill_ghost_corners`, `s_amr_restrict_overwrite_device`, `s_amr_reflux_apply_faces`,
+ `s_amr_fine_seam_exchange`, `s_amr_fill_fine_ghosts_sf`. Some take TWO block fields (parent+child,
+ or two seam neighbours) and become two `loc` arguments - which is better for batching, not worse.
+ Some take a MIX (`s_amr_copy_fine_fields(q_cons, q_cons_stor, ...)`); the unmigrated dummy is still
+ mapped there, so that call site keeps its per-region tax until `q_cons_stor` follows.
+- `m_amr_restart.fpp`'s 6 sites are HOST-side I/O with explicit `GPU_UPDATE` - retarget them at the
+ store (whole-store update is wasteful but restart is rare).
+- **It cannot be split.** The store is either authoritative for `q_cons` or it is not; a dual-write
+ staging period is exactly the silent-divergence trap. Convert in dependency order, build often, run
+ the goldens once at the end, and bisect by reverting individual routines if they fail.
+
+**The bridge costs more than first assumed, so the payoff is smaller.** All four shared routines are
+`intent(inout)`, and `s_compute_rhs` reaches `s_populate_variables_buffers`, which writes `q_cons`'s
+buffer region - so the bridge must copy BOTH directions at all 8 sites. Each crossing is a region taking
+a `scalar_field` dummy (~20 argument maps) while the batched kernels it enables cost 0. Per block
+advance that turns ~9.3 AMR-local launches into ~2.4, i.e. **~25-30% of total operations, not the ~35%
+launch share**. Quote the 25-30%.
+
+**Harness note:** the session scratchpad rotates and ate a UUID list mid-run (the failure looks like a
+kill, not a missing file). Keep test lists and logs under `amr-bench/logs/store/`.
+
+#### 2b RESULT (2026-08-03): the store is authoritative for `q_cons`
+
+Converted in dependency order, one build per group, goldens once at the end. Net **+86 lines** across
+three files (`m_amr.fpp`, `m_amr_regrid.fpp`, `m_amr_restart.fpp`); `t_level%%q_cons` and its
+`@:ALLOCATE`/`ACC_SETUP_SFs`/`@:DEALLOCATE` are gone.
+
+**The site count was 80, not 70.** The earlier inventory grepped `%%q_cons` and filtered out lines
+containing `q_cons_stor` - which also dropped every line carrying BOTH, hiding `s_amr_copy_fine_fields`
+and `s_amr_fine_rk_update` (4 sites, 2 signatures). When inventorying a rename, filter on the token, not
+on the line.
+
+**Three callees turned out to be polymorphic** over "a block" and "the level-0 monolithic field", so they
+became two Fypp-generated variants from one body rather than one converted routine:
+
+| routine | `_st` (flat store) | `_sf` (scalar_field) |
+|---|---|---|
+| `s_l0_pack_unpack_block` | migration / scatter of a block | `q_cons_vf`, `coarse_tgt`, `rhs_delta` |
+| `s_amr_restrict_overwrite_device` | fold a child into a parent BLOCK | fold into level-0 |
+| `f_amr_rho_tot` | fine sensor on a block | coarse sensor on `q_cons_base` |
+
+`s_amr_gather_from_parent_field` (and its two callees) needed the same split for a different reason: it
+is called once with the parent's `q_cons` (store) and once with its `q_cons_stor` (still a
+`scalar_field`), which is the subcycle's two-bracket gather.
+
+**`s_amr_fill_fine_ghosts`'s `_sf` variant DISAPPEARED**, folding into the `_gsta`/`_gstb` pattern from
+2a - all three targets are now `(q_coarse, loc)`. Same for `s_amr_lerp_fine_ghosts`, which lost its
+`q_tgt` argument entirely. That is where most of the deleted lines came from.
+
+**The bridge is 6 crossings, not 8**, because the two `s_compute_rhs` sites and the two
+`s_ibm_correct_state` sites are if/else arms - the load/store hoists around the branch, so one round trip
+per stage, not per arm. The sixth is `s_amr_reflux_apply_faces`, which is NOT one of the four shared
+solver routines: it lives in `m_amr_registers`, which `m_amr` already `use`s, so reaching the store from
+it would be a circular dependency. The bridge solved that at zero extra design cost.
+
+**Bridge invariant: crossings must not nest.** `amr_cons_br` is a single shared buffer, so a load inside
+a load would silently clobber the outer block's state. None of the six call chains re-enters AMR code;
+check that before adding a seventh.
+
+**Two traps hit:**
+
+- ``#:for DIR, LHS, RHS in [('load', A, B), ('store', B, A)]`` fails `lint_source.py` - it reads the
+ flattened list and reports `A` and `B` as duplicate entries. Make the direction a flag and derive the
+ operands (``#:set LHS = BR if DIR == 'load' else ST``), which is clearer anyway.
+- `./mfc.sh build ... | grep error:` reports GREP's exit code, not the build's. Redirect to a log and
+ echo `$?` on its own line. (Same class as the `--only` comma trap already recorded.)
+
+**Confirmation that 2b was the right prerequisite:** `s_amr_fine_seam_exchange`'s own comment named this
+change as its blocker - *"Batching further, across PAIRS, is NOT possible without a flat per-slot backing
+array: each slot's `q_cons(i)%%sf` is an independent allocation and `amr_slots` is not `GPU_DECLARE`'d, so
+a runtime slot index inside a kernel is a null deref."* Both blocks are now addressed by a plain integer
+subscript into a `GPU_DECLARE`'d module array. Same for `s_l0_pack_unpack_block` and
+`s_l0_fill_ghost_corners`, whose dummies existed only to dodge that null deref.
+
+**2b is a toll, not a win.** It adds two whole-block device copies per crossing and, per the attach/map
+measurements, saves none of the ~20 argument maps at the crossing itself. All of its value is unlocking
+step 2. Measure step 2's operation count with `amr-bench/attach/serial/gaps.py` before believing any of
+the projected 25-30%.
+
+#### EXECUTION PLAN for 1b + 2 (written 2026-08-03, SUPERSEDED IN PART - read the section above first)
+
+**1b - migrate `{q_cons, q_ghost_a, q_ghost_b}` to the flat store.** They move together because
+`s_amr_fill_fine_ghosts` targets all three; see the scoping constraint above.
+
+```fortran
+real(stp), allocatable :: amr_cons_st(:,:,:,:,:) ! (x, y, z, var, LOCAL slot)
+real(stp), allocatable :: amr_gst_a(:,:,:,:,:), amr_gst_b(:,:,:,:,:)
+$:GPU_DECLARE(create='[amr_cons_st, amr_gst_a, amr_gst_b]')
+integer :: amr_st_cap = 0
+```
+
+Order of work, each sub-step compiling and golden-clean before the next:
+
+1. Declare the stores + `s_amr_st_reserve()` (geometric growth on `amr_loc_n`). Call it from
+ `s_amr_alloc_slot` after `amr_slot_live = .true.`. Guard the ghost stores on `amr_subcycle`.
+ `q_cons` growth MUST preserve device contents (unlike the ghosts) - copy old -> new before freeing.
+2. Convert `s_amr_fill_fine_ghosts`: replace the `q_fine` dummy with `(target, loc)` where target
+ selects `amr_cons_st`/`amr_gst_a`/`amr_gst_b`. **Duplicate the target region per branch** rather than
+ branching inside one region, or the unmigrated dummy is still mapped and the win is lost.
+3. Convert `s_amr_lerp_fine_ghosts` (1 write site) and the 5 ghost call sites.
+4. Convert the `q_cons` readers/writers. 59 references across 4 files - do it file by file, building
+ between each. `amr_slots(k)%%q_cons(i)%%sf(a,b,c)` becomes `amr_cons_st(a,b,c,i,amr_loc_of(k))`.
+5. Delete `q_cons`/`q_ghost_a`/`q_ghost_b` from `t_level` and from alloc/free.
+
+**2 - batch the per-block kernels.** Replace `do k = ...; call s_amr_select_slot(k); ` with
+a single region carrying `loc` as an extra collapsed dimension over `1:amr_loc_n`. Start with
+`s_amr_fine_rk_update` (self-contained, 2 regions), then the RHS path. Requires that per-block loop
+bounds (`amr_slots(k)%%m/n/p`) also be readable on device - stage them into a small
+`GPU_DECLARE`'d `integer :: amr_blk_m(:), amr_blk_n(:), amr_blk_p(:)` indexed by `loc`.
+
+**Verification protocol, non-negotiable.** Every sub-step is a pure data-layout or scheduling change,
+so **all 76 AMR/L0 goldens must stay byte-identical**. A diff means the change is wrong, not that the
+goldens need regenerating. In addition, after step 2 confirm the mechanism actually engaged by
+re-running the gap analysis (`amr-bench/attach/serial/gaps.py` on a `rocprofv3` dir) and checking that
+the operation count fell - a passing golden set with an unchanged operation count means the batching
+did not take effect.
+
+**Traps already paid for, do not rediscover:**
+- `amr_slots` is allocated in TWO places (`s_initialize_amr_module`, behind `if (.not. amr) return`, and
+ `s_l0_tiles_init` for pure-L0). Anything allocated beside it must follow the POOL. Fingerprint: only
+ the `L0 tiles` goldens fail.
+- Print the text being REPLACED on every non-trivial substitution. A `max(..., bub_pos_frac*u0)` clamp
+ was nearly rewritten to `max(..., 0._wp)` - a silent physics change that only a Lagrange-bubbles
+ golden would have caught, hours later.
+- Do NOT pass the store as a dummy argument. A plain-array dummy costs the same per-region map traffic
+ as a deep-type one (9.4 vs 9.4); only a plain MODULE array reaches 0.
+- The tool timeout is 10 minutes and an MFC rebuild exceeds it - background the build and poll a log
+ marker, and never write `pgrep -f ""`, which matches the poller.
+
+#### De-risking MWEs, each run BEFORE the matching phase
+
+Build them as one matrix in a single compile (`amr-bench/attach/mtu/`), not one hypothesis per MFC
+rebuild - a 6-phase matrix compiled in ~20 s eliminated four hypotheses at once and correctly predicted
+an MFC failure, where the same questions cost ~20 minutes each in-tree.
+
+| MWE | de-risks | pass condition |
+|---|---|---|
+| M1 promotion, multi-TU | module state referenced from a DIFFERENT translation unit than it is declared in | correct result; per-region time at the ~22 us module level, not the ~110 us dummy level |
+| M2 copy-in/advance/copy-out | the AMR feed path, with host and device data DELIBERATELY DIVERGED | correct result; copy cost measured and compared against the mapping it replaces |
+| M3 serial reuse, varying extents | one shared working set reused by many blocks of DIFFERENT sizes | correct for every block, in any order |
+| M4 sub-block extents | working arrays sized at `mbuf` max while a block uses a sub-range | no read/write outside the block's own range |
+
+M2's divergence requirement is not optional: uniform host/device data hid a data-movement defect through
+seven passing variants in the session that produced this note.
+
+#### MWE RESULTS (2026-08-03, `amr-bench/attach/promote/`): correctness de-risked, 5/5
+
+| phase | de-risks | result |
+|---|---|---|
+| S1 | promotion through a 3-deep call chain, cross-TU, over a sub-range | PASS |
+| S2 | POISONED halo beyond the block untouched - no out-of-range write | PASS |
+| S3 | 25 advances with host/device DELIBERATELY diverged, plus unrelated target regions between them | PASS |
+| S4 | 48 blocks of VARYING extents cycled through one shared working set | PASS |
+| S5 | working set REALLOCATED mid-run | PASS |
+
+**Mechanism detail that matters for implementation.** A module-scope deep type needs the parent
+descriptor mapped AND its members mapped; `map(to:)` on the parent alone leaves `%%sf` null on device
+and the first kernel faults at a nil address. With promotion this setup runs **once at init** and the
+working set is never re-pointed - which is exactly why promotion sidesteps the attach problem that
+killed the view-based design.
+
+**Timing could NOT be measured cleanly and no speedup is claimed here.** The node showed a ~134 us
+per-region launch floor, uniform across all 8 GCDs (129-135 us) with the GPUs otherwise idle, against
+~20 us for the same construct earlier the same day. Within-program A/B gave 448 vs 501 us/region: 53 us
+saved for 2 dummy arrays, ~26 us per array per region. Extrapolating instead from MFC's own profile
+(485 copies / 24 regions = 20 maps per region, 2.0 s / 696 invocations = ~6 us per map = ~120 us per
+region, against a 69 us mean kernel) implies roughly a **2-3x per-region reduction**. Treat the 4.4x
+from the earlier quiet-node reproducer as an UPPER BOUND and re-measure on an idle node before quoting.
+
+#### Phases, each golden-gated and independently revertible
+
+1. **`s_amr_fine_rk_update`** - AMR-only, one file, three arrays. Smallest in-tree proof of the pattern.
+ Gate: all AMR goldens byte-identical AND its copies/dispatch measured 54 -> ~0.
+2. **`s_compute_rhs`'s three field dummies** - 5 call sites. Benefits the uniform solver too (it pays
+ 18.6 copies/launch to AMR's 19.2). Gate: FULL suite byte-identical, plus a uniform-case timing.
+3. **Walk the call chain** - `m_riemann_solver_hllc` (44 maps/dispatch), `m_riemann_state` (33),
+ `m_viscous`, `m_weno`; ~57 call sites pass these three arrays. Gate: full suite, per-stage.
+
+Stop after any phase whose measured gain does not survive its own run-to-run spread, and say so.
+
+#### What would falsify this plan
+
+- M1 shows promotion does not remove the maps once the reference crosses a TU boundary.
+- The copy-in/out is not device-to-device (a host round trip would cost far more than the tax).
+- Phase 1 changes any golden. This is a storage-location change with identical arithmetic; a diff means
+ the model is wrong, not that the goldens need regenerating.
+
+### SETTLED 2026-08-03: concurrency (option C) is DEAD; fusion (option B) is MEASURED
+
+Both settled on one harness, `amr-bench/attach/serial/conc.f90` (wall clock via `omp_get_wtime`;
+`NBLK` blocks x `NREG=15` dependent regions x `NADV=30`, deep-allocatable dummies = the MFC interface).
+
+**Option C - concurrent block advances - produces ZERO overlap and is slower.** Each block was given
+its OWN `a/b/c/d` arrays AND its own `depend` token, so the `NBLK` chains were genuinely independent:
+the best possible case, with nothing to serialize on.
+
+| NBLK | serial | conc | |
+|---|---|---|---|
+| 1 | 0.059 s | 0.072 s | 1.23x SLOWER |
+| 4 | 0.235 | 0.262 | 1.11x slower |
+| 16 | 0.948 | 1.031 | 1.09x slower |
+| 64 | 3.91 | 4.13 | 1.06x slower |
+
+Both scale perfectly linearly in `NBLK` - no hint of overlap - and a `rocprofv3` trace of the `conc`
+variant confirms it directly: **7201 kernels, 0.0% overlapped**. `nowait` plus independent per-block
+`depend` tokens produce no device-side concurrency at all on this backend (amdflang/AFAR, gfx90a).
+
+**This is NOT a repeat of the earlier `nowait` result.** `s.f90`'s `k_nowait` put `depend(inout: d)` on
+ONE shared token, serializing every region into a single chain; it asked whether a SERIAL chain
+pipelines. The question of whether SEPARATE chains overlap was open until now. It is now closed.
+
+Corollary: the ~17 module-scope `GPU_DECLARE`'d families in `m_rhs` that would have to be replicated
+per stream are MOOT - concurrency fails before sharing ever becomes the constraint. **Do not re-attempt
+concurrency, streams, or async task graphs.** With this, TEN mechanisms for reducing or hiding
+per-region cost have been measured and all ten failed.
+
+**Option B - fewer regions - is the whole game, and wall time is LINEAR in region count.** Same
+arithmetic in every variant (`result=21.00`), only the region count differs:
+
+| regions/advance | wall | vs 15 regions | s per region |
+|---|---|---|---|
+| 15 (= serial) | 0.945-0.955 s | 1.00x | 0.063 |
+| 5 | 0.313-0.429 | 3.0x | 0.074 |
+| 3 | 0.188-0.190 | 5.0x | 0.063 |
+| 1 | 0.064 | 14.8x | 0.064 |
+
+`wall ~ 0.064 s x regions`, flat to +-15% across a 15x range (the 5-region point is the one noisy
+sample: 0.313 and 0.429 on two runs). `FUSE=1` reproduces `serial` (0.955 vs 0.945), which is the
+harness checking itself.
+
+**Re-pricing option B against the real profile.** The harness is 97.5% idle with ~6 us kernels; the real
+AMR run is 72% idle with 91 us average kernels, so fusion helps proportionally less there. Using the
+real split - the `s_compute_rhs` tree is 55.5% of launches at ~14.7 regions per block-stage - a 3x
+region reduction inside it removes ~37% of all operations, i.e. **~26% of wall**. That is roughly 2.5x
+the ENTIRE remaining step-2 batching programme (~10% across three 2b-sized field migrations), and it
+also benefits uniform runs, which AMR-local batching does not.
+
+**What this means for the plan.** Every surviving lever is the same lever: FEWER REGIONS. Fusion (B),
+batching (A), and bigger blocks (`amr_max_grid_size`, shipped, ~20x) are three applications of it.
+Nothing that reduces per-region COST works, and nothing that OVERLAPS regions works. Rank by measured
+value: B ~26% > A-remainder ~10% > C = 0. The concrete next target is `m_weno` + `m_riemann_state` -
+3216 launches each, ~4.2 regions per block-stage apiece, adjacent in the pipeline with a direct
+producer/consumer dependency.
+
+Method notes worth keeping: `cpu_time` is WRONG for this measurement (it sums CPU across threads and
+made `conc` look merely 2-16% slow when the wall-clock gap was different); use `omp_get_wtime`.
+`rocprofv3` needs `--output-format csv` or it writes only a `.db`. And the pre-existing `k_fused` in
+`s.f90` is NOT arithmetically equivalent to its `k_base` (`result=12` vs `30`), so its timings cannot
+be used to price fusion - `conc.f90`'s variant was written to be equivalent and checks it.
+
+### MEASURED 2026-08-03 AT PRODUCTION SIZE (3D, 400^3): the cap is exhausted, balance is state of
+### the art, and AMR captures ~11% of its own potential
+
+Everything below is on `amr-bench/cases/sc3dx_amr.py` - 400^3 = 64M base cells, np=8, ~48% of a 64 GB
+GCD per rank at the ~1M points / 2 GB rule. **All prior AMR pricing in this document came from a 2D case
+at ~4% of GCD capacity and should not be trusted where it disagrees with this section.**
+
+**`amr_max_grid_size` is EXHAUSTED in 3D.** Clean U-curve with the optimum exactly at the shipped
+default, walled off above by device OOM rather than by tuning:
+
+| cap | boxes | boxes/rank | s/step | ns/cell |
+|---|---|---|---|---|
+| 12 | 1089 | 136 | 22.18 | 258.2 |
+| 16 | 2401 | 300 | 27.34 | 299.5 |
+| 24 | 1089 | 136 | 16.76 | 171.3 |
+| **32** | **625** | **78** | **9.5-9.8** | **93.9-96.1** |
+| 48 | 324 | 40 | 16.73 | 158.5 |
+| 64, 96, 128 | - | - | **OOM** | - |
+
+> **THIS ROW IS WRONG (correction 2026-08-15/18).** Cap 64 runs fine from scratch and is now the
+> recommended setting (2.24x less wall at LOWER memory); the OOMs were a checkpoint-restart confound.
+> Caps 96 and 128 were never retested from scratch, so their status is UNKNOWN, not OOM. Do not cite
+> this row for any cap. See `amr_action_plan.md` Tier 0.1.
+
+cap 32 reproduced across two independent sweeps to 2%. cap 16 is anomalous (2401 boxes, MORE than
+cap 12's 1089) - the clusterer tiles pathologically there; an oddity, not a trend.
+
+**This OVERTURNS the recorded 2D conclusion** that bigger blocks are "by far the largest available win"
+(~20x, cap 128 -> 1024). That is a 2D result. In 3D the cap costs memory as cap^3 (the validator says so
+explicitly: solver scratch is sized to the cap, "growing as the cap raised to the dimension count"), so
+the base problem and the cap compete for the same memory and the ceiling arrives immediately.
+
+**CORRECTION: OOM does NOT present as a hang.** It aborts at exit 134 with
+`HSA_STATUS_ERROR_OUT_OF_RESOURCES` and an explicit message. The wrapper's `rc=143` is the OUTER
+timeout, two layers up - reading it as a timeout was wrong.
+
+**AMR vs uniform, both converged.** Uniform 400^3 needed ~100 steps to converge (Time Avg 0.493 at 21
+steps -> **0.7068** converged, a 43% error); AMR needed ~60 (9.54 single-sample -> **~10.24** Time Avg,
+still drifting down). **20-step runs are NOT converged - the cap table above therefore holds as a
+RELATIVE comparison (identical protocol per arm) but its absolute ns/cell understates AMR by ~7%.**
+
+| | cell-updates/step | s/step | ns/cell |
+|---|---|---|---|
+| uniform 400^3 | 64.0M | 0.7068 | **11.05** |
+| AMR cap 32 | 101.5M (64.0M base + 37.5M fine) | ~10.24 | **~100.9** |
+
+- **AMR per-cell penalty = ~9.1x** - NOT the ~31x on record, which came from the small 2D case.
+- Matching AMR's finest resolution uniformly is 1600^3 = 4.096e9 cells: a **40.4x** cell-update saving.
+- AMR converts that into **~4.4x** of wall clock, i.e. it captures **~11% of its own geometric
+ potential**. The missing ~9x IS the per-region cost.
+- AMR is unambiguously WINNING here (an earlier worry that it might be a net loss is retracted), and
+ 1600^3 uniform would need ~8.2 TB against 512 GB available - it does not merely lose, it does not fit.
+
+**LOAD BALANCING IS NOT THE PROBLEM - it is state of the art.** Measured on this case:
+`max/mean 1.016-1.018, ranks_with_no_fine_block 0` -> **efficiency 0.982-0.984** on AMReX's own metric
+(mean load / max load). Published AMReX values: knapsack 0.97-1.00, Painter's SFC 0.92-1.00, original
+SFC 0.80-0.95 (arXiv 2505.15122). **We match knapsack and beat their original SFC.** That paper also
+explicitly declines to claim production wall-clock savings for ANY algorithm - so our own 0.4% recovery
+from rebalancing is not a sign of being behind, it is what converting a good epsilon into seconds looks
+like. Do not spend effort here: the remaining 2% of balance is noise against 72% idle.
+
+**THE REAL GAP vs state of the art is BLOCK COUNT.** AMReX operates at 4-16 boxes per rank ("at least 4
+... more than 16 starts to cause performance issues"). Our OPTIMUM is 78 boxes/rank, and every cheaper
+cap is worse (300/rank at cap 16). We are ~5x outside their regime at our best setting and cannot move
+toward it, because per-block memory is cap^3 x ~17 module scratch families where their MultiFab is ONE
+contiguous array per level. Same root cause as the 19.5 copies/launch: per-block replication instead of
+a packed representation.
+
+**What this means for priorities.** Fusion (~26%) and the step-2 batching remainder (~10%) are margin
+work against a ~9x gap between AMR and its own potential. Both of those numbers are also 2D-derived and
+must be re-priced here before they are quoted. The axis that matters is per-block overhead and block
+count - which is what the flat store began.
+
+**Harness rules this cost four self-inflicted failures to learn** (three already documented and hit
+anyway): never run a benchmark while another `mfc.sh run` is live (they contend for the same GPUs and
+the control silently never starts); never `pgrep -f` a pattern that appears in the poller's own command
+line (an `until ! pgrep` loop then never exits - three stalled monitors and counting); pass `mfcrun.sh`
+an ABSOLUTE case path (it `cd`s to the tree first, so a relative path resolves there); and never edit a
+shell script while an instance of it is executing (bash reads scripts incrementally, so the running copy
+then fails to parse, at a line number that no longer means anything). `mfcrun.sh` now enforces the first three.
+
+### PROPER 3D PROFILE (2026-08-04): the 9.1x penalty is 1.38x arithmetic and 6.6x overhead
+
+Profiled the REAL case - 400^3, np=8, cap 32, all 8 ranks under rocprofv3 - and, critically, computed
+idle as `1 - (kernel busy from the trace) / (wall from a CLEAN unprofiled run)`, so the profiler's own
+overhead is excluded from the idle figure. Uniform 400^3 profiled identically.
+
+| | uniform 400^3 | AMR cap 32 |
+|---|---|---|
+| kernels / rank / step | **600** | **44,174** |
+| kernel busy | 0.552 s/step | 1.207 s/step |
+| **GPU idle** | **21.9%** | **88.2%** |
+| kernel work per cell | **8.62 ns** | **11.89 ns** |
+| wall per cell | 11.05 ns | 100.9 ns |
+| copies per launch | - | 19.5 |
+
+**The 9.1x per-cell penalty decomposes as 1.38x arithmetic + 6.6x pure per-region overhead.** AMR's
+kernels are only 38% less efficient per cell than the monolithic solver's; everything else is idle.
+**AMR runs 73.6x more kernels for 1.59x the work.** That single ratio is the whole problem - it is not
+load balance (0.98, state of the art), not the block cap (exhausted, optimum = default), and not
+arithmetic.
+
+Region mix (rank 0): compute_rhs tree 56.1%, AMR-local 34.8%; `m_weno` and `m_riemann_state` are 7344
+launches EACH. Pricing at the measured 88.2% idle:
+
+| change | d_ops | **d_wall** |
+|---|---|---|
+| fuse `weno`+`riemann_state` (1:1, adjacent producer/consumer) | 16.8% | **14.9%** |
+| 3x reduction across the tree | 37.4% | **33.0%** |
+| tree -> ~1 region | 52.3% | **46.1%** |
+| tree->1 + all AMR-local batched | 83.7% | **73.8% (3.8x)** |
+
+**What the prize really is.** Removing per-region overhead entirely would take AMR from 9.1x uniform
+per cell to **1.38x**, and from delivering 4.4x of its 40.4x geometric potential (**11%**) to ~29x
+(**72%**). The full program above reaches ~17x (**42%**). The earlier 2D-derived "~26%" was not wrong in
+magnitude but priced the wrong change: 26% described a 3x tree reduction, which measures 33% here.
+
+An earlier proxy profile (128^3, np=1) gave 84.2% idle and 12-15% / 28-33% for the same two changes -
+close enough to validate the method, but the real case is worth MORE, not less. Region mix is set by
+`num_dims`/`weno_order`/`riemann_solver`, not by problem size; the IDLE FRACTION is what needs the real
+case, and it must be computed against an unprofiled wall.
+
+**Harness: never profile or run in the shared `cases/` directory.** `-t pre_process` alone does NOT
+regenerate `simulation.inp`, so a stale 400^3 input silently ran under a 128^3 case name and OOM'd on one
+GPU - misread twice as a real memory ceiling before the input file was checked. `blocksize_sweep.sh`
+uses `mktemp -d` per arm for exactly this reason. Multi-rank profiling also needs a per-rank `-d`
+directory (a wrapper keyed on `$SLURM_PROCID`), or the 8 ranks collide on one output prefix.
+
+### RETRACTED 2026-08-04: "fuse weno+riemann_state, ~26%" IS WRONG. Fusion pays only for LIGHT kernels.
+
+**The MWE that produced the linear-in-regions law was invalid in two ways, both load-bearing.**
+
+1. **Problem size.** It used `NS=5 x nxr=64` = **320 elements per kernel**. A real region spans a whole
+ fine block: 72^3 x sys_size ~= **2.2M elements**. 320 elements cannot fill ONE compute unit of a
+ 110-CU GCD, so occupancy - the exact effect being tested - was structurally unable to appear.
+2. **Compile flags.** It used bare `-O2 -fopenmp`. MFC builds with `-O3 -march=native` plus
+ `-fopenmp-assume-threads-oversubscription`, `-fopenmp-assume-teams-oversubscription` and
+ `-fopenmp-assume-no-nested-parallelism` - precisely the flags that steer team scheduling.
+
+**Re-measured at realistic size with MFC's exact flags** (`amr-bench/attach/serial/fuse.f90`: 78 blocks
+x 72^3 x sys_size 6, NREG=15, ~68 MiB and ~55 us per region - the same regime as MFC's 27-91 us
+kernels). Total arithmetic is held IDENTICAL on both sides, so the only variable is region count:
+
+| live registers | split (15 regions) | f=3 (5) | f=5 (3) | f=15 (1) | **fusion gain** |
+|---|---|---|---|---|---|
+| 1 | 2.413 | 1.269 | 0.714 | 0.517 | **5.81x** |
+| 8 | 4.831 | 4.088 | 3.234 | 2.417 | **1.89x** |
+| 32 | 8.145 | 11.403 | 10.208 | 7.673 | **0.92x - a LOSS** |
+
+**Register pressure kills fusion.** The earlier toy said fusion still gave 8x at 48 live accumulators;
+at real size it goes NEGATIVE by 32. The first sweep was reassuring me about the one risk I had
+identified as load-bearing, and it was an artifact.
+
+**CONSEQUENCE: DO NOT FUSE `weno` + `riemann_state` (or any arithmetic-heavy pair).** WENO holds a
+5-point stencil x sys_size; the HLLC solve holds L/R states plus wave speeds - easily 30-60 live
+doubles, i.e. the wgt=32 column, where fusing LOSES. That refactor would have been a net slowdown
+discovered only after touching numerics-adjacent shared solver code.
+
+**The program splits in two:**
+
+- **LIGHT kernels (data movement, copies, reshapes) - FUSE.** Near-zero live set, the 5.8x regime.
+ `s_finalize_riemann_solver` (7344 launches, pure copies) is the type case and is now fused 6 -> 3
+ regions per block-stage. `weno::pack_weno_input_arr` (3672, marshalling) is the next candidate.
+- **HEAVY kernels (`weno` 3672, `riemann_solver_hllc` 3672) - DO NOT FUSE.** They are where the launches
+ are, and they are exactly where fusion costs more than it saves.
+
+**Revised prize.** The realistically fusable set is the light kernels, ~25% of launches, of which fusion
+can remove perhaps half -> **~11% of wall, NOT the 46% (tree->1) or 74% (full program) projected
+earlier.** Those projections assumed every region fuses equally; they do not. The 6.6x per-region
+overhead is real, but kernel fusion cannot recover most of it - only reducing the NUMBER OF BLOCK
+ADVANCES or the per-region map traffic can, and both of those are already refuted or exhausted.
+
+**This also puts a caveat on the concurrency disproof above.** That measurement (0.0% overlap) used the
+SAME invalid harness - 320-element kernels, wrong flags. The conclusion may well stand (nothing in the
+result looked marginal), but it has NOT been re-verified at realistic size and should be before anyone
+relies on it. Re-running it is cheap: add a `nowait`/per-block-token variant to `fuse.f90`.
+
+### THE MEASUREMENT THAT OVERTURNS THIS DOCUMENT (2026-08-04): AMReX head-to-head on the same node
+
+AMReX built from source with the SAME AFAR drop (`clang++`, HIP, `--offload-arch=gfx90a`) and the same
+OpenMPI as MFC, running `Tests/Amr/Advection_AmrCore` at MATCHED AMR settings - 400^3 base, max_level 2,
+ref_ratio 2, max_grid_size 32, regrid_int 2, no subcycling, reflux on, np=8 - measured with the SAME
+instruments (`rocprofv3`, and a PMPI shim; `amr-bench/mpiprof/` has a Fortran-symbol shim for MFC and a
+C-symbol one for AMReX).
+
+| per rank per step | MFC AMR | AMReX | |
+|---|---|---|---|
+| kernel launches | 7,270 | **57,585** | AMReX launches **7.9x MORE** |
+| **argument-map copies** | **143,586** | **54** | |
+| **copies per launch** | **19.75** | **0.00** | |
+| total GPU operations | **150,856** | 57,639 | MFC 2.6x more |
+| MPI calls | 1,258 | **166** | MFC 7.6x more |
+| MPI time | 2.73 s | **0.318 s** | MFC 8.6x more |
+
+**KERNEL COUNT IS NOT THE PROBLEM, AND MOST OF THIS DOCUMENT ASSUMED IT WAS.** AMReX launches EIGHT
+TIMES as many kernels as MFC and is still faster, because it pays essentially nothing per launch. Every
+projection above that prices a change by how many REGIONS it removes - the 14.9% weno+riemann figure,
+the 33% "3x tree reduction", the 46% "tree to 1 region", the 74% full programme, and the governing law
+"wall ~ regions x constant" - optimises the wrong variable. Treat them as historical.
+
+**The variable that matters is COST PER LAUNCH: 19.75 argument-map copies versus 0.00.** That is not a
+hardware limit, not an AMR limit, and not a ROCm limit - it is a property of MFC's OpenMP-target
+interface. A `target` region taking `type(scalar_field), dimension(sys_size)` re-maps every deep `%%sf`
+member on entry. AMReX passes device-resident `Array4` views BY VALUE into HIP kernels, so there is
+nothing to map. The ten refuted mechanisms in this document all tried to make OpenMP mapping cheaper;
+AMReX's answer is to have no mapping inside the loop at all.
+
+**This re-prices the flat store.** Migrating `q_cons` to `amr_cons_st` - a plain `GPU_DECLARE`'d module
+array indexed by a dense slot, replacing per-slot `scalar_field`s - was recorded as "a toll, not a win"
+because it did not reduce region count. Region count was the wrong metric. It is the only change so far
+that moves MFC toward the layout that gives AMReX 0.00 copies per launch, and it should be read as the
+first step of the fix rather than as overhead paid for batching.
+
+**Our MPI is independently worse**: 7.6x the calls and 8.6x the time per step. AMReX aggregates its
+FillPatch/FillBoundary communication across all boxes of a level into one phase; MFC's coarse-patch
+gather is per block (measured: `WAITALL` ~116 times per rank per step).
+
+**Caveats that must travel with these numbers.** AMReX tiles level 0 into 32^3 boxes (~1953 of them)
+while MFC keeps L0 monolithic - that is WHY they launch more kernels, so launch count is not
+like-for-like. Their advection carries one scalar; MFC carries sys_size = 6. Wall-clock is NOT
+comparable (linear advection vs compressible multiphase) and no wall-clock ratio appears above.
+**Copies per launch is the robust figure**: it is a per-launch property, independent of decomposition
+and variable count.
+
+### Remaining increments
+
+1. **Per-slot derived tables.** Give each slot its own WENO/FD coefficient storage so a swap
+ selects rather than rebuilds. Bit-identical; measurable only on stretched/axisymmetric
+ grids (`amr_weno_coef_recompute`), where it also drops ~18 device transfers per swap.
+2. **Per-slot device grid state.** Make the device copies of `m/n/p`, `idwint/idwbuff`, and
+ the coordinate arrays per-slot so `s_amr_sync_grid_state_to_device` becomes an index
+ change rather than a transfer.
+3. **Batched block kernels.** Replace the per-block launch of each RHS/RK kernel with one
+ launch over a block list, with the per-block geometry read from the slot arrays produced
+ by increments 1 and 2. This is the increment that actually removes the measured cost, and
+ the one that retires the `amr_swapped` paired-swap guard. With the packed super-grid
+ disproved above, this is again the *only* route to batching — and it still needs the flat
+ backing store it always did, since `amr_slots` is not `GPU_DECLARE`'d and a runtime slot
+ index inside a kernel is a null dereference. Cost and risk are unchanged from the original
+ assessment: `ACC_SETUP_SFs` would perform overlapping partial mappings of one shared array,
+ which is undefined for the present table and untestable outside Cray. Settle that with a
+ build before committing to the increment.
+
+Re-measure with the `l0_ntile` sweep above after each increment: it is cheap, byte-identity
+checked, and needs no new instrumentation. Two harness traps: the LAST `Time Avg` line in a
+run log is a "Saving" line reporting 0.0 (parse the `Time step` lines), and `D/` is only
+populated by post_process (checksum `restart_data/` instead).
+
+### 2026-08-06: the retraction above is HALF WRONG, and promotion works when the target is FLAT
+
+The 2026-08-03 table retired promotion on the row *"module state - static, allocatable, or the exact
+`freg` pattern | 32.8 | 3.5x WORSE"*. That row is real but it measured **derived types at module
+scope**, which are indeed the worst case. It does not describe a **flat array at module scope**, which
+is the cheapest form available. Retiring "promotion" on that row retired two different things under
+one name.
+
+Re-measured from scratch (`amr-bench/mwe/desc.f90`, 12 variants, one per PROCESS under `rocprofv3` so
+no attribution is needed, built with the EXACT solver flags scraped from `flags.make`):
+
+| what the KERNEL sees | copies/launch | us/launch |
+|---|---|---|
+| flat array, MODULE scope (2 arrays or 12 - same) | **0.63** | 32-55 |
+| flat array, DUMMY (2 arrays) | 4.61 | 89 |
+| flat array, DUMMY (12 arrays) | **24.51** | **391** |
+| derived-type components, module scope | 24.51 | 387 |
+| derived-type components, DUMMY | 28.10 | 446 |
+
+Identical arithmetic in every variant, so every difference is per-region mapping. **Flat-as-dummy costs
+exactly what derived-type-as-module costs**; only a flat array at module scope is free. Cost is ~2 copies
+and ~14 us per descriptor the kernel must materialize per launch, additive across arrays. That single
+model fits all 12 variants, the 08-03 table, and MFC in situ (16.39 copies/launch ~= 8.2 descriptors x 2,
+against the runtime trace's measured 9.75 attaches/kernel).
+
+**Confirmed IN SITU, not just in an MWE.** `s_hllc_riemann_solver`'s hot kernel (`:1013`, **756 of 7,609
+launches/rank-step**) referenced `qL_prim_rsx_vf`/`qR_prim_rsx_vf` 17x each as dummies. Moving their
+actuals (`qL_rsx_vf`/`qR_rsx_vf`) from `m_rhs` to `m_riemann_state` and reading them module-direct:
+
+| | copies/rank-step | copies/launch |
+|---|---|---|
+| baseline `107695df` | 124,749 | **16.39** |
+| predicted | ~121,300 | ~15.9 |
+| measured | **121,729** | **16.00** |
+
+Launches identical (7,609). 3,020/756 = **4.0 copies removed per launch** against 4.6 predicted. The MWE
+constant transfers. **This un-retires promotion for the flat case** - and note it needs no attach
+primitive at all, which is what killed the 08-02 attempt: the arrays are simply DECLARED somewhere both
+sides can see.
+
+**Do NOT read this as "flatten the interface".** Flat *dummies* measure the same as deep dummies (08-03
+row 2, and V12 above). The variable is module-vs-dummy, not flat-vs-deep. Flatness matters only because
+a module-scope derived type is also expensive.
+
+#### Open contradiction, unresolved - read before trusting the model
+
+Flattening `freg` from `type(t_face_reg) :: freg(3)` to six flat `declare target` module arrays should
+have been free-to-free at worst. It measured **WORSE**: copies 16.39 -> 16.61, and a `LIBOMPTARGET_INFO`
+diff on the same case showed attaches **4,027 -> 4,203 (+176)** at identical kernel count. Six flat
+module arrays cost more than one module derived type with six components. The MWE says the opposite
+(V11: 12 flat module arrays = 0.63). The only structural difference found is that `freg_lo*` are PUBLIC
+and USE-associated into `m_amr`, while the MWE's are same-module. **Untested.** Until it is explained,
+predict promotion gains only for arrays that stay within one module, and measure every conversion.
+
+`freg` was also the wrong target for a second reason the 08-02 table already recorded:
+`s_amr_capture_boundary_flux(id, stage)` takes **two scalars and no array dummies**. It was at the floor
+already. Enumerate a kernel's array dummies before converting it.
+
+#### The second penalty, not previously recorded: OCCUPANCY
+
+A 32^3 block is 32,768 work items. An MI250X GCD wants ~1e5-1e6 in flight. **Every fine-block kernel runs
+about an order of magnitude underfilled**, while uniform (8M cells/rank) saturates - consistent with the
+88.2% idle figure. Measured directly by the block-size sweep at constant physics:
+
+| `amr_max_grid_size` | cells/block | fine cells | wall |
+|---|---|---|---|
+| 16 | 4,096 | 27.29 M | **128.58 s** |
+| 32 | 32,768 | 37.53 M | 75.36 s |
+
+Smaller blocks advanced **27% fewer cells in 71% more wall**. So small blocks cost twice: the fixed
+per-invocation cost amortizes badly AND the arithmetic itself runs at a fraction of peak. Batching fixes
+both with one change (32 blocks batched ~= 1M work items = full occupancy), which makes the batching
+prize larger than the `C` analysis alone implies.
+
+There is currently **no minimum block size and no occupancy floor** in the code - only `amr_max_grid_size`
+(a cap) and `amr_cluster_eff`. From the payoff data (overhead 235x at 0.30M cells/GCD, 38x at 2.13M, ~9x
+at production, against a ~40x geometric potential) **breakeven is ~2M fine cells per GCD**; below that,
+refining is a net loss versus running uniform.
+
+### THE PLAN (2026-08-06). Root cause, increments, audits, MWEs
+
+**ROOT CAUSE.** Block identity is a *state reconfiguration* (`s_amr_swap_to_fine` overwrites global grid
+state), not a *data dimension*. Everything follows: the swap, the geometry sync, `C` paid 963x/step, the
+per-box gather, per-box reflux, and the occupancy deficit. The fix is to make the block index an argument
+to the index space rather than a mutation of module state.
+
+**THREE FACTS THAT MAKE IT CHEAPER THAN IT LOOKS.**
+1. At a given level every block shares `dx` and extents; only the ORIGIN shifts. Geometry
+ de-globalization is one integer offset per block per dimension, not a rewrite of every kernel that
+ touches `dx`.
+2. The flat store `amr_cons_st(x,y,z,var,slot)` already exists and already pads every slot to identical
+ `mbuf` extents - ragged blocks are already solved in storage.
+3. It chunks. Batch `B` blocks at a time, `B` traded against scratch memory. `B=2` proves the mechanism,
+ `B=32` captures the win.
+
+**HARD CONSTRAINT.** Batched kernels must read FLAT MODULE arrays with a slot dimension, never dummies
+and never module-scope derived types. Violating this reintroduces exactly the tax the batching removes.
+
+#### Increment B1 - slot dimension on the RHS working set
+
+- Add a trailing slot dimension to the RHS scratch (`q_cons_qp`, `q_prim_qp`, `flux_rs*_vf`,
+ `qL/qR_rsx_vf`, `dq*`): `(..., 1:B)`. TRAILING, matching `amr_cons_st`, so each block's cells stay
+ contiguous.
+- Outer loop over `b = 1, B` collapsed with the spatial loops, so occupancy rises with `B`.
+- Per-block origin offsets in a small `declare target` integer array; `dx`/extents stay global per level.
+- Blocks smaller than `mbuf` compute on pad cells that nobody reads. **AUDIT:** confirm no NaN/Inf
+ escapes the pad region into a reduction - there are no global reductions in the RHS, but verify rather
+ than assume.
+- **MWE first** (`amr-bench/mwe/batch.f90`): one kernel over `(b, k, j, i)` against `B` sequential
+ kernels, identical arithmetic, measuring copies/launch AND wall. Establishes the achievable `B` before
+ any solver edit, and prices the pad waste.
+- **AUDIT:** copies/launch (expect ~1/B of the per-invocation share), `rhs` phase, and occupancy via
+ `rocprofv3` grid size. Goldens after each `B`.
+
+#### Increment B2 - aggregate the gather per level
+
+Gated on the substage measurement now running. Replace the per-box `s_amr_gather_coarse_patch` with one
+per-level phase (AMReX's FillPatch model). **AUDIT:** `gather` phase and `g:box`/`g:mpi`/`g:dev`/`g:alloc`
+substages; the box set must stay byte-identical (`[amr-balance] fine_work`).
+
+#### Increment B3 - batch reflux. #### Increment B4 - regrid, gated on the `rg:*` substage sweep.
+
+#### Standing measurement protocol
+
+1. `copies_per_launch.sh` FIRST - it resolves ~1% and is not noise-limited. Wall time on `prof_amr` has
+ a **+-10% run-to-run spread** (71.26 vs 78.21 s for an identical binary; `reflux` 7.53 vs 10.60),
+ so no sub-10% wall A/B is callable from one rep per arm.
+2. State the predicted number BEFORE running. Every mechanism refuted this campaign was refuted by a
+ prediction that missed.
+3. Goldens for anything touching shared solver code. Copy counts are blind to wrong answers - the L/R
+ swap at `m_rhs.fpp:714` (`qR_rsx_vf` is passed into the `qL_prim_rsx_vf` slot) makes a same-name
+ rename silently transpose the Riemann states.
+4. `ls -t` on build dirs picks the CHEMISTRY variant; scrape the binary MFC actually ran. `ls -t` on
+ `/tmp/mfcrun.*.log` returns a STALE log when a run is refused by the contention guard.
+
+#### Refuted this campaign - do not retry without new evidence
+
+| mechanism | result |
+|---|---|
+| `rhs` module-level bridge (change the ACTUAL argument) | copies **+4.8%**. The callee's dummy declaration sets the cost; the actual is irrelevant. |
+| `freg` derived type -> 6 flat module arrays | copies **+1.3%**, attaches **+176**. See the open contradiction above. |
+| USM (`-fopenmp-force-usm` + `xnack+`) | builds, runs, **65x SLOWER** on MI250X. "Unified" here is host DRAM over the bus; it targets MI300A APUs. Did confirm the tax is 100% mapping: flat and derived-type converge under USM. |
+| `map(alloc:)` vs `map(to:)` at enter-data | no effect, either kind |
+| literal vs loop-variable component indexing | no effect |
+| static vs allocatable derived-type container | no effect |
+
+### 2026-08-07/08 PROFILED (rocprof-sys, not brackets): the straggler is GATHER OWNERSHIP
+
+Switched from hand-placed timers to `rocprof-sys-sample` (`amr-bench/scratch/sysprof.sh`, no code
+changes). It found in ~20 minutes a 14% line item that ~30 timer brackets had folded silently into
+"reflux", and it audited the brackets themselves.
+
+**A 1-integer `MPI_ALLREDUCE` (`s_amr_reduce_xchg_flag`) is 12.23 s = 14.4% of the step loop.** PMPI
+agrees: 27 calls / 11.56 s = **~428 ms per call** for an integer max that should cost tens of
+microseconds. It does no work - it is a pure skew meter, and it says the ranks are ~0.4 s out of
+step at every global sync.
+
+**Per-rank, late ranks (5,6,7) vs early (0,1):**
+
+| routine | late | early | diff |
+|---|---|---|---|
+| **amr_gather_coarse_patch** | **13.12** | **5.45** | **+7.67** |
+| amr_fine_stage_fill | 15.34 | 8.63 | +6.71 |
+| **amr_recv_parent_patch** | **6.04** | **2.56** | **+3.48** |
+| compute_rhs | 25.91 | 24.80 | +1.11 |
+| mpi_allreduce (WAITING) | 0.10 | 10.55 | -10.46 |
+
+**Ranks 5-7 do ~2.4x the GATHER work; compute is nearly equal.** The parent->child ownership mapping
+is asymmetric, so high ranks carry 2.4x the `recv_parent_patch` burden, block there, arrive last, and
+the other five ranks sit in the allreduce.
+
+**It follows the RANK, not the GPU.** Re-ran with `ROCR_VISIBLE_DEVICES=7,6,5,4,3,2,1,0` (MFC picks
+`dev = mod(local_rank, devNum)`, `m_start_up.fpp:1043`): straggler set unchanged, values within ~5%.
+That exonerates GPU placement *and* host/GPU locality (rank 7 drove GCD 0 with identical timing), and
+proves the pattern is not noise - 8 per-rank values reproduced across two independent runs.
+
+**Why the balancer misses it:** it equalizes `fine_work` (CELLS) to 1.018. It does not equalize
+COMMUNICATION burden, and gather cost is per-block and per-ownership-crossing. "Load balance is state
+of the art" is true for cells and false for the gather.
+
+**Clean negative:** no MFC host routine carries meaningful self-time - the host sits in
+`WaitAcquire` (GPU) and `opal_progress` (MPI). Every "expensive host work" theory dies at once.
+Bracket audit: rhs/regrid/reflux agree within a point; `seam` was 2.5x off; `save_data` (9.2%) was
+never instrumented.
+
+#### REVISED PRIORITY (supersedes the increment order above)
+
+1. **Co-locate children with parents** in the ownership assignment - the code already has a
+ "tower co-location" path where the gather degenerates to a local device copy. Attacks the 2.4x
+ directly; changes assignment logic, not the solver.
+2. **`rebuild_slots`** - still 93% of the regrid anomaly (16.0 -> 36.0 s at gs=64), still unexplained.
+ Fixing it makes gs=64 viable, worth ~-15% of wall with no solver change.
+3. **Aggregate the gather per level** (B2) - makes the burden collective instead of per-rank and
+ removes the per-block synchronization together.
+
+**DOWNGRADED:** the per-kernel descriptor conversion (2.4% of the tax per edit, ~40 edits for the
+whole prize, and batching subsumes it - keep only its design CONSTRAINT that batched kernels must read
+flat module arrays). **Non-blocking MPI as a standalone fix** - the receives are asymmetric in COUNT,
+so overlapping helps the loaded ranks but does not remove the asymmetry.
+
+**`hllc` module-direct is HELD, not committed**: correct (706/706), non-regressing on both arms
+(uniform +0.7%, AMR -2.9%, both inside a +-10% noise floor), but worth only ~0.6% of wall and it
+leaves two unreferenced dummies in the signature shared by all four Riemann solvers. Fold it into B1,
+where flat module arrays are load-bearing rather than cosmetic.
+
+## 2026-08-08 MEASURED: co-location is REFUTED, and the parent gather is SKEW not communication
+
+The previous section made "co-locate children with parents" the top priority, on the profiled finding
+that ranks 5-7 do 2.4x the gather work. **That priority is now withdrawn, and the 2.4x attribution with
+it.** Both were settled by measurement before any assignment logic was written.
+
+### The instrument
+
+`s_amr_report_gather_burden` (scaffolding, `mfc-amr-dev`): rank 0 only, gated on `load_weight_wrt`, and
+built entirely from REPLICATED metadata (`amr_block_owner`, `amr_region_*_all`, `f_amr_parent_block`,
+`s_amr_rank_coarse_range` + `s_amr_box_isect`). No hot-path timers, no MPI, no collective added to the
+assigner. It counts exact ownership crossings for both gather paths and - the decisive part - computes
+the COUNTERFACTUAL balance that co-location would produce, so the fix could be priced without being
+built, and without a golden cycle to revert.
+
+### Result 1: co-location is admissible
+
+| level-2 weight balance (max/mean) | value |
+|---|---|
+| actual (independent per-level SFC cuts) | 1.010 / 1.012 |
+| if every L2 block follows its parent | **1.028 / 1.026** |
+| ranks left idle if co-located | **0** |
+
+The stated reason co-location was removed - pinning a subtree to one rank caps granularity at depth -
+does not bite at this configuration. 625 level-2 boxes over 8 ranks leaves ample slack.
+
+### Result 2: co-location is nevertheless worthless
+
+Measured at 400^3 / np=8 / `amr_max_grid_size` 32, from the barrier probe (`PH_P_BAR`) that splits
+"waiting for the peer to arrive" from "the exchange once it has":
+
+| bracket | mean s | % wall |
+|---|---|---|
+| `p:all` - whole level>=2 parent gather | 30.433 | 37.0% |
+| `p:bar` - skew before the exchange | **29.562** | **36.0%** |
+| `p:mpi` - the exchange itself | **0.185** | **0.2%** |
+| `p:pack` / `p:copy` | 0.306 / 0.375 | 0.4% / 0.5% |
+
+`p:mpi` moves 106.6 MB in 0.185 s over 189 calls/rank = **4.46 GB/s, near fabric speed**. The parent
+exchange is not slow; it is negligible. Co-location removes 261 of 625 crossings, so its entire ceiling
+is `p:mpi` + `p:pack` ~= **0.49 s of 82 s = 0.6%** - against the 1.8% balance cost above. **Plausibly a
+net loss.** A 160:1 barrier-to-transfer ratio says the parent gather is SKEW; removing messages cannot
+touch skew.
+
+### Result 3: the 2.4x was wait misread as work
+
+Measured crossing counts, ranks 5-7 vs ranks 0-1: **1.23x**, not 2.4x. The heaviest rank is **3**
+(L1recv 53, L2recv 60), which is not in the profiled straggler set at all. `s_amr_gather_coarse_patch`
+receives with `IRECV` + `WAITALL`, so its INCLUSIVE time absorbs skew - the profile's "gather work" is
+substantially "waiting for peers." This is the same inclusive-time trap already recorded once in this
+campaign, re-entered from the other side: last time ranking by SELF time hid a real cost, this time
+ranking by INCLUSIVE time invented one.
+
+The cells-vs-communication mismatch is nonetheless real and worth keeping: cell balance **1.016** while
+`L1recv` imbalance is **1.50x** and `L2recv` **1.84x**. It is simply not what makes ranks late.
+
+Burden at the same configuration: L1 169 boxes with 109 local / **283 wire** contributor pairs; L2+ 625
+boxes at co-located fraction **0.582**, rising to 0.795 at the next regrid.
+
+### TRAP: this build's phase budget is not a production number
+
+`PH_P_BAR` inserts a global barrier PER BOX. A per-box barrier partly manufactures the serialization it
+measures - each one waits for that box's slowest rank, and 625 boxes accumulate an artifact rather than
+a cost. So `p:bar`, and the 82.2 / 88.2 s wall from this build, must not be used to price anything
+absolute. `p:mpi` is exempt for a specific reason: the barrier sits immediately BEFORE it, which is what
+makes it measure pure transfer. Quote `p:mpi`; do not quote `p:bar` as a cost.
+
+### Revised priority
+
+1. **`rebuild_slots`** - `rg:rebld` is 31.6% of wall and its `rg:gpatc` leaf is 27.4%, while the gather's
+ own instrumented internals (`g:mpi` 3.63, `g:dev` 0.77, `g:box`/`g:alloc` ~0.00) account for a small
+ fraction of it. That gap is the largest unexplained block in the budget and is a COST, not a skew
+ artifact. Measure it on a build WITHOUT the probe barrier.
+2. **Find the skew source.** Cells balance to 1.016, box counts to 1.136/1.024, and messages cost 0.185 s
+ - none of these explain ranks arriving milliseconds apart, thousands of times per run.
+3. **Aggregate the gather per level** (AMReX FillPatch) - unchanged, still the structural answer.
+
+**DEAD (do not re-propose):** co-locating children with parents, and any cost model that balances
+ownership crossings - the crossings cost 0.185 s in total.
+
+## 2026-08-08 CONTROLLED EXPERIMENT: the AMR tax, MFC vs AMReX, on clean binaries
+
+Everything above this line was measured with in-code instrumentation that, in at least three cases,
+distorted what it measured. This section is the controlled replacement: an uninstrumented binary, all
+timing external, arms interleaved, repeats, and one estimator applied identically to both codes.
+
+Configuration: hpcfund np=8, 400^3, `amr_max_grid_size` 32, `amr_ref_ratio` 2, subcycle off, reflux on.
+MFC at `107695df` built clean (hllc stashed, no phase timers, no probe barrier). AMReX `amrex-ref`
+Advection_AmrCore 3d with `run/inputs.match`. Harness and raw logs: `amr-bench/expt/`.
+
+### Result
+
+| tax, per cell advanced, vs that code's OWN uniform arm | MFC | AMReX | excess |
+|---|---|---|---|
+| max_level 1 | **5.9x** | **1.26x** | **4.7x** |
+| max_level 2 | **15.4x** | **1.31x** | **11.8x** |
+
+Absolute ns per cell-update -- MFC 4.38 / 26.0 / 67.4, AMReX 0.711 / 0.896 / 0.932 -- are NOT
+comparable across codes (AMReX advects one linear scalar, MFC solves 6-equation multiphase). Only the
+within-code ratio is, which is why the tax is defined that way.
+
+### The shape, not the magnitude, is the finding
+
+AMReX's tax is FLAT with refinement depth (1.26 -> 1.31, +4%). MFC's nearly TRIPLES (5.9 -> 15.4,
++161%). Adding a level multiplies BLOCK count at roughly fixed cells per block, so a cost that grows
+with depth is per-BLOCK and one that does not is per-CELL. This is the per-block thesis measured
+directly rather than inferred from a profile.
+
+The block counts sharpen it. MFC runs **794 boxes** (169 at L1 + 625 at L2, printed by the code).
+AMReX advances 572.3M cells/step at L2 against MFC's 88.0M; its box count is not printed, but at
+`max_grid_size` 32 the cell counts floor it at 99.1M/32^3 + 393.6M/32^3 = **>= 15,000 boxes**. That is
+a DERIVED LOWER BOUND, shown so it can be audited -- do not quote it as a measurement. AMReX therefore
+carries on the order of 19x the blocks for roughly 1/12 the tax.
+
+### Estimator, and the evidence it is sound
+
+ marginal s/step = (A_last*n_last - A_first*n_first) / (n_last - n_first)
+
+from MFC's cumulative `Time Avg` prints and from AMReX's `Total Time:` at two step counts. This removes
+startup and the early transient without having to estimate either.
+
+It validates internally: two independent MFC windows -- steps 11-31 of a 40-step run and steps 26-76 of
+a 100-step run -- agree to **0.4%** (5.84 vs 5.94 at L1, 15.42 vs 15.40 at L2). The window dependence
+that plagued the first pass is gone.
+
+### Four methodology bugs, each of which changed a number
+
+1. `Coarse STEP n ends. TIME =` is SIMULATION time, not wall. `amr-bench/amrex_tax.sh` regexes it.
+2. `Total Time` / steps includes setup, which inflates the CHEAPER arm proportionally more and so
+ DEFLATES the measured tax -- biasing the comparison in MFC's favour.
+3. Measuring one code in its transient and the other in steady state. Both codes have transients and
+ they run in OPPOSITE directions (MFC L2 falls 6.506 -> 6.032 over 100 steps; MFC uniform RISES
+ 0.247 -> 0.276; AMReX per-cell falls 23% between the 20-40 and 50-200 windows). This alone moved
+ the MFC L2 tax from **19.1x to 15.4x -- a 24% error**.
+4. Interval `Time/step` is a 3-sample-per-run estimator that fluctuates **38% within a single run**.
+ Its noise was initially mistaken for machine noise: on the uniform arm, interval rates spread 22.7%
+ across reps while cumulative averages spread 4.2% -- same runs, same machine, different sample size.
+
+### Reproducibility is itself a result
+
+Spread across reps, on BIT-IDENTICAL work (`fine_work` was identical to the digit for every rep of an
+arm, so the grid is deterministic): uniform **0.9%**, L1 **~3%**, L2 **7.7%** at 100 steps and **19.9%**
+at 40. Only the deepest AMR arm fails to reproduce, and longer runs tighten it -- consistent with
+skew-dominated execution rather than deterministic compute. Note also that the +-10% noise floor quoted
+earlier in this document is a property of the INSTRUMENTED build, not of the machine.
+
+Peak VRAM 36.5 GiB/GCD, 5.7x above the starvation floor, so none of this is a starved-GPU artifact.
+
+## 2026-08-08 CORRECTION: the excess is ~2x, not ~12x -- the denominator was wrong
+
+The section above reported an MFC-vs-AMReX AMR excess of 4.7x (L1) and 11.8x (L2). **Both numbers are
+wrong, by about 5x.** The controlled experiment was sound; the BASELINE was not.
+
+**A tax ratio is only as good as its denominator.** MFC's uniform arm is MONOLITHIC -- 400^3 over 8
+ranks, 200^3 per rank. AMReX's uniform arm at `max_grid_size 32` is decomposed into ~1953 boxes, and
+that decomposition costs it **5.4x** (0.7109 ns/cell at cap 32 vs **0.1312** at `max_grid_size 200`,
+which gives 8 boxes -- one per rank, MFC's exact decomposition). That box cost sits in BOTH of AMReX's
+arms and cancels out of its own ratio. So the original comparison set "MFC vs a fast monolithic
+baseline" against "AMReX vs an already-slow boxed baseline" and attributed the difference to AMR
+machinery.
+
+### The settled comparison
+
+Both codes against a structurally identical monolithic baseline, and with AMReX additionally given
+MFC's per-level structure (`amr.max_grid_size = 200 32 32`: L0 monolithic, fine levels at 32):
+
+| tax vs monolithic baseline | MFC | AMReX structure-matched | excess |
+|---|---|---|---|
+| max_level 1 | 5.94x | **5.43x** | **1.09x -- parity** |
+| max_level 2 | 15.40x | **7.01x** | **2.20x** |
+
+Making AMReX's L0 monolithic barely moved its L2 tax (7.10 -> 7.01), which confirms per-level structure
+was not the distortion -- the denominator was.
+
+### What this redirects
+
+MFC's tax nearly TRIPLES from one refinement level to two (5.94 -> 15.40) while AMReX's grows 1.29x
+(5.43 -> 7.01). The gap is therefore specific to **what the SECOND level adds** -- the parent<->child
+gather, nesting, the level>=2 path -- and NOT to per-block cost in general, where MFC is at parity.
+Any future work aimed at "block overhead" writ large is aimed at the wrong place; at one level MFC
+already matches AMReX.
+
+Raw logs: `amr-bench/expt/amrex_mono` (baseline), `amr-bench/expt/amrex_matched` (structure-matched),
+`amr-bench/expt/logs` (MFC). 3 reps each, marginal-slope estimator throughout.
+
+## 2026-08-08 ROOT CAUSE: the GPU is idle 85% of the time, and it is NOT MPI
+
+Everything above diagnosed AMR's cost by attribution -- brackets, ratios, inference. This section is
+the direct measurement, on a clean uninstrumented binary with external profilers only.
+
+### The time budget (amr_l2, 400^3, np=8, cap 32; wall 6.665 s/step/rank)
+
+| component | s/step | % of wall |
+|---|---|---|
+| kernel execution | 0.694 | **10.4%** |
+| memory copies | 0.850 | 12.8% |
+| **neither -- GPU idle** | **5.12** | **76.8%** |
+
+The uniform arm is the control and validates the instrument: in-kernel 0.2279 s against a 0.2145 s
+wall = **106%**, i.e. the method reads ~100% when the GPU really is busy (the 6% overshoot bounds its
+accuracy). So AMR's 10.4% is a real reading, not an artifact.
+
+### It is NOT MPI -- the decisive discriminator
+
+The same AMR case at 200^3, run at np=1 (no MPI at all) and at np=8:
+
+| | in-kernel | GPU idle |
+|---|---|---|
+| **np=1, zero MPI** | 14.7% | **85.3%** |
+| np=8 | 7.8% | 92.2% |
+
+**85 points of idle survive with a single rank.** Inter-rank effects add ~7 points on top. This
+**retires the skew narrative as the primary cause**: the 12.23 s allreduce, the 160:1
+barrier-to-transfer ratio, gather ownership, co-location and load balance are all real, all measured,
+and all live inside those ~7 points.
+
+### The mechanism
+
+Per rank-step MFC issues **6,146 kernel dispatches + 101,400 memory copies = ~107,546 GPU operations**,
+and blocks in **51,822 `hsa_signal_wait_scacquire`** calls -- roughly one wait per two operations, and
+**92% of all HSA API time**.
+
+| per rank-step | uniform | amr_l2 | ratio |
+|---|---|---|---|
+| kernel dispatches | 82 | 6,146 | 75x |
+| memory copies | 1,318 | 101,400 | 77x |
+| blocking signal waits | 826 | 51,822 | 63x |
+| **waits per dispatch** | **10.1** | **8.4** | **the same** |
+| **copies per dispatch** | **16.07** | **16.50** | **the same** |
+| **seconds per kernel** | **2.8 ms** | **95 us** | **1/30** |
+
+**The per-dispatch toll is identical in both arms** -- slightly higher in uniform, in fact. What
+differs is the work inside: uniform's 2.8 ms kernels hide a ~55 us per-operation host toll completely;
+AMR's 95 us kernels cannot. **AMR issues 77x the GPU operations to advance 1.375x the cells.**
+
+### Ruled out by direct measurement
+
+- ~~**host<->device transfers**: none exist. Every copy is `MEMORY_COPY_DEVICE_TO_DEVICE`.~~
+ **RETRACTED - this was an instrument artifact, and it was the exact opposite of the truth.**
+ `hsa_amd_memory_lock` pins the host buffer, after which rocprofv3 labels a genuine host<->device
+ transfer `MEMORY_COPY_DEVICE_TO_DEVICE`. Byte accounting and call-stack sampling
+ (`targetDataEnd -> retrieveData -> pushMemoryCopyD2HAsync`) independently put ~11.6 GB/step on the
+ link at 1.5-4.9 GB/s against ~50 GB/s: **~75% of AMR wall**. Host<->device traffic is not ruled
+ out, it is THE root cause. Lesson: a negative result from a single instrument is a claim about the
+ instrument until a second method agrees.
+- **occupancy / slow kernels**: AMR in-kernel is 7.9 ns/cell vs uniform's 3.6 -- only **2.2x**, not 54x.
+ The arithmetic is fine.
+- **the descriptor tax as THE mechanism**: uniform pays the same ~16 copies per launch.
+- **MPI, skew, distribution, block size**: see above; block size is separately exhausted (cap 32 is the
+ knee, cap 128 OOMs).
+
+Copies are nonetheless real and numerous: 1.48M on rank 0 over 12 steps, 83% of them 5-10 us with a
+4.64 us floor -- fixed-overhead dominated, the descriptor-attach signature. **They are 94% of the
+OPERATION COUNT even though only 12.8% of wall time**, and since the cost is per-operation host
+synchronisation rather than per-byte transfer, that is the denominator that matters.
+
+### Consequences for the plan
+
+Prize: taking the GPU from 23% busy to saturated is wall 6.665 -> ~1.0-1.5 s/step, a **4-6x** on the
+AMR arm, which would put MFC's tax near 3x against AMReX's 6.33x.
+
+Levers, ordered by operation-count reduction (operations = dispatches x (1 + copies/dispatch)):
+1. **Batch kernels across blocks** (~68x fewer dispatches). Blocked by block identity being a STATE
+ RECONFIGURATION (`s_amr_swap_to_fine` rewrites global grid state) rather than a data dimension.
+2. **Eliminate descriptor copies** (~17x fewer operations) -- now motivated by operation count.
+3. **Async `nowait`/`depend`** -- keep the dispatches, remove the blocking waits. Cheapest to test.
+
+**Pilot discipline:** batching one kernel family removes ~200 of 6,146 dispatches = ~3% of wall, which
+is BELOW this arm's ~8% run-to-run spread. Measure a pilot by **dispatches per rank-step and idle
+fraction**, never by wall -- wall would return a false negative and kill a correct mechanism.
+
+## Removing the regrid host<->device round trip (attempt 4: the A/B split)
+
+### Why attempt 3's NaN could not be attributed
+
+Attempt 3 cut the recurring regrid traffic hard -- slot copies 486 -> 14, H2D 24,251 -> 724 MB -- and
+then NaN'd at a base-grid index. It changed three things at once, so nothing was attributable:
+
+ (a) the `GPU_UPDATE(device=amr_cons_st)` moved BEFORE the overlap, leaving HOST `amr_cons_st`
+ carrying prolong-only data;
+ (b) `s_amr_st_reserve` growth interacting with a now-device-only stash;
+ (c) the overlap bounds rewritten from three per-dimension `cycle`s to one guarded assignment.
+
+### The coupling that forces the split
+
+The stash and the overlap-copy cannot be separated by traffic, because **both the prolong
+(`s_prolong_one_var`) and the overlap-copy are HOST loops**. The stash's D2H of `amr_cons_st` exists
+to feed a host overlap loop that reads host `amr_stor_st`; drop it while the overlap is still on the
+host and the overlap reads nothing. So the win only lands once BOTH move -- which is why attempt 3
+moved both, and why it could not be bisected after the fact.
+
+The split is therefore by **what each step can prove**, not by what each step saves:
+
+| Step | Change | Traffic | Isolates |
+|---|---|---|---|
+| A | overlap-copy -> device kernel (`s_amr_overlap_fine_fields`); push moved ahead of the loop; all existing `GPU_UPDATE`s kept | neutral by construction | (a) and (c) |
+| B | stash -> `s_amr_copy_fine_fields` (device) + conditional host pull | the win | (b) |
+
+If A is clean, a NaN in B is attributable to (b) alone. That is the entire purpose of A.
+
+### Two things the code review found before any run
+
+- **`s_amr_copy_fine_fields` (`m_amr.fpp`) already is the device stash B needs.** B is a deletion plus
+ a call, not new code.
+- **An np>1 bug in A, found by reading rather than by testing.** A migrated block is unpacked into
+ HOST `amr_stor_st` only. Once the overlap reads the stash on the device, those blocks feed garbage.
+ **np=1 cannot see this** -- same shape as attempt 1's failure. A now pushes received slots to the
+ device in the unpack loop.
+
+### Verification gates (`amr-bench/stepA.sbatch`)
+
+Ordered by what each can actually see:
+
+1. **golden suite** -- the only HEAD-independent reference; catches the bounds rewrite (c).
+2. **3D np=1** -- device residency (a), which the goldens do not exercise.
+3. **3D np=8** -- the migration path. Non-optional: goldens cannot see memory-safety bugs (706/706
+ once passed while a 400^3 np=8 run died of an OOB read).
+
+**Harness note.** The build/run variant is STICKY: a bare `--gpu mp` inherited `--no-mpi` from the
+previous session and silently produced a serial binary, on which the np=8 gate would have proven
+nothing while looking like a pass. The job now asserts the binary is MPI-linked and newer than the
+source before trusting any gate.
+
+### Measured: paired HEAD vs Step B (job 367662, 4-step census + 3 timed reps, interleaved)
+
+Both arms prebuilt and saved, installed per run, on the same node, same case, same parser. Necessary
+because both builds land on the SAME variant hash and would otherwise overwrite each other; the job
+aborts if the two arms hash identically.
+
+| np | H2D | D2H | total |
+|---|---|---|---|
+| 1 | 53,668 -> 48,166 MB (-10.3%) | 37,975 -> 32,473 MB (-14.5%) | **-12.0%** |
+| 8 | 59,991 -> 55,172 MB (-8.0%) | 41,981 -> 37,162 MB (-11.5%) | **-9.5%** |
+
+Both directions fall by EXACTLY 5,501.7 MB - the signature of removing one D2H of `cons` plus one
+H2D of `stor` of equal size. Predicted from the copy count 322 x 17.09 MB = 5,503.0 MB; measured
+5,501.7 MB, **0.02% agreement**. Attribution by `Name=` confirms it: every other source file is
+byte-identical between arms and the whole delta is `m_amr.fpp` (644 copies = 322 x 2).
+
+**Wall clock is a SPLIT result and must be reported as one:**
+
+- np=8: **-5.0%**, triplicates non-overlapping (head 3.132-3.184 vs stepB 3.008-3.031). Real.
+- np=1: **-0.1%**. No effect - despite removing proportionally MORE traffic there.
+
+That asymmetry is the interesting part: 12% fewer bytes bought 0% wall at np=1, so the removed
+transfers were not on the critical path. "~75% of wall is host<->device traffic" does NOT convert
+linearly into wall-clock, and any future estimate that assumes it does is unfounded.
+
+**This is NOT attempt 3.** Attempt 3 reported 486 -> 14 slot copies (-97%); Step B cuts bulk slot
+copies 1932 -> 1288 (-33%). A second, independent confirmation that attempt 3 carried a fourth and
+larger change - the one that NaN'd.
+
+### Where the remaining bulk bytes are (stepB, np=1, 4 steps, m_amr.fpp)
+
+| size | count | total | what |
+|---|---|---|---|
+| 17.09 MB | 1288 | 22,007 MB | per-slot copies - the RECURRING cost |
+| 34 -> 8748 MB (doubling) | 26 | ~47,431 MB | `s_amr_st_reserve` growth - a startup transient that amortises away |
+
+Next increment: the surviving 17.09 MB copies are the host-side prolong push and the tag pull. Both
+are the same pattern this step removed - a HOST loop over fine data forcing a full-slot round trip -
+so moving `s_prolong_one_var` to the device is the direct continuation. Note the wall-clock lesson
+above before pricing it: bytes removed != wall saved.
+
+### Harness bugs found this round (all of which produced confident wrong numbers)
+
+- **awk `substr()` returns a STRING.** `n >= 10000000` compared LEXICOGRAPHICALLY, so "5000" > "10000000"
+ and the census reported all 946,278 copies as bulk. Force numeric with `+0`.
+- **The census piped its raw output away**, leaving nothing to attribute. Bulk lines are now kept
+ gzipped - which is the only reason the per-file attribution above exists.
+- **The build/run variant is STICKY**: a bare `--gpu mp` inherited `--no-mpi` from a previous session
+ and silently produced a serial binary. An np=8 gate on it proves nothing while looking like a pass.
+- **``grep -cE '^ *Time step'`` reported steps=0** on runs that had advanced fine, because the line is
+ indented differently than assumed. A gate whose own counter reads zero is not a pass.
+- **LTO builds here are NOT reproducible** (`.text` differs across identical-source rebuilds), so
+ binary identity cannot be used to skip a re-test.
+
+### Unrelated repo bug: running the test suite breaks precheck
+
+The chemistry TESTS write into the EXAMPLES' gitignored `IC/` caches with smaller parameters
+(`lines` 32 vs 160, and 1024 vs 19200). The resulting cache-key mismatch sends
+`./mfc.sh validate` down the IC regeneration path, which aborts in TensorFlow's thread pool
+(`pthread_create` EAGAIN). So `./mfc.sh test` followed by `./mfc.sh precheck` fails on a clean tree.
+Observed twice, restored both times from a clean worktree. The fix is for the tests to use their own
+IC directory rather than the examples'.
+
+## 2026-08-10: the tax is LAUNCH-PATH SERIALIZATION, and this REVERSES the 2026-08-02 conclusion
+
+The section above ("the per-block tax is DUMMY ARGUMENTS, not launch count or descriptors") ruled
+batching out. Measurement at production size says the opposite, and the earlier result has an
+identifiable methodological cause.
+
+Method, which is the reason to believe this over the earlier attempt. 3D 256^3, np=1 (no MPI), and
+crucially measured at STEADY STATE: spin up 30 steps uninstrumented, checkpoint, restart, discard
+the post-restart warm-up, and verify the regime by kernels per step (26,869 measured against 26,868
+extrapolated from an independent 8-to-32-step slope). Copies per launch and gaps per launch are
+taken from SEPARATE RUNS of the same window, because taking both from one timeline makes the
+regression circular. Argument lists come from joining LIBOMPTARGET_INFO to the kernel trace by
+ordinal, gated on an exact 1:1 correspondence (86,118 = 86,118) and on replicate consistency.
+
+Three instruments agree on the mechanism:
+
+- The device is genuinely idle. Clean wall 12.75 s/step against 2.09 s/step of kernel time, so the
+ GPU is busy 16.4% of wall. Intersecting the copy trace with the inter-kernel gaps, 85.9% of gap
+ time has neither a kernel nor a copy active - the idle is not hidden data movement.
+- The host is spinning, not blocked. perf on a run with 1.4% overhead (12.93 against 12.75 s/step)
+ puts 82.63% of host CPU inside libhsa-runtime64, 81.49% self. The cycles event samples only a
+ running CPU, so this is busy execution in the runtime.
+- The volume explains it: about 195.6 HSA calls PER KERNEL LAUNCH - 47 signal stores, 31 signal
+ loads, 17 system-info queries, 17 copies, 14 queue submissions, 9.4 blocking waits and 5.2 signal
+ creations. One OpenMP target region costs roughly 195 runtime calls and 14 HSA packets.
+
+### What this corrects in the section above
+
+- Kernels reading module-level state do NOT pay zero. `capture_boundary_flux` measures 8.73
+ copies per launch, not 0.0. The zero came from TEMPORAL attribution, which credits the following
+ kernel with copies emitted by intervening non-kernel data regions. The same method also made
+ `capture_creg_dense_batch` look like 33 copies per launch when it performs 2.67.
+- Copies are not a first-order cost of WALL time. Regressing gap on copies with the two quantities
+ taken from independent runs gives R-squared 0.283. The counterexamples are decisive: the three
+ advection-source regions perform 0.00 copies per launch and carry 545 to 812 microseconds of gap,
+ while `amr_copy_fine_fields` performs 34 copies and carries 120 microseconds.
+- Argument mapping does not predict the cost. Rank correlation between a region's total argument
+ count and its gap per launch is +0.067.
+- Therefore batching is NOT ruled out. The tax is charged per launch, so reducing launches is the
+ lever. Private ARRAY variables do predict COPIES well (rank correlation +0.771, and hllc's 23
+ private arrays give 53 copies per launch, a third of all copies), but copies do not predict wall,
+ so that is not a wall-time target.
+
+### Runtime configuration does not fix it (12 settings tested)
+
+Harmful: HSA_ENABLE_INTERRUPT=0 is 3.2x slower, NUM_INITIAL_HSA_SIGNALS=1024 is 1.8x slower, and
+HSA_QUEUE_BUSY_TRACKING=0 is worse than baseline. Unresolved: STREAM_BUSYWAIT, NUM_HSA_QUEUES,
+NUM_INITIAL_STREAMS, USE_MULTIPLE_SDMA_ENGINES and HSA_QUEUE_SIZE all land inside the baseline
+spread. The best candidate was re-tested with interleaved triplicates over a 16-step window
+(averaging the last 8 steps): baseline 13.490, 12.781, 13.368 against 13.375, 13.309, 13.534, an
+effect of -1.5% with fully overlapping ranges. That the harmful settings register at 1.8 to 3.2x is
+what makes this null meaningful rather than merely underpowered.
+
+Measurement caveats worth reusing: a post-restart window of 8 steps is too short, because the
+warm-up is about 4 steps and a last-4 average still contains it, inflating every value by roughly
+15 percent. Baselines must be interleaved with the treatment rather than grouped, or node drift
+reads as an effect - the first sweep showed two identical baselines differing by 7.6 percent.
+Instrument distortion must be measured rather than assumed: on the same window, settled seconds per
+step were 12.75 clean, 12.93 under perf, 16.77 under kernel tracing, 26.61 adding LIBOMPTARGET_INFO
+and 30.52 adding HSA tracing.
+
+## 2026-08-13: the per-entity mapping law, Step 1 landed, and the scope that follows
+
+### The law, measured in a controlled microbenchmark
+`amr-bench/scaling/` varies launch count and mapped-entity count INDEPENDENTLY (N target regions,
+M entities each, M swept 0..32, amdflang with MFC's exact flags, MI250X). Every fit below has
+R-squared 1.0000 on the HSA-call term and exactly 2.00 copies per entity.
+
+| construct | copies/entity | HSA calls/launch | wall/launch |
+|---|---|---|---|
+| private SCALARS | 0 | 6.2 constant | ~14 us constant |
+| module arrays referenced directly | 0 | 6.2 constant | free |
+| explicit-shape dummy arrays (bound from an argument OR from module state) | 0 | 6.2 constant | free |
+| BLOCK-scoped arrays inside the loop body | 0 | 6.2 constant | free |
+| private / local fixed-size ARRAYS (any size, with or without a private clause) | 2.00 | +27.9 per entity | +30.5 us per entity |
+| assumed-shape dummy arrays | 2.00 | +26.9 per entity | +34.3 us per entity |
+
+So the per-launch floor is only 6.2 HSA calls and about 11-14 microseconds. Everything above it is
+per-ENTITY, and an entity is expensive exactly when the compiler must materialise a runtime
+descriptor or a per-thread private copy. The cost is independent of the array's size.
+
+### Step 1, landed and measured
+One clause on one macro call at `src/simulation/m_riemann_solver_hllc.fpp:1013`, naming exactly the
+23 private ARRAYS and none of the 60 scalars (naming a scalar would demote it from pass-by-value to
+a real device allocation). Fypp propagates it to all three direction instantiations.
+
+- map-ops on the three regions: 66/70/71 becomes 43/47/48, exactly 23 fewer each
+- hllc copies per launch: 52.7 becomes 6.67, a drop of 87.3 percent
+- fleet copies per launch: 17.02 becomes 12.08, a drop of 29.0 percent
+- correctness: checkpoints after three steps are BYTE-IDENTICAL, both files
+- wall, interleaved triplicates on a 16-step window: 13.170 becomes 10.632 seconds per step,
+ **a drop of 19.3 percent**, ranges non-overlapping
+- AMR goldens 4 of 4, precheck 7 of 7
+
+**Implied cost per copy in situ: 19.1 microseconds.** The microbenchmark slope transferred; a
+review that assumed 9.6 to 10.1 microseconds predicted only 9.9 percent and was wrong by a factor
+of two. This also settles an older dispute: removing copy COUNT converts to wall even though
+removing 12 percent of BYTES did not. They are different currencies.
+
+### Remaining budget, measured after Step 1
+Of the 10.63 seconds per step that remain, 6.20 is copy cost (324,451 copies per step), 2.09 is
+kernel arithmetic, and 2.34 is residual non-copy overhead.
+
+| phase | target | seconds per step | risk |
+|---|---|---|---|
+| A | remaining private arrays: weno l1117 times three (6 arrays each), convert_conservative_to_primitive (6) | 1.75 | low, mechanical, proven pattern |
+| B | AMR kernel dummies: br_store, fine_rk_update, capture_boundary_flux, fill_fine_ghosts, br_load | 3.18 | high; these have no array privates, their cost is descriptor-bearing dummies, and fine_rk_update needs the flat store first |
+| C | rhs advection terms, entity class not yet classified | 1.26 | unknown |
+| D | the 2.34 second residual | measurement only | gates batching |
+
+Phase D matters more than its size suggests. The microbenchmark's per-launch floor predicts only
+0.3 to 0.4 seconds per step, so roughly 2 seconds is unaccounted for. Batching pays only if that
+residual is per-launch; if it is host-side AMR bookkeeping instead, batching cannot reach it. Run
+the measurement before committing to the refactor.
+
+Ceiling: phases A through C complete give about 4.4 seconds per step, roughly 3.0 times today's
+baseline. Removing the residual as well would give about 2.1 seconds, 6.3 times - which
+independently corroborates the 6.6 times per-region overhead measured on the production case.
+
+### Refuted, with the measurement that killed each
+Runtime environment tuning (twelve settings, all null under interleaved triplicates; two of them
+1.8 to 3.2 times slower). Byte reduction (12 percent removed, zero wall). `defaultmap` on the AMD
+branch (hard compile error, reproduced: Firstprivate is currently unsupported defaultmap
+behaviour). `nowait` (compile error for any region with a private clause). `has_device_addr`
+(memory access fault). `firstprivate` for arrays (18 map entries become 38). Interface flattening
+(flat dummies measure the same as deep). The chemistry Fypp guard (dominated by the map(alloc:)
+clause, which needs no semantic change).
+
+
+## 2026-08-15: the matched AMReX decomposition answers Phase D, and the plan that follows
+
+Phase D above asked whether the unaccounted residual is per-launch (batching reaches it) or
+host-side AMR bookkeeping (batching cannot). **It is host-side AMR bookkeeping**, and the shape of it
+is now measured on both codes.
+
+### What is established
+Matched case (400^3, np=8, 2 levels, ref_ratio 2, volumetric blob, refined fraction matched to 1%),
+warm-started, wall from untraced marginal slopes:
+
+| | tax | arithmetic | idle | busy uniform -> l2 | launches/step | dead/launch |
+|---|---|---|---|---|---|---|
+| AMReX | 3.13x | **1.96x** | **1.59x** | 85.7% -> 53.7% | 36 -> 2,582 | **15.3 us** |
+| MFC | 23.92x | **1.60x** | **14.91x** | 80.7% -> 5.4% | 81 -> 14,091 | **1,237 us** |
+
+**Our arithmetic multiplier is BETTER than AMReX's (1.60x vs 1.96x): the AMR algorithm is not what is
+wrong.** The entire deficit is idle - 81x more dead time per launch, 443x more total dead time/step.
+
+**THE STRUCTURAL DIFFERENCE, from call counts (exact, unperturbed by instrumentation):**
+
+| operation both codes must do | AMReX | MFC | ratio |
+|---|---|---|---|
+| coarse->fine patch fill | 2.23/step (`FillPatchTwoLevels`: whole LEVEL per call, all boxes in one `ParallelCopy`) | 625/step (`s_amr_gather_coarse_patch`: ONE BOX per call, own `MPI_WAITALL` each) | **281x** |
+| all MPI exchanges | 16.6/step | >=625/step (regrid alone) | **>=38x** |
+| regrid box generation | 0.57/step | 0.5/step | ~1x |
+| tagging | 1.10/step | 0.5/step | ~0.5x |
+
+**AMReX batches per LEVEL; MFC loops per BOX.** Everything else is comparable. That one design choice
+produces the 81x dead time, the host spinning in Open MPI progress (~51% of host CPU, vader 39.7%),
+and the 94.6% GPU idle.
+
+Device data resident: **AMReX 2.8 GB/rank vs MFC ~50 GB/rank (17x)** - which is why AMReX affords
+64^3 blocks and we are pinned at 32^3 (caps 40/48/64 all OOM at 77-87% VRAM).
+
+### The budget, and why no single fix reaches the target
+To BEAT AMReX's 3.13x we need 18.43 -> 2.41 s/step: **remove 87% of wall.**
+
+| item | % wall | s/step | pattern |
+|---|---|---|---|
+| gather (rbgath 17.4% + gather 13.7%) | 31.1% | 5.73 | per-box |
+| physics dead time inside rhs | 21.0% | 3.87 | per-launch mapped entities |
+| reflux | 10.3% | 1.90 | per-box (expected, NOT measured internally) |
+| rgmig fine-state migration | 7.8% | 1.44 | per-box |
+| rgbuild tail (reconcile + IB + seam revalidate) | 6.9% | 1.27 | per-box |
+| seam halo | 4.7% | 0.87 | serial cross-rank SENDRECV |
+| residual (unbracketed) | 7.1% | 1.31 | unattributed |
+
+Removing the top TWO alone leaves 8.83 s/step = tax 11.46x - still far short. **This is a campaign,
+not a patch.** The kernel floor is 1.00 s/step (tax 1.29x at 100% busy).
+
+### The plan
+
+**Gate 0 - measure the device-memory split (cheap, unblocks Track C).** ~50 GB/rank is spread across
+per-slot `%%q_prim`/`%%rhs` (sized to the CAP, ~56 MB/block), the shared store (`amr_cons_st` etc.,
+grown by DOUBLING - up to 2x overshoot), and O(cap^3) per-rank solver scratch. The split is inferred
+from source, never measured. Instrument the three allocation sites and print at init. Until this
+exists, Track C is guesswork.
+
+**Track C - reduce per-block footprint so the cap can rise (highest leverage per unit work).**
+Cap 32 -> 64 is 8x fewer boxes, which divides EVERY per-box row above by ~8: the four per-box rows
+are 56% of wall today and would become ~7%. That is a larger win than batching, for less
+restructuring - IF the memory can be found. The suspect is the O(cap^3) scratch, which grows 8x with
+no compensating reduction (per-slot storage stays ~constant: 8x bigger blocks, 8x fewer). Sizing the
+fine advance's scratch to the actual block rather than the cap is the specific change to evaluate.
+Blocked on Gate 0.
+
+**Track A - per-box -> per-level batching (the AMReX pattern).** Restructure
+`s_amr_gather_coarse_patch` and its callers so one call services a whole level: post every box's
+IRECV/ISEND, then ONE WAITALL, and hoist the four per-call heap allocations
+(`rbuf`/`sbuf`/`reqs`/`srank`, m_amr.fpp:910) out of the loop. Then apply the same shape to reflux,
+rgmig and the rgbuild tail. Addresses the four per-box rows = 56% of wall (10.34 s/step).
+NOTE the measured split: of the ~31% in gather, only 7.2% of wall is the WAITALL itself; ~24% is
+per-call host work. **So batching the exchange alone is worth ~7%; the allocation/geometry/pack
+hoist is the larger half.** Do the hoist first - it is mechanical and independently valuable.
+
+**Track B - per-launch mapped-entity cost in the physics.** `rhs` is 22.1% of wall and only ~22%
+busy. This is the proven `map(alloc:)` pattern (-26.4% measured at np=1) plus the remaining phases A
+to C above. Independent of Tracks A and C; can proceed in parallel.
+
+### Sequencing and gates
+1. Gate 0 (memory split) - hours, unblocks C.
+2. Track A step 1: hoist the per-call allocations out of the gather. Mechanical, low risk,
+ independently valuable. Measure before and after with the phase budget (`rank_time_wrt = T`).
+3. Track C if Gate 0 says the scratch is the bulk - highest leverage.
+4. Track A step 2: batch the exchange per level.
+5. Track B in parallel throughout.
+
+Every step validates the same way: `./mfc.sh test` for correctness, then the phase budget plus the
+untraced marginal slope on the matched case for wall. **Never take wall from an instrumented run** -
+rocprofv3 inflates MFC 1.3-2.4x and TinyProfiler inflates AMReX 37%.
+
+### Caveats carried forward
+The matched case runs `riemann_solver = 5` (LF) and `weno_order = 1` - the cheapest numerics, chosen
+to match AMReX's linear advection - so neither landed `map(alloc:)` clause is active on it and 23.92x
+is an UPPER bound on the tax for production numerics. The 7.64x excess is NOT decomposition-matched
+(MFC 32^3 vs AMReX 64^3) and cannot be, since MFC cannot allocate 64^3 here; read it as "MFC at its
+memory-forced decomposition vs AMReX at 64^3". MFC phase timers GPU_WAIT at every bracket (phases
+include GPU execution); AMReX TinyProfiler does not (host regions, async kernels) - **share-vs-share
+between the two codes is invalid; call counts are the honest comparison.**
+
+### SUPERSEDED 2026-08-15: the three-track plan above, and the 7.64x it was built on
+The action list now lives in `amr_action_plan.md`. Two things invalidated the plan above:
+1. **The 7.64x excess was an unmatched comparison** - MFC at cap 32 against AMReX at cap 64 (a `sed`
+ override of an inputs file whose committed value was 32). At MATCHED cap the excess is 2.03x
+ (cap 64) or 4.15x (cap 32), and AMReX's tax is not flat in the cap either (5.84 -> 3.40).
+2. **"The cap is exhausted / larger caps OOM" was a checkpoint-restart confound.** Cap 64 runs, gives
+ 4.9x fewer boxes and 2.74x less wall at LOWER memory. Every phase share in the plan above was
+ measured with 4.9x more boxes than we would ship with, so all of its sizing is stale.
diff --git a/docs/documentation/amr_endstate.md b/docs/documentation/amr_endstate.md
new file mode 100644
index 0000000000..784781b69a
--- /dev/null
+++ b/docs/documentation/amr_endstate.md
@@ -0,0 +1,274 @@
+# The AMR end-state: weak-scaling architecture and the re-derived program
+
+Written 2026-08-20, from the ground up, after a month of measurement. This document is the
+**constitution** for the AMR performance program: it states the architecture we are building toward,
+disposes of every piece of work done so far (keep / carry / delete / never-revisit), and re-derives
+the increment ladder so that **every increment is a permanent piece of the end state**. The
+day-to-day work list remains `amr_action_plan.md`; the exchange-layer contract remains
+`amr_plan_based_exchange.md`. Findings update this document; they do not re-found it.
+
+## 1. The diagnosis — why a month of work has not closed the gap
+
+The campaign produced real wins (store fix 2.32x, ISEND pool -17 to -22%, tax 23.92x -> 11.03x,
+payoff now above 1) and a definitive evidence base. It also has a structural failure worth naming,
+because it is the answer to "something critical is going on":
+
+**D1 — Sequencing by phase share, not by architecture.** Each cycle attacked the biggest phase at
+the current operating point. But the measured decomposition proves no single-phase attack can reach
+parity: 23.92x = 1.60x arithmetic x 14.91x idle, and parity needs ~41% GPU busy while *deleting all
+AMR infrastructure outright* only reaches 16.4% — the advance itself is ~22% busy from per-block
+launches. Two independent overheads, **both required**. Yet "batching the advance" was deferred
+because "regrid is 47.4% now" — an operating-point artifact, not a refutation. The result: a month
+of pathology removals (correct, kept) while the two structural constants — per-box kernels and
+per-box messages — remained untouched.
+
+**D2 — Four efforts that are one architecture, never unified.** The flat store (landed), batched
+AMR-local kernels (proven 12.4x on the AMR-local ops), the plan-based exchange (designed, v2), the
+fused advance (T2, never started), and the S-track scaling items are the four pillars of a single
+architecture — the one AMReX/Parthenon/SAMRAI all implement. Tracked as separate tracks with
+separate justifications, each kept being individually deprioritized against the others.
+
+**D3 — The stated goal has no instrument.** The goal is weak-scaling AMR; every measurement is
+np=8 on one node. The weak-scaling harness (S0, ~150 LOC) does not exist; the known scaling walls
+come from code audit; no increment is currently gated on a scaling metric. A program cannot
+converge on a goal it never measures.
+
+The methodology fixes already adopted (5% noise floor, deterministic byte/count gates,
+phase-tree mechanization, pre-registered decision rules) stay. The strategic fix is this document.
+
+## 2. Should we keep this implementation at all?
+
+Three options were weighed:
+
+- **(a) Rearchitect in place along the four pillars below — CHOSEN.** MFC already has the
+ design AMReX/Chombo/BoxLib share: whole-box ownership, absolute cap, replicated box metadata with
+ communication-free assignment, P2P data movement. The earlier "exascale needs a rewrite"
+ conclusion was retracted after audit (the real ceiling was subdomain-derived caps, since removed).
+ Two pillars are partially landed (flat store; plan-based exchange designed and I0 in
+ verification). The gap is *granularity of execution*, not topology of ownership.
+- **(b) Adopt AMReX as the mesh layer.** Rejected: a C++/HIP dependency across four CI compilers
+ plus AMD flang; and the hardest item — rewriting MFC's solver kernels to operate on batched box
+ sets — is *contained in* option (b) anyway, plus an integration layer. All of (b)'s value with
+ less risk is available by adopting AMReX's *patterns* (which this document does, explicitly).
+- **(c) Continue phase-share optimization.** Rejected — it is diagnosis D1.
+
+## 3. The end state, stated as invariants
+
+> **The "today" column below is a SNAPSHOT and drifts.** It was written 2026-08-20 and was a week
+> stale when re-audited on 2026-08-27 (ledger 35: W1 is O(global boxes^2), not O(global boxes); W8
+> now holds through np32). Do not trust it - **run `amr-bench/invariant_scorecard.py `**,
+> which computes the invariant-facing quantities from the `[amr-scale]` counters the code already
+> emits. The program drifted for five days onto a wall-clock metric that is structurally blind to
+> W4; a scorecard you have to remember to consult is one that stops being consulted.
+
+A weak-scaling AMR arm satisfies, at fixed per-rank work as ranks and problem grow together:
+
+| # | invariant | today | end state |
+|---|---|---|---|
+| W1 | per-rank step cost = f(local cells, peers) | seam all-pairs scan FIXED (5ec798ed). Pass-2's O(parents x global tagged cells) rescan is retired by S3.3a. **ROOT CAUSE FOUND 2026-08-28: the block metadata is REPLICATED GLOBALLY** -- `amr_region_lo_all`/`amr_region_hi_all`/`amr_owns_all`/`amr_block_level` are all allocated to `amr_max_blocks`, so every rank holds every block's geometry, ownership and level (~240 MB/rank of metadata at 1e5 ranks x 75 blocks/rank). Every `do ob = 1, amr_num_blocks` site is only writable BECAUSE of this, so W1 cannot be closed by restructuring loops: pass 1 is still O(parents x global blocks) = **O(P^2) per rank**, and S3.3c takes it to O(P) but no lower. Closing W1 needs the metadata DISTRIBUTED (own blocks + neighbour halo, remote queries through `f_amr_owner`) -- an architectural increment on the scale of the store flattening, to be scoped before further W1 loop work | f(local, peers) |
+| W2 | kernel launches/step = O(levels x stages) | 14,091/step (O(boxes x stages x kernels)). **FLAT IN P** (75 boxes/rank at np8/16/32), so this is an efficiency/parity item and NOT on the scaling critical path -- also the largest and least-bounded item | ~10^2 |
+| W3 | MPI messages/step = O(peers x families x levels) | measured live 2026-08-27: **F5 is 71.7 percent of ALL messages** (10,944 of 15,258) while carrying 9.8 percent of the words -- its messages average 0.8 MB against 8-65 MB for every other family. A LATENCY problem; F1/F2 aggregation is the template | O(peers) |
+| W4 | no per-CELL global collectives | **level-1 gather DELETED by S3.1** (`s_amr_union_gtag` gone; ntag_bytes 185 MB -> 0 per rank per regrid, box set bit-identical). **RESTATED 2026-08-28 by differencing per regrid: the residual wall is COLLECTIVE COUNT, not volume.** The level-1 reducing path is FLAT in P in both per-rank bytes (1.39 MB) and collective count (**16,383 global `MPI_ALLREDUCE`s per regrid**, cap-fixed) -- and **99.93% of those are on nodes lying wholly inside ONE rank**, where the reducing rank already holds every tag in the subtree, so they buy nothing but a full-machine sync. Only 7 (np8) / 11 (np16) span >1 rank. The earlier `rbytes` growth of 1.67x/1.83x per doubling lives entirely in the **level-2 forest**, which does zero collectives today. **2026-08-28, CORRECTED: BOTH paths are O(P).** The level->=2 window `ALLGATHERV`, `gwin_bytes` = 360/719/1440 MB per rank at np8/16/32 — exactly 2.00x per doubling, and larger than the 185 MB gather S3.1 deleted. Level 1 is O(P) too: with the block cap raised so it never binds, level-1 tree nodes (= global ALLREDUCEs per regrid) go 13,825 / 27,537 / 54,961 = 1.992x, 1.996x, and its shared set goes 11 / 23 / 47. The earlier 'flat 16,383' and 'O(log P) shared set' readings were BOTH artifacts of a fixed amr_max_blocks = 8192 saturating in every rung (16,383 = 2*8192-1). So S3.3 (each rank clusters only the parent windows it OWNS — the forest is 99.8% rank-local at a CONSTANT fraction in P) goes FIRST, then S3.2b for level-1's flat 16,383-collective latency constant** -- and S3.3 also retires W1's regrid pass-2 loops. Prerequisites B0 and B1 have landed | tag exchange O(local + peers) |
+| W5 | tag space independent of box count | the SECOND wall, at ~28k ranks (2^21 / ~75 boxes per rank). Verified 2026-08-27: **19 of 41 AMR p2p call sites still tag per box**; F1 only partially converted (I2b unlanded), migration tags by column index, and the subcycle sites are an EXPLICIT deferral to I8. Needs I2b + I7 + I8, not one increment | (family, epoch) tag bases |
+| W6 | store lifecycle device-resident | a device-native growth path EXISTS; the host round trip is a deliberate fallback above `amr_grow_dev_cap = 32` columns because device-native staging transiently doubles the footprint (a measured OOM sits behind it). Fix is CHUNKED device-side migration, not deleting the host path | device-side remake, index derived |
+| W7 | migration priced and bounded | verified: `s_compute_load_weight` is 1.0 inside the active box and 0.0 outside -- a CELL COUNT, not a cost model. 170 LOC, so the code surface is tiny; the blocker is choosing the model (the ledger records that a*cells + b*boxes failed its residual test and greedy remapping was worse than none). Goes LAST | work + migration terms, decoupled, hysteresis |
+| W8 | per-rank DEVICE memory = f(live local boxes), never f(global index space) | **HOLDS THROUGH np=8 as of f5f99337 (2026-08-21 night, P1 pooling): np=4 peaks 30.2-39.5 GiB (was 63.6), np=8 COMPLETES for the first time at 39.0-51.3 GiB with live 72-75/rank — >12 GiB headroom on every card** | landed: in-place re-densify + capped growth + early-free + stash-only replicas (9bcc9865) + pooled q_prim/rhs advance scratch (f5f99337) |
+
+Deliberately **kept global**: the replicated box list + owner map (~tens of bytes/box on every
+rank). That is AMReX's own design — it buys communication-free assignment and is tolerable to
+~10^7 boxes. Do not trade it away (audited conclusion, 2026-08-01). What must go is everything
+sized per-cell globally, iterated per-box globally, or allocated O(boxes x ranks).
+
+## 4. The four pillars, with existence proofs
+
+**P1 — Storage: level-major flat store, device-authoritative.**
+One contiguous device array per field family, dense slot index, remade device-side at regrid,
+local index *derived* (search over the owned-box list), no recycle stack.
+*Foreign proof:* AMReX MultiFab + RemakeLevel; Parthenon lid = n - nbs.
+*Status:* flat store landed and authoritative for q_cons; bounded growth + compaction landed
+(2.32x); **remaining:** device-side remap (kills the host round trip that forces the 3x/2x
+hysteresis; steady state 2-3x live -> 1x), then index derivation (deletes the ratchet bug class).
+**PROMOTED 2026-08-21: these two are the measured W8 fix** — at np>=2 the ratchet runs over
+GLOBAL slot indices (a shifting SFC window plus received migration slots) and device-OOMs the
+weak-scaling sweep at np=4; invisible at np=1 where the owned window is static. They are the
+first S-track increment in practice and slot in alongside Phase 1 (independent of the exchange
+conversion; ~120 LOC per the old R5/S2-tier estimates).
+**LANDED same day — S0 np=4 completes; per-rank live boxes AND store capacity measured flat
+across np (the W8 invariant holds).** What survived contact differs from the design: the full
+device-side remake OOMed on its own staging transient and broke a host-coherence contract the
+rebuild's carry-forward depends on (both churn goldens caught it). The landed form is in-place
+index re-densification every reconcile + capped growth increments + early-free of consumed old
+slots + stash-only replica slots, plus the `[amr-cap]` invariant instrument — full narrative in
+`amr_action_plan.md` "W8 FIX LANDED". np=4's hot card peaks 63.6/64 GiB: the next memory term
+is pooling per-slot q_prim/rhs (this pillar, proper) before growing the operating point.
+Local-index derivation stays open as a cleanliness increment (no longer a memory one).
+
+**P2 — Compute: one kernel per (stage, level) over the local box set.**
+Flattened-prefix indexing with binary search over a cell-count prefix (the form already shipping
+and mandated in the exchange design), explicit-shape or module-array access — free under the
+mapped-entity law — with map(alloc:) for unavoidable private arrays.
+*Foreign proof:* AMReX ParallelFor over a FabArray; Parthenon packs rebuilt only on remesh.
+*Why it is required, measured three ways:* a per-block advance costs ~1x a full monolithic step
+regardless of block size (launch count confirmed by kernel trace, 20x launches at 16 tiles); the
+mapped-entity law prices every mapped array at 2.00 copies / ~31 us per launch, irreducible by
+clauses (7 mechanisms refuted); batching the AMR-local kernels over the flat store measured
+**433.5 -> 35.0 ms (12.4x), operations 15,370 -> 250**. The advance (s_compute_rhs tree: 88-91% of
+kernel time, 60-66% of launches) is the one place this form has not been applied.
+*Status:* proven on AMR-local ops; **the advance conversion is the largest open item and the
+parity item.**
+*Caveat carried from Parthenon-VIBE:* full kernel fusion alone still measured 4.4% busy on a
+3-level case — fusion removes the launch term, not host-side mesh bookkeeping. P2 without P3/P4 is
+not sufficient either. The pillars compose; none substitutes for another.
+
+**P3 — Communication: plan-based, per-(family, level) exchange waves.**
+The complete contract is `amr_plan_based_exchange.md` (v2, four-auditor review): SoA plans, epoch
+staleness, aggregated per-peer messages, mandated pack-kernel form, persistent wire buffers,
+per-family precision, hardened validator, increments I0-I8.
+*Foreign proof:* AMReX FillPatch/FillBoundary; Chombo copyTo; SAMRAI RefineSchedule.
+*Status:* designed; I0 (epoch, tags, asserts, the migration-stash corruption fix) in verification.
+Payoff floor 8-12% of wall at the matched point; **the scale case (W3/W4/W5) is unconditional.**
+
+**P4 — Regrid + load balance: local, scan-based, migration-aware.**
+Block-lattice tag coarsening (512x volume cut at 8^3 blocks — AMReX blocking_factor), MPI_SCAN
+prefix weights (8 B/rank regardless of box count — p4est), local clustering with boundary
+reconciliation (SAMRAI), adapt decoupled from repartition (p4est Principle 2.1), SFC cut with a
+migration-cost term and gain hysteresis (ParMETIS vsize; Uintah gainThreshold; Charm++ RefineLB —
+three decades of literature agree migration-blind rebalancing is a net loss, 10-30x more movement).
+*Status:* not started. **Warning to the measurer:** these score ~0 on the matched benchmark
+(rg:tag 0.5%, rg:clus 2.2%); they are judged on S0 scaling metrics and deterministic bytes, never
+on 400^3 wall time.
+
+## 5. Why this reaches the goal — the arithmetic, honestly
+
+Matched point today: 799.022 s, tax 11.03x, AMReX 3.13x (AMReX's own arithmetic floor 1.96x).
+
+- Regrid made free (P3+P4 ceiling): 11.03x -> ~5.8x.
+- Advance at our own uniform arm's efficiency (P2 target; uniform MFC is 80.7% busy, launches 81
+ per step): the decomposition gives 1.60x arithmetic floor — *below* AMReX's 1.96x. The AMR
+ algorithm was never the problem.
+- Composite: **estimate <=5x after Phase 2 lands, 3-4x band after Phase 3** — estimates, not
+ promises; each phase carries its own measured gate.
+- Weak scaling: W1-W7 are what AMReX demonstrates at 10^4 GPUs. Nothing in MFC's ownership
+ topology forbids them; every violation is an implementation artifact with a named fix above.
+
+Two cheap discriminators calibrate the ordering before the big investments (Phase 0): the M2
+mechanism split (is the matched-point idle local-launch-bound or MPI-progress-bound — 200^3 np=1
+arm at equal cells/GCD vs the existing np=8 budget) and the CMA-off transport control (splits
+posting-skew from pack/bandwidth in the exchange families).
+
+## 6. Disposition of everything written so far
+
+**KEEP — already end-state pieces:** flat store + device-authoritative contract; growth bound A'
++ compaction B; level-2 ISEND pool; loop-invariant coarse-halo hoist; P2P parent/child + tower
+de-colocation; per-box allreduce hoist; merge-sort SFC cut; map(alloc:) clauses (hllc, weno);
+phase instrumentation + phase_tree.py + [amr-scale]/[amr-mig] counters; the v2 exchange design;
+seam topology relaxations; store-fix regression case.
+
+**CARRY until replaced by the ladder:** per-box gather paths (replaced in I2-I5b); per-box advance
+(replaced in Phase 2); whole-block migration sends (I4 keeps them for the exact-bytes gate;
+clipping is I4b); subcycle per-box call sites (I8).
+
+**DELETE — candidates, each a user decision:**
+- The L0 coarse-tiling machinery (~1014 LOC of s_l0_ routines): measured 28-35% cost with perfect
+ placement, rebalancing recovers 0.4% (inside noise), and the granularity argument is structural
+ (the finest correction is one tile = 25% of a rank's load). Its goldens would go with it.
+- The recycle stack + amr_loc_free/amr_loc_n bookkeeping — deleted by P1 index derivation.
+- The flux families (deletion already in progress on its own evidence).
+
+**NEVER REVISIT (closed by measurement; the ledger in `amr_action_plan.md` holds the evidence):**
+packed super-grid; cap above 64; greedy/unconditional remapping; per-region map-cost reduction by
+clauses; optimizing reflux (it is the sink, not the source); batch-converting blocking calls
+without a downstream sync; T0 micro-items as a program; L0-sourcing; "cost grows with sim time".
+
+## 7. The ladder, re-derived
+
+Ordering rule: correctness first; then what unblocks measurement; then the scaling walls; then
+constant factors. Every increment lands green and reports S0 metrics once S0 exists. **The local
+test gate is the AMR subset (--only AMR plus the four coexist UUIDs) plus a small cross-section
+when a change touches shared code — never the full 706 locally (user directive, stated three
+times); the full matrix and the other compilers are CI's job on push.**
+
+**Phase 0 — instruments and in-flight verification (days).** Results: `amr_action_plan.md`,
+"2026-08-21 PHASE 0 MEASUREMENTS".
+| id | item | status |
+|---|---|---|
+| 0.1 | migration-stash fix: verify + commit | **DONE** ca360af2, subset 65/65 |
+| 0.2 | CMA-off control | **DONE** — waits +15-18% only: skew/bandwidth mechanism confirmed, sender-progress refuted |
+| 0.3 | M2 mechanism split: 200^3 np=1 arm | **DONE** — rhs per-call IDENTICAL with/without MPI (17.10 vs 17.48 ms): the idle is LOCAL; P2 confirmed as the parity lever, regrid's 5.45x np=8 per-call excess is P3's |
+| 0.4 | **S0 weak-scaling harness** (`amr-bench/s0_sweep.sh` + `s0_report.py`, gate arms `s0_w8gate.sh`) | **DONE, and the W8 blocker it found is FIXED (9bcc9865)** — boxes/rank and fine_work/rank flat by construction (imb 1.004); post-fix np=2/np=4 both complete with flat VRAM plateaus (55.3 / 63.6 GiB) and live 72/rank at both. **The measured gap is now TIME: wall 2.59x per np-doubling at fixed per-rank work (255.6 -> 662.3 s), with ntag/gwin/cost all doubling per np-doubling (W4). Next S0 runs: phase-budget diff of the np=2/np=4 pair (split the 2.59x BEFORE building anything), np=8 arm, np=1 on the current build.** (The earlier freg/creg ~1 GiB attribution guess was WRONG — their np-delta is ~90 MiB; the ratchet + per-slot q_prim/rhs were the real terms.) |
+| 0.5 | uniform-baseline re-run (13% discrepancy) | pending |
+
+**Phase 1 — P3 exchange (in flight; contract = `amr_plan_based_exchange.md`).**
+I0 -> I6 as staged there, plus the two independent cheap scaling items folded in early: S1
+block-lattice tag coarsening and S2 scan-based weights (~100 LOC combined, judged on S0 metrics).
+Exit: messages O(peers); plans cached on epoch; validator green at ppn=4; bitwise goldens.
+
+**Phase 2 — P2 batched advance (the parity item).**
+- 2a prototype: batch convert_conservative_to_primitive over each level's boxes (the single
+ biggest kernel in BOTH arms, 562 launches/step -> one per stage per level). Prices the full
+ conversion before commitment; gate: launch count + matched wall + byte-identity.
+- 2b the rhs tree: (stage, level) kernels over the flat store; flattened-prefix box indexing;
+ explicit-shape/module access; map(alloc:) private arrays. The largest single investment in the
+ program (m_rhs/m_weno/m_riemann, three offload backends). Risk bounded by 2a, the l0_ntile
+ byte-identity sweep (the established instrument for exactly this cost), and per-family
+ conversion order.
+Exit: launches/step O(levels x stages); l0_ntile sweep ratio ~1 (today 16.75x at 16 tiles);
+matched tax at or below ~5x.
+
+**Phase 3 — P4 regrid + load balance.**
+S3 local clustering + reconciliation; M5 decouple adapt/repartition (prerequisite for pricing
+migration at all); M3 migration-cost term + A7 hysteresis (judged on deterministic bytes — the
+10,748,501,376-byte reproducibility makes this an exact experiment); I7/S4 shrink the O(boxes)
+loops and the O(boxes x ranks) allocations whose consumers are all converted.
+Exit: per-rank regrid cost O(local + peers); S0 metrics flat across the size sweep.
+
+**Phase 4 — completion.**
+I8 subcycle conversion; execute the deletion list; full suite + four CI compilers + AMD flang;
+**multi-node weak-scaling validation** (needs an allocation decision — see below); upstream PR
+strategy for #1628.
+
+## 8. Decision points (user)
+
+- **D-phase2: RE-SEQUENCED 2026-08-27 — 2b is required but is NOT next.** The 2026-08-20 decision
+ ("yes full commitment we need to get this done") stands on WHETHER; ledger 35 changed WHEN. W2 is
+ FLAT in P (75 boxes/rank at np8/16/32 alike): a ~173x launch constant is a permanent efficiency
+ tax at every scale, but it is not what fails at 1e5 ranks. W4 and W1 are, and both have far
+ smaller fixes. Order: W4 -> W1 -> W5 -> W3 -> W2 (2b) -> W6/W7. 2a stays gated off
+ (`amr_prim_batch = .false.`); its bridge-load regression is the argument FOR store-native 2b, not
+ against Phase 2.
+- **D-node: CONSTRAINED 2026-08-20 — nodes are scarce here.** Weak-scaling validation is designed
+ single-node-first: S0 sweeps problem size and rank count (1..8 GCDs) at fixed per-rank work,
+ which exposes every O(boxes) and O(P) term without a second node. Multi-node becomes a final
+ spot-check if and when an allocation window exists; nothing in the ladder blocks on it.
+- **D-l0: DECIDED 2026-08-27 — DELETE.** MFC's level 0 is balanced BY CONSTRUCTION (a Cartesian
+ decomposition hands every rank one equal-sized chunk), so L0 tiling load-balances something that
+ cannot be imbalanced in the uniform-cost case. AMReX boxes level 0 only because there boxes ARE
+ the decomposition, which is also why the literature's ">=4 boxes/rank" floor does not transfer.
+ Measured: tiling costs 28-35% wall, rebalancing recovers 0.6% (inside noise). **RE-ENTRY
+ CONDITION, and it is live rather than hypothetical:** a measured level-0 work imbalance above
+ ~10% on an IB, chemistry, or Lagrangian-bubble case, with `[amr-balance]` extended to level 0 —
+ MFC's own fine-block cost model already carries `K_ib`/`K_pc` terms, so the code encodes that
+ per-cell cost is NOT uniform once those physics are on; level 0 just gets no equivalent. Before
+ deleting, check what the 12 L0/coexist tests cover incidentally. The L0 restart-writer filter is
+ DROPPED - do not repair save/restart for machinery being removed.
+
+## 9. Planning discipline: just-in-time contracts, one phase ahead
+
+Only one phase carries a detailed implementation contract at a time (as of 2026-08-27: the W4 fix =
+`amr-bench/notes/s3_distributed_clustering_design.md`; Phase 1's `amr_plan_based_exchange.md` is
+landed and no longer the active contract). When phase N is roughly 70% landed, phase N+1 gets its own
+contract at the same resolution — family/kernel inventory, data-layout contract, portability
+constraints, increments with gates — written against the code as it exists *then*, and put
+through the independent multi-reviewer audit ritual before its first increment (v1 of the
+exchange design was wrong seven ways when audited; the ritual also found a live corruption bug).
+Planning further ahead than one phase is recorded here only at the pillar/invariant level.
+Concretely: the Phase 2 contract is written during Phase 1's I4-I6 stretch, seeded by the landed
+pack-kernel form, the 2a prototype's measured price, and the M2 discriminator's verdict.
+
+## 10. Standing rules (unchanged, restated)
+
+Noise floor ~5%: single-run wall deltas below it are not results; judge deterministic bytes/counts
+where possible. Pre-register decision rules before data lands. Mechanize error-prone readings.
+An unexplained golden diff is a bug report. Smallest correct change; increments land green,
+one commit each. Findings update this document's status columns; re-founding it requires evidence
+that an invariant in section 3 is wrong.
diff --git a/docs/documentation/amr_fine_distribution.md b/docs/documentation/amr_fine_distribution.md
new file mode 100644
index 0000000000..746e75bf12
--- /dev/null
+++ b/docs/documentation/amr_fine_distribution.md
@@ -0,0 +1,172 @@
+@page amr_fine_distribution AMR fine-level distribution
+
+# AMR fine-level distribution (design note)
+
+> **Design record / implementation note.** This documents the internal design and development of AMR
+> fine-block distribution across MPI ranks. For user-facing behavior and parameters, see @ref amr.
+
+## Problem
+
+MFC's AMR uses a **mirror decomposition**: the fine level reuses the coarse rank
+decomposition, so each rank owns exactly the fine cells over its coarse subdomain's
+intersection with the blocks (`s_amr_compute_isect` → `amr_rank_owns_block`). This makes
+coarse↔fine coupling entirely rank-local (zero communication) but leaves fine work
+**unbalanced**: if refinement concentrates in a sub-region, only the ranks owning that
+region do the fine advance while the rest idle. At scale this caps AMR speedup.
+
+## Target
+
+Give the fine level its **own distribution**, decoupled from the coarse decomposition, so
+fine blocks spread across all ranks by measured work — the AMReX per-level
+`DistributionMapping` idea. MFC already enforces an invariant that makes this far simpler
+than the general case: **blocks are kept ≥ `buff_size` apart** (regrid merge), so with
+**whole-block-per-rank** assignment there is *no fine–fine halo at all*
+(`s_mpi_sendrecv_amr_fine_halo` disappears). The only coupling that becomes communication
+is coarse↔fine, block-granular.
+
+## Coupling changes (whole-block-per-rank)
+
+| Step | Today (mirror, local) | Decoupled |
+|---|---|---|
+| Ownership | intersection, multi-owner (`amr_rank_owns_block`) | single owner (`amr_block_owner(k) == proc_rank`) |
+| Ghost fill / prolong (coarse→fine) | read local coarse `q_cons` | **gather** coarse patch (block + `buff_size` halo) from coarse owner(s) to block owner |
+| Reflux + restriction (fine→coarse) | write local coarse cells | **scatter** corrections from block owner back to coarse owner(s) |
+| Fine–fine halo | coarse Cartesian neighbors | none (blocks separated) |
+| Regrid | cluster (global) → mirror | cluster → **assign** (`amr_block_owner`) → **migrate** fine state |
+
+The gather/scatter is the only new communication surface. SFC-ordered assignment keeps a
+block's coarse patch on an SFC-nearby rank, bounding the cost. Conservation exactness is
+preserved because the scatter applies the *same* reflux add / restrict overwrite the
+mirror model applied locally — a pure data-movement change, not a numerics change.
+
+## Reuse
+
+`m_load_weight` (per-cell cost field) and `m_sfc_partition` (Morton order + chains-on-chains
+balanced partition) already exist as an init-time diagnostic. They become the fine-level
+distributor: feed the block list + per-block fine-work weight, return `amr_block_owner(:)`.
+
+## Phasing (each independently mergeable)
+
+1. **Distribution map, computed but not applied** (behavior-preserving). Add
+ `amr_block_owner(:)` + SFC assignment + an imbalance diagnostic; mirror ownership and all
+ coupling unchanged. Goldens bit-identical. *(this note's first increment)*
+2. **Apply the map**: switch `amr_rank_owns_block` to single-owner, add the coarse↔fine
+ gather/scatter, drop the fine–fine halo. Validate conservation + assignment-independence.
+3. **Dynamic rebalance each regrid**; optionally drop the fixed max-size slot pool for
+ right-sized boxes.
+
+Phase 2 carries the correctness risk (gather/scatter exactness) and is the checkpoint gate.
+
+## Phase 2 implementation status (branch `amr-fine-dist-wip`)
+
+Done and np=1 bit-identical (the gather reduces to the local read when the owner is the sole rank):
+
+- **Gather** (`s_amr_gather_coarse_patch`): per-block coarse patch `[region_lo-nmar : region_hi+nmar]`
+ assembled by a sentinel-MAX allreduce into `amr_cg` (a drop-in `scalar_field`). Contribution rule
+ `f_amr_own_coarse` claims interior cells + physical-boundary ghosts only (never inter-rank ghosts), so
+ there is one authoritative contributor per cell and no coarse-ghost halo dependence. `pull_host` flag
+ stages device-resident coarse to host for the runtime callers.
+- **Read side rerouted**: init/regrid host prolongation (`s_interpolate_coarse_to_fine`) and the runtime
+ device ghost-fill (`s_amr_fill_fine_ghosts`, stage + subcycle) now prolong from `amr_cg`.
+- **Restriction scatter** (`s_restrict_fine_to_coarse`): owner restricts on host into the `amr_cg_wp`
+ scratch (sole contributor), sentinel-MAX assembles, each rank overwrites the covered coarse cells it
+ owns. `s_restrict_all_vars` (old local device kernel) deleted.
+- **Fine–fine halo dropped**: `s_mpi_sendrecv_amr_fine_halo` calls removed (whole-block owner has no
+ continuation faces; blocks ≥ buff_size apart). Routine in `m_mpi_proxy` now dead — remove with the
+ reflux rework.
+
+Remaining (the conservation crux — reflux is NOT yet decoupling-correct):
+
+- **Reflux redesign.** `s_amr_reflux_face_flags` derives transverse participation `tv` from `amr_isect`,
+ which is owner-only in the decoupled model, so `own_lo/own_hi` (gating BOTH `creg` capture and the
+ reflux apply) is true only on the block owner — which does not own the outside coarse cells. Fix:
+ (1) recompute `tv` from the replicated block range (`amr_region_lo/hi(t)` overlap with `sidx:sidx+ext`),
+ so any coarse-outside-owner participates; (2) the owner captures `freg` (already correct) and BROADCASTS
+ it (allreduce, replacing the cart-neighbor `s_mpi_sendrecv_amr_reflux_faces`); (3) coarse-outside-owners
+ capture `creg` locally and apply `(freg-creg)` to their owned outside cells — verify the apply's
+ block-relative transverse indexing maps onto each receiver's local coarse slice. Conservation-critical.
+- **QBMM pb/mv** gather/scatter for np≥2 (currently local; non-polytropic QBMM+AMR now **gated fail-closed** at np≥2 in
+ `m_checker` — see "Known open" for the scatter follow-up).
+- np=2 conservation + assignment-independence validation once reflux lands (acceptance goldens:
+ BD21A5C0, 5EFB3277, 79B334C7 — they pass on `up/mega` via the mirror).
+
+## Phase 2 status: DONE and validated (reflux + scalability)
+
+The reflux redesign above landed (block-relative frame, participation from the replicated block range), and the
+whole coupling is now **point-to-point + right-sized** — the fine level distributes with no global collective per
+stage and per-rank memory that scales with the decomposition.
+
+- **Reflux**: `s_amr_reflux_face_flags` derives `tv`/`tlo`/`thi` from the replicated block range; `creg` capture +
+ both applies index block-relative; the owner's `freg` is delivered to the applying coarse-outside-owners.
+- **Point-to-point coupling** (replaced the correctness-first global collectives): a replicated coarse-decomposition
+ table `amr_decomp` (allgathered once at init) lets any rank compute which ranks hold a coarse-cell range.
+ - gather: owner `Irecv`s patch slices from the coarse-owners (`f_amr_rank_coarse_range`).
+ - restriction: owner `Isend`s each coarse-owner its covered slice (`f_amr_rank_interior`).
+ - reflux: owner `Isend`s `freg` only to participants (`f_amr_reflux_participates` = `own_lo/hi` parameterized by
+ rank via `amr_decomp`); `s_amr_p2p_reflux_faces` in `m_amr`.
+ Non-participants exchange nothing.
+- **Right-sized memory**: fine/coord/register arrays sized to `amr_maxc_fit` (min-over-ranks local half-extent = the
+ max block a rank can own, enforced by the scratch-constraint abort), not the global half-domain `amr_maxc` — about
+ `1/num_procs` (and `1/num_procs^(d-1)` for the face registers) the memory at scale.
+- **Coordinate fix**: `s_amr_swap_to_fine` extends fine ghost coords from the global boundaries `amr_g?cb` (the owner
+ need not hold the block's local coarse coord slice).
+
+Validated: np=1 1D/2D/3D goldens bit-identical; np=2 conservation exact in 1D (energy 1.9e-16) and 2D with
+transverse-face appliers (mass 1.4e-14), bounds-clean. `s_mpi_allreduce_array_max` remains only for the
+once-at-init coordinate assembly.
+
+## Phase 3
+
+1. **Block-splitting / tiling** (the coverage gap) — DONE.
+ - **Tiling**: `s_amr_tile_box` splits any box > `amr_maxc_fit` into contiguous ≤`amr_maxc_fit` sub-blocks, wired into
+ the initial-block setup and the regrid pipeline (non-IB); `s_populate_amr_fine` loops over all blocks refreshing
+ per-block mirrors via `s_amr_select_slot`.
+ - **Block-to-block fine-fine halo**: the fine advance is three driver phases — **fill all** (gather + coarse
+ ghost-fill), **`s_amr_fine_fine_halo`** (overwrite each seam ghost with the neighbour's *stage-entry* interior,
+ buff_size-deep, `MPI_Sendrecv` between owners or a local copy when one rank owns both; adjacency from the
+ replicated `amr_region_*_all` via `f_amr_seam`), **advance all** (RHS + RK). `s_advance_amr_fine_stage` split into
+ `s_amr_fine_stage_fill` / `s_amr_fine_stage_advance`.
+ - **Reflux seam-exclusion**: `f_amr_face_is_seam` drops a sub-block face shared with another fine sub-block from
+ `s_amr_reflux_face_flags` `own_lo/own_hi` (fine-fine, not c/f).
+ - **Owner-ordering fix**: `s_amr_assign_block_owners` runs BEFORE the owner-dependent `s_set_amr_fine_geometry` in
+ init, regrid, AND restart — the stale default (rank-0) owner map otherwise sized multi-block owners wrong (only
+ surfaces once tiling makes several blocks). Restart (`s_read_amr_restart`) is a two-pass read (regions → assign →
+ place data) for both the parallel_io and non-parallel_io paths.
+2. **Regrid cross-rank fine-state migration** — DONE (the stretched-np≥2 correctness fix). The regrid overlap-copy
+ preserves a covering old block's fine detail by reading `amr_slots(kk)%%q_cons_stor`, but that was local-only
+ (`if (.not. old_owns(kk)) cycle`). Under fine-level distribution an old block can be owned by a rank *other* than the
+ one now owning a covering new block, so the copy was silently skipped and the new block kept only its
+ coarse-prolonged values — **exact on uniform grids** (prolongation reproduces the fine field) but **~O(1e-4) wrong on
+ stretched grids** (prolongation is not exact). Fix: broadcast every old block's stashed fine state from its owner
+ into the replicated slot's `q_cons_stor` on all ranks (`num_procs>1`; no-op at np=1), copy the overlap from *every*
+ covering old block regardless of ownership, and take `old_ilo`/`old_ext` from the global replicated region (not the
+ owner-only isect). Correctness-first collective; a per-block P2P version mirroring `s_amr_gather_coarse_patch` is
+ future work. Validated (`-b mpirun`): 79B334C7 (1D stretched dynamic-regrid, 2 ranks) passes; F0DDE1B4 (np=1 twin),
+ 5EFB3277 + BD21A5C0 (uniform np=2 tiled + restart), and the np=1 AMR batch all pass.
+
+## Golden regeneration note (tiling refines more at np=1)
+
+At np=1, tiling adds a capability the mirror never had: refining a tagged region **larger than `amr_maxc`** (half the
+domain per dim). The old regrid **clamped** any box to `amr_maxc_fit` (`hi = lo + amr_maxc_fit - 1`), so a big tag was
+only partially refined; block-splitting **tiles** it and refines the whole tag. Any np=1 AMR golden whose tag exceeds
+`amr_maxc(dim)` therefore changes (more cells refined) and must be regenerated with the tiled binary — an *intended*
+solution change, not a regression (the tiled advance is bit-identical to the mirror where footprints match, conservation
+is exact, and the seam is exact). Example: **B7704247** (2D stretched-y regrid) — the mirror refined `y4:23` (20 cells,
+clamped); tiling refines the full `y4:35` (`y4:19` + `y20:35`). Golden regenerated. np≥2 goldens are unaffected: the
+mirror splits a block across ranks there, so its footprint already matches tiling.
+
+## Known open
+
+- **QBMM pb/mv** gather/scatter for np≥2 — the pb/mv side-state coarse↔fine coupling (`s_amr_prolong_pbmv` /
+ `s_restrict_pbmv`) and the regrid QBMM overlap-copy are still LOCAL-only (same bug class as the q_cons migration
+ above). Now **gated fail-closed**: `m_checker` PROHIBITs `qbmm .and. .not. polytropic .and. num_procs > 1` for `amr`,
+ so np≥2 non-polytropic QBMM+AMR aborts at case load instead of silently coupling to the wrong coarse side-state.
+ Distributing pb/mv (gather/scatter/migration, mirroring q_cons) is future work for when np≥2 QBMM+AMR is needed and
+ testable. Polytropic QBMM+AMR at np≥2 is unaffected (its moments ride q_cons, which is already distributed).
+- **`amr_g?cb` lacks physical-boundary ghost coords** (sized `-1:m_glb`; the base grid's `x/y/z_cb` carry BC-aware ghosts
+ via `s_populate_grid_variables_buffers`). A near-domain-edge **whole** (untiled) block can drive the fine ghost-coord
+ build out of `amr_gycb` bounds — surfaced only by artificially disabling tiling; tiled blocks stay in bounds. Fix if
+ untiled near-edge whole blocks ever become reachable.
+- Minor: the P2P routines scan all `num_procs` to find participants (integer-only, O(P) per block per stage); the regrid
+ migration broadcasts (correctness-first, → P2P); patch-only device transfers instead of whole-field host round-trips
+ (GPU only); own-only slot allocation.
diff --git a/docs/documentation/amr_implementation.md b/docs/documentation/amr_implementation.md
new file mode 100644
index 0000000000..e9be09c5ff
--- /dev/null
+++ b/docs/documentation/amr_implementation.md
@@ -0,0 +1,523 @@
+# AMR Implementation Reference
+
+`amr.md` describes *what* MFC's AMR does. This document describes *how it is built*: the index
+spaces, the data structures, the exact call sequences, and the invariants that hold between them.
+
+It exists because the conceptual description is not sufficient to modify the code safely. Every
+serious defect found during the 2026 performance campaign came from a wrong belief about one of
+the items below — not from a wrong algorithm. Sections 2 and 11 are the two most load-bearing.
+
+Routines are cited by name rather than line number so this document ages gracefully; every name
+here is greppable in `src/simulation/m_amr.fpp`, `src/simulation/m_amr_regrid.fpp`,
+`src/simulation/m_amr_registers.fpp`, `src/simulation/m_global_parameters.fpp`, or
+`src/simulation/m_time_steppers.fpp`.
+
+---
+
+## 1. Module map
+
+| File | Responsibility |
+|---|---|
+| `src/simulation/m_global_parameters.fpp` | Slot pool metadata, working-slot mirrors, `s_amr_select_slot` |
+| `src/simulation/m_amr.fpp` | Everything per-block: store, gather, prolong, restrict, reflux, halo, swap |
+| `src/simulation/m_amr_regrid.fpp` | Tagging, clustering, nesting, box shaping, slot rebuild |
+| `src/simulation/m_amr_registers.fpp` | Flux registers (capture and application) |
+| `src/simulation/m_amr_restart.fpp` | Checkpoint of the hierarchy |
+| `src/simulation/m_time_steppers.fpp` | The driver: where the AMR calls are sequenced within an RK stage |
+
+`m_amr.fpp` is ~7000 lines and holds ~90 routines; it is the file to read for anything per-block.
+
+---
+
+## 2. The four index spaces
+
+**This is the section to read before touching anything.** Four distinct integer index spaces are
+in play, they are all `integer`, and nothing in the type system distinguishes them. Confusing two
+of them produces a silent wrong answer, never a compile error.
+
+### 2.1 Global slot index — `k`, and the working value `amr_cur`
+
+Range `1 : amr_max_blocks`. **Replicated on every rank**: every rank knows the level, owner, and
+region of every block in the hierarchy, whether or not it owns it. This is what indexes:
+
+```
+amr_block_level(k) amr_block_owner(k) amr_slot_live(k)
+amr_region_lo_all(:,k) amr_region_hi_all(:,k)
+amr_isect_lo_all(:,k) amr_isect_hi_all(:,k) amr_owns_all(k)
+```
+
+The pool is **tiles-prefix partitioned**:
+
+```
+[1 : l0_slot_off] level-0 L0 tiles
+[l0_slot_off+1 : l0_slot_off+amr_max_fine] regrid-managed fine blocks
+```
+
+With the L0-tile path disabled (the common configuration) `l0_slot_off = 0` and
+`amr_max_fine = amr_max_blocks`.
+
+`amr_cur` is the *working* slot. `s_amr_select_slot(islot)` sets `amr_cur = islot` and copies that
+slot's region/intersection/ownership into the scalar working mirrors (`amr_region_lo`,
+`amr_isect_lo`, `amr_rank_owns_block`, ...) that the per-block machinery reads. Most per-block
+routines take no slot argument — **they read `amr_cur` implicitly**. Calling one without a
+preceding `s_amr_select_slot` operates on whatever block was selected last.
+
+`amr_num_blocks` is the number of currently active slots, and the loops are
+`do islot = 1, amr_num_blocks` **on every rank**, with a `cycle` for blocks the rank does not own.
+The loop is therefore collective in structure even where the work is not.
+
+### 2.2 Local dense index — `loc = amr_loc_of(k)`
+
+Range `1 : amr_loc_n`, **per-rank and private**. Defined only for blocks this rank owns;
+`amr_loc_of(k) == 0` means "not live here". This is the only thing that indexes the flat field
+store's slot dimension.
+
+The two spaces are related solely through `amr_loc_of`. There is no inverse map. `loc` values are
+handed out by a counter with a recycle stack, **not derived from the live set** — see §5, and
+§11.3 for why that distinction is the root of a real bug.
+
+> **The two per-block arrays disagree on index space.** The field store is indexed by the *local*
+> dense index; the **flux registers are indexed by the *global* slot index**
+> (`freg(d)%%lo(:,:,:,amr_cur)` in `m_amr_registers.fpp`) and sized `1:amr_reg_cap`, which grows
+> toward `amr_max_blocks`. So `amr_cons_st(...,amr_loc_of(k))` and `freg(d)%%lo(...,k)` refer to the
+> same block through different subscripts. Passing one where the other is expected compiles
+> cleanly and silently reads another block's data.
+
+### 2.3 Box index — `k` within a regrid, `ks = f_l0_slot(k)`
+
+During `s_amr_regrid_*`, freshly clustered boxes are numbered `1 : nboxes`. This is a *third*
+space, mapped to global slots by `f_l0_slot(k)`. The regrid code holds **old** and **new** box sets
+simultaneously (`old_np`, `old_ilo`, `old_ext`, `old_level`, `old_owns` describe the pre-regrid
+set), and both are indexed in this space. Reading `old_*` with a new box index, or vice versa, is
+the classic regrid bug.
+
+### 2.4 Cell index
+
+Block regions are stored **in level-0 cell indices at every level**. A level-`l` block's fine
+extent per dimension is `amr_ref_ratio**l * region_width - 1`. So `amr_region_lo_all` is *not* in
+the block's own resolution, and comparing a region bound against a fine-grid loop bound requires
+the scale factor.
+
+---
+
+## 3. The flat field store
+
+```fortran
+real(stp), allocatable, dimension(:,:,:,:,:) :: amr_cons_st, amr_stor_st, amr_gst_a, amr_gst_b
+! (x, y, z, var, LOCAL slot)
+$:GPU_DECLARE(create='[amr_cons_st, amr_stor_st, amr_gst_a, amr_gst_b]')
+integer :: amr_st_cap = 0
+```
+
+One contiguous device-resident array per role, replacing a per-slot vector of independently
+allocated `scalar_field`s. This is the layout AMReX's `MultiFab` single-chunk path uses and the
+prerequisite for batching one kernel over all blocks.
+
+| Array | Role |
+|---|---|
+| `amr_cons_st` | Conserved state. **Authoritative** for `q_cons` on fine blocks. |
+| `amr_stor_st` | Regrid stash — the pre-regrid state, read to seed new blocks |
+| `amr_gst_a`, `amr_gst_b` | Subcycle ghost pair; allocated **only** when `amr_subcycle` |
+
+Every slot carries the same buffered extents (`mbuf*_lo : mbuf*_hi`), so one array serves them all.
+The cost of that uniformity is that every slot is sized for the *largest* block, not its own.
+
+`amr_st_cap` is the number of local slots the store is sized for.
+
+### 3.1 The copy bridge
+
+`s_compute_rhs`, `s_ibm_correct_state`, `s_pressure_relaxation_procedure` and
+`s_infinite_relaxation_k` all take `type(scalar_field), dimension(sys_size)` and also serve the
+monolithic (non-AMR) path, so the flat store cannot be passed to them. A pointer view into the
+store is **not attachable on the OpenMP-offload backend** (measured; see `amr_block_batching.md`).
+
+A single block-shaped `scalar_field` array bridges instead:
+
+```
+amr_cons_br --s_amr_br_load--> call --s_amr_br_store--> amr_cons_st
+```
+
+All four dummies are `intent(inout)` — `s_compute_rhs` writes the buffer region through
+`s_populate_variables_buffers` — so **both directions are required at every crossing**. This
+round trip, once per block per RK stage, is a first-order cost.
+
+`amr_br_batch` is a compile-time constant currently `1`, i.e. **the batched path is dormant**. G0
+measured `PH_RHS` at 54-57% GPU-busy, capping batching at roughly 1.09x.
+
+---
+
+## 4. Per-block geometry and the swap
+
+Because the shared solver reads module-scope grid state (`x_cb`, `dx`, `idwint`, `idwbuff`, ...),
+running it on a fine block requires **temporarily overwriting the global grid state** with that
+block's:
+
+```
+s_amr_swap_to_fine -> rebuild coords, extents, WENO coefficients; push to device
+ ... solver call ...
+s_amr_restore_coarse -> put the coarse grid state back
+```
+
+`s_amr_swap_to_fine` performs on the order of nine host array copies plus heap allocations and
+calls `s_amr_sync_grid_state_to_device` (four `GPU_UPDATE` groups); `s_amr_restore_coarse` does
+four more. Measured at 0.5-0.8% of wall, so it is **not** a leading cost, but it is why the fine
+advance cannot simply be hoisted out of the per-block loop.
+
+---
+
+## 5. Slot lifecycle and store sizing
+
+Five routines, in `m_amr.fpp` (post-W8-fix, commit 9bcc9865):
+
+| Routine | Effect |
+|---|---|
+| `s_amr_alloc_slot(islot)` | Full slot: dense index + geometry (+ QBMM side-state; + per-slot `rhs`/gated `q_prim` for L0 **tile** slots only). Idempotent for full slots; **upgrades a live stash-only slot in place** (keeps its index and stor data, adds the arrays). |
+| `s_amr_alloc_slot_stash(islot)` | **Stash-only slot**: dense index + `amr_slot_live` only — no geometry or field arrays. Used for migration replicas, which only ever touch their `amr_stor_st` half. |
+| `s_amr_free_slot(islot)` | Idempotent, handles both flavors (each array family's teardown guarded on its own `allocated`; the full-vs-stash discriminator is `allocated(x_cb)`). Pushes the index onto `amr_loc_free`. |
+| `s_amr_st_reserve(nloc)` | Grows the store, increments capped at 16 slots. Never shrinks the allocation. |
+| `s_amr_scr_init()` | Allocates the **pooled `q_prim`/`rhs` advance scratch** (`amr_scr_prim`/`amr_scr_rhs`), once, on every rank. Called where `mbuf*` are final per mode: module init (pure AMR) or after `s_l0_tiles_init`'s mbuf union (any tiles). |
+| `s_amr_compact_store()` | Re-densifies the local index space **in place on the device**, every reconcile. Does NOT realloc. |
+
+**P1 pooling (this section's state after it): fine blocks carry NO per-slot `q_prim`/`rhs`.**
+The fused per-block advance (`s_amr_fine_stage_advance`: rhs then rk on one block) leaves no
+cross-block lifetime, so all fine blocks share one slot-shaped scratch pair; the stage routines
+take the target arrays as dummies and the caller chooses (fine → scratch; L0 tiles → per-slot,
+because all owned tiles' rhs coexist across the MPI reflux point, and a tile's `q_prim` is read
+in the RK pass after other tiles' RHS work — allocated per-slot exactly when the `m_rhs`
+copy-out gate writes it: `run_time_info|probe_wrt|ib|bubbles_lagrange`). This removes ~2×105 MiB
+per live fine slot (~15 GiB/rank at the S0 point) AND the per-slot alloc/free churn that fed
+the libomptarget retention plateau. Per-slot device cost is now the slot's share of the flat
+store (`amr_cons_st` + `amr_stor_st`) plus, under QBMM only, the per-slot side-state.
+
+### 5.1 How the store grows — and the host-coherence contract
+
+`s_amr_st_reserve` early-returns when `nloc <= amr_st_cap`. Otherwise it grows by
+`max(min(oldcap/4, 16), 8)` slots and reallocates, staging **through the host**:
+
+```
+GPU_UPDATE(host=...) -> tmp = store -> DEALLOCATE -> ALLOCATE(newcap) -> zero -> copy -> GPU_UPDATE(device=...)
+```
+
+The increment cap matters at scale: a proportional (+25%) increment is itself store-sized, and
+its transient is what tipped a 59.5 GiB card over the 64 GiB ceiling on the S0 np=4 arm.
+
+**The host round trip is LOAD-BEARING, not incidental.** The rebuild's overlap carry-forward
+(`s_amr_regrid_rebuild_slots`) reads `amr_stor_st` on the HOST without pulling first — it relies
+on every store resize leaving host == device, so that the migration stash's host writes (pushed
+to device at write time) survive a mid-rebuild grow. A device-only resize was tried (2026-08-21)
+and NaN'd both churn goldens through exactly this path. Until the carry-forward is converted to a
+device kernel, any change to `s_amr_st_reserve` must preserve: *after a resize, the full host
+copy equals the device copy*.
+
+### 5.2 The high-water problem — SOLVED by re-densification (the W8 fix)
+
+`amr_loc_n` is still `(live slots) + (recycle-stack depth)` mid-rebuild, and
+`s_amr_regrid_rebuild_slots` still allocates new blocks while old stashes are live. What changed:
+
+1. **`s_amr_compact_store()` runs at EVERY reconcile**, renumbering `amr_loc_of` densely and
+ moving slot data **in place on the device** (`s_amr_st_move_slot`, no staging array, no
+ realloc). In-place is safe because moves are processed in ascending source order: each
+ destination (the rank of its source among live indices) is <= its source, and every pending
+ source lies above the current destination. Moved slots' host copies go stale — that is the
+ store's normal state between rebuilds; §5.1's contract applies to *resizes*, not moves.
+2. So `amr_loc_n` is pinned to the live count at every reconcile, and `amr_st_cap` plateaus at
+ the **rebuild-transient high-water** (old + new generations coexisting) instead of ratcheting
+ run-long. The ratchet's weak-scaling form — at np>=2 the owned set is a shifting SFC window
+ plus received replicas, so the union grows without bound — is dead: S0 measures flat VRAM
+ plateaus and live 72/rank at both np=2 and np=4.
+3. The rebuild loop **early-frees** old-only slots the moment their last covering new box is
+ built (`last_use` per old block, geometric region overlap as a conservative superset of every
+ stash read), so freed indices recycle into the very next allocations and the transient union
+ itself stays small.
+4. Replicas received in migration are **stash-only** slots (see table above).
+
+The old hysteresis compaction (`cap > 3*nlive` trigger, `2*nlive` target, full host-staged
+rebuild of the store) is gone with the constraint that forced it.
+
+**Instrumentation:** `[amr-cap] rank r live n cap c` prints on stderr at every reconcile when
+`rank_time_wrt` is on — per-rank store capacity is the W8 invariant quantity (device memory =
+f(live local boxes)), and wall time cannot see it. `cap - live` is the transient envelope.
+
+> **Comparison.** AMReX and Parthenon have no analogous quantity, because neither *allocates* a
+> local index. AMReX's `localindex` is a binary search over the sorted owned-box list; Parthenon's
+> `lid = n - nbs` is recomputed contiguous every regrid. In both, the index space *is* the live
+> set by construction, so it cannot ratchet. Re-densification gets MFC the same invariant at
+> reconcile granularity; deleting `amr_loc_free`/`amr_loc_nfree` outright ("derive the index")
+> remains a cleanliness follow-up. See §11.3.
+
+---
+
+## 6. The timestep
+
+Within each RK stage `s`, in `s_tvd_rk` (`m_time_steppers.fpp`), non-subcycled path:
+
+```
+PH_COARSE s_compute_rhs on the coarse (level-0) grid [1 per stage]
+
+if (amr .and. .not. amr_subcycle):
+ PH_HALO s_amr_exchange_coarse_cons_halo [1 per stage]
+
+ PH_GATHER s_amr_stage_fill_wave ! ALL level-1 fills as ONE F1+F3 wave [1 per stage]
+ do ilev = 2, amr_num_levels
+ PH_GATHER s_amr_parent_fill_wave(ilev) ! level-lev fills as one F2 wave [1 per LEVEL]
+
+ PH_SEAM s_amr_fine_fine_halo(0) ! all levels together [1 per stage]
+
+ do islot = 1, amr_num_blocks ! skip level 0
+ PH_RHS s_amr_fine_stage_advance [1 per BLOCK]
+
+ do islot = 1, amr_num_blocks ! skip level 0 AND level >= 2
+ PH_REFLUX PH_RFP2P s_amr_p2p_reflux_faces [1 per L1 BLOCK]
+ PH_RFAPP s_amr_apply_reflux
+```
+
+Then after the stage loop, in reverse slot order:
+
+```
+PH_RESTR do islot = amr_num_blocks, 1, -1
+ s_restrict_fine_to_coarse
+ s_amr_reflux_to_parent
+```
+
+**Multiplicity is the thing to notice.** `PH_COARSE`, `PH_HALO` and `PH_SEAM` are once per stage;
+everything else is once per *block*. At 224 blocks that is the difference between 3 and ~670 calls
+per step.
+
+Three facts that are easy to get wrong:
+
+- **`PH_COARSE` is not part of `PH_RHS`.** The coarse `s_compute_rhs` is bracketed separately. An
+ early analysis in this campaign charged it to `PH_RHS` and overstated GPU-busy by ~10 points.
+- **The reflux loop skips level >= 2**, so `PH_REFLUX` covers level-1 blocks only.
+- **The loops run on every rank** and `cycle` on non-owned blocks, so loop *trip count* is global
+ even though the work is local.
+
+---
+
+## 7. The level-1 / level-2 divergence
+
+`s_amr_gather_coarse_patch` — the routine that fills a fine block's coarse-side data — branches at
+the top:
+
+```fortran
+if (amr_block_level(amr_cur) >= 2) then
+ call s_amr_gather_from_parent(pull_host) ! entirely different path
+ return
+end if
+```
+
+**Everything after that branch is level-1-only code.** On the production case, 160 of 224 blocks
+are level >= 2, so the majority of blocks never execute the routine's main body.
+
+This one early return explains a long list of "refuted" optimization candidates from the campaign:
+changes made to the main body were measured on a case where most blocks took the other path. Any
+instrumentation or optimization of coarse-patch gathering **must cover both branches** or it
+reports on a minority of the work.
+
+The level >= 2 path (`s_amr_gather_from_parent`) does a parent-to-child point-to-point exchange:
+the parent's owner packs the patch on device and sends it; the child's owner receives and unpacks.
+The send side now uses a deferred `ISEND` pool (§8.2).
+
+---
+
+## 8. Communication
+
+### 8.1 Inventory
+
+Raw call counts by call site (not by dynamic frequency):
+
+| | `m_amr.fpp` | `m_amr_regrid.fpp` |
+|---|---|---|
+| `MPI_RECV` (blocking) | 13 | - |
+| `MPI_SEND` (blocking) | 11 | - |
+| `MPI_ISEND` | 7 | 1 |
+| `MPI_IRECV` | 2 | 1 |
+| `MPI_SENDRECV` | 6 | - |
+| `MPI_WAITALL` | 6 | 1 |
+| `MPI_ALLREDUCE` | 4 | - |
+| `MPI_ALLGATHER(V)` | - | 5 |
+
+**These are static call sites, not expanded counts.** Many sit inside Fypp `#:for` loops over
+dimensions, so a `grep` undercounts what actually executes — `s_amr_p2p_reflux_faces` shows 2
+`MPI_RECV` call sites but issues **6** in 3D (three dimensions x lo/hi). Read the Fypp, not the
+grep, when sizing a communication path.
+
+**Blocking calls outnumber non-blocking roughly 2:1.** Combined with fixed tags and a globally
+ordered block loop, this produces head-of-line blocking: rank A cannot progress past block *i*'s
+rendezvous even when block *i+1*'s partner is ready. This "convoy amplification" is the structural
+explanation for why measured MPI time is ~87% *wait* rather than bandwidth.
+
+### 8.2 The deferred send pool
+
+`amr_gsnd_pool` / `s_amr_gsnd_reserve` / `s_amr_gather_send_flush`, capacity `amr_gsnd_max = 64`.
+
+The parent-gather send site was converted from `allocate / MPI_SEND / deallocate` per box to a
+device-side pack into a pooled buffer plus `MPI_ISEND`, with a single drain. **Measured: -17 to
+-22% wall, regrid -39.3%, 76/76 goldens.**
+
+The safety rule: any call site whose original semantics were "the send has completed when this
+returns" must be followed by `s_amr_gather_send_flush()`. Two such sites exist in
+`s_amr_subtree_stage_advance` and carry that call with a comment. **A deferred send with no
+downstream drain is a deadlock**, and one was introduced and caught during this work.
+
+An attempt to hoist the drain to once per step improved the target phase ~14% and made wall time
+*worse*; it was reverted. Deferring sends pays only where a downstream synchronization already
+absorbs the timing drift.
+
+### 8.3 Reflux exchange
+
+`s_amr_p2p_reflux_faces`: the block owner posts `2 * num_dims` `ISEND`s per participating rank
+followed by one `WAITALL`; **each participating non-owner does `2 * num_dims` blocking `MPI_RECV`s**
+(6 in 3D) on fixed tags `2*d` and `2*d+1`, i.e. tags 2-7, then a `GPU_UPDATE`. Both the sends and
+the receives are generated by a Fypp `#:for` over dimensions guarded by `if (d <= num_dims)`. Reflux is ~99.6% communication. Its cost grows with simulation time
+through per-call *wait* (7.4 ms -> 74.5 ms), not through participation (+17%).
+
+Reflux is the **sink** for load skew, not its source: imbalance originates in `PH_RHS` (1.09 ->
+2.90) and is absorbed here.
+
+---
+
+## 9. Regrid
+
+`s_amr_regrid` (`m_amr_regrid.fpp`), in order, with three early exits:
+
+```
+PH_RGHALO s_amr_exchange_coarse_cons_halo
+ s_amr_compute_lag_supp (bubbles_lagrange only)
+PH_RGTAG s_amr_regrid_tag_cells -> tag_grid
+PH_RGCLUS s_amr_regrid_cluster_tags -> boxes, nboxes
+ if (nboxes == 0) return ! nothing tagged anywhere
+PH_RGSHAPE s_amr_regrid_shape_boxes
+ if (nboxes == 0) return ! all boxes died in the domain margin
+ s_amr_regrid_nest_children
+ s_amr_check_box_caps ! invariant: no box exceeds its level cap
+ s_amr_regrid_boxes_unchanged -> same
+ if (same) return ! identical box set: keep live slots
+PH_RGMIG s_amr_regrid_stash_migrate -> amr_stor_st, ownership
+PH_RGBUILD s_amr_regrid_rebuild_slots -> amr_cons_st, new slots
+```
+
+The `same` early exit is what makes regrid cost bimodal — a regrid that changes nothing is nearly
+free, so averaging cost over regrid *calls* understates the cost of a real one.
+
+### 9.1 stash_migrate
+
+Writes each old block's state into `amr_stor_st` at its **old** local index, exchanges blocks whose
+owner changed, sets the new `amr_num_blocks`, and calls `s_amr_assign_block_owners`
+(SFC/work-balanced, `s_amr_sfc_cut`).
+
+### 9.2 rebuild_slots — and the ordering constraint
+
+```fortran
+do k = 1, nboxes
+ ks = f_l0_slot(k)
+ ...
+ if (amr_block_owner(ks) == proc_rank) call s_amr_alloc_slot(ks)
+ ...
+ amr_cons_st(fi,fj,fk,i, amr_loc_of(ks)) = amr_stor_st(ofi,ofj,ofk,i, amr_loc_of(kks))
+ ! ^^ NEW slot ^^ OLD slot, kks = f_l0_slot(kk)
+```
+
+**This line is why old slots cannot be freed wholesale before the rebuild.** The stash is read at
+*old* local indices for `kk = 1, old_np` while new slots are being allocated, so both index sets
+must be simultaneously valid. An attempted blanket free-before-allocate was staged and then
+withdrawn on discovering this read — it would have produced silent wrong answers, not a crash.
+The correct refinement landed 2026-08-21 (9bcc9865): the rebuild loop precomputes `last_use(kk)`
+(the last new box whose region overlaps old block `kk` — a conservative geometric superset of
+every stash read) and frees each old-only slot at the top of iteration `last_use(kk) + 1`. The
+freed dense indices recycle into the very next allocations, which is what keeps the transient
+union — and with it the store's capacity plateau — small.
+
+`s_amr_reconcile_slots` runs at the end (`PH_RBREC`), frees the remaining now-dead slots, and
+calls `s_amr_compact_store` (which now re-densifies the index space every time, §5.2).
+
+---
+
+## 10. Phase instrumentation
+
+`m_phase_timing.fpp` defines `PH_N = 45` phase ids with `s_phase_tic` / `s_phase_toc`. Both ends
+issue `GPU_WAIT()`, so brackets measure completed device work, not launch return.
+
+Reporting is gated on `rank_time_wrt`. **Benchmark cases usually set it `.false.`** to keep I/O out
+of the timings — which is why the phase budget was invisible for most of this campaign. The
+counters accumulate regardless; enabling reporting costs two `MPI_ALLREDUCE`s at finalize.
+
+The report emits mean/max/imbalance per phase, a calls column and ms/call (from an `MPI_ALLREDUCE`
+over an `ncall` array), and per-rank lines for `PH_RHS`, `PH_REFLUX`, `PH_GATHER`, `PH_SEAM`.
+
+Five traps, each of which has cost real time:
+
+1. **Zero-time phases are dropped from the report** (`if (gsum(i) <= 0._wp) cycle`). A phase id
+ that is declared but never `tic`'d is indistinguishable from one whose code is missing. A binary
+ was once built with four ids declared and unwired, and it looked identical to a correct one.
+ `amr-bench/gate_phases.py` now checks: `PH_N` matches the name count, every used id is imported,
+ and every declared id is actually `tic`/`toc`'d.
+2. `PH_NAME` is `len=8`; longer names silently truncate and can collide.
+3. `RESIDUAL` is meaningless once brackets nest — nested phases double-count against wall.
+4. A phase must bracket **both** branches of §7 or it reports on a minority of blocks.
+5. Per-call cost, not total, is the diagnostic quantity when block counts differ between runs.
+
+---
+
+## 11. Invariants and traps
+
+### 11.1 Checkable invariants
+
+| Invariant | Where it can break |
+|---|---|
+| `amr_loc_n == live + amr_loc_nfree` | Holds today; verified by instrumentation |
+| `amr_loc_of(k) > 0` iff rank owns live block `k` | `alloc`/`free` ordering in rebuild |
+| `amr_st_cap >= amr_loc_n` | `s_amr_st_reserve` post-condition |
+| Every `@:ALLOCATE` has a matching `@:DEALLOCATE` | The store's realloc paths |
+| No box exceeds its level's slot cap | `s_amr_check_box_caps` |
+| `amr_reg_cap >= amr_num_blocks` | Flux registers are indexed by *global* slot (§2.2) |
+| Block regions are in L0 cell indices at all levels | Any new geometry code |
+
+### 11.2 Traps that have actually bitten
+
+- **Implicit `amr_cur`.** Per-block routines take no slot argument. A missing `s_amr_select_slot`
+ silently operates on the previous block.
+- **Two-space confusion in regrid.** `old_*` arrays are indexed by old box index; the live arrays
+ by new. Both are `integer` and both are in scope.
+- **The level >= 2 early return** (§7) hides the majority of blocks from anything measuring the
+ level-1 body.
+- **Deferred send with no drain** deadlocks (§8.2).
+- **`amr_buf` does double duty**: it sets the ghost width *and* enters the box-merge threshold
+ `thr = buff_size + 2*amr_buf`. Changing it to tune ghosts also changes the box topology.
+- **`rocm-smi` GPU[N] enumeration need not match HIP device N.** Rank-to-device is
+ `dev = mod(local_rank, devNum)`; do not infer the slow rank from the busiest GPU row.
+- **Recycle-stack depth is tautological when read at a high-water print** — it is printed only when
+ the high-water rises, which requires the stack to be empty. Instrument where the value can vary.
+
+### 11.3 Known structural weaknesses
+
+1. **The local index is allocated, not derived** (§2.2, §5.2). AMReX derives it by binary search
+ over the sorted owned-box list; Parthenon recomputes `lid` contiguous every regrid. Since
+ 2026-08-21 the index space is re-densified at every reconcile, which gets the same invariant
+ at reconcile granularity — deriving it outright (deleting `amr_loc_free`/`amr_loc_nfree`) is
+ now a cleanliness item, not a memory one.
+2. **Store GROWTH still stages through the host** (§5.1) — and this is now a documented
+ contract, not merely a weakness: the rebuild's overlap carry-forward host-reads depend on
+ resize leaving host == device. The obvious AMReX-style fix (full device-side remake into a
+ staging array) was BUILT AND REFUTED 2026-08-21: its old+staging transient device-OOMed the
+ very weak-scaling case it targeted, and dropping the host round trip NaN'd both churn goldens
+ through the carry-forward. The path that remains: convert the carry-forward to a device
+ kernel first, then growth can go device-side — as part of P1's pooling, not before.
+3. **Slots are sized for the maximum block, not their own** (§3). AMReX's single-chunk arena sums
+ actual per-box bytes. This is an independent multiplier equal to the max/mean box-volume ratio;
+ measure that ratio before deciding it is worth the change to non-uniform striding.
+4. **Blocking-dominated communication** (§8.1) with fixed tags over a globally ordered loop.
+
+---
+
+## 12. Related documents
+
+| Document | Content |
+|---|---|
+| `docs/documentation/amr.md` | User-facing overview, parameters, usage |
+| `docs/documentation/amr_multilevel.md` | Nesting rules and level semantics |
+| `docs/documentation/amr_fine_distribution.md` | Ownership and the SFC distribution map |
+| `docs/documentation/amr_per_level_distribution.md` | Per-level distribution design |
+| `docs/documentation/amr_block_batching.md` | Batching investigation, including the pointer-attach measurement |
+| `docs/documentation/amr_tax_review.md` | Measured phase budgets and experiment log |
+| `docs/documentation/amr_slowness_analysis.md` | Causal model of the AMR overhead |
+| `docs/documentation/amr_action_plan.md` | Current open work |
diff --git a/docs/documentation/amr_multilevel.md b/docs/documentation/amr_multilevel.md
new file mode 100644
index 0000000000..4ffeada821
--- /dev/null
+++ b/docs/documentation/amr_multilevel.md
@@ -0,0 +1,95 @@
+@page amr_multilevel Multi-level AMR nesting
+
+# Multi-level AMR nesting — design and implementation plan
+
+> **Design record / implementation note.** This documents the internal design and development of
+> multi-level AMR nesting. For user-facing behavior and parameters, see @ref amr.
+
+Status: **multi-level nesting implemented.** The block-structured AMR core supports arbitrary
+refinement depth (L0, L1, …, L`amr_max_level`, 2:1 per level): static AMR (`amr_regrid_int = 0`)
+nests one level-2 block, dynamic regrid (`amr_regrid_int > 0`) nests deeper and per-level. This
+document is the design record. It was implemented in behavior-preserving increments: at
+`amr_max_level = 1` the code is bit-identical to the single-level core.
+
+## The one assumption to generalize
+
+Everywhere in `m_amr`, "coarse" means the **L0 base grid**:
+
+- `t_level%%region` is a box in **L0 cell indices**.
+- Every coupling routine reads/writes the L0 fields (`q_cons_base` / `q_cons_ts(1)`):
+ gather (`s_amr_gather_coarse_patch`), prolong (`s_interpolate_coarse_to_fine`),
+ restriction (`s_restrict_fine_to_coarse`), reflux (fine flux corrects L0).
+- The advance driver (`m_time_steppers`) loops the single fine-block pool once per L0 step.
+
+Multi-level replaces "coarse = L0" with "**the coarse side of level `l+1` is level `l`**".
+
+## Target architecture
+
+- Levels `0 .. amr_max_level`. A level-`l` block (`l ≥ 1`) refines a covering level-`(l-1)`
+ region by `amr_ref_ratio` (2 today). Level `l+1` must be **properly nested** inside level `l`
+ (surrounded by level-`l` cells; never adjacent to level `l-1`).
+- **Flat pool + per-block level tag** (chosen over a per-level pool array): `amr_slots` stays
+ one pool; each block gains `level` and `parent` (the covering coarser block, or 0 for an
+ L1 block whose parent is L0). Rationale: the distribution machinery (SFC owners, P2P
+ gather/restriction/reflux/migration, lazy owned-only slot allocation, repartition-on-restart)
+ all operate on the flat pool and are level-agnostic, so they carry over with near-zero change.
+ A per-level pool array would force rewriting every `amr_slots(k)` reference (high churn,
+ silent-bug-prone — the same reason the #4 lazy-alloc avoided a global→local pool remap).
+- **Recursive subcycling** (chosen over lock-step): `advance(l)` advances level `l` by `dt_l`,
+ then for `s = 1..amr_ref_ratio` recursively advances level `l+1` by `dt_{l+1} = dt_l/amr_ref_ratio`
+ with time-interpolated C/F boundary data from level `l` (extends today's 2-level subcycle,
+ `q_ghost_a/b`, recursively), then refluxes `l+1 → l`. Most accurate and efficient; the
+ standard Berger–Colella time integration.
+
+## Increments (each validated np=1 bit-identical + np≥2 conservation + GPU)
+
+1. **Foundation (bit-identical).** `amr_max_level` namelist param (default 1), gated
+ `amr_max_level > 1` fail-closed in `m_checker` until the recursion lands. *(this increment)*
+2. **Recursive coupling.** Add the per-block `%%level`/`%%parent` tags (done: `amr_block_level`
+ in 2a; `f_amr_parent_block(k)` finds the covering coarser block by region overlap), then
+ parameterize gather/prolong/restriction/reflux by a coarse-level source: the level-`l` block
+ data instead of only `q_cons_base`. The L1↔L0 path is the `l = 0` case and stays byte-identical.
+
+ **The one hard detail — the coarse frame.** The prolong reads `amr_cg` via
+ (`amr_isect_lo`, `amr_cpat_off`, `amr_ref_ratio`) and is reused unchanged as long as `amr_cg` and
+ that frame are in **parent-level cell indices**. Level-1 block: parent level is L0, frame is
+ L0 indices (today). Level-2 block with L0 region `R2`, parent L1 block `p` with L0 region `R1`:
+ - parent-fine index of L0 cell `c` is `2*(c - R1.lo)` (amr_ref_ratio per level);
+ - coarse footprint in the parent's fine frame: `isect = 2*(R2 - R1.lo)`;
+ - fine extent `m = amr_ref_ratio*(parent-fine footprint) - 1 = amr_ref_ratio^2 * |R2| - 1`;
+ - `amr_cg` holds the parent's fine cells `[isect.lo - nmar : isect.hi + nmar]`, gathered from
+ `amr_slots(p)%%q_cons` (np=1: local copy; np≥2: P2P via `amr_block_owner`);
+ - "coarse coords" are the parent's fine coords `amr_slots(p)%%x_cb`, not `amr_gxcb` — needed
+ only for the advance/stretched grids, so a **uniform-grid np=1 operator self-check**
+ (`prolong → restrict` conserves) is the first testable milestone and can skip coords.
+ `s_set_amr_fine_geometry` and `s_amr_gather_coarse_patch` choose this frame; each gains a
+ `level == 1 ? L0 : parent-fine` branch.
+3. **Advance (make level-2 evolve).** 2b built the coupling *into* a level-2 block
+ (gather-from-parent, prolong); this builds the coupling *out* of it plus the driver:
+ - **restrict-to-parent** — level-aware `s_restrict_fine_to_coarse` folds a level-2 block's
+ fine averages back into its parent L1 block's fine array (mirror of gather-from-parent,
+ same parent-fine frame);
+ - **reflux-to-parent** — the Berger-Colella C/F flux correction from L2 into L1's cells
+ (the reflux registers key off "the coarse", which becomes level l-1);
+ - a **persistent static L2 block** (replacing the non-intrusive self-test), and a
+ **level-loop driver** in `m_time_steppers`: for level 1..maxlevel, fill+advance from the
+ parent then restrict+reflux to it.
+ Both restrict-to-parent and reflux-to-parent are required for conservation.
+ **Lock-step first** (all levels advance at L0's `dt`, interleaved per RK stage — extends
+ today's non-subcycle mode; no time-interpolation/recursion): first milestone is a np=1
+ static 2-level case that runs several steps and conserves (~1e-13). **Then** add recursive
+ subcycling (level l+1 takes `amr_ref_ratio` substeps with time-interpolated ghosts) on top,
+ generalizing `s_advance_amr_fine_substeps` (already Berger-Colella for L0↔L1).
+4. **Per-level regrid + proper nesting.** Tag each level for the next-finer one; build level
+ `l+1` boxes clustered + tiled + nested inside level `l`; distribute (reusing the SFC map).
+5. **Restart / distribution / GPU per level.** Extend the fine-restart record with a per-block
+ level; validate repartition-on-restart and the device present-table across levels.
+
+## Design decisions on record
+
+- Flat pool + per-block `level`/`parent` tag (not a per-level pool array).
+- Recursive subcycling with time-interpolated C/F BCs (not lock-step).
+- `amr_ref_ratio` stays 2 for now (ratio-4 is separate, banked work); nesting/coupling are written
+ ratio-generic so ratio-4 drops in later.
+- Load balance: the existing SFC map distributes blocks across **all** levels from the flat
+ pool; the `amr_max_blocks < num_procs` warning applies per the total block count.
diff --git a/docs/documentation/amr_per_level_distribution.md b/docs/documentation/amr_per_level_distribution.md
new file mode 100644
index 0000000000..7de1af5290
--- /dev/null
+++ b/docs/documentation/amr_per_level_distribution.md
@@ -0,0 +1,1076 @@
+@page amr_per_level_distribution AMR per-level distribution
+
+# AMR per-level distribution
+
+Design for the next phase of block-structured AMR: distribute each refinement level
+independently, so AMR strong-scales instead of degrading as ranks are added. Written
+2026-07-29 against `up/mega` @ `7b1e4933`. Companion to @ref amr_block_batching, which covers
+the per-block launch cost, and @ref amr_multilevel, which covers the nesting.
+
+**How to read this.** "What actually blocks exascale" is the primary open work item and comes first.
+"Status" says what has landed. "The cost model is regime-dependent" and "Superseded measurements"
+together record what measurement has and has not established - several earlier conclusions in this
+file were retracted, and the retractions are kept rather than deleted. "Sequencing" is the queue.
+
+## Status
+
+All four design steps are landed. The measured outcome did **not** confirm the performance thesis,
+and the reason matters more than the steps did — see "The cost model is regime-dependent" and
+"Superseded measurements".
+
+| Step | Commit | Result |
+|---|---|---|
+| 1. Scratch decoupling | `86782249` | landed |
+| 2. Rank-independent cap | `a108dd37` | np=4->8 flipped 1.16x slower to 0.84x faster (single level) — **but see the caveat below** |
+| 3. P2P parent<->child | `6832d299`, `d53fac46` | landed; 3d `26e0d080` hoists the level advance to lockstep |
+| 4. Per-level mapping | `cfdd2847` | landed; correctness proven with a split tower, **no measured speedup**; the A/B that produced that result was run too small to interpret — see "Superseded measurements" |
+| 5. Balance metric | `fc53e097`, `3780f30a` | landed; `[amr-balance]` per-level max/mean behind `load_weight_wrt`. Its *conclusion* ("box supply binds") is **retracted** — see below |
+| 6. Model vs measured | — | done; **the cost model does not predict measured time**. Redirects the effort to step 7 |
+
+Landed alongside, from auditing the above (2026-07-31):
+
+| Change | Commit | Note |
+|---|---|---|
+| Multi-level subcycle at np>1 un-gated | `8dca4b65` | its stated blocker had been removed by `3db24df0`; golden `C45DBB52` |
+| Level-general child slot cap | `be94db38`, `1e07eb65` | fixed `/2` was level-2-specific; **verified to fail without** — old cap core-dumps at `amr_max_level=3` |
+| Brand-new-region box skipped the cap | `cfbacebe` | **heap corruption** under the pinned cap; golden `00EB793A` |
+
+### Caveat on step 2, and the coverage hole behind it
+
+`amr_max_grid_size` had **zero test coverage** until `00EB793A` — not one golden or example case set
+it, only the schema, validator and parameter definitions. It is the mechanism this whole step rests
+on (pin the cap → many small boxes → `boxes_per_level >> num_procs`), and nothing exercised it.
+
+That is not hypothetical. `s_amr_regrid`'s brand-new-region branch emitted level≥2 boxes without ever
+consulting `amr_maxc_fit` — the one box emitter that skipped `s_amr_tile_box` — so a child over the
+cap made `s_amr_build_block_coords` write past `x_cb`, corrupting the heap on every regrid and
+surfacing much later as `corrupted size vs. prev_size` inside an unrelated `free()`. Under `-O2` it is
+silent. It needs all four of: pinned cap ≡ 0 (mod 8), `amr_max_level ≥ 2`, `num_procs ≥ 2`, and a
+scattered IC (a Sod-like patch grows regions that already have fine data, so the branch never fires).
+
+**Therefore step 2's measured numbers were collected on a code path that could silently corrupt the
+heap, and a corrupting run still produces plausible timings.** The conclusion is probably still right
+— the defect is a bounds overrun, not a change to the distribution — but it is no longer a clean
+measurement, and it should be re-run on fixed code before being cited as settled.
+
+The general lesson is the one worth keeping: **a parameter with no golden is a parameter whose every
+failure mode is invisible**, and the plan leaned on this one for months.
+| `no_blocks_ranks` is not idleness | `3ab65ab6` | see "What binds at scale" |
+
+Two findings from the step-4 A/B that redirect this work:
+
+1. **Per-level distribution shows no benefit at np<=8** on a 3-heavy-tower case (flat within
+ noise at every rank count). Expected from the granularity floor below, but **not attributable**
+ — there is no imbalance metric, so a flat result cannot distinguish "nothing to fix" from
+ "balancer did nothing".
+2. **Per-box overhead, not balance, is the dominant cost.** At np=1 the same case runs ~40x the
+ coarse solve while the refinement it adds accounts for only ~2.5x. That ~16x residual belongs
+ to @ref amr_block_batching, not here.
+3. **The sweep was run too small above np=2.** The uniform control reaches only 18% parallel
+ efficiency at np=8, so both arms are latency-bound exactly where distribution should have
+ mattered — finding 1 is therefore inconclusive rather than negative. Check the control's
+ efficiency before trusting any A/B run against it.
+
+The consequence for sequencing: **instrumentation precedes further distribution work.** Steps 1-4
+were gated on correctness and end-to-end s/step, neither of which measures balance.
+
+## Where this stands (2026-08-02), and what large scale actually demands
+
+**The goal is state-of-the-art AMR with load balancing at large scale.** This section is the current
+measured position against that goal; everything below it is the history that produced it, including
+several retracted conclusions.
+
+### Measured position
+
+| question | answer | evidence |
+|---|---|---|
+| Does AMR strong-scale? | **yes, 0.790 at np=8** (was 0.426) | 3D 256^3, rank-invariant box set, n=3 |
+| Does AMR weak-scale? | **yes, 0.846 at np=8** | constant 2.10M base cells/rank, work/rank held to 1.00-1.10x |
+| Is load balance the constraint? | **no** | imbalance 1.000-1.071 and ZERO idle ranks at every cap, even at 152 blocks/rank |
+| Is AMR efficient? | **no - 4.2x uniform per cell** at the best cap | cap sweep, np=8 |
+| Biggest single lever | `amr_max_grid_size`: 64 is **3.2x** faster than 32 | cap sweep |
+| Beyond one node? | **UNKNOWN** | nothing here exceeds 8 GCDs on one node |
+
+Two cautions on those numbers. The scaling figures are AMR compared to ITSELF at constant work; the
+uniform control at these sizes runs at ~4% of device capacity, so comparisons against it are
+meaningless (an earlier version of this document claimed "AMR scales better than uniform" - that was
+an artifact of a starved baseline and is retracted). And the strong/weak efficiencies come from a
+single case at a single cap on a single node.
+
+### What produced the gain, and what that implies about this plan's method
+
+The 0.426 -> 0.790 improvement did NOT come from per-level distribution. It came from removing a
+**loop-invariant call**: `s_amr_exchange_coarse_cons_halo` sat inside per-block loops in both the
+lock-step and subcycle paths, exchanging a coarse field that every fill reads and none writes -
+~960 identical whole-subdomain exchanges per step where 3 suffice. Because the count tracked the
+GLOBAL box count while each exchange costs the same, it did not distribute at all.
+
+It was found by top-down phase attribution in one run. It was NOT predicted by any cost model in this
+document, and the hypotheses this document did advance - replicated metadata as "THE exascale
+blocker", per-box collectives, cross-rank adjacency, kernel launch count - were each measured and
+found to be minor or wrong (regrid is 2.4% of the step and SCALES DOWN; launches are 8.5% of GPU
+time). **Attribute before hypothesizing.** `amr-bench/audit.sh` encodes the measurement failure modes
+that produced the wrong conclusions.
+
+### The tension that governs large scale
+
+Load-balance freedom requires `boxes_per_level >> num_procs`. Per-block cost is approximately FIXED
+per block. These pull in opposite directions, and rank count decides which wins:
+
+- At np=8, cap 64 gives 10 blocks/rank - enough for perfect balance (1.000, no idle ranks) and few
+ enough that per-block cost is tolerable (4.2x uniform per cell).
+- At 10^3-10^4 ranks, holding 10 blocks/rank means 10^4-10^5 blocks GLOBALLY. That simultaneously
+ (a) multiplies the fixed per-block cost by the block count, and (b) reactivates every O(global
+ boxes) term, including limit 3's replicated metadata (~560 MB/rank at 10^7 boxes).
+
+**So per-block cost is escapable at 8 ranks and unavoidable at 10^4.** Raising `amr_max_grid_size`
+is the lever today, but it is bounded by device memory (cap 96 device-OOMs in 3D) and by the block
+supply the balancer needs. At large scale the code is forced into the many-blocks-per-rank regime,
+which is precisely the regime where per-block cost dominates. **That, not balance, is what stands
+between this implementation and large-scale AMR.**
+
+### Configuration guidance: the parameters are worth more than the code
+
+Measured 2026-08-02, 3D, np=8, 256^3 two-slab interface, `fine_work` IDENTICAL in every arm
+(17765376) so all comparisons are like-for-like refinement.
+
+| lever | setting | gain | what it costs |
+|---|---|---|---|
+| `amr_max_grid_size` | 32 -> **64** | **3.2x** | nothing measurable here; bounded by device memory (96 OOMs in 3D) |
+| `amr_regrid_int` | 2 -> **8** | **1.39x** | the box set lags a moving feature |
+| `amr_subcycle` | F -> **T** | **1.55x** | a DIFFERENT time integration, not a free optimization |
+| **combined (MEASURED, not multiplied)** | | **7.012x** | no code changes |
+
+Measured cumulatively at np=8, each row adding one lever, `fine_work` identical across the last three
+arms (17765376) so the comparison is like-for-like refinement:
+
+| arm | s per unit PHYSICAL time | vs default | marginal |
+|---|---|---|---|
+| default (cap 32, lock-step, regrid 2) | 6.716e4 | 1.000x | - |
+| + `amr_max_grid_size` 64 | 2.210e4 | 3.039x | 3.04x |
+| + `amr_subcycle` | 1.408e4 | 4.771x | 1.57x |
+| + `amr_regrid_int` 8 | **9.578e3** | **7.012x** | 1.47x |
+
+**The three levers compose cleanly** - every marginal contribution reproduces its standalone value
+(3.2 / 1.55 / 1.39), because they act on independent things: the cap cuts per-block invocation count,
+subcycling cuts how often the coarse level is integrated, and the regrid interval cuts tag-sweep
+frequency.
+
+**A retraction.** An earlier draft of this section warned that naive multiplication (~6.9x) was
+"impossible, because it would put AMR faster per cell than a uniform grid". That objection was wrong:
+it compared against a uniform per-cell rate computed at FIXED dt, but subcycling CHANGES dt, so the
+comparison rather than the composition was invalid. The measured total is 7.0x.
+
+For comparison, the loop-invariant halo hoist landed the same day is worth 2.4x, and the entire
+remaining code agenda - flat backing store (~1.13x), P2P batching (~1.08x), per-phase rebalancing
+(<=1.24x) - totals under 1.6x even if all three land. **The parameters are worth more than every code
+lever combined, several times over.**
+
+### Per-phase load imbalance: the balancer optimises the wrong quantity
+
+Whole-step balance reads 1.000-1.010 at every rank count tested, including 32 ranks on 4 nodes. But
+per-phase imbalance (`[amr-imbal]`, same `rank_time_wrt` gate) is 1.12-1.64, and it worsens off-node:
+
+| phase | np=8 max/mean | np=16 max/mean | wait s/step at np=16 |
+|---|---|---|---|
+| fill | 1.229 | 1.475 | 0.128 |
+| coarse_rhs | - | 1.447 | 0.085 |
+| reflux | 1.212 | 1.348 | 0.080 |
+| halo | 1.357 | 1.611 | 0.065 |
+| restrict | 1.453 | 1.643 | 0.059 |
+| coarse_halo | 1.133 | 1.476 | 0.017 |
+
+**19.4% of the np=16 step is ranks waiting at phase syncs.** The cause is structural: the balancer
+distributes TOTAL weight, but every phase has its own barrier and each is driven by a DIFFERENT
+quantity - `reflux` touches only level-1 blocks, `restrict` is per-block, `coarse_rhs` is per-cell. A
+rank can carry exactly the right total weight and still hold the wrong number of level-1 blocks, so it
+arrives late at that phase's barrier while every other rank waits. Perfect per-phase balance is
+unattainable (blocks are indivisible), so 1.24x is a ceiling, not a target - but it is the largest
+measured code-side lever, and it is confined to the balancer rather than the solver.
+
+
+
+**`amr_max_grid_size`.** The default of 0 derives the cap from the decomposition, so it SHRINKS as
+ranks are added - backwards for strong scaling. AMReX defaults to 32 in 3D but its GPU guidance pushes
+to 128; measured here, 64 is 3.2x faster than 32 and 10.8x faster than 16, with imbalance 1.000 and
+ZERO idle ranks at the fastest point. Granularity, not balance, is the binding constraint in 3D.
+
+**`amr_regrid_int`.** `regrid` is ~9% of the step and, importantly, FLAT in global box count (1.8x
+across a 15x box-count range), so it is dominated by the per-cell tag sweep rather than the box
+machinery. Regridding less often recovers more than regrid's own share (1.39x for interval 2 -> 8),
+which means it triggers downstream work - slot rebuild, migration - that the phase timers do not
+attribute to it. Risk: a fast-moving feature can outrun a stale box set. This case's refinement is
+stable so it costs nothing; a strong moving shock would under-refine.
+
+**`amr_subcycle`.** THE METRIC MATTERS. Lock-step advances every level at the FINEST-stable dt, so the
+coarse grid is integrated 2**amr_max_level = 4x more often than its own stability requires. Berger-
+Oliger subcycling advances L0 at its own dt, which is 4x larger: per unit physical time the work drops
+from 34.5M to 22.0M cell-updates, predicting 1.57x - measured 1.551x, agreement to 1%. On a per-STEP
+basis the subcycled arm looks 2.6x WORSE (2.8564 vs 1.1079 s/step) because each of its steps covers 4x
+the physical time; comparing s/step would reject the better algorithm. **This is not a drop-in:** the
+two are different time integrations and the answers differ beyond roundoff.
+
+### Gap against the state of the art
+
+| | AMReX | Parthenon | MFC today |
+|---|---|---|---|
+| per-block compute | box bounds passed as ARGUMENTS to a lambda over a POD view | `MeshBlockPack` - many blocks in ONE kernel launch | swaps GLOBAL state (`m/n/p`, `idwint/idwbuff`, coords) and calls the monolithic solver PER BLOCK |
+| ghost fill | `FillPatch` over a whole MultiFab: one aggregated communication phase for the level | device-resident, packed | per BLOCK, with every rank participating in every block's gather |
+| data residency | device-resident | "all data in device memory" | per-slot allocations; `~626 descriptor copies per RHS call` |
+| demonstrated scale | production exascale | **92% weak scaling to 73,728 GPUs** | 8 GCDs, one node |
+
+The architectural difference is *granularity of both compute and communication*: both reference codes
+operate on a whole level at once, MFC operates per block. Parthenon adopted packing for exactly the
+symptom measured here - kernel runtime smaller than the per-invocation overhead. That is the target
+to match, and it is the same flat-backing-store restructuring @ref amr_block_batching describes -
+but justified by the LARGE-SCALE argument above rather than by the packing rationale, which was
+disproved (see "the packed super-grid cannot work").
+
+### Open work to finish the AMR + load-balancing plan
+
+Scored against the three tracks' own "done when" criteria, 2026-08-02.
+
+**Track 2 (multi-level at np>1): COMPLETE.** Towers no longer co-locate (see the per-level
+distribution comment in `s_amr_assign_block_owners`), P2P parent<->child landed, and the L2 seam
+abort is gone - `s_amr_check_seam_topology` now rejects only genuinely illegal geometry.
+
+**Track 3 (batch per-rank block advances): CLOSE AS SUPERSEDED.** Its criterion was a strong-scaling
+curve showing blocks no longer serialize through one slot. Strong scaling reached **0.790 at np=8
+(from 0.426) with the single-slot model untouched** - the limiter was a loop-invariant coarse-halo
+exchange. Packing is disproved; the flat backing store measures ~1.13x at the cap the code should run
+at. The mechanism was never built and no longer needs to be.
+
+**OPEN 1 - ANSWERED, negatively: the coarse-grid balancer does not pay for itself.** Every earlier
+measurement in this document ran `l0_ntile = 0`, so **every balance figure here (1.000-1.010, zero idle
+ranks, to 32 ranks on 4 nodes) is a FINE-LEVEL result only**; the coarse level was a fixed Cartesian
+decomposition. That path has now been benchmarked on a corner-concentrated 2D case (4096x2048, blob IC
+so refinement sits entirely in one rank's half, np=2, `l0_ntile = 2` -> 8 tiles / 2 ranks, 40 steps,
+3 reps):
+
+| arm | `l0_ntile` | `l0_rebalance_interval` | med s/step | spread | vs A |
+|---|---|---|---|---|---|
+| A monolithic | 0 | - | 0.8892 | 0.9% | 1.000x |
+| B tiled, no rebalance | 2 | 0 | 1.2045 | 0.8% | **0.738x** |
+| D tiled + rebalance | 2 | 4 | 1.1991 | **11.3%** | 0.742x |
+
+**Tiling costs 35%; rebalancing recovers 0.4% of it - inside D's own spread.** The rebalancer was live
+(9 invocations, confirmed in-log, not a wiring failure). It migrated exactly once in 40 steps, and that
+migration made the load gap **6.8x worse** and never recovered:
+
+```
+t_step=32 load-gap 5.738E-02 -> 3.898E-01 (1 migrations)
+t_step=36 load-gap 3.488E-01 -> 3.488E-01 (0 migrations)
+```
+
+The cause is structural, not tuning. The deadband admits gaps above 5% of mean load, but the SFC re-cut
+is restricted to CONTIGUOUS Morton ranges, so its finest correction is one whole tile - **25% of a
+rank's load at 4 tiles/rank**. A correction quantum 5x larger than the smallest gap worth correcting can
+only overshoot. The escape is self-defeating: correcting at the 5% scale needs ~20+ tiles/rank, and
+tiles are exactly what cost the 35%. **The granularity required for useful coarse balancing costs more
+than the imbalance it corrects.**
+
+Fixed in passing: the re-cut committed its partition unconditionally, never comparing the resulting gap
+to the current one. It now evaluates into a temporary and commits only on strict improvement (the cut
+array must move with the owner map - `f_amr_owner` resolves tile ownership against `amr_owner_cut`, so
+refreshing one without the other splits ownership silently).
+
+**Scope limit - what this does NOT disprove.** One case class: 2D, single refinement level (the blob
+tags level 1 only, confirmed in-log), hydro with uniform per-cell coarse cost, 2 ranks. Coarse work is
+near-uniform there by construction, which is *why* there was nothing to recover. Cases where per-cell
+coarse cost genuinely varies - IB ghost points, chemistry stiffness, Lagrangian bubbles - are untested
+and remain the only place this feature could still pay. The burden of proof has moved: it costs 35% and
+has no demonstrated benefit.
+
+**OPEN 2 - DEMOTED by OPEN 1's answer.** It was gated on coarse rebalancing being worth having; it is
+not, on the evidence above. Recorded for the case that an imbalanced-coarse-cost case revives it.
+`amr_tile_l0_owner` is fixed to the
+Cartesian init owner and stays fixed under migration, while COMPUTE ownership follows the cut. Every
+migrated tile therefore pays a scatter-back each step through four routines that branch on
+`bown == lown`: `s_l0_fill_tiles_from_coarse`, `s_l0_scatter_tiles_to_coarse`,
+`s_l0_add_reflux_to_tiles`, `s_l0_restrict_to_tiles`. This is the plan's own product claim - the
+coarse grid cannot yet rebalance in production. The `l0_ntile > 0 .and. amr` gate IS lifted, so the
+feature runs for dynamic regrid, subcycle, and multi-level.
+
+**A sequencing claim in the original goal is falsified.** It recorded as verified fact that Track 1's
+remaining gate and Track 3's redesign were "ONE blocker" and that "Track 1/2 cannot finish underneath
+the single-working-slot model". Track 2 finished under exactly that model, and strong scaling improved
+1.85x without Track 3.
+
+### Queue
+
+1. **Multi-node weak scaling (8/16/32 ranks, 1/2/4 nodes).** The open exascale question. Nothing
+ measured so far leaves one node, so inter-node MPI has never been exercised. Harness:
+ `amr-bench/multinode.sbatch` - no uniform control for the scaling claim, oversubscription guard,
+ and per-run host verification (GPUs here are not Slurm-managed, and ranks silently packing onto one
+ node once produced a fake interconnect cliff).
+2. **Sibling-defect audit of the remaining per-block loops.** The hoist found ONE loop-invariant call.
+ Three per-block communication sites remain - `s_amr_gather_coarse_patch`, the fine-fine halo, and
+ reflux - each entered by every rank per block. This is the only vector that has actually produced a
+ large win, and it is cheap.
+3. **`amr_max_grid_size` guidance.** The default is 0 = the DERIVED cap, which SHRINKS as ranks grow -
+ backwards for strong scaling. Measured: 64 is 3.2x faster than 32 and 10.8x faster than 16 in 3D.
+ Documenting the curve is nearly free; changing the default moves every AMR golden and needs its own
+ commit.
+4. **Then per-block cost**, re-derived at the cap the code should actually run at (the descriptor
+ figures were taken at cap 32, where blocks/rank is 4x higher), and checked on a second compiler
+ first - the ~626 copies per call may be an amdflang OpenMP mapping artifact rather than structural.
+
+**Correction on limit 3.** An earlier draft of this queue demoted it as "2.4% of the step and scales
+down". That measurement was taken at **80 global boxes** and is structurally incapable of seeing the
+effect. Balance requires roughly constant blocks/rank, so the GLOBAL box count grows linearly with
+rank count, and with it every O(global boxes) term:
+
+| ranks | global boxes (10/rank) | replicated metadata |
+|---|---|---|
+| 8 | 80 | 0.9 MB/rank |
+| 32 | 320 | 3.5 MB/rank |
+| 10^3 | 10,000 | 110 MB/rank |
+| 10^4 | 100,000 | **1.1 GB/rank** |
+
+Per-block COMPUTE per rank stays constant at fixed blocks/rank - that scales. What grows is the
+O(global) work. So limit 3 is not refuted, it is unmeasurable at the scales tested here, and absence
+of evidence at 8 ranks is not evidence of absence at 10^4.
+
+**It is testable without 10^4 ranks**, by decoupling global box count from rank count: at fixed np=8
+the cap sweep already varies global boxes 1217 -> 80. Run it WITH phase attribution and watch which
+phases grow with the GLOBAL box count rather than with blocks/rank - `regrid` growing implicates the
+tag allgatherv and assignment, `gather_patch` growing implicates the per-block communication, and
+`advance` growing implicates only per-block compute, which is not a scaling problem. That is a
+cheaper and strictly more targeted probe than multi-node, which at 32 ranks reaches only 320 global
+boxes.
+
+Deliberately NOT next: packing (disproved), launch fusion (8.5% of GPU time).
+
+## What actually blocks exascale: the assignment and regrid cost scale with the GLOBAL box set
+
+**Limit 1 is implemented (pending goldens); limits 2 and 3 remain open.** It was previously recorded only as a diagnosis inside "The
+problem, measured" and had no design entry, no queue entry, and no owner. Audited against the code
+2026-07-31.
+
+The strategy demands `boxes_per_level >> num_procs`. Three costs in the implementation grew with the
+*global* box count, so the strategy and the implementation were in direct contradiction. Limits 1
+and 2 are now fixed; limit 3 is open and deliberately not next:
+
+| # | limit | code | 512 boxes (today) | 10^5 boxes |
+|---|---|---|---|---|
+| 1 | ~~one global collective PER BOX per regrid~~ **HOISTED** | was: `s_set_amr_fine_geometry` reduced inside `do k = 1, nboxes`. Now accumulates into `amr_xchg_bad`; `s_amr_reduce_xchg_flag` reduces ONCE per scan | 512 -> **1** | 10^5 -> **1** |
+| 2 | ~~O(n^2) sort in the cut~~ **FIXED** | was: `s_amr_sfc_cut` insertion sort, comment "n small". Now a bottom-up stable merge sort | 1.3e5 -> 4.6e3 ops | 5e9 -> 1.7e6 ops |
+| 3 | O(global boxes) replicated metadata per rank | `amr_region_lo_all`, `region_hi_all`, `isect_lo_all`, `isect_hi_all`, `block_owner`, `block_level`, all sized `amr_max_blocks` | 5.6 MB/rank | ~560 MB/rank at 10^7 |
+
+**What the hoist will and will not do.** @ref amr_block_batching measured that batching these
+allreduces "buys nothing" at 14-21 boxes, because the 7.4-13 ms per call is absorbing load-imbalance
+spread and a barrier collapses it - the time is the wait, not the reduction. That is correct in that
+regime and the hoist should NOT be expected to speed up current benchmarks. It removes the O(nboxes)
+term: with `nboxes` collectives the cost has a floor of `nboxes x latency` regardless of imbalance,
+~0.5 s per regrid at 10^5 boxes before any imbalance at all.
+
+Limit 1 is the worst, and it is worse than box count alone suggests: @ref amr_block_batching measured
+that allreduce at **7.4 ms (np=4) to 13 ms (np=8) per call, ~700x a real one-integer allreduce**,
+because it absorbs the spread in the owner-only work preceding it. Inserting a barrier collapses the
+phase from 0.089 s to 0.0011 s. So its cost grows with rank count as well as with box count.
+
+### Limit 1: how it was removed, and a latent bug it was hiding
+
+The reduction answers "is any block too close to a subdomain edge to prolong its ghosts". Every
+per-box answer is immediately OR-ed into one accumulator and only the accumulator survives:
+
+ any_xchg = .false.
+ do k = 1, nboxes
+ call s_set_amr_fine_geometry(...) ! ends in s_mpi_allreduce_integer_max
+ any_xchg = any_xchg .or. amr_xchg_coarse_ghosts
+ end do
+ ...
+ amr_xchg_coarse_ghosts = any_xchg ! m_amr_regrid.fpp:1456 - ONLY the OR is kept
+
+So `nboxes` collectives became **one**: each call ORs into the module accumulator `amr_xchg_bad`, and
+`s_amr_reduce_xchg_flag` performs a single allreduce to close the scan. All five call sites close
+their scan explicitly.
+
+**Two of those call sites were also wrong.** The loops in `s_initialize_amr_module` (L0 tiles) and in
+both restart paths kept only the LAST block's answer rather than the OR - an earlier block needing the
+coarse-ghost exchange could be masked by a later one that did not, silently skipping an exchange the
+fine advance depends on. The accumulator fixes that by construction, since every block ORs in. `amr_xchg_coarse_ghosts` is module state also read in the fine advance
+(`m_amr.fpp:4426`, `:4558`), so the flag must still end up global - which is exactly what the hoisted
+single reduction produces. Roughly ten lines: split the local test from the reduction and hoist.
+
+### The AMReX model, and which half is adopted
+
+The ownership half is done. The communication half is where the gap is.
+
+| AMReX property | MFC | evidence |
+|---|---|---|
+| whole-box ownership | yes | always had it |
+| absolute small box cap | yes | `amr_max_grid_size` (`3a718392`) |
+| per-box scratch, not subdomain-sized | yes | `idwbuff_alloc` (`7b1e4933`) |
+| per-level box list AND rank mapping | yes | `cfdd2847` |
+| mapping computed redundantly, no communication | yes | `s_amr_sfc_cut` is all-real arithmetic on replicated weights in a fixed order |
+| data movement P2P, not collective | yes | `s_amr_gather_coarse_patch`: "Non-participants send/recv nothing (no global collective)" |
+| **regrid free of per-box collectives** | **NO** | limit 1 above |
+
+Note what is NOT wrong: the gather is already P2P, and the owner mapping is already computed without
+communication. The single defect is the reduction, which was never a design decision - it is a
+convenience that is invisible at 512 boxes.
+
+### Sequencing for this arc
+
+1. **Hoist the per-box reduction** (limit 1). Small, mechanically safe, removes the dominant term.
+ Correctness bar: byte-identical goldens, since the OR is unchanged.
+2. ~~**Replace the insertion sort**~~ **DONE.** Bottom-up merge sort: O(n log n), iterative, and
+ stable (`<=` keeps the left run first on ties), so the order is a pure function of the input and
+ every rank still produces the identical permutation - which is what the assignment depends on and
+ what `s_amr_validate_owner` checks. All 72 AMR goldens byte-identical, as expected: same-level
+ boxes have distinct Morton keys, so any correct sort yields the same order.
+3. **Only then consider the replicated metadata** (limit 3). It is the least urgent: 5.6 MB/rank at
+ 10^5 boxes is tolerable, and removing it means giving up the redundant-mapping property that makes
+ the assignment communication-free. Do not trade that away without a measurement showing it binds.
+
+None of this is visible on a single node: 512 boxes is three orders of magnitude below where limit 1
+bites, which is why the measurements in this document could not have found it and a code audit did.
+
+## The per-block floor: AMR costs ~31x uniform per cell, and the overhead is per-BLOCK
+
+The three limits above are about *scalability* - costs that grow with the global box count. This one
+is about *efficiency*, it is a constant factor, and it is much larger than anything else here. A
+constant factor of 31 is not fixed by scaling better.
+
+**The measurement.** 75.5M cells, 2D, np=8, `run_time_info=F`, 8 steps, identical grid and IC in both
+arms (`amr-bench/cases/hg8_amr.py` and `hg8_ctl.py`); the AMR arm additionally advances a refined
+level, so the arms are compared per cell-update, not per step:
+
+| arm | s/step | cell-updates/step | ns per cell-update |
+|---|---|---|---|
+| uniform | 0.117 | 75.5M | **1.55** |
+| AMR (`amr_max_grid_size` 256) | 10.2 | 75.5M + 134.1M fine | **48.7** |
+
+That ratio was unreadable until the balance report started printing `fine_work` (the summed assigned
+weight, which with no cost signals is exactly the fine cells advanced). Without it, "AMR is 87x
+slower per step" cannot be separated into "it advances 2.78x the cells" and "it pays 31x per cell",
+and only the second is a defect.
+
+**The cause is the block count, not the block size.** Same case, same ranks, varying only
+`amr_max_grid_size` - which changes how finely the same feature is tiled (`amr_max_blocks` raised to
+4096 so it never binds):
+
+| `amr_max_grid_size` | boxes | fine cells | s/step | s per box | ns per cell-update |
+|---|---|---|---|---|---|
+| 128 | 4096 | 268M | 70.3 | 0.0172 | 204 |
+| 256 | 934 | 414M | 40.3 (39.8) | 0.0431 | 82 (81) |
+| 512 | 458 | 511M | 12.9 (12.6) | 0.0282 | 22 (21) |
+| 1024 | 144 | 761M | 8.5 | 0.0588 | 10 |
+
+Parenthesised values are a repetition of those two rows: 1.3% and 2.9% apart, so everything below is
+far outside run-to-run spread.
+
+**Read the first three columns together: the arm that advances the MOST cells is the FASTEST.** 144
+boxes over 761M fine cells takes 8.5 s/step; 4096 boxes over 268M fine cells takes 70.3 s/step. Time
+rises monotonically with box count while the work done falls monotonically. Cost is set by the number
+of blocks advanced, not by the amount of data in them - no curve fitting required to see it.
+
+This confirms at production scale what @ref amr_block_batching measured in the small: a per-block
+advance costs a substantial fraction of a full monolithic step regardless of block size, and does not
+amortize. Note the per-block cost is not a clean constant either - `s per box` is non-monotonic
+(0.0431 at 934 boxes vs 0.0282 at 458), reproducibly so, so it is not simply `a + b*cells`. Something
+super-linear in box count is present as well - adjacency-driven work such as fine-fine seam exchange
+is the obvious suspect and is not yet isolated.
+
+**Consequences.**
+
+- @ref amr_block_batching's premise is CONFIRMED — per-block overhead is what costs, and the table
+ sizes the prize at ~20x between the finest and coarsest tiling of the same feature. Its premise was
+ previously argued from efficiency figures since found contaminated (starved GPUs, `run_time_info`
+ device syncs), so it had been left open. **But confirming the premise did not validate the planned
+ fix:** the packed super-grid was subsequently DISPROVED (2026-08-01), because `s_amr_tile_box`
+ splits evenly and so leaves every tiled block larger than half the tile size, making blocks exactly
+ slot-sized and \f$P_{\max} = 1\f$. See @ref amr_block_batching, "the packed super-grid cannot work".
+- The per-level cap `amr_max_grid_size` is a first-order performance knob, not just a correctness or
+ portability one. Small caps are ~20x worse per cell. With packing disproved this is the *only*
+ presently-available lever on the per-block floor, and it is bounded by device memory: cap 2048 on
+ this case runs the GCD out of memory before the first step completes.
+- This interacts with balance in the wrong direction. More boxes per level is what gives the balancer
+ freedom (`boxes_per_level >> num_procs`), and it is exactly what costs. The two goals are in
+ tension until batching removes the per-block floor, and any future balance work that buys evenness
+ by splitting boxes further must be measured against this table.
+
+**What this measurement is not.** The arms do not refine identical areas - a block is a rectangle, so
+coarser tiling over-covers, which is why fine cells RISE with the cap. So this is not a clean
+single-variable A/B on tiling, and the ns-per-cell column mixes the two effects. The argument
+deliberately does not rest on that column: it rests on time and work moving in OPPOSITE directions,
+which no confound between them can produce. Repeated rows agree to 1-3%.
+
+## The problem, measured
+
+Cost tracks the **total** number of refined boxes, not the number a rank owns. On a fixed 2D
+2048x1024 case with seven refined features, varying only rank count:
+
+| np | `amr_maxc_fit` | boxes | per-rank boxes | s/step |
+|---|---|---|---|---|
+| 1 | 1024 x 512 | 14 | 14 | 0.6552 |
+| 4 | 256 x 512 | 14 | 3.5 | 0.2892 |
+| 8 | 256 x 256 | 21 | 2.6 | 0.3479 |
+
+Two things go wrong together. **Box count grows with rank count** — `amr_maxc_fit` is the
+min-over-ranks local half-extent, so adding ranks shrinks the cap until a fixed feature must be
+tiled into more pieces (a 624-cell-tall feature needs 2 tiles at a cap of 512 and 3 at 256; at
+np=32 the cap reaches 128 and it needs 5, giving 35 boxes). And **cost follows total box count
+near-linearly**: holding the box set fixed at 35 with `amr_max_grid_size` and comparing against
+the default arm at matched rank counts gives time ratios of 2.25x, 2.09x and 1.42x against box
+ratios of 2.50x, 2.50x and 1.67x — an exponent of 0.68 to 0.93.
+
+That combination is why np=4 -> 8 regresses. Per-rank boxes *fall* 3.5 -> 2.6, so per-rank work
+should drop to ~0.217 s/step; measured it *rose* to 0.3479. The ~1.6x gap is work proportional
+to the global box set: every per-box collective in the regrid rebuild loop runs over all boxes on
+all ranks.
+
+## Why whole-box ownership is not the problem
+
+An earlier reading of this concluded that a rank must hold an entire block, so per-rank AMR
+memory cannot strong-scale, and therefore blocks must be split across ranks. **That conclusion
+was wrong.** AMReX, Chombo and BoxLib all keep whole-box ownership — a box belongs to exactly one
+rank. They scale because of three properties MFC only partly has:
+
+1. an **absolute, small** box size cap, so boxes are many and small;
+2. **per-box scratch**, sized to the box, rather than one working set sized to the subdomain;
+3. **per-level distribution** — each level has its own box list *and its own rank mapping*.
+
+Under (1) and (2), per-rank memory is `O(boxes_per_rank * cap^d)`, and `boxes_per_rank` falls as
+ranks are added, so it strong-scales. The MFC ceiling was never ownership; it was a cap *derived
+from the subdomain* combined with solver scratch *sized to the subdomain*. Those are
+`amr_max_grid_size` (landed, `3a718392`) and `idwbuff_alloc` (landed, `7b1e4933`).
+
+## Target design
+
+Adopt (3). Each level keeps its own box list and its own owner mapping, chosen without reference
+to the coarse decomposition. Inter-level coupling becomes general point-to-point.
+
+The two rejected alternatives, for the record:
+
+- **Domain-aligned ("mirror") ownership** — a block's fine cells live on whichever rank owns the
+ underlying coarse region (named at `m_amr.fpp:326-330`). Parent<->child and reflux become
+ rank-local and the communication problem largely disappears, but load balance is then dictated
+ by the coarse cut, so a locally-refined region overloads a few ranks. That is precisely the
+ problem AMR load balancing exists to solve.
+- **Block sub-decomposition** — split a large block across a rank subset. Smallest change from
+ today, but it adds a second decomposition layer beneath the existing one and keeps
+ block-as-atom, the concept causing the trouble.
+
+## What MFC already has
+
+This is less of a leap than it appears; the branch has been converging on it.
+
+- `s_amr_sfc_cut` / `f_amr_owner` already compute an owner mapping independently of the
+ Cartesian coarse decomposition.
+- P2P coarse<->fine gather and scatter already exist (`s_amr_gather_coarse_patch`,
+ `s_amr_scatter_pbmv`), including the device-side unpack.
+- Per-level box lists already exist (`amr_block_level`, `box_level`).
+- Level-selective seam halo already exists (`1895c0ef`).
+
+## What was missing — Track 2 (now landed)
+
+Gather, restrict and flux-register delivery were all np=1-local. Multi-rank worked only because a
+refinement tower co-located on its level-1 anchor, which made a whole tower the balancer's smallest
+atom (weight `cost * rr^(l*d)`) and capped granularity at depth. Under per-level distribution
+co-location is not a constraint to be relaxed separately — it disappears as a consequence, which is
+why Track 2 was the spine of this phase rather than one item on a queue.
+
+All three paths are now P2P (`6832d299`, `d53fac46`), plus a fourth constraint that was **not** on
+the original list and blocked step 4:
+
+- **3d, the per-level lockstep advance** (`26e0d080`). `s_amr_advance_children` drove one parent's
+ subtree to completion while the `s_amr_fine_fine_halo(clev)` interposed in its stage loop spans
+ EVERY parent, so a seam pair straddling two parents had only one side present. Co-location hid
+ the MPI half by putting both ends on one rank. The codebase already knew — `m_checker.fpp`
+ fail-closes `amr_subcycle .and. amr_regrid_int > 0 .and. num_procs > 1 .and. amr_max_level > 1`
+ citing exactly this. Lifting that PROHIBIT is now unblocked and is the only thing that would
+ cover the subcycle SETUP gather added in `cfdd2847`, which currently has **no golden coverage**.
+
+The general lesson, since it cost four bugs: **whenever an invariant says two owners always
+coincide, every read that depends on it is load-bearing and invisible.** Grep for the invariant,
+not for the symptom.
+
+## Load balancing
+
+Distribution decides *where* a box lives; balancing decides whether that placement spreads work
+evenly. Per-level distribution is a prerequisite for the second, not a substitute — this section
+states the mechanism, the metric, and the limits that bind at scale.
+
+### Mechanism
+
+Three pieces, only the third of which is AMR-specific:
+
+| Piece | Where | Role |
+|---|---|---|
+| L0 Cartesian rebalance | `m_load_balance.fpp`, `s_load_balance_rebalance` (called once from `m_start_up`) | weighted splits of the base grid; `load_balance` |
+| Cost model + imbalance metric | `m_load_weight.fpp`, `m_rank_timing.fpp` | per-cell weights and a measured per-rank compute time; `load_weight_wrt` |
+| AMR block assignment | `s_amr_block_cost` -> `s_amr_sfc_cut` (`m_amr.fpp`) | owner map for level>=1 blocks |
+
+The AMR path weighs each block by `cost(k) * rr**(level*d)`, where `cost` sums a per-cell model
+over the block's L0 footprint: base 1, plus `K_ib` per IB-marked cell, plus `K_pc` per
+phase-change Newton iteration (`m_constants`: 2 and 3; `K_bub` = 50 applies to Lagrangian bubbles,
+which are excluded from blocks by construction). One `MPI_ALLREDUCE(SUM)` makes the vector
+identical on every rank, after which the assignment is deterministic and rank-independent.
+`s_amr_sfc_cut` then does a chains-on-chains split of the blocks in Morton order of their low
+corner, one independent cut **per level**.
+
+**Step 4 is the load-balancing enabler, not merely a distribution change.** Under tower
+co-location the balancer's smallest atom was a whole refinement tower, weight `cost * rr**(l*d)`.
+No assignment can fix an imbalance whose atom is larger than the imbalance itself, so a single
+deep tower pinned work that adding ranks could not relieve. Cutting each level independently is
+what makes the cost model actionable.
+
+### The metric
+
+Balance is `max_r W(r) / mean_r W(r)` over per-rank assigned weight `W`, reported per level and
+for the total. Two properties are required, and only the second is about scale:
+
+1. **Quality** — imbalance below a fixed tolerance at a given rank count.
+2. **Scale invariance** — imbalance must not *grow* with rank count. A scheme that is well
+ balanced at np=8 and degrades monotonically by np=1024 has not solved the problem; this is the
+ property to test, and it is not visible on a single-node sweep.
+
+`m_rank_timing` supplies the measured counterpart (per-rank RHS + relaxation time), which is the
+honest check on the *model*: a cost model that predicts balance while measured times diverge is
+wrong, and the model is what the assignment actually uses.
+
+### What binds at scale
+
+These are structural, not tuning knobs, and each sets a floor on achievable balance:
+
+- **Granularity floor.** A level cannot be balanced across more ranks than it has boxes. In
+ `s_amr_sfc_cut` a level holding one box always lands on rank 0 (the loop assigns `r = 0` and
+ advances only once cumulative weight crosses a share boundary), so a shallow hierarchy leaves
+ ranks holding *no block at that level* by construction. Scaling therefore requires
+ `boxes_per_level >> num_procs`, which is what the absolute cap `amr_max_grid_size` exists to
+ deliver — the cap and the balancer are one mechanism, not two.
+
+ **This is not idleness, and the `[amr-balance]` counter must not be read as if it were.** A rank
+ holding no level-`L` block still owns level-0 work — level 0 covers every rank always — and may
+ own blocks at other levels. Even the TOTAL line's counter means only "owns no *fine* block". The
+ counters are named `no_blocks_ranks` / `ranks_with_no_fine_block` for exactly this reason. Idleness
+ is measurable only from `m_rank_timing`; a granularity-floor count is an upper bound on the harm,
+ never a measurement of it.
+- **Indivisible atom.** The cut is contiguous in Morton order and cannot split a box, so
+ imbalance is bounded below by the heaviest single block's weight. As ranks grow, mean per-rank
+ weight falls while that floor does not, so imbalance rises unless the cap falls with it.
+- **Static within a regrid interval.** Cost is sampled at regrid; work that migrates between
+ regrids is not tracked. The relevant knob is `amr_regrid_int`, and its cost is itself
+ rank-scaling work (see the box-count analysis above).
+- **Cost-model blindness by default.** With no live signals `cost(k)` degenerates to the
+ footprint cell count — pure geometry. `pc_iter_count` is populated only when `load_weight_wrt`
+ is enabled. A run with heterogeneous per-cell cost and `load_weight_wrt` off is balanced on
+ geometry alone, which will look correct and be wrong.
+- **Assignment cost.** `s_amr_block_cost` is an allreduce over the global block vector every
+ regrid - one call, not one per box (limit 1), and the cut is now O(n log n) (limit 2). What
+ remains is that the vector itself is sized by the *global* box set, the same term identified in
+ "The problem, measured"; that is limit 3.
+
+### Acceptance criteria
+
+1. Per-level and total imbalance reported at np = 1..N, with imbalance flat or falling in `N`.
+2. Model vs measured agreement: `m_rank_timing` per-rank times consistent with assigned weight.
+3. A cost-heterogeneous case (IB or phase change) with `load_weight_wrt` on, showing the weighted
+ assignment beating the pure-geometry fallback. Geometry-only cases cannot demonstrate this.
+4. Deep-tower case: imbalance must not depend on refinement depth once towers may split.
+
+## The cost model is regime-dependent, and production is the cell-dominated regime
+
+Measured 2026-07-31 across three problem sizes. Which metric predicts measured `[rank_time]` flips
+with how much work a box carries:
+
+| regime | boxes/rank | box size | measured time tracks |
+|---|---|---|---|
+| 511x255, `mgs=64`, np=8 | ~2 | tiny | **box count** (1.308 vs measured 1.259; cell weight flat at 1.050) |
+| 75.5M, `mgs=256`, np=8 | 13-19 | large | **cell weight** (1.058 vs measured 1.058; box count 1.121) |
+
+Per-block overhead is a FIXED cost - a per-block advance costs ~1x a monolithic step regardless of
+size (@ref amr_block_batching). When boxes are tiny that fixed term dominates and load tracks box
+count. When boxes carry real work the cell term grows until the two metrics nearly coincide: at 75.5M
+with clustered refinement, level-2 weight imbalance is 1.058 and box count 1.121, so the two
+objectives barely conflict.
+
+**A prediction that failed, recorded because it constrains the model.** Reading "measured tracks
+weight, not box count" at 75.5M, the expectation was that a fixed per-box term would make balance
+WORSE by steering toward the metric that does not predict runtime. It did not: `K_box = 8` on the
+clustered case moved measured imbalance 1.031 -> 1.022 (np=2, 4) and 1.058 -> 1.038 (np=8), pulling
+box-count imbalance 1.121 -> 1.047 while weight imbalance stayed ~1.05. So at scale the two objectives
+are close enough that improving one does not cost the other. The regime difference is real but it is a
+CONVERGENCE of the two metrics, not a reversal.
+
+Consequence for `K_box` (not landed, see `0e3418ef`): the gain at production scale is ~2% imbalance,
+comfortably inside the run-to-run variance measured on this machine (np=4 moved 1.084 -> 1.170 between
+two runs of an identical configuration). That does not justify a tunable constant that also requires
+the ULP cut fix as a prerequisite. It remains worth revisiting if a future regime pushes
+boxes-per-rank back down - which `amr_max_grid_size` does directly.
+
+Three measurement flaws had to be removed before any of this was visible, each of which produced a
+confident wrong conclusion first:
+
+1. **Starved GPUs.** 511x255 at np=8 is 16k cells/rank; an MI250X GCD needs O(1e6) to be compute
+ bound. `mfcrun.sh` now refuses below 1e5 cells/rank.
+2. **`run_time_info=T`** forces a device->host sync and a global reduction EVERY step. It made a
+ uniform 75.5M control look like 6% parallel efficiency at np=8. Now off in every generated case.
+3. **A low-discrepancy IC.** `gen_blobs.py` places blob centres with a Weyl sequence - evenly spread
+ BY DESIGN (24 blobs land 3,3,2,4,3,2,4,3 across eight x-slabs). The workload is inherently
+ balanced, so the case cannot discriminate between cost models. `gen_clustered.py` concentrates the
+ refinement instead.
+
+And a fourth, which is a result rather than a flaw: **spatial clustering does not create imbalance**,
+because per-level distribution decouples ownership from position. With all refinement in one quadrant
+the balancer still spreads boxes over every rank (`no_blocks_ranks 0 of 8`, imbalance 1.03-1.06).
+That is step 4 working as designed.
+
+## Sequencing
+
+Steps 1-4 are LANDED (see "Status"); they are kept here because the ordering constraints between
+them are load-bearing and a reader retracing the work needs them. Steps 5-7 are the live queue.
+
+### Landed
+
+1. **Finish the scratch decoupling.** Convert the `m`/`n`/`p`-keyed allocation family that an
+ `idwbuff` grep does not find: `m_riemann_solvers` sizes on `-1:m,-1:n,-1:p` and `m_weno` on
+ `is*_weno` (`is1_weno%%end = m - is1_weno%%beg`). **Only then** relax the
+ `amr_max_grid_size > fit_d` abort in `m_amr.fpp`. Relaxing it first writes out of bounds
+ silently rather than failing to compile.
+2. **Measure with the cap pinned below the derived cap at every rank count.** This is what shows
+ the box set going rank-invariant and the np=8 turnover softening. Run the uniform control arm
+ at every point; without it an AMR curve at 65k cells/rank is unreadable.
+3. **Generalise parent<->child to P2P**, level by level, with the level mapping still equal to
+ the coarse one — behaviour-preserving, so the existing goldens gate it.
+4. **Give each level its own mapping** and drop tower co-location.
+
+ Splitting towers made four latent reads reachable, all one shape: a **parent-slot field
+ guarded on owning the CHILD**, safe only while the two owners always coincided. Undefined
+ `amr_slots(pblk)%%amr_ref_ratio`, a bisected unallocated `%%x_cb`, and `lbound`/`ubound` of that
+ same unallocated array. Symptom was garbage cell widths and NaNs at the rank seam, several
+ steps later. Anything reading another block's slot must be guarded on owning **that** block, or
+ derive from replicated metadata (`s_amr_parent_foot`, `s_amr_build_block_coords`).
+
+### Next
+
+5. **Instrument balance.** LANDED (`fc53e097`, fixed in `3780f30a`). `s_amr_report_balance` prints
+ per-level and total `max/mean` assigned weight, box-count imbalance, and the no-block rank count,
+ gated behind `load_weight_wrt`. Needs no MPI - the inputs are replicated, so rank 0 prints.
+ Its first conclusion ("box supply binds, not the owner mapping") was RETRACTED: it was inferred
+ from box counts and model imbalance on a starved case, with no measured counterpart.
+ `m_rank_timing` was already implemented and wired the whole time - acceptance criterion 2 was a run
+ to perform, not code to write.
+6. **Model vs measured (acceptance criterion 2).** DONE. At production scale the model predicts the
+ measurement: 1.000 model vs 1.006-1.058 measured across np = 2, 4, 8 at 75.5M cells. On starved
+ cases they diverged 8x, which is what motivated step 7.
+7. **Reweight `s_amr_block_cost` on a fixed per-box term.** ATTEMPTED, MEASURED, **REJECTED.**
+ `K_box` (fixed per-box cost in mean-block-cell units, added after the allreduce, fine blocks only)
+ improved balance substantially on small cases and delivers ~2% at production scale - inside this
+ machine's run-to-run variance. Not worth a tunable constant that also requires the ULP cut fix as a
+ prerequisite. Removed in `0e3418ef`; see "The cost model is regime-dependent" below for the
+ measurements and for a prediction of mine that failed.
+
+ **The experiment paid for itself anyway.** Perturbing the weights exposed two latent partitioner
+ bugs, both fixed independently and both of which had survived only because the arithmetic happened
+ to be benign:
+ - `2051aa19` - `s_amr_sfc_cut` compared an n-term accumulation against a closed-form target, so an
+ exact share boundary turned on 1 ULP. Correct only because every cost term is integer-valued.
+ - `c3364a5b` - uninitialized L0 tile-prefix slots entered the fine-level cut as phantom key-0
+ blocks. Correct only because they all happened to land on rank 0.
+
+### The live queue
+
+Two questions are now settled, and they narrow the remaining work considerably.
+
+**Balance is solved at production scale.** At 75.5M cells with refinement clustered in one quadrant,
+the balancer holds 1.03-1.06 measured imbalance and puts blocks on every rank. Spatial concentration
+does NOT create imbalance, because per-level distribution decouples ownership from position - step 4
+working as designed. The cell-based cost model is adequate there; an experimental fixed per-box term
+bought ~2%, inside run-to-run variance, and was rejected (`0e3418ef`).
+
+**The scaling ceiling is MFC's, not this branch's and not AMR's.** Same portable uniform case
+(`amr-bench/gen_uniform.py`, no AMR in the path), same harness, run on MFC master `bfdc8f5e` and on
+this branch, 3 reps alternating between trees:
+
+| np | master median | branch median | ratio | within-tree spread |
+|---|---|---|---|---|
+| 4 | 0.3285 s | 0.3359 s | **1.022** | 6.9% / 2.0% |
+| 8 | 0.2326 s | 0.2380 s | **1.023** | 11.1% / 5.2% |
+
+The branch costs ~2% on a uniform problem - indistinguishable from noise at an 11% within-tree
+spread. Uniform efficiency is ~60% at np=8 on both trees. **No AMR work can move that**, and a
+single-run comparison earlier suggested 15% at np=4 purely as an artifact: three reps put it at 2%.
+
+Consequence for measurement discipline: at 11% run-to-run spread on this machine, **any A/B claiming
+less than ~10% needs repetitions**, taken alternating between arms so drift hits both equally.
+
+8. ~~**Hoist the per-box reduction in the regrid rebuild loop.**~~ **DONE** (`3f754893`), and limit 2
+ with it (`83bf4572`).
+9. ~~**What does AMR actually cost relative to uniform, at a loaded size?**~~ **ANSWERED: ~31x the
+ per-cell cost of uniform**, and the overhead is per-BLOCK, not per-cell. See "The per-block floor"
+ below - this is now the largest single number in this document.
+10. ~~**Then, and only then, revisit @ref amr_block_batching.**~~ **Its premise is CONFIRMED**, and by
+ a measurement rather than by the contaminated efficiency figures it originally rested on. Per-block
+ overhead does dominate; item 9 sizes the prize at ~20x. **The planned fix, however, is DISPROVED:**
+ the packed super-grid needs blocks smaller than half the cap, and the even-split tiler guarantees
+ the opposite, so \f$P_{\max} = 1\f$ on every measured configuration. Batching survives only via the
+ flat backing store and its unresolved `ACC_SETUP_SFs` aliasing risk. Confirming that a cost is
+ per-block says nothing about whether a given mechanism can remove it.
+
+13. **A proper 3D scaling benchmark.** The 2D 75.5M pair is retired for scaling work: it cannot
+ strong-scale (per-rank AMR memory is ~refined-volume/ranks, so it OOMs at np <= 4 at most caps —
+ memory pressure rises as ranks are REMOVED) and its refinement is not reproducible across rank
+ counts (@ref amr_block_batching, "the box set is not rank-invariant"). The replacement is a 3D
+ sharp-interface case, verified rank-invariant first. The current one (128^3) is still small — at
+ np=8 both arms sit near the starvation floor — and forms no level-2 blocks, so it exercises a
+ single refinement level. Deepen and enlarge it before treating it as the primary benchmark.
+
+ First valid AMR-vs-uniform strong scaling, identical box set at every rank count (16 level-1
+ boxes, `fine_work` 691200, imbalance 1.000):
+
+ | np | AMR s/step | uniform s/step | AMR eff | uniform eff | AMR ns/cell-upd | uniform ns/cell-upd | ratio |
+ |---|---|---|---|---|---|---|---|
+ | 1 | 1.132 | 0.1142 | 1.000 | 1.000 | 405.9 | 54.4 | 7.46 |
+ | 2 | 0.712 | 0.0841 | 0.795 | 0.679 | 255.3 | 40.1 | 6.37 |
+ | 4 | 0.656 | 0.0714 | 0.431 | 0.399 | 235.3 | 34.1 | 6.91 |
+ | 8 | 0.454 | 0.0679 | 0.312 | 0.210 | 162.7 | 32.4 | 5.03 |
+
+ Two results worth keeping. **AMR scales BETTER than uniform at every rank count here** (0.431 vs
+ 0.399 at np=4), because at 2.1M cells the uniform arm starves first — AMR carries more work per
+ rank and hides latency longer. So AMR is not the scaling limiter at these sizes; problem size is.
+ And the per-cell overhead of 5.0–7.5x independently reproduces the ~7.3x measured in 2D at the
+ best cap, from a different case, dimension, and cap — the first time that figure has been
+ confirmed twice.
+
+14. **THE SCALING LIMITER IS CROSS-RANK BLOCK ADJACENCY, not the per-block constant.** Same 3D case
+ enlarged to 256^3 (16.8M base), rank-invariant (64 L1 + 256 L2 boxes, `fine_work` 15160320
+ identical at every rank count), np=1 device-OOMs so efficiencies are normalized to np=2:
+
+ | np | AMR s/step | uniform s/step | AMR eff | uniform eff | AMR ns/cell-upd | uniform ns/cell-upd | per-cell |
+ |---|---|---|---|---|---|---|---|
+ | 2 | 13.121 | 0.3146 | 1.000 | 1.000 | 410.8 | 18.75 | 21.9x |
+ | 4 | 9.071 | 0.1763 | 0.723 | 0.892 | 284.0 | 10.51 | 27.0x |
+ | 8 | 7.544 | 0.1281 | 0.435 | 0.614 | 236.2 | 7.63 | 30.9x |
+
+ Against the 128^3 case (16 blocks) run identically, AMR there scaled BETTER than uniform and its
+ per-cell overhead SHRANK with ranks (7.46 -> 5.03). Here, with 320 blocks, AMR scales WORSE than
+ uniform and per-cell overhead GROWS (21.9 -> 30.9). Same code, machine, cap and dimension; the
+ only variable is block count.
+
+ **CORRECTION - the mechanism is NOT growing communication.** This section first attributed the
+ rising overhead to cross-rank block adjacency. Direct attribution with `rank_time_wrt` (which
+ accumulates per-rank RHS + relaxation compute behind a device sync) refutes that. Same case, same
+ ranks, 20 steps:
+
+ | np | s/step | compute s/step | non-compute s/step | non-compute share | compute efficiency |
+ |---|---|---|---|---|---|
+ | 2 | 13.048 | 5.472 | 7.576 | 58.1% | 1.000 |
+ | 4 | 9.003 | 2.794 | 6.209 | 69.0% | 0.979 |
+ | 8 | 7.227 | 1.447 | 5.780 | 80.0% | 0.946 |
+
+ **The solver scales almost perfectly (0.946 at np=8). The AMR-side work barely distributes:**
+ 7.58 -> 5.78 s/step for 4x the ranks, a 1.31x reduction against an ideal 4x, rising from 58% to
+ 80% of runtime. So the overhead is not growing with rank count - it is roughly CONSTANT in
+ absolute time and fails to parallelize. The per-cell overhead trend (21.9 -> 30.9x) is that fixed
+ cost becoming a larger share as compute shrinks. This is Amdahl, not a communication blow-up, and
+ it caps AMR strong scaling regardless of how cheap the per-block advance becomes.
+
+ **Mechanism, measured with `rocprofv3` - and it is NOT kernel launch count.** One profiled run in
+ the 320-block steady state at np=2, tracing kernels and memory copies together:
+
+ | stream | count | GPU time | share of span | mean |
+ |---|---|---|---|---|
+ | kernel execution | 143290 | 9.91 s | 8.5% | 69.2 us |
+ | device-to-device copies | **2937729** | 28.60 s | 23.5% | 9.7 us |
+ | GPU idle (host / MPI) | - | ~82 s | **~68%** | - |
+
+ Mean kernel duration is 69 us, so these are not launch-latency-bound kernels, and 143k launches at
+ a generous 10 us each is ~1.4 s - it cannot explain ~82 s of idle. The striking number is **20.5
+ device-to-device copies per kernel**, ~306 per block per RK stage, costing 2.9x more GPU time than
+ all kernel execution combined. Ranking: host/MPI serialization first, small device-to-device
+ copies second, compute a distant third.
+
+ **This undercuts @ref amr_block_batching's core premise.** That arc ranks increments by launches
+ removed, on the strength of a 16-tile / 1-fine-block measurement where launch count was the cost.
+ At 320 blocks launch count is not in the top two terms, so launch fusion cannot address the
+ limiter. Re-derive the increment ranking against copies and host time before spending on it.
+
+15. **THE ACTUAL LIMITER WAS A LOOP-INVARIANT CALL, and the biggest lever is a PARAMETER.** Two
+ results supersede much of the framing in item 14, both found by top-down phase attribution rather
+ than by reasoning about mechanisms.
+
+ **(a) `s_amr_exchange_coarse_cons_halo` ran once per BLOCK.** It sat inside `s_amr_fine_stage_fill`
+ (lock-step) and `s_amr_subcycle_setup_block` (subcycle, twice - two lerp sources), both called per
+ block per stage. It exchanges the COARSE field, which every fill READS and none WRITES, so it is
+ loop-invariant: ~960 identical whole-subdomain exchanges per step where 3 suffice. Because the
+ count tracked the GLOBAL block count while each exchange costs the same, it did not distribute -
+ adding ranks made it absolutely SLOWER (phase efficiency 0.155, 58% of the step at np=8).
+ Hoisting it to the two call sites gives, on the 256^3 rank-invariant case:
+
+ | np | before | after | strong-scaling efficiency |
+ |---|---|---|---|
+ | 2 | 13.48 | 10.37 | 1.000 -> 1.000 |
+ | 4 | 9.54 | 6.00 | 0.707 -> 0.864 |
+ | 8 | 7.91 | 3.28 | **0.426 -> 0.790** |
+
+ `fine_work` is identical at every rank count, and 61 AMR goldens are byte-identical. AMR now
+ strong-scales BETTER than the uniform control (0.790 vs 0.432, the control starving first).
+
+ **(b) `amr_max_grid_size` is worth more than the code fix.** Sweeping it at np=8 (2 reps,
+ `amr_max_blocks` pinned so it cannot bind):
+
+ | cap | boxes | blocks/rank | idle ranks | imbalance | s/step | ns/cell-update |
+ |---|---|---|---|---|---|---|
+ | 16 | 1217 | 152.1 | 0 | 1.017 | 11.82 | 428.1 |
+ | 32 | 320 | 40.0 | 0 | 1.000 | 3.47 | 108.6 |
+ | 48 | 180 | 22.5 | 0 | 1.071 | 2.17 | 65.5 |
+ | **64** | **80** | **10.0** | **0** | **1.000** | **1.09** | **31.7** |
+ | 96 | - | - | - | - | device OOM | - |
+
+ Monotone to 64, then a MEMORY wall (confirmed `__tgt_target_data_begin_mapper`; slot and solver
+ scratch both go as cap^num_dims). **Cap 64 is 3.2x faster than 32 - which is AMReX's 3D DEFAULT -
+ and 10.8x faster than 16**, with perfect load balance at the fastest point. So granularity, not
+ balance, is the binding constraint in 3D here; AMReX's own GPU guidance (`max_grid_size` 128) says
+ the same. Against the accuracy-matched baseline (brute-force uniform 1024^3 at 8.19 s/step) AMR
+ captures 3% of the available 33.6x benefit before the fix, 7% after, and **22% at cap 64**.
+
+ **What this demotes.** Item 14's "replicated metadata / Limit 3" hypothesis is WRONG: regrid is
+ 2.4% of the step and scales DOWN. The per-invocation descriptor traffic is real and is now the
+ largest GPU-side term (66% of GPU time), but at cap 64 there are 10 blocks/rank rather than 40, so
+ it matters ~4x less than the cap-32 measurements suggested. Re-derive its value at the cap the code
+ should actually run at before committing to the flat backing store.
+
+ **ROOT CAUSE - `s_compute_rhs` has a FIXED per-invocation cost, and AMR pays it per BLOCK.**
+ Profiling the uniform control on the identical base grid isolates it. Per `s_compute_rhs` call the
+ cost is ~15-31 kernel dispatches and ~305-609 device-to-device copies, essentially independent of
+ how many cells that call covers. Uniform pays it 3x per step; AMR pays it 963x (320 blocks x 3
+ stages + coarse):
+
+ | | uniform | AMR (320 blocks) | ratio |
+ |---|---|---|---|
+ | RHS invocations / step | 3 | 963 | **321x** |
+ | kernel dispatches (10 steps) | 936 | 143290 | 153x |
+ | memory copies (10 steps) | 18260 | 2937743 | 161x |
+ | **copy GPU time** | **0.26 s** | **28.53 s** | **109x** |
+ | kernel GPU time | 2.58 s | 9.86 s | 3.8x |
+ | mean kernel duration | 2761 us | 69 us | 0.025x |
+
+ So the per-block floor is not a mystery constant: it is the RHS machinery's fixed setup, paid once
+ per block per stage rather than once per stage. The copies dominate - negligible at 0.26 s in the
+ uniform run, they become the largest single GPU consumer at 28.5 s, and with their HSA signalling
+ (`hsa_amd_memory_async_copy_on_engine` fires 2928329 times) they account for ~88% of all 33.2M host
+ GPU-API calls.
+
+ **What the copies ARE - CONFIRMED by varying `sys_size`.** `q_cons`/`q_prim`/`rhs` are arrays of
+ `scalar_field` with pointer `%%sf` components, so the suspicion was OpenMP map/descriptor traffic
+ rather than bulk data movement. Test: 3D uniform control, `num_fluids` 1 -> 2 (`sys_size` 6 -> 8),
+ everything else fixed.
+
+ | `num_fluids` | `sys_size` | kernels / call | copies / call |
+ |---|---|---|---|
+ | 1 | 6 | 30 | 626 |
+ | 2 | 8 | 30 | 719 |
+
+ **Copies scale with `sys_size`; kernel count does not** (the `sys_size` loops live INSIDE the
+ kernels). Solving the two points gives **~46.5 copies per field variable plus a ~347 fixed base**.
+
+ That correlation alone does NOT identify descriptors - any per-field operation in a
+ `do i = 1, sys_size` loop scales identically. Two further tests settle it. Varying grid size at
+ fixed `sys_size` (63^3 / 127^3 / 255^3, a 64x volume change) gives **626 copies per call at every
+ size - exactly constant** - so the count is not data-proportional. And the duration distribution at
+ 255^3 is sharply bimodal:
+
+ | bucket | count | share of copy time |
+ |---|---|---|
+ | ~5.4 us (p50) | 11243 (99.7%) | 29.4% |
+ | >1 ms | 29 (0.3%) | 70.6% |
+
+ The 29 millisecond-scale copies are bulk data (initial load and save, ~5 per step, not per call);
+ they are what made the MEAN appear to grow with grid size. The per-call population is 99.7% flat
+ ~5.4 us copies, p10-p99 spanning only 5.0-7.0 us across that 64x volume change - latency-bound, so
+ bytes not megabytes. Count fixed in volume, duration flat in volume, count linear in `sys_size`:
+ that is metadata/descriptor traffic per (field x mapped argument), ~3.4 ms per `s_compute_rhs`
+ entry. Uniform pays it 3x/step (~10 ms, invisible); AMR pays it 963x.
+
+ **Why it is addressable:** `sys_size` is fixed once `s_read_input_file` completes, so every array
+ shaped by it has known, unchanging extents from initialization onward. Re-establishing these
+ mappings on every RHS entry is redundant work, not an inherent cost.
+
+ **Consequence for the fix.** Making these mappings persistent instead of per-call is the lever, and
+ it is worth noting this is the same flat-backing-store restructuring
+ (`%%sf => amr_qall(:,:,:,i,k)`) that @ref amr_block_batching proposed for an unrelated reason
+ (enabling batched kernels). The batching rationale is dead (see "the packed super-grid cannot
+ work"); the descriptor-traffic rationale is live and is supported by direct measurement. Its
+ `ACC_SETUP_SFs` aliasing risk on Cray is unchanged and still needs a build to settle.
+
+ **SIZING CAVEAT - these magnitudes are provisional.** Measured density on this machine is 19.34 GiB
+ for 16.8M uniform 3D points = 0.87M points/GiB, so a 64 GiB GCD holds ~56M points. This case runs
+ 2.1M points/rank at np=8, about **4% of capacity**, which inflates the non-compute share (compute
+ is tiny while AMR overhead is roughly fixed). The DIRECTION - AMR-side work does not distribute -
+ is robust, but every magnitude above needs re-measuring at ~30-40M points/rank (roughly 640^3 for
+ the uniform control, with headroom for AMR slots) before being quoted. Profiling also costs ~16%
+ (15.9 vs 13.7 s/step), inflating the idle fraction somewhat, though not enough to change the
+ ranking.
+
+12. **Where does the residual ~7.3x go at the best cap?** Even at cap 1024 - the largest that fits
+ device memory here - AMR is 11.4 ns/cell-update against uniform's 1.55. Packing cannot close it
+ and raising the cap further OOMs, so this is the standing efficiency question. Candidates, in the
+ order they are worth measuring: remaining unfused ghost-slab loops (`s_amr_lerp_fine_ghosts` is
+ the valuable one - it runs per SUBSTEP, not per stage), the super-linear-in-box-count term from
+ item 9, and per-block occupancy at the RHS kernels themselves.
+11. **Multi-node scale invariance.** This is the actual exascale question and single-node np<=8 cannot
+ answer it: the granularity floor and the indivisible atom only bind once ranks approach the box
+ count per level. Everything measured here tops out at 8 ranks with 13-64 boxes per rank - a
+ regime where the balancer is comfortable. The interesting regime is the one where it is not.
+
+## Superseded measurements, and why they are kept out of the body
+
+Three earlier sections were removed in the 2026-07-31 reorganisation because their numbers are known
+to be contaminated. They are recorded here so a reader meeting them in git history knows not to trust
+them, not because they are still evidence.
+
+- **"Balance is no longer the limiter"** quoted 62% parallel efficiency at np=4 and 38% at np=8, and
+ concluded that per-box overhead had to be the remaining cost. Both figures came from runs with
+ `run_time_info = T`, which forces a device->host sync and a global reduction every step. The same
+ configuration measured 6% efficiency at np=8 on a *uniform* 75.5M-cell control, i.e. the figure was
+ measuring a diagnostic barrier.
+- **"The cost model weighs the wrong quantity"** reported measured time tracking box count (1.308)
+ while cell weight stayed flat (1.050) at np=8. That is real, but only in the starved regime: at
+ 511x255 a rank holds ~2 boxes of 16k cells. See "The cost model is regime-dependent" for the
+ measurement at production size, where the two metrics converge.
+- **The step-4 A/B "Measured outcome"** (2047x1023, co-location vs per-level) was run at a size where
+ the uniform control reached 18% parallel efficiency at np=8, so both arms were latency-bound
+ exactly where the effect should have appeared. It cannot distinguish "no imbalance to fix" from
+ "balancer did nothing".
+
+The general lesson, which cost most of a day: **a timing number is only as good as the configuration
+that produced it.** Check `run_time_info`, cells per rank, and the uniform control's own efficiency
+before interpreting any of them.
+
+## Validation
+
+The bar this branch already uses: np=1 bit-identical, np>=2 conservation-exact, plus the goldens'
+tolerance compare. Cross-compiler coverage (CCE, gfortran, nvfortran, ifx) is CI's job and runs on
+the PR — the **local** gate is correctness under OMP GPU offload with the AMD AFAR compilers. Do
+not hold work waiting on a Frontier run. Expect CCE to be where a regression in this area first
+appears, though: every one so far has been CCE-only, so treat a CCE failure as a real bug rather
+than flaky infrastructure.
+
+For steps 3 and 4, prefer the **conservation ladder** over field diffs: authoritative mass after
+each stage, the pure reflux delta, coarse-equivalent fine mass per block, and covered-cell mass
+per block, all allreduced and printed from both arms. That is what localised the np>=2 restrict
+bug (`ab87d49e`) when field diffs could not; many-to-many coupling is exactly where that class of
+bug hides.
+
+Balance is validated separately from correctness, and neither substitutes for the other. A run can
+be conservation-exact and golden-clean while every fine block sits on one rank; nothing in the
+golden suite measures distribution quality, because the goldens are single- and two-rank
+tolerance compares of field data. Use the acceptance criteria in "Load balancing" above, and treat
+end-to-end s/step as a *consequence* of balance rather than evidence of it — a case whose towers
+happen to spread evenly will scale well regardless of whether the balancer did anything.
+
+Note that `./mfc.sh test --only AMR` does not match the coexist goldens — their trace token is
+"AMR + L0 tiles". Run `1F074C5D 8D466A94 83CC5C6D 33060D84 FD056B71 98AA6EDB D99F85F8 09E0D257
+93EFC4F6` by UUID as well, or they silently go untested. (A `-l | grep -i amr` filter does catch
+them, since the token still contains "AMR"; the suite is 71 cases as of `1e07eb65`.)
+
+**A new golden must be shown to fail without the change it protects.** `3db24df0` set this bar and
+it has caught real self-deception since: two attempted counterfactuals for the level-3 slot cap
+produced byte-identical output and proved nothing, because the case was too small and then because
+only the grid was scaled and not `amr_buf` — boxes track the *feature*, not the domain. The third
+attempt crashed the old code outright. Where a path genuinely cannot be covered, say so in the test
+comment with the reason, as `C45DBB52` does for the level-2 seam over MPI; silent non-coverage reads
+exactly like coverage a year later.
\ No newline at end of file
diff --git a/docs/documentation/amr_plan_based_exchange.md b/docs/documentation/amr_plan_based_exchange.md
new file mode 100644
index 0000000000..105fe2d307
--- /dev/null
+++ b/docs/documentation/amr_plan_based_exchange.md
@@ -0,0 +1,410 @@
+# T1/S4: plan-based exchange and distributed block metadata — v2, post-review
+
+v1 of this design was independently audited by four reviewers (code-truth vs source, MPI transport,
+GPU/compiler portability, adversarial correctness). Every blocker they found is folded in below,
+with the finding named where it changed the design. **v1's payoff mechanism was partly wrong and its
+increment scoping was wrong; the architecture survived.** This version is the implementation
+contract.
+
+## What is wrong today, stated structurally
+
+Every AMR data exchange is driven **per box**, inside loops every rank walks over **all global
+boxes**. Two consequences:
+
+1. **O(boxes) rendezvous and posting skew.** Measured: `rb:wait` 583 ms x 123, `mg:wait` 3227 ms x
+ 16, plus two barriers (`rb:xchg`, `rb:flush`) absorbing the skew.
+2. **O(boxes) metadata per rank.** 21+ arrays at `amr_max_blocks` extent on every rank, plus
+ O(boxes) stack automatics in the regrid path (`old_ilo`/`old_ext`/..., `t_box` lists) and
+ O(boxes x ranks) request arrays (`rq(old_np*num_procs)`). At 10^6 boxes the tags alone break:
+ box-id tags exceed Cray MPICH's `MPI_TAG_UB` (~2^21). Fatal at scale independent of the tax.
+
+AMReX fills a level with one `FillPatch`; Chombo with one `copyTo`; SAMRAI with one
+`RefineSchedule`. The gap is granularity. The same refactor removes both consequences.
+
+## The exchange-family inventory — complete this time
+
+v1 claimed six families / 26 call sites; the audit counted 17 call sites in the named families and
+found the rest in families v1 never named. The full inventory:
+
+| # | family | per | notes |
+|---|---|---|---|
+| F1 | level-1 coarse gather (`s_amr_gather_coarse_patch`) | box | regrid AND per-stage fill |
+| F2 | level>=2 parent gather (`s_amr_gather_from_parent`) | box | source is the freshly built parent |
+| F3 | **qbmm pb/mv twin** (`s_amr_gather_coarse_patch_pbmv`) | box | LIVE at np>1 (single-level qbmm passes the checker); blocking `MPI_SEND` (never got the R1 fix); shares tag `amr_cur` with F1 under a non-overtaking lockstep contract |
+| F4 | migration (`s_amr_regrid_stash_migrate`) | old block | already posts-then-waits (see mechanism) |
+| F5 | reflux faces (`s_amr_p2p_reflux_faces`) + `s_amr_p2p_freg_to_parent` | block | pure `wp`, no precision crossing |
+| F6 | seam halo (`s_amr_fine_fine_halo`) | pair | **also called from the L0 tile advance** — v1's "does not touch L0" was false |
+| F7 | **restrict** (`s_restrict_fine_to_coarse`, `s_amr_restrict_to_parent`, `s_amr_scatter_pbmv`) | box, per STEP | reverse slot order: finest level first; v1 named it and then implemented it in no increment |
+
+The subcycle path (`amr_subcycle`) reaches F1/F2/F3/F5/F7 through its own call shapes (two parent
+snapshots per child on the same tag, ordered by non-overtaking; forced `s_amr_gather_send_flush`
+sites). **Scope decision, now explicit: the subcycle call sites are NOT converted in v2.** They keep
+the per-box path behind their existing gates; each converted site asserts its `amr_subcycle`
+handling. Conversion is a follow-on increment (I8) after the lockstep path is proven.
+
+### Call-site inventory, verified against source 2026-08-21 (pre-I1 sweep)
+
+A full sweep of every AMR p2p MPI call found **42 sites** and nine facts the family table above
+misses. The ones that change I1/I2:
+
+1. **Ten call sites in five `s_l0_*` tile-routing routines sit outside the seven families**
+ (`s_l0_fill_tiles_from_coarse`, `s_l0_scatter_tiles_to_coarse`, `s_l0_add_reflux_to_tiles`,
+ `s_l0_restrict_to_tiles`, `s_l0_migrate_tile` — all blocking pairs, tags `k`/`4300`/`4400+k`).
+ **Out of scope for conversion pending the D-l0 deletion decision** (`amr_endstate.md` sec. 8):
+ the machinery measures 28-35% cost for 0.4% recovery, so converting it first would be waste.
+ The I1 validator instruments them read-only (they are inert at the `l0_ntile=0` default).
+2. **F1 and F2 share ONE request pool and ONE drain** (`amr_gsnd_req`/`amr_gsnd_pool`, cap 64,
+ `s_amr_gather_send_flush`); a reserve for either family can force-drain the other's sends.
+ The two families must be converted or fenced TOGETHER at each wave boundary — a per-family
+ `amr_gsnd_n == 0` assert is meaningless while the pool is shared.
+3. **F2's receive is a blocking `MPI_RECV`** (m_amr.fpp:1388) against pooled nonblocking sends,
+ and its send site is fypp-instantiated twice (`_cons`/`_stor` — the subcycle calls both per
+ child). The doc's per-box count undercounts, and F3's blocking-send defect has a twin on F2's
+ recv side.
+4. **F5 uses literal tags 2-7 (reflux faces) and 42-47 (freg), which numerically collide with the
+ `amr_cur` tag space used by F1/F2/F3/F7** at small block counts. Phase separation is the only
+ thing preventing mispairing today — one more reason the runtime tag bases (above) must land
+ before any family is converted.
+5. **F7 is three routines with three different blocking disciplines** (ISEND+WAITALL/blocking-RECV;
+ fully blocking pair; ISEND+WAITALL/blocking-RECV): the "restrict" row is not one shape.
+6. **F6 is blocking `MPI_SENDRECV` only** (tags 4200/4201): the validator cannot count
+ posts-vs-drains there and must instrument the SENDRECV calls directly.
+7. F5's send-side `reqs` allocation reuses `nreq` with two meanings (rank count at allocation,
+ request count at the drain) — correct today, but a naive posts-vs-drains check will trip on it.
+8. Non-AMR p2p the validator's instrumentation must NOT capture: `m_ibm.fpp` force halo
+ (MPI_PACKED), `m_mpi_proxy.fpp` Lagrangian particle exchange, `m_start_up.fpp` IB
+ neighbor-table build.
+
+## The mechanism, corrected (MPI review B1/B2; code-truth M2; convergent)
+
+v1 claimed the waits were late-sender under rendezvous with no async progress. **Wrong for this
+transport, and refuted by our own code:**
+
+- Open MPI 4.1.8 vader uses **CMA single-copy** (confirmed on the production node:
+ `single_copy_mechanism=cma`, `ptrace_scope=0`). The RGET rendezvous is **receiver-driven**: once
+ an ISEND is posted, the owner in `WAITALL` pulls the payload itself via `process_vm_readv`. A
+ sender computing elsewhere stalls nothing that is already posted.
+- **The in-tree control:** migration already posts all IRECVs, packs, posts all ISENDs, then one
+ `WAITALL` — the exact v1-proposed structure — and still measures `mg:wait` = 3.2 s/rebuild.
+
+The recoverable cost decomposes as: (a) **posting-order / head-of-line skew** — a send not yet
+POSTED because its rank is still walking earlier boxes (batching removes this); (b) **pack/arrival
+skew** — serial host packs, per-slot `GPU_UPDATE` staging, uneven ownership work (batching does NOT
+remove this; pack parallelisation and staging restructure do); (c) **node-aggregate bandwidth** —
+each byte crosses host DRAM ~5x (D2H stage, wp pack, CMA copy, stp unpack, H2D): 8 ranks x ~1.1 GiB
+x 5 against ~100-200 GB/s shared is a floor of **0.3-0.6 s per rebuild per node**, not v1's 130 ms.
+
+Pending measurement: a CMA-off control run (two-copy vader, where sender progress genuinely gates)
+is in flight; its result calibrates the split between (a) and (b).
+
+**Payoff, re-derived with a floor:** ceiling ~20% of wall (regrid pool with `mg:wait` mostly
+excluded, plus the per-step F1/F6 families at 13.7%, at partial recovery); **floor 8-12%** if
+pack/arrival skew dominates everywhere as it provably does in migration. Tax 11.03x -> **9.0-9.9x
+floor, ~8x ceiling** for T1 alone. The program's case does not rest on the tax number: the scale
+argument (tags, O(boxes) metadata, O(boxes x ranks) requests) is unconditional.
+
+## The abstraction (revised per GPU review B1/B2/M3)
+
+**No derived types.** The host plan is SoA flat arrays of intrinsics (avoids the CCE module-scope
+derived-type descriptor bug class already worked around at `m_amr.fpp:641`); the device form is the
+same arrays:
+
+```fortran
+! per (family, level): module-scope, GPU_DECLARE(create=...), allocate-max-once, 1.25x growth,
+! refilled at plan build via contiguous-prefix GPU_UPDATE(device='[pl_lo(:,1:n)]') updates.
+integer :: pl_npeer, pl_nxs, pl_nxr
+integer, allocatable :: pl_peer(:), pl_soff(:), pl_scnt(:), pl_roff(:), pl_rcnt(:)
+integer, allocatable :: pl_loc(:) ! LOCAL dense slot, resolved at build (amr_loc_of is
+ ! host-only; kernel-side blk->loc translation is
+ ! impossible). Couples plan validity to slot
+ ! reconciliation - see the epoch rule.
+integer, allocatable :: pl_lo(:,:), pl_hi(:,:), pl_off(:,:) ! (3, nx)
+integer, allocatable :: pl_coff(:) ! exclusive prefix of CELL counts per transfer,
+ ! per-peer-sliced: the unit the pack kernel's flat
+ ! index runs over (sys_size factor NOT included)
+integer(8) :: pl_epoch = -1
+```
+
+**The pack/unpack kernel form is mandated, not suggested** (GPU review B1): a gang loop over
+transfers with an inner vector loop is **silently serial on CCE and AMD flang** (`OMP_LOOP` expands
+empty there). The portable form — already shipping in this codebase at `m_amr.fpp:3403` and `4167`
+— is one flattened index over the peer's concatenated cells, decoded by **binary search over
+`pl_coff`**, `collapse=2` with the `sys_size` loop. Per-family Fypp instantiation (the `GSFX`
+idiom) supplies the array and the precision conversion. All of it lives in a new `m_amr_plan.fpp`
+(compile-time isolation from the 7k-line `m_amr.fpp`).
+
+**Wire buffers are persistent module arrays** (GPU review M1): `GPU_DECLARE`d, allocated once at
+high-water, drained by contiguous-prefix `GPU_UPDATE` per peer. Never per-launch `copyout` of pool
+slices (re-imports the 2.00-copies-per-entity map tax), never strided-section updates (AMD flang
+corrupts non-contiguous `target update` — documented three times in `m_amr.fpp`). Unpack is a
+device kernel wherever the destination is device-resident; per-family residency:
+
+| family | source | destination |
+|---|---|---|
+| per-step fill (F1/F2/F3) | device | device |
+| regrid gather (F1/F2/F3) | **host** (`q_cons_base` host-current) | patch storage |
+| migration (F4) | host stash | host stash, then device push (see the fixed bug) |
+| reflux/freg (F5) | device registers (`wp`) | device registers |
+| restrict (F7) | device | device |
+
+Precision: the wire is always `real(wp)`/`mpi_p`; stp<->wp conversion is a per-family template
+parameter. **F5 is `wp` end-to-end with no conversion — the one family a shared hard-wired
+conversion would corrupt under `--mixed`, invisibly to default-precision goldens.**
+
+## Execution: per-(family, level) waves — the central correctness rule
+
+Three reviewers independently converged on v1's worst flaw: "exchange everything, then prolong
+everything" is **impossible**, because a level-l block's exchange source is *produced* by the
+level-(l-1) prolong in the same rebuild ("re-prolongs from its (freshly-built, parents-first)
+parent", `m_amr_regrid.fpp:1428`). The rule:
+
+> A level-l exchange wave may start only after the level-(l-1) prolong + overlap-copy **and its
+> device push** have completed. (The F2 pack is a device kernel; prolong writes the parent on the
+> host; batching the `PH_RBPUSH` pushes to the end would feed the pack stale device data even with
+> correct level staging.)
+
+So: `for lev = 1 .. num_levels: build/execute plan(family, lev); prolong(lev); push(lev)`. Restrict
+(F7) is the mirror image: **finest level first**, reverse waves. The per-step stage *fill* is the
+one place cross-level batching IS legal (children are inset by `amr_cpat_mar`, so fill gathers read
+only parent interior stage-entry cells) — that asymmetry is deliberate and must not be "unified".
+
+Two-pass state rule (adversarial M6): `amr_cpat_off` and the working mirrors are written by the
+gather and consumed by prolong. Pass 2 **recomputes both per box** — never inherits pass 1's frame.
+Invisible on single-block cases, where the frames coincide.
+
+Order of operations within a wave: post all IRECVs FIRST, then pack, then ISENDs, then one WAITALL
+(with real statuses + `MPI_Get_count` under `MFC_DEBUG`, not `MPI_STATUSES_IGNORE`), then unpack.
+Self-transfers (`peer == proc_rank`) are device copy kernels, present in the no-MPI build.
+
+## Staleness: the epoch, not the dirty flag (adversarial B2; GPU B2)
+
+v1 folded `amr_seam_pairs_dirty` into the stamp. **That flag is consumed** — cleared by whichever of
+five lazy cache-rebuild triggers fires first — and ownership changes with NO regrid exist
+(`s_l0_rebalance` migrates tile ownership mid-run; restart reassigns owners). A cached plan can see
+"clean" and execute with the old owner map: a hang under clean tags, silent corruption under
+colliding ones.
+
+Rule: a monotone `amr_mesh_epoch` (integer(8), module scope), incremented at every site that sets
+the dirty flag (`m_amr_regrid.fpp:1271`, `m_amr_restart.fpp:450`, `m_amr.fpp:6478`), at every real
+regrid (after the `same` early-out), and at every slot reconciliation (plans bake `pl_loc`, so
+recycled local indices invalidate them). Plans compare epochs; the boolean remains for the seam
+caches only.
+
+## Tags (MPI M1/M5; adversarial M5)
+
+Live tag spaces today: `amr_cur` in [1..amr_max_blocks] for SIX logical transfers, migration
+[1..old_np], reflux 2-7, freg 42-47, seam 4200/4201, L0 move 4300 — already numerically colliding,
+safe only via phase separation and non-overtaking. Rules:
+
+- Family tag bases derived at runtime: `base_f = amr_max_blocks + 100*f` (never literals; asserted
+ below `MPI_TAG_UB` at init — Cray MPICH's is ~2^21, not INT_MAX).
+- The epoch folded into the tag: `tag = base_f + mod(pl_epoch, K)` — a skipped epoch then mismatches
+ loudly instead of pairing silently.
+- `@:ASSERT(amr_gsnd_n == 0)` at every plan-exchange entry (the deferred pool legitimately holds
+ level>=2 sends tagged `amr_cur` until the rebuild flush).
+- Chunk any per-peer message above ~256 MB (buffer footprint + completion granularity; the int32
+ count limit is 16 GiB and is not the reason).
+
+## The validator (I1) — hardened (MPI M3; adversarial M4)
+
+The v1 validator (set comparison + per-peer byte counts) cannot see: same-size transposition (most
+blocks are exactly slot-sized, so swapped xfers have equal bytes), cross-rank builder asymmetry,
+order/multiplicity semantics, dropped self-transfers, or which family a message belongs to (three
+families share tag `amr_cur`, disambiguated only by call-site order). Requirements:
+
+1. **Instrument the real MPI call sites** — log what is actually sent, partitioned by call site,
+ never re-derived from the same metadata the builder reads (that validates the builder against
+ itself).
+2. Compare **ordered multisets per (peer, family)**, not sets.
+3. `MFC_DEBUG` per-xfer identity: header words `(blk, lo, hi, family)` prepended to each transfer,
+ verified at unpack.
+4. **Destination-coverage tiling assert**: local copies plus received transfers exactly tile each
+ destination patch, no gaps, no overlaps — the only check that sees self-transfer bugs, and it
+ runs at np=1 for serial CI.
+5. Cross-rank plan-hash `MPI_Allreduce` (debug builds): sender-side and receiver-side plans agree.
+6. Builders read ONLY the replicated `*_all` arrays — never `amr_isect_lo/hi` or `amr_cpat_off`
+ (empty on non-owners; the exact trap the parent-gather comments warn about). Assert it.
+7. Explicit per-increment family scope, so the F3 twin cannot silently keep running per-box inside
+ a converted loop.
+
+Verified property worth one assert: old blocks ARE pairwise disjoint (cluster partition + merge
+threshold + IB overlap-merge), so per-peer unpack reordering is safe for migration/overlap
+destinations. Enforce with `@:ASSERT` after `shape_boxes`, don't inherit it as folklore.
+
+## STATUS (verified against commits and source, 2026-08-27)
+
+**Landed:** I0, I1a, I1b, I2a, I3, I4a, I4b, I5.
+**Outstanding:** I2b, I5b (~250 LOC), I6 (~200), I7 (~600), I8 (unpriced).
+
+Verified against the code, not inferred: **19 of 41 AMR p2p call sites still tag per box** (22 use
+plan tags `tq`). F1 retains an unconverted path that passes the block index `amr_cur` as the MPI tag,
+and migration (F4) passes the column index. The `.not. amr_subcycle` assert in the stage-fill wave
+confirms the subcycle deferral recorded below is still in force.
+
+**CONTRADICTION TO RESOLVE.** `m_amr.fpp` states the `amr_max_blocks` term leaves the tag base "with
+the last per-box family (increment **I7**)". That cannot be right as written: I7's own boundary below
+says "any family left per-box (subcycle) keeps its tables", and subcycle conversion is **I8**. So the
+tag space -- and with it the ~28k-rank W5 wall -- does not clear until **I8**, not I7. The source
+comment has been corrected; this note records why.
+
+**Relation to S3 (W4).** S3.1 deleted the level-1 tag ALLGATHERV. The clustering tag union is
+explicitly OUT of scope for I7 ("tag-union/clustering stay global (that is S3)") and that boundary
+still holds -- S3.2/S3.3 own it.
+
+## Increments, re-staged and re-priced
+
+| # | content | LOC | gate |
+|---|---|---|---|
+| **I0** | prep, no plan code: `amr_mesh_epoch`; tag-base constants + init assert; `amr_gsnd_n==0` asserts; **the migration-stash device-push fix** (found live by this review: the receive-unpack path lacked the push its sibling has, so a mid-rebuild store grow clobbered migrated data) + a ppn=2 churn+growth regression case; box-disjointness assert | ~120 | AMR subset + the new case |
+| I1 | validator: call-site instrumentation across ALL families incl. F3, F5-freg, F7, plus the six checks above. **Split 2026-08-21: I1a = `m_amr_xchg_audit` site registry (30 ids over the 35 physical sites; fypp twins share ids), always-cheap per-site msg/word/tag-range counters at every AMR p2p call, per-family global send==recv conservation asserts at finalize, the stash-only-replica reconcile assert, and the `[amr-xa]` report. I1b = MFC_DEBUG per-xfer identity headers (blk, lo, hi, family verified at unpack) + the destination-coverage tiling assert, gated by a SEEDED-BUG tripwire test.** | ~500 | I1a: goldens + subset green with `[amr-xa]` totals sane at ppn=2 AND ppn=4, no behaviour change. I1b: the seeded bug is CAUGHT. |
+| I2 | F1+F3 level-1 gathers via plans (both twins together — converting one breaks their tag-order contract), per-owned-box patch storage + `amr_cpat_off` threading through the prolong/fill chain | ~600 | message count; per-xfer identity; bitwise goldens |
+| I3 | F2 as per-level waves with the device-push rule | ~250 | dynamic-multilevel ppn=2 golden, bitwise |
+| I4 | migration: parallelise the serial host pack; per-peer aggregation; right-size `spack`/`rq` (kills two O(boxes) allocations). **Decision made now, not during: whole-block sends preserved in I4 so the bytes gate stays exact; overlap clipping is I4b with a recomputed expected-bytes gate** | ~300 | bytes exact vs expectation; pack time |
+| I5 | F5 reflux+freg (wp, no conversion) + F6 seam including the L0-advance call site | ~300 | bitwise; seam validated under L0 coexist |
+| I5b | F7 restrict as finest-first waves | ~250 | bitwise; reverse-order assert |
+| I6 | plan caching on `amr_mesh_epoch`; per-step F1/F2/F3 fills through cached plans | ~200 | plan-build count == epoch increments |
+| I7 | S4: distributed builder; shrink global arrays **whose consumers are all converted**; convert the O(boxes) stack automatics. Boundary stated: tag-union/clustering stay global (that is S3); any family left per-box (subcycle) keeps its tables | ~600 | `[amr-scale]` per-rank bytes vs size |
+| I8 | subcycle call-site conversion (two-snapshot ordering via distinct tag bases) | later | subcycle goldens |
+
+~3100 LOC total (v1 said 1900 — the delta is the pbmv twin, restrict, the patch-storage
+restructure, and the validator hardening; better to know now).
+
+### I1b implementation binding (2026-08-23, line numbers at commit 0b36c148)
+
+Scope: **I1b-gather** — headers on the trio I2 converts (F1/F2/F3), per the validator's
+own explicit-family-scope principle; remaining families get headers with their conversion
+increments (F5/F6 with I5, F7 with I5b). Priced against the int=20 ladder: the gather
+family is 23% of np=8 steady wall scaling 3.84x/doubling — I2 is the program's
+highest-value increment and this is its gate.
+
+Mechanics (the trick that keeps it ~100 LOC): `m_amr_xchg_audit` exports
+`XA_NH` (= 8 under `MFC_DEBUG`, else 0) plus `s_xa_hdr_pack(buf, fam, blk, bl, bh)` /
+`s_xa_hdr_check(buf, fam, blk, bl, bh)` (integers encoded as `real(wp)`, exact ≤ 2^53).
+Every wire count/offset gains `+ XA_NH` UNCONDITIONALLY (zero when the header is off, so
+production arithmetic is untouched and no call site needs an `#ifdef`); pack/verify calls
+are `if (XA_NH > 0)` — dead-code-eliminated. Anchors are the existing `s_xa_rec` calls
+(1:1 with wire ops by I1a's construction):
+- plan sizes: `amr_gpl_sz`/`amr_gpl_psz` in `s_amr_build_gather_plan` gain +XA_NH per
+ message (recv posts at m_amr.fpp:1063/1073 then need no size edits);
+- chunked F1: pack/send 1140-1156 (header before the pack loop, `boxsz + XA_NH` on the
+ wire), pool unpack 1266 (verify then offset); chunked F2: send via
+ `s_amr_gather_from_parent_field_cons` (1876), device-unpack 1219 (host-verify the first
+ XA_NH words before `s_amr_unpack_parent_patch_device`, then pass the offset slice);
+- per-step F1: 1482 (recv)/1570 (send) + twins at 3403/3416 and 4307/4320 (fypp
+ instantiations share XA ids — enumerate by grepping `XA_F1_`); F3: 1677/1766;
+ per-step F2 blocking recv: 1911 (xbuf);
+- pool reserves: `s_amr_gsnd_reserve(maxsz + XA_NH)` at 1136 and the `need` sum in
+ `s_amr_gather_chunk_post` (~1040).
+Header check failure → `call s_mpi_abort` with family/blk/expected-vs-got. Tiling assert
+(the other I1b half): at each owner's unpack completion, assert the union of contributor
+slabs plus the own-slice tiles the patch exactly (count cells, compare to patch volume) —
+lives beside the existing gather asserts. Gate: the seeded-bug counterfactual (swap two
+plan source entries locally → headers must abort; revert seed) + 75-golden subset +
+`[amr-xa]` totals unchanged (headers are size-invisible to the F-family word counters:
+count payload words only, i.e. record `cnt` not `cnt + XA_NH`).
+
+### I2a implementation binding (2026-08-23)
+
+I2 is staged. **I2a (landed)**: `s_amr_stage_fill_wave` (m_amr.fpp) converts the
+non-subcycle per-stage LEVEL-1 fill (F1 + the F3 twin together) to one wave per RK stage —
+SoA transfer lists built per wave from the replicated caches (both sides enumerate boxes
+ascending with per-rank running offsets, so the per-(peer, family) wire layout — the
+ascending-box concatenation of [XA_NH header | slab] — agrees with no metadata exchange),
+recvs-then-packs-then-sends-then-one-WAITALL per the order-of-operations rule, tags
+`amr_tag_base(1|3) + mod(amr_mesh_epoch, 100)`, wave audit sites XA_F1W_*/XA_F3W_* folding
+into families F1/F3 (payload-words-only, so `[amr-xa]` family words stay exactly comparable
+to the per-box baseline — the landed gate). Consume is box-major through the single
+`amr_cg`/`amr_cpat_off`, reusing the per-box device kernels on contiguous pool slices:
+**per-owned-box patch storage turned out unnecessary for the wave** — it only buys
+cross-box batched unpack kernels, deferred to **I2b (contingent)** on the post-I2a budget
+showing launch/map overhead rather than wait left in the gather share. The mandated
+binary-search pack/unpack kernel form applies to I2b's kernels when/if they exist; I2a
+adds zero device kernels. Plan caching on the epoch remains I6; the regrid-path F1
+(chunked) and init/static/restart/subcycle sites keep the per-box path unchanged.
+
+### I3 implementation binding (2026-08-23)
+
+`s_amr_parent_fill_wave(lev)`: the per-step F2 gather as one wave per level per stage,
+levels ascending from the driver (`do ilev = 2, amr_num_levels`). Each split child is
+exactly one (parent-owner -> child-owner) transfer; both sides derive the pair list from
+`f_amr_parent_block` + `s_amr_parent_foot` + `amr_block_owner` ONLY (the per-owner
+mirrors lag a generation — the map's asymmetry finding). Tags `amr_tag_base(2)` + epoch
+fold; audit sites XA_F2W_* (family F2, payload-words-only). Reuses the I2a wave's
+scratch (q-side arrays only; the waves never overlap in time). The pack kernel reads
+module `amr_cpat_off`, so the pack loop sets the CHILD's frame per transfer; consume
+recomputes per box. `s_amr_fine_stage_fill` deleted with the conversion (no caller
+remained). Restart gotcha fixed with it: `amr_num_levels` was regrid-only; the per-level
+driver needs it truthful after restart too (set in `s_read_amr_restart`). Remaining
+per-box F2: regrid chunked (converts with I6/I7 work if ever), subcycle (I8),
+init/static.
+
+### I5-F6 implementation binding (2026-08-23)
+
+The seam wave lives INSIDE `s_amr_fine_fine_halo` (all four call sites covered,
+subcycle shape-preserved). Plan = the replicated `amr_seam_pairs` list itself, walked
+twice (sends, then recvs); each cross-rank pair is one transfer each way per owner;
+per-peer aggregation on tag `amr_tag_base(6)` + epoch fold; audit sites XA_F6W_*
+(payload-words-only keeps family F6 words exact vs the SENDRECV baseline — the landed
+gate). Reuses the fill waves' fw scratch, with `amr_fw_spo/rpo` repurposed to carry
+per-transfer `cnt` (the F6 payload is not derivable from bl/bh alone at consume). The
+shared `amr_seambuf_x/y` and their tile-grow reconciliation are deleted. Header
+convention: [site, sending slot, (d, pack dlo, pack dhi), (cnt, 0, 0)] — the receiver
+derives the peer's pack bounds from the same replicated metadata. F5 remains per-box;
+its conversion notes: faces recv directly into the mapped `freg` host mirror (zero-copy)
+so headers must be DEBUG-ONLY COMPANION MESSAGES, not prefixes; `s_amr_reg_reserve`
+must hoist ahead of any wave posting into `freg` (the apply can reallocate the
+registers); the owner-side multicast membership is `cand ∩ f_amr_reflux_participates`
+vs the receiver's bare predicate — a wave must reproduce the conjunction exactly.
+
+- **No existing test runs np>2.** Every plan degenerates to <=1 remote peer: multi-peer slicing,
+ peer ordering, and multi-contributor assembly are structurally unexercised. One ppn=4 dynamic
+ regrid case is mandatory before I2 lands.
+- A dynamic-regrid pbmv (qbmm non-polytropic) case at np=2 (the rebuild-path twin is uncovered).
+- Bitwise golden diff mode: several AMR goldens carry `override_tol` up to 1e-5, so "tolerance
+ zero" must be an explicit bitwise comparison, or drift hides inside existing tolerances.
+- An `MFC_DEBUG` artificially-low chunk-threshold test (the >256 MB path never triggers at golden
+ sizes).
+- A periodic-seam np>1 case (a builder that forgets wrap pairs deadlocks only there).
+
+## Merge gates
+
+Four CI compilers + AMD flang; `GPU_*` macros only; `@:ALLOCATE` pairing; full 706-test suite at
+merge (AMR subset per iteration); one increment = one commit, each independently green; bitwise
+comparison per increment as above. Every wall-time claim measured against the 5.3% run-to-run floor
+with >=3 repeats, or judged on exact byte/count gates instead.
+
+### I5-F5 implementation binding (2026-08-23)
+
+`s_amr_reflux_faces_wave` (level-1 walk, ascending slots) and `s_amr_freg_wave`
+(level>=2 cowner->powner pairs) replace the per-box F5 exchanges in the lock-step
+driver; the subcycle path keeps its per-box form (`do_xchg` on
+`s_amr_reflux_to_parent`). Plan = the replicated owner/region tables: face-wave
+participants are cand from `s_amr_ranks_overlapping` on region+-1 INTERSECTED with
+`f_amr_reflux_participates(r)` (the conjunction the per-box form applied — a wave must
+reproduce it exactly or a rank posts a recv no one sends). Receives are ZERO-COPY into
+the `freg(d)%%lo/hi(:,:,:,slot)` host mirrors (each box owns a register slot — there is
+no pool and MUST be none, or the zero-copy design is lost); owner D2H before the ISENDs,
+receivers H2D after the WAITALL. Tags: `amr_tag_base(5) + mod(epoch, 50)`, freg wave at
+`+50`. Identity headers are DEBUG-ONLY COMPANION 8-word messages carried in
+`amr_fw_sq/rq` (never `s_xa_rec`'d, so [amr-xa] family words stay comparable to the
+per-box baseline); `amr_fw_rblk` tracks the expected box order at consume.
+`s_amr_reg_reserve(amr_num_blocks)` runs FIRST in both waves — the apply can reallocate
+`freg`, and a recv posted into a stale mirror is a silent wrong-memory write.
+
+### Ring-clip-on-waves implementation binding (2026-08-24)
+
+The stepfill clip (`amr_stepfill_ring_clip.md` — the dead-byte proof survived the
+revert) is applied inside the stage-fill wave's TWO plan walks: after each pair's
+`s_amr_box_isect`, the slab is fed through `s_amr_shell_clip` against the box's shell
+(`s_amr_shell_slabs` of the padded patch minus the open core [region_lo+1,
+region_hi-1]; collapsed dims pass 0 so they never cut). Up to 6 sub-slabs replace the
+one transfer; both walks derive the identical list from replicated metadata, so the
+no-metadata-exchange property is untouched, and pack/unpack/consume — already generic
+over (bl, bh) — need no change. Messages stay at the per-peer count; only payload
+words drop (F1 -61% on the S0 probe). The consume's own-box copy becomes shell-only
+(`s_amr_gather_own_shell_device`), which is what arms the debug NaN-poison gate
+(`s_amr_poison_patch_device` floods the patch first; any consumer read of an unshipped
+cell aborts within a step). The pbmv gather (F3) keeps its full-box wire contract, so
+`do_pbmv` runs take the unclipped single-slab path — extending the clip to qbmm needs
+its own dead-byte analysis. All four primitives are lifted verbatim from the reverted
+implementation (archived: amr-bench/notes/ringclip_original_m_amr.fpp.txt).
diff --git a/docs/documentation/amr_regrid_gather_batching.md b/docs/documentation/amr_regrid_gather_batching.md
new file mode 100644
index 0000000000..d2e4ff8190
--- /dev/null
+++ b/docs/documentation/amr_regrid_gather_batching.md
@@ -0,0 +1,337 @@
+# Batching the regrid coarse-patch gather
+
+**Target:** `rb:gath` = 13.4% of wall. Regrid overall is 47.5% of wall at the matched operating
+point, and `rg:build` is 28.6% of it.
+
+> **CORRECTION (audit, 2026-08-20).** An earlier revision said "13.4% plus `rb:wait` 8.9% = 22.3%".
+> **That double-counted.** `PH_RBWAIT` is bracketed *inside* `s_amr_gather_coarse_patch`
+> (`m_amr.fpp:954`) while `PH_RBGATH` brackets the *call site* (`m_amr_regrid.fpp:1398`), so
+> `rb:gath` (109.0 s) **already contains** `rb:wait` (72.9 s). The correct reading is: `rb:gath` is
+> 13.4% of wall, **of which 67% is MPI wait**. Ten other phases nest inside it likewise
+> (`PH_PGALL, PH_RBALLOC, PH_RBOWN, PH_RBPACK, PH_RBPOST, PH_RBRSV, PH_RBSEAM, PH_RBSEND,
+> PH_RBUNPK, PH_RBUPD`). See
+`docs/documentation/amr_action_plan.md` for the measurement.
+
+## What happens today
+
+`s_amr_regrid_rebuild_slots` loops over the new box set and, for **each box**, calls
+`s_amr_gather_coarse_patch`, which is collective:
+
+```
+do k = 1, nboxes
+ amr_cur = f_l0_slot(k)
+ s_set_amr_fine_geometry(...)
+ s_amr_gather_coarse_patch(q_cons_base, .false.) ! <-- one full rendezvous PER BOX
+ if (.not. amr_rank_owns_block) cycle
+ s_interpolate_coarse_to_fine() ! consumes amr_cg
+ ...overlap-copy from stashed old blocks...
+end do
+```
+
+Inside that call, for a level-1 block:
+
+- **owner**: unpacks its own overlapping coarse cells locally, then posts one `MPI_IRECV` per
+ contributing rank (`amr_ovl_gather(:,amr_cur)`, tag = `amr_cur`), then `MPI_WAITALL`, then
+ unpacks each slice into `amr_cg`.
+- **every other overlapping rank**: packs its slice and sends it to the owner.
+
+So the message count is `sum over boxes of (contributing ranks)` — roughly 224 boxes x 2-4
+contributors = 450-900 messages per regrid — and there is a **separate `WAITALL` per box**. That
+per-box rendezvous is the convoy: rank A cannot progress past box *i* even when box *i+1*'s partner
+is ready.
+
+SAMRAI fills an entire new level with **one `RefineSchedule`**; Chombo with **one `copyTo` +
+`Copier`**. The gap is granularity, not algorithm.
+
+## The constraint that shapes the design
+
+The obvious fix — "gather everything first, then loop boxes" — **does not fit in memory**, and this
+is the thing to understand before writing any code.
+
+`amr_cg` is a *single* patch buffer sized for the largest block
+(`amr_cg(i)%%sf(0:amr_cpat_hi(1), 0:amr_cpat_hi(2), 0:amr_cpat_hi(3))`). The gather fills it, and
+`s_interpolate_coarse_to_fine` immediately consumes it. Holding all boxes' patches at once would
+need `nboxes x patch`: a cap-64 block has a coarse patch of roughly `(64 + 2*margin)^3` cells, so with
+`amr_cpat_mar = (buff_size + ref_ratio - 1)/ref_ratio + 1` and the matched case's **`sys_size = 6`**
+(`model_eqns = 2`, `num_fluids = 1`) that is roughly `68^3 x 6 x 8 B` = **~15 MB per box, ~3.4 GB
+for 224 boxes** (an earlier revision said 5.6 GB by assuming `sys_size ~ 10`). Against a working set
+already near the 64 GiB device limit — and given that ungoverned store capacity is exactly what we
+just spent a day removing — that is not acceptable.
+
+## The design: chunked plan-then-execute
+
+Process the box list in **chunks of `amr_gath_chunk` boxes** (default 32). Within a chunk:
+
+1. **Plan** — for every box `k` in the chunk and every rank `r` in `amr_ovl_gather(:,k)`:
+ - `r == me and owner(k) /= me` -> append `(k, bl, bh)` to `sendlist(owner(k))`
+ - `owner(k) == me and r /= me` -> append `(k, bl, bh)` to `recvlist(r)`
+ Both sides iterate boxes in the same global order and read the same cached overlap lists, so the
+ two layouts agree by construction. **That agreement is the correctness invariant** and must be
+ asserted, not assumed (see below).
+2. **Exchange** — one packed `MPI_ISEND` per destination peer and one `MPI_IRECV` per source peer,
+ then a **single `WAITALL` for the whole chunk**.
+3. **Consume** — loop the chunk's boxes; for each, unpack its slices out of the peer buffers into
+ `amr_cg`, prolong, and do the overlap-copy exactly as today.
+
+Message count per regrid falls from ~450-900 to `ceil(nboxes/chunk) x peers` — about 7 chunks x <=7
+peers = ~50. Staging memory is bounded at `chunk x patch` ~= 480 MB at chunk 32, and the chunk size
+is the single knob trading memory against message count.
+
+## Correctness invariants to assert, not assume
+
+- **Layout agreement.** Sender and receiver must derive identical `(k, bl, bh)` sequences per peer.
+ Deterministic iteration over the same cached lists gives this, but a mismatch would be a silent
+ wrong answer, not a crash. Assert matching byte counts per peer before unpacking.
+- **`amr_cur` is implicit.** Per-block routines read `amr_cur`; the plan phase must not leave it
+ pointing at the wrong box for the consume phase.
+- **Level >= 2 blocks take a different path** (`s_amr_gather_from_parent`) and are untouched by this
+ work. They are the majority of blocks on the production case, so this change should be measured on
+ the level-1 population specifically.
+- **The `pull_host` path and the `num_procs == 1` shortcut** must keep their current semantics.
+- **Deferred sends need a drain.** The existing `amr_gsnd_pool` already carries this rule; a batched
+ send with no matching wait is a deadlock.
+
+## Increments
+
+1. **LANDED (2026-08-21 night).** Plan builder (`s_amr_build_gather_plan`, both families:
+ level-1 contributor lists + sizes AND the level>=2 parent source/size) + always-on
+ `@:ASSERT`s at all five derivation points in the per-box gathers, exchange still per-box
+ (no behaviour change). Validated three ways: AMR subset 67/67 with asserts armed (zero
+ trips = plan reproduces the live message set across the suite), and TWO seeded-bug
+ tripwires that each ABORTED as required (level-1 size +1 -> "send entry mismatch" on a
+ contributor rank; parent size +1 -> parent send-size assert on the parent owner; S0-style
+ np=4, first rebuild). The plan may now be trusted by step 2.
+2. **LANDED 01cc4318 + assert re-guard 3de4724e (2026-08-22). Verdict below.** Chunked
+ exchange for BOTH families, `pull_host = .false.` only (pre-post the chunk's level-1
+ IRECVs and the level>=2 per-box IRECVs, sends stay pooled, consume in box order).
+3. Extend to the pb/mv gather (`s_amr_coarse_patch_pbmv`) — **DEPRIORITIZED** after the
+ step-2 verdict: F3 is absent from the S0 operating point (QBMM gated), and the tag
+ split (`k + amr_max_blocks`) it requires buys nothing until an F3-heavy case matters.
+
+## STEP-2 VERDICT (2026-08-22, node k004-001, on-node differenced arms)
+
+**Correctness: proven at every np.** AMR subset 67/67 goldens; XA exchange report
+line-for-line identical in FOUR comparisons (np=4 tripwire, np=4 arm, np=8 both arms);
+output BIT-IDENTICAL across binaries at np=4 (1.5 GB state + 14.8 GB hierarchy file) and
+np=8 (3.1 + 31.3 GB) — which also demonstrates the pipeline is bitwise deterministic
+cross-node, legitimizing bit-diff as the np>2 verification method. VRAM peaks identical
+card-for-card (the chunk pool is host-side).
+
+**Wall (same node, differenced): np=4 421.1 -> 413.0 s (-1.9%); np=8 1246.0 -> 1235.6 s
+(-0.8%).** Both inside the 4.96% noise floor, both the right sign. Mechanism brackets at
+np=8: `rb:wait` 63.9 -> 45.2 (-29%), `rb:gath` 180.1 -> 159.6, `rg:build` -13.4 s; ~11 s
+reabsorbed at `rb:tail`/`rb:xchg` (skew moved one fence later, as the design's own caveat
+predicted).
+
+**THE ATTRIBUTION CORRECTION — read before proposing more exchange work.** `pg:recv` did
+NOT move (np=4: 15.3 -> 16.2 s; np=8: 106.2 -> 101.7 s) even though most level-2 parents
+sit in earlier chunks and DID get the early phase-B send. The banked "158 s rendezvous
+bound" was wrong: the F2 payload is CREATED BY THE REBUILD ITSELF — the parent's store
+exists only after the parent owner's own consume + prolong + device push — so the child's
+wait measures the build-backlog difference between the two owners plus pack/D2H/copy.
+Pre-posting removes none of that. `rb:wait` was the true rendezvous share (~20 s at np=8);
+level-1 sends have no data dependency (`q_cons_base` is host-current before the loop), so
+they overlap fully once posted early. **Further MPI batching of the parent-gather family is
+a dead end; the residual ~100 s yields only to owner-local rebuild (removing the lockstep
+all-ranks box walk) or rebuild-work rebalancing.**
+
+**Node confound recorded:** k004-001's GCD 6 runs hot/slow (rank-6 rhs 237/216 s vs ~175
+mean on BOTH binaries; +8% total GPU compute vs k004-004 on byte-identical work; the seven
+healthy ranks absorb it as 90-129 s of reflux wait). Never compare walls across
+k004-001/k004-004 — the +11.7% cross-node scare that triggered the same-node control was
+entirely this.
+
+**Follow-ups from the expert review round (MPI + AMR auditors, 2026-08-22):** the
+`amr_gcr_*` chunk machinery is scaffolding — absorb and delete it when the v2 plan-based
+exchange (cached per-peer schedules) lands; add a forced-drain counter to
+`s_amr_gsnd_reserve` (cap-64 + width-regrowth triggers) when next instrumenting; the
+program's next constraint is DEAD BYTES (the per-step fill family ships full patches whose
+interior is never read — see the action plan's re-aimed increment list).
+
+## Step-2 design — REVIEWED 2026-08-22: two independent adversarial reviewers (MPI/deadlock
+## lens + state/lifetime lens) CONVERGED on one fatal defect and four bindings. The design
+## below is AMENDED accordingly; implement only the amended form.
+
+**FATAL (found by BOTH reviewers, D1): the phase-B level>=2 pack reads an UNBUILT parent.**
+The parent's new-generation store content is produced only in the parent's own phase-C
+iteration (alloc m_amr_regrid.fpp:1478, fill 1491-1521, device push 1524); the box list is
+parents-first but not chunk-aligned, so a same-chunk parent/child pair makes phase B pack
+stale or unallocated store memory (amr_loc_of = 0 -> out-of-bounds device read). The XA
+identity invariant is PROVABLY BLIND to it (same counts/sizes, wrong payload).
+**AMENDMENT: level>=2 sends split by parent position — phase B ONLY when parent index <
+c_lo (parent consumed in an earlier chunk = the early-send win); otherwise the pack+ISEND
+stays at the child's box position in phase C (parents-first guarantees the parent's consume,
+index < k, has completed). Both reviewers confirm the deadlock induction survives this.**
+
+Further bindings from the review (all mandatory):
+- **Ownership predicate = `amr_block_owner(ks)` everywhere in phases A/B.** The mirrors
+ (`amr_owns_all`, `amr_rank_owns_block`) hold the PREVIOUS generation until phase C's
+ geometry call (writers: m_amr.fpp:2496/2519 only).
+- **`amr_cpat_off` is per-level and per-phase**: level-1 = region - margin; level>=2 =
+ parent-foot - margin (parent-fine frame). Recompute in every phase that calls a kernel or
+ host loop reading it; NEVER inherit it across phases (phase B's last write is arbitrary).
+- **Tag collision with QBMM pbmv (F3) is real**: pbmv reuses (src, tag=k) against F1/F2.
+ Correctness rests on MPI NON-OVERTAKING plus fixed posting order (F1 recv in A before
+ pbmv recv in C; F1 send in B before pbmv send in C) — now a STATED invariant. The pbmv
+ per-box call stays in phase C, all ranks, box order. Step 3 MUST disambiguate the tag
+ space (k + amr_max_blocks) before chunking pbmv.
+- **Keep the per-box ``GPU_UPDATE(device='[amr_cg]')``** (m_amr.fpp:1125-1131) in phase C —
+ device coherence of amr_cg is not proven dead; dropping coherence updates on a hunch is
+ the restart-NaN bug class.
+- **Recorded progress assumption**: any blocking MPI call progresses ALL traffic (true for
+ Open MPI 4.1 ob1/vader; the induction survives even per-request progress). No collective
+ may enter the chunk loop (the only rebuild collective is s_amr_reduce_xchg_flag at
+ rb:tail — keep it there).
+- Request-array reuse across chunks is safe ONLY because phase C consumes every box
+ unconditionally (the owner-cycle comes after the WAITALL position) — preserve that.
+
+## Step-2 design (original text; read with the amendments above)
+
+Restructure `s_amr_regrid_rebuild_slots`'s box loop into chunks of `CHUNK` boxes (start 32):
+
+```
+call s_amr_build_gather_plan(nboxes)
+do c_lo = 1, nboxes, CHUNK
+ c_hi = min(c_lo + CHUNK - 1, nboxes)
+ A: post - for each box k in chunk I OWN: IRECVs per plan entry (level-1: one per
+ contributor; level>=2 split: one from the parent owner), tag k, into the
+ chunk recv pool; requests appended IN BOX ORDER so each box's requests are
+ a contiguous run.
+ B: send - for each box k in chunk where I contribute (level-1: plan lists me;
+ level>=2: I own the parent, split): pack + pooled ISEND exactly as today
+ (s_amr_gsnd_reserve/amr_gsnd_pool unchanged, forced drains included).
+ C: consume - per box k in chunk, IN ORDER: the existing per-box body (early-free,
+ alloc, geometry) but the gather call replaced by: set amr_cpat_off for k;
+ own-slice host copy; MPI_WAITALL on k's contiguous request run; unpack
+ (host for level-1 slices, device for the level-2 buffer); co-located
+ level>=2 parent copy happens HERE (device copy, as today); then
+ interpolate/carry-forward/push unchanged.
+end do
+flush (existing rb:tail) ! sends may still be in flight across chunks - unchanged
+```
+
+Load-bearing details, each verified against source during the step-1 audit:
+- **Geometry without the swap.** The post/send phases need only plan data + `bl/bh`
+ (recomputable from replicated caches, as the builder does) + `start_idx` (rank-constant).
+ `amr_cpat_off` is consumed host-side by the pack/unpack kernels (captured into locals
+ before the kernel), so setting it per box in the phase that calls the kernel suffices;
+ the full `s_set_amr_fine_geometry` swap stays in phase C where it is today.
+- **Buffers.** One flat `real(wp)` chunk recv pool + an offset table, sized from the plan
+ (sum of the chunk's owned-box message sizes; bound ~CHUNK x patch ~ 0.5-1 GB at 32);
+ one request array; a per-box (first-request, count) index. Reused across chunks, grown
+ monotonically, freed at module finalize.
+- **No (src, tag) ambiguity.** Tag = box index; a box is exactly one level; level-1 sources
+ are distinct ranks; the level>=2 rebuild path sends only the `_cons` message. So every
+ (source, tag) pair in a chunk is unique - pre-posting cannot mismatch.
+- **Deadlock-freedom argument.** Recv-posting (A) contains no MPI waits. The only blocking
+ points are per-box WAITALLs (C) and the send pool's forced drain (B, cap 64). Consider
+ the rank at the globally minimal (chunk, phase) position: its phase A completes
+ unconditionally; its drains wait on sends whose receivers are at-or-ahead and whose
+ matching recvs are posted in THEIR phase A, which they reach without waiting on anything
+ from the minimal rank's current chunk. So the minimum always advances - no cycle. (The
+ refuted per-STEP drain hoist does not apply: that experiment deferred sends past a sync
+ that could not absorb the drift; here recvs are pre-posted and the WAITALL that pays the
+ skew is per-box but no longer serializes the WHOLE exchange behind it.)
+- **`num_procs = 1` and co-located parents** degenerate naturally: empty plan entries, no
+ posts/sends; phase C's own-copy and co-located device copy reproduce today's path.
+- **Validation:** goldens + subset must stay green; XA_F1/F2 message and word totals must be
+ IDENTICAL to the per-box path (same plan, same messages, different timing); S0 np=4/np=8
+ differenced arms judge the win (target: pg:recv 99 s + rb:wait 59 s at np=8 collapse
+ toward one skew absorption); watch the reflux/gather/seam shadows for the downstream
+ effect. Step-1's per-box asserts are bypassed on the chunked path by construction - the
+ XA identity is the replacement invariant.
+
+Step 1 is the safety net: if the plan does not reproduce the current message set box for box, the
+batching is wrong and it is visible before any data moves.
+
+## S0 np=8 REVERSES the level-1/level-2 priority (2026-08-21, post-P1 gate, logs/p1gate-0821_2144)
+
+> **The section below this one concluded — correctly, for the MATCHED point — that the level-1
+> WAITALL dominates and `pg:all` "cannot dominate." At the WEAK-SCALING point (S0, fixed
+> 200^3/rank, amr_max_level=2) the ordering flips: the split is operating-point-dependent, and
+> the increment must cover BOTH families.**
+
+Measured sub-brackets of `rb:gath` (mean s):
+
+| | np=4 | np=8 | mechanism |
+|---|---|---|---|
+| `pg:all` (level>=2 parent gather) | 15.6 | **108.0** | of which `pg:recv` 15.3 / **99.2** — the **blocking per-box `MPI_RECV`** (m_amr.fpp:1405), 252 / 208 ms/call, imb ~1.3-2.0 |
+| `rb:wait` (level-1 WAITALL) | 1.2 | **58.9** | 85 calls x 693 ms at np=8 |
+| everything else (pack/unpack/alloc/post/send) | ~0.15 | ~1.6 | dead — fixes aimed there stay dead |
+
+At S0 the refined region is a deep blob: most boxes are level 2, and each one costs a pairwise
+rendezvous — both ranks walk the same global box list, so the owner's blocking RECV for box k
+absorbs whatever skew the parent rank accumulated (rb:slot/rb:ovl/rb:push differ by ownership).
+R1 converted this site's SEND to the ISEND pool; **the RECV side is the unconverted half, and at
+np=8 it is the single largest item inside `rg:build`.**
+
+**Scope change:** the chunked plan-then-execute below covers BOTH families in one framework:
+- level-1: peer send/recv lists exactly as designed below;
+- level>=2: trivial plan (one known parent rank per box, sizes computable on both sides with no
+ handshake) — pre-post one `MPI_IRECV` per owned level>=2 box in the chunk into a per-box
+ buffer, keep the parent's pooled device-pack ISEND as-is, keep the device unpack;
+- consume in box order as today; a box is exactly one level, so tag = box index stays unambiguous
+ across the two families for pre-posted receives.
+Chunk memory bound now covers both: level-1 staging (~480 MB at chunk 32) + per-box level-2
+buffers (~15 MB each) — ~1 GB/rank at chunk 32, affordable post-P1 (>=12 GiB headroom).
+**Validation tripwire:** increment 1's plan must reproduce today's message set exactly — the I1a
+`XA_F1_*`/`XA_F2_*` conservation counters (m_amr_xchg_audit.fpp) must be IDENTICAL before/after.
+
+Expected payoff at S0 np=8, stated as a bound: rb:wait + pg:recv = 158 s = 14.3% of wall; the
+realistic target is the rendezvous share of it (not the bytes) — differenced runs required, and
+the downstream wait shadows (reflux/gather/seam, which absorb regrid-side skew) may move too.
+
+## The level-1 / level-2 split — RESOLVED without a run (MATCHED point; superseded for S0 above)
+
+`PH_PGALL` (the level >= 2 parent-gather path) is nested inside `rb:gath`, so `rb:gath` covers both
+the level-1 body this design batches and the level >= 2 path it does not. An earlier revision called
+this a blocking unknown needing a fresh run. **It is not — the call counts settle it.**
+
+| quantity | value | meaning |
+|---|---|---|
+| `rb:gath` calls / rebuild | 3615/16 = **226** | every box, every level |
+| `rb:own` calls / rebuild | 128/16 = **8** | level-1 **owner branch only** |
+| boxes owned per rank per rebuild | 226/8 = **28** | |
+| => level-1 share of owned boxes | **28%** | level >= 2 is ~72% |
+
+So ~72% of boxes *are* level >= 2. But the time splits the other way:
+
+| | s | % of `rb:gath` | % wall |
+|---|---|---|---|
+| level-1 branch (bracketed phases, all after the line-875 early return) | **73.6** | **67.5%** | 9.0% |
+| of which `rb:wait` | 72.9 | 66.9% | **8.9%** |
+| remainder = `pg:all` + `rb:post` + `rb:send` + unbracketed | <= 35.4 | <= 32.5% | <= 4.3% |
+
+**The level-1 path is the minority of boxes and the majority of the time**, because each level-1
+gather performs a **593 ms owner-side `WAITALL`** (123 calls). `pg:all` is bounded above by 4.3% of
+wall and cannot dominate.
+
+`PH_RBWAIT` is at `m_amr.fpp:954`, after the level >= 2 early return at 871-875, so it is
+unambiguously level-1 — verified from the source, not inferred.
+
+**Conclusion: the design is aimed correctly.** Batching the level-1 gather targets the 8.9%-of-wall
+wait term.
+
+## Expected payoff, stated as a bound
+
+Corrected for the nesting above:
+
+| if we eliminated | wall | tax |
+|---|---|---|
+| all of `rb:gath` | x0.866 | 11.03x -> **9.56x** |
+| only its wait term | x0.911 | 11.03x -> 10.04x |
+| all of regrid | x0.525 | 11.03x -> 5.79x |
+
+Batching removes the per-box *rendezvous*, not the bytes, so the realistic target is a fraction of
+the wait term — call it 4-7% of wall, **which is close enough to the 4.96% noise floor that the
+experiment must be differenced, not single-run.**
+
+## One more correction from the audit
+
+`regrid` shows 40 calls but `rg:build` and `rg:mig` show **16**: only 16 of 40 regrids actually
+rebuild, the rest hit the `boxes_unchanged` early-out. So "9.7 s per regrid" (387.5/40) understates
+the real thing — **a rebuilding regrid costs ~21.4 s** (`rg:build` 14.5 + `rg:mig` 6.9). Quote the
+per-rebuild figure, not the per-call average.
+
+Cross-check that validates the call accounting: `rb:gath` 3615 calls / 16 rebuilds = **225.9 boxes
+per rebuild**, against a converged box count of ~224.
diff --git a/docs/documentation/amr_slowness_analysis.md b/docs/documentation/amr_slowness_analysis.md
new file mode 100644
index 0000000000..410286a904
--- /dev/null
+++ b/docs/documentation/amr_slowness_analysis.md
@@ -0,0 +1,159 @@
+# Why MFC is slow with AMR: the unified analysis (2026-08-19)
+
+Synthesis of the full measurement campaign plus a five-reviewer panel (advance-path architecture,
+communication structure, memory/regrid, AMReX source comparison, rhs-skew mechanisms), each reviewer
+reading actual code — MFC's and AMReX's — under read-only constraints, with the campaign's refuted-
+ideas list supplied so nothing dead was re-proposed. Companions: `amr_action_plan.md` (what to do),
+`amr_tax_review.md` (measurement audit trail). This document answers WHY.
+
+Reviewer priors were committed to disk before any report was read; section 7 records where they
+were wrong.
+
+---
+
+## 1. The one-paragraph answer
+
+MFC's AMR treats **the block** as the unit of communication, scheduling, and memory, walked on **one
+global ordered list** that every rank traverses in lockstep with a blocking element at nearly every
+position. That design (i) pays fixed per-box costs O(boxes) times per step where AMReX pays them
+O(neighbor-ranks) times per level with cached communication graphs; (ii) **amplifies** any rank-local
+cost divergence into convoys — head-of-line blocking on rendezvous-class messages makes everyone's
+per-call wait grow ~10x while counts and bytes stay flat; and (iii) **ratchets memory** to the
+high-water union of every mesh the run has ever had, which both OOMs long runs (terminal, at the
+64-to-128 capacity doubling) and — via VRAM pressure on the per-launch allocation path — appears to
+be the *source* of the rank-local slowdown that the convoys amplify. AMReX's units are **the level**
+(aggregated, cached, nonblocking exchanges with one waitall) and **the arena** (fully reusable
+memory), which is why its tax is flat in regrid frequency and simulation time where MFC's grows.
+
+## 2. The measured facts any explanation must fit
+
+| # | fact | status |
+|---|---|---|
+| F1 | Tax grows with sim time at CONSTANT mesh: 4.02x (steps 40-80) to 12.14x (80-160), identical 224 boxes, fine_work, rhs calls | replicated |
+| F2 | The growth is per-call WAIT: reflux ms/call 2.5 to 28 (10x) at 2.33x calls; participation only +17% | measured |
+| F3 | Growth is paid at blocking sites with LOW, falling imbalance (reflux 1.32 to 1.16) | measured |
+| F4 | The divergence ORIGINATES in rhs: imbalance 1.09 to 2.90; PH_RHS is MPI-free and GPU_WAIT-bracketed, so it is genuine rank-local time | measured + code-verified |
+| F5 | Coarse rhs echoes it small: +77% with near-flat imbalance (1.04 to 1.06) | measured |
+| F6 | Memory OOMs by REGRID COUNT: 40 regrids dies, 8 over 2x the steps survives | confirmed behind a VRAM gate |
+| F7 | Removing one per-box rendezvous (R1, level-2 gather) bought -17/-22% wall AND shrank the untouched allreduce 54-84% | measured, causal prediction held twice |
+| F8 | Removing a rendezvous with NO downstream sync (step-1 hoist) improved its phase 14% and WORSENED wall — cost relocated | measured, both operating points |
+| F9 | Cells balanced 1.02, boxes 1.15, while rhs seconds diverge 2.9x | measured |
+| F10 | Per-regrid cost ~6-26 s vs AMReX ~0.027 s | measured |
+
+## 3. The causal chain (best-supported model)
+
+```
+ regrid churn (blob advects)
+ └─> rank-local slot high-water creeps up (amr_loc_n never decrements; frees only recycle)
+ └─> store capacity doubles rank-locally (s_amr_st_reserve, newcap = max(2*oldcap, nloc), no shrink)
+ ├─> TERMINAL: the 64->128 doubling must allocate 28.2 GB into ~14 GB free ==> OOM (F6)
+ └─> VRAM pressure on ratcheted ranks
+ └─> per-launch map(alloc:) allocations in the rhs kernel family hit a slow path
+ └─> rank-local rhs slowdown, ~2100 launches/step exposed (F4), coarse echo at ~75 launches (F5)
+ └─> the per-box blocking lattice (rendezvous msgs, fixed tags, one global order)
+ CONVOYS the divergence: everyone's wait grows, imbalance stays low (F1,F2,F3)
+```
+
+Two links are proven (ratchet arithmetic; convoy amplification is the only reading consistent with
+F2+F3+F7+F8). The middle link — VRAM pressure causing the rhs slowdown via the per-launch allocation
+path — is the leading hypothesis (E-H1), currently being adjudicated by a per-rank instrumented run,
+and has a 2-line decisive A/B (revert the two `map(alloc:)` clauses, rerun 160 steps).
+
+## 3b. THE PER-RANK RESULT: it is ONE SICK RANK (measured 2026-08-19, after this model was drafted)
+
+Per-rank phase times, production point, 160 steps (`amr-bench/logs/rank-0819_1156`):
+
+| rank | 0 | 1 | 2 | 3 | 4 | **5** | 6 | 7 |
+|---|---|---|---|---|---|---|---|---|
+| fine_work (M cells) | 23.5 | 23.5 | 23.0 | 23.1 | 23.5 | **23.6** | 23.5 | 22.5 |
+| **rhs (s)** | 225 | 240 | 240 | 259 | 253 | **976** | 240 | 247 |
+| **reflux (s)** | 853 | 844 | 820 | 804 | 808 | **71** | 823 | 820 |
+
+Rank 5 does IDENTICAL work (+1.4%% on cells) and takes **4x longer in rhs**; the other seven then
+wait ~820 s in reflux while rank 5 waits 71 s. Totals are near-equal (1047 vs ~1065 s) - a clean
+mirror. `max/mean` = 2.91, which IS the aggregate 2.90. At 80 steps there is no straggler at all
+(imbalance 1.06), so the pathology **develops on one rank between steps 80 and 160**.
+
+**This sharpens the model in section 3 rather than replacing it.** The chain still holds, but the
+final link is now specific: it is not a diffuse per-rank divergence, it is ONE rank falling off a
+cliff, with the convoy converting that into seven idle ranks. Consequences:
+- **Composition is dead** as an explanation (work is balanced to 1.4%%).
+- **The cost-weighted balancer (section 6.4) is DEPRIORITISED** - the load is already balanced;
+ rebalancing cannot help a rank that is slow at equal work.
+- **The convoy is confirmed as transmission, not source** - and still worth fixing, because it is
+ what turns one sick rank into eight.
+- E-H1's pre-registered signature (fine_work flat + rhs bimodal + rank-local) is matched exactly.
+
+**Decisive test in flight:** the store trip-wire asks whether rank 5 carries a HIGHER `amr_st_cap`
+than its peers. If yes, the memory ratchet and the rank pathology are ONE mechanism and section 6.1
+becomes the whole fix. If no, E-H1 dies and the rank-local cause must be found elsewhere.
+
+## 4. The four structural deltas vs AMReX (from source, both codes)
+
+1. **Exchange granularity and caching.** AMReX `FillPatchTwoLevels`: one coarse-patch MultiFab, one
+ `ParallelCopy` in, one out; the communication graph is CACHED per (BoxArray, DistributionMapping)
+ and re-used; `PostRcvs` posts ONE Irecv per source RANK with all boxes packed. MFC: one
+ gather per BOX per stage (~2,500-3,500 rendezvous-class p2p messages/step at 224 boxes vs
+ ~150-250 for the aggregated equivalent), overlap geometry recomputed per call. Explains F7, F10,
+ and why MFC's tax responds to regrid_int while AMReX's does not.
+2. **Reflux.** AMReX `FluxRegister::Reflux`: six aggregated per-LEVEL `copyTo` calls plus one fused
+ kernel. MFC: per BOX, 6 ISENDs per participant + WAITALL on the owner, 6 blocking RECVs per
+ participant. This is the lattice where F1-F3 are paid.
+3. **Regrid.** AMReX: unchanged levels are not touched at all; `RemakeLevel` fills new MultiFabs with
+ one FillPatch, interpolation on device, migration implicit; old fabs return to a reusing `CArena`.
+ MFC: per-box collective gather in the rebuild, host-based prolong history, stash/migrate host
+ round trips, grow-only uniform-slot store. Explains F6, F10.
+4. **Load model.** AMReX's DEFAULT is also cell-weighted SFC — so "MFC weights the wrong quantity" is
+ NOT by itself the delta. The delta: aggregated nonblocking comm TOLERATES skew (absorbed at one
+ waitall); MFC's per-box blocking chains AMPLIFY it. AMReX additionally ships runtime-cost
+ rebalancing (`makeKnapSack(rcost_local, ...)`) for when apps need it; MFC has no such hook.
+
+## 5. Ranked root-cause hypotheses (with adjudication status)
+
+| rank | hypothesis | evidence for | discriminator | status |
+|---|---|---|---|---|
+| 1 | **Convoy amplification** on the global lockstep block list (4 walks per stage-cycle, blocking element in each) | F2, F3, F7, F8; two reviewers independently | timestamp rank arrivals at 3 list positions; spread grows along the list | strongly supported |
+| 2 | **Store ratchet -> VRAM pressure -> slow per-launch alloc path** as the rhs-divergence source | F4, F5, F6; unifies memory + skew | per-rank data: fine_work flat, rhs bimodal, same slow ranks both windows; then the 2-line map(alloc:) revert | leading; being adjudicated |
+| 3 | **Device-heap fragmentation** (same ratchet, different mechanism) | same as #2 | map(alloc:) revert helps (#2) vs does not (#3); fix identical either way | fallback for #2 |
+| 4 | **Ownership composition drift** (L2 share / block count per rank re-dealt at each regrid) | windows contain 2 vs 4 regrids; box imbal 1.15 | per-rank regression: rhs seconds vs block count and cells | partial at best (1.15 cannot give 2.9x) |
+| 5 | Data-dependent kernel cost (blob steepening) | grows with time by construction | per-rank: slow ranks track the interface and rotate | largely ruled out (smooth single-fluid advection; coarse imbalance flat; gfx90a full-rate denormals) |
+| 6 | GCD thermal/clock divergence | long runs | slow ranks correlate with clocks, not regrid count; rotate across replicas | disfavored (replication matched to 4%) |
+
+Also surfaced, not yet priced: an **unbracketed per-step per-box blocking chain** after the stage
+loop (`restrict_to_parent`, `freg_to_parent`, `restrict_fine_to_coarse`, m_time_steppers ~:783-800)
+— same defect shape, invisible to the budget, feeding each step's exit skew into the next step's
+entry (a candidate for the super-linearity); and a per-rhs-call **capture sweep over the global
+block list** with an ~11-array metadata push on every rank (m_amr_registers ~:586-616) — a fixed
+launch-tax term at O(global boxes) per call.
+
+## 6. Fix architecture, in order
+
+1. **Stop the bleed (bounded, this week).** (a) Free stale slots BEFORE allocating new ones in the
+ rebuild (or reconcile mid-loop) so the union spike never reaches the store-growth path; add a
+ shrink-on-reconcile or a capacity cap with eviction. (b) Per-regrid stderr trip-wire:
+ `amr_loc_n`, `amr_st_cap`, live-slot count per rank. (c) Bracket the unbracketed restrict/reflux
+ chain (PH_RESTR) so 6% of wall stops being invisible.
+2. **The decisive cheap experiments.** (a) The per-rank run in flight (adjudicates #2 vs #4/#5).
+ (b) The 2-line `map(alloc:)` revert at 160 steps (adjudicates #2 vs #3). (c) B's freg pre-post
+ pilot: IRECVs for all participating blocks posted at stage start with per-block tags, one
+ WAITALL before the apply loop — buffers are already per-block indexed, so this is aggregation-
+ lite with no refactor, and it doubles as the convoy discriminator.
+3. **The structural fix (the campaign's endgame).** Per-LEVEL aggregation of the four per-box
+ exchange families (fill gather, seam halo, reflux, restrict) with cached communication graphs —
+ the FillPatch/FluxRegister shape. This is what F7/F8 jointly demand: aggregation removes cost
+ AND keeps a sync point, where piecewise deferral only relocates cost.
+4. **Balancer, conditional.** Only after #2's verdict: if composition matters, runtime-cost
+ weighting (AMReX `makeKnapSack` shape). Not before — with convoys active, a better balance would
+ be largely absorbed by the lattice anyway.
+
+## 7. What the pre-registered priors got wrong (recorded for honesty)
+
+- "Data-dependent kernel cost, 55%" — too high for THIS case: relax/igr/adap_dt/chemistry are all
+ off, the blob is smooth single-fluid, and the coarse-grid echo has flat imbalance. Demoted.
+- "Low imbalance at reflux = real work" (earlier session reading) — wrong inference: a convoy
+ distributes waiting uniformly, so low imbalance at a sink is what a chain-propagated straggler
+ looks like. The conclusion (skew paid at blocking sites) survived; the reasoning did not.
+- The balancer-currency delta ("MFC weights cells, cost is physics") — weakened: AMReX's default is
+ also cell-weighted. The operative delta is skew TOLERANCE of the communication design.
+- Missed entirely until reviewer A: the unbracketed post-stage chain and the windows' unequal
+ regrid counts (2 vs 4), which entangle composition drift with time in F1.
diff --git a/docs/documentation/amr_stepfill_ring_clip.md b/docs/documentation/amr_stepfill_ring_clip.md
new file mode 100644
index 0000000000..631cb2ed84
--- /dev/null
+++ b/docs/documentation/amr_stepfill_ring_clip.md
@@ -0,0 +1,119 @@
+# Ring-clipping the runtime fill gathers
+
+> **STATUS 2026-08-22: IMPLEMENTED, PROVEN CORRECT, and PARKED (reverted) on an amdflang
+> whole-image codegen regression — NOT on any defect of this design.** The implementation
+> (commits dc6d4129 + bd85c792 + a7970743, reverted immediately after) passed the full
+> correctness bar: output bit-identity at np=4 and np=8, zero transport-assert trips,
+> wire words −64 to −72%, gather family −33% at np=8. But adding its 7 target regions
+> made amdflang's whole-image device link deterministically regenerate UNTOUCHED kernels
+> with 2.4–4.5x worse ISA (weno 5x scratch, riemann VGPR→AGPR flip, LDS 2048→2560
+> image-wide). Verdict, evidence, and the re-landing trigger: `amr_action_plan.md`
+> "2026-08-22 (final)".
+
+**Target:** the step-fill gather family = 14.3% of np=8 wall (185.8 s post-step-2 on
+k004-001), whose words are **71.2% provably dead** (`[amr-cov]`, logs/p1gate-0822_1259:
+48.2e9 of 67.7e9 words at np=8). The ghost-fill kernel reads only `floor(f/rr) +- 1`
+(`s_amr_fill_fine_ghosts_*`), so of the full patch `[region-mar, region+mar]` only the
+**hollow shell** — the patch minus the open core `[region_lo+1, region_hi-1]` — is ever
+consumed. Ship the shell, not the patch.
+
+## REVIEWED 2026-08-22: two adversarial reviewers (MPI/consumer lens + state/lifetime
+## lens). The shell claim itself SURVIVED both line-by-line audits — every runtime
+## consumer of amr_cg is a shell reader, the open core is exact with ZERO margin (reach
+## is 1 on every branch incl. the multi-fluid closure; do NOT enlarge the shell), and the
+## host/device asymmetry structurally insulates the rebuild's full-patch readers (runtime
+## writes device-only; rebuild reads host truth after full-box host writes). But the
+## original spec was defective in one place and validation-blind in four. This document
+## is the AMENDED form; implement only this.
+
+## Scope (amended per finding F1, both reviewers)
+
+**ALL runtime gathers** — every `s_amr_gather_coarse_patch(..., .true.)` site and every
+level>=2 `to_host = .false.` path — **subcycle included**. The original "lockstep only"
+scope was unimplementable: the subcycle sites pass the identical flags (level-1
+`m_amr.fpp:5527/5533`; level>=2 `5741-5751` vs the lockstep `1791/1796` — no argument
+distinguishes them), and the expansion is proven safe because the subcycle consumers
+(`fill_gsta/gstb`) are generated from the same Fypp body as `fill_cons` — the shell-read
+proof covers them identically. Consequences: `s_amr_cov_note_fill` must also be called at
+the subcycle fill sites (so accounting matches behavior), and the validation sweep must
+include the subcycle goldens. Routing fact the original doc got wrong: the lockstep
+level>=2 consumer is `fill_cons` (5387); `gsta/gstb` are subcycle-only.
+
+Still out of scope, with named coherence walls (F11): the rebuild/init gathers
+(`pull_host=.false.` / `to_host=.true.` — their consumers prolong the FULL patch), the
+pbmv twin, and the four full-array `GPU_UPDATE`s of amr_cg (m_amr.fpp:1268, 1512, 1955,
+1990) — they are the load-bearing host/device coherence walls; the clipped runtime path
+must never add a host write of amr_cg, and no one may "optimize" those updates as part of
+this work.
+
+## Design
+
+1. **One shared slab helper, used by every side** (sender pack, owner recv-size, owner
+ unpack, own-box copy, np=1 shortcut, and the XA/cov shadow accounting):
+ `(patch, core) -> <= 6 DISJOINT slabs`, fixed order (x-low/x-high full-transverse,
+ then y-low/high restricted to the core's x-interval, then z-low/high restricted in x
+ and y). Conventions (F6): collapsed dims define `core_d = [0,0]` (full interval, no
+ transverse slabs); width<=2 regions have an empty core (shell = whole patch, legal);
+ width-1 overlap resolved by clamped subtraction; always `@:ASSERT` slab disjointness
+ AND `sum(slab words) == patch - core`. The transverse restriction is to the CORE
+ interval, not the closed region (the closed-region variant double-covers face planes).
+ The shell is the 3D box difference — never an independent per-face ring (transverse
+ coordinates of shell reads go arbitrarily deep per-dim).
+2. **Clipped exchange, same message set** (F8/Finding 2): iterate today's
+ `amr_ovl_gather` contributor list UNCHANGED on both sides; a contributor whose overlap
+ lies inside the core sends a ZERO-word message (legal MPI) — never a one-sided
+ emptiness skip (that is an owner-side WAITALL hang; reachable at exascale operating
+ points where rank slabs are narrower than region-2). One buffer, one message, today's
+ tag per contributor; pack slices concatenated in slab order.
+3. **amr_cg stays full-size**; only shell cells are written on the runtime path; the core
+ is stale BY DESIGN — acceptable only because of the walls in Scope.
+4. **Fused kernels** (F10): own-copy, pack, and unpack iterate the <= 6 slab
+ intersections through the concatenated-flat-index single-kernel idiom the fill kernel
+ already uses — one launch per message, never one per slab (the family's measured tax
+ is launch-path serialization).
+5. **Frame assert** (F7): the clip makes sender-frame (replicated region/foot) vs
+ consumer-frame (`amr_isect_lo`) agreement load-bearing; `@:ASSERT(amr_isect_lo ==
+ region_lo)` (level-1) / `== foot lo` (level>=2) on the owner in every clipped path.
+6. **Precision/conversion points preserved verbatim** (F9): own-box/co-located copies
+ stay direct stp:=stp; wire pack stays real(stp->wp); wire unpack stays real(wp->stp);
+ keep the `(i, g3, g2, g1)` per-slab linear order and the fixed slab order both sides.
+
+## Validation (amended per F2-F5 — the original plan was partially circular/blind)
+
+- **Primary, non-circular: output BIT-IDENTITY** vs HEAD at np=1, 4, 8 (the step-2
+ method) + goldens 67/67.
+- **The MFC_DEBUG poison arm is MANDATORY and covers the WHOLE patch, not the core**
+ (F3): a debug-gated device kernel writes quiet NaN (stp) over the box's entire patch
+ extent at the top of every clipped gather, before any shell write — sites: the runtime
+ branch of `s_amr_gather_coarse_patch` (covering the np=1 shortcut and the np>1 owner
+ path), `s_amr_copy_parent_patch_*` (to_host=.false.), and
+ `s_amr_unpack_parent_patch_device` (to_host=.false.). Any read of an unshipped cell —
+ core OR a missed shell slab (the hole class the core-only poison is blind to) — NaNs
+ the ghost fill and trips goldens/ICFL within a step. Sweep: the 67-case AMR subset
+ under MFC_DEBUG at np=1 and the suite's ppn=2 cases (contributor-slab arithmetic exists
+ only at np>1).
+- **Transport asserts via MPI_GET_COUNT** (F4): the clipped recvs keep statuses (today
+ they discard them) and assert `MPI_GET_COUNT == predicted live words` per message —
+ sender-vs-receiver recomputation of the same replicated function is a tautology and is
+ NOT the check. XA cannot see short sends (it records posted sizes).
+- **Word accounting is shadow-counted at the send/recv sites** (F2): the `[amr-cov]`
+ counter is the SAME arithmetic the slabs derive from (circular) and counts non-wire
+ words (own-box, np=1) that XA never sees, and XA ids blend runtime/rebuild/subcycle.
+ The word prediction therefore asserts TRANSPORT only; shell correctness rests on
+ bit-identity + the poison arm.
+- **Boundary-block coverage (F5): CLOSED BY EVIDENCE, no new test.** The attempted
+ boundary golden (static block at 0, ppn=2) aborts in the RUNTIME checker: "amr block
+ must lie at least buff_size cells inside the domain boundaries" — the reviewer's
+ premise (only `>= 0` enforced) missed this simulation-side @:PROHIBIT. Since
+ `amr_cpat_mar = ceil(buff_size/rr) + 1 <= buff_size` for buff_size >= 2, no VALID
+ configuration produces a patch crossing the domain boundary. The implementation
+ asserts the premise instead of handling the case: `@:ASSERT(amr_cpat_mar <=
+ buff_size)` at shell-helper init.
+
+## Expected payoff, stated as a bound
+
+stepfill is bytes + skew (CMA-off control: bandwidth is real but not all of it). Bytes
+cut ~71% on a 14.3%-of-wall family + pack/unpack kernels iterate ~71% fewer cells + ~71%
+less PCIe. Ceiling ~10% of np=8 wall; realistic 4-8%. Judged by differenced same-node
+arms against the 4% run-to-run variance (single runs are not evidence), and the
+np-doubling ratio reported against the SOTA bar (AMReX 1.20x/1.15x, amrexs0-0822_1330).
diff --git a/docs/documentation/amr_tax_review.md b/docs/documentation/amr_tax_review.md
new file mode 100644
index 0000000000..b0d9bf16ef
--- /dev/null
+++ b/docs/documentation/amr_tax_review.md
@@ -0,0 +1,370 @@
+# AMR tax campaign: an outside review (2026-08-18)
+
+A fresh-eyes review of the whole investigation into why MFC's AMR arm pays a much larger tax than
+AMReX, written after re-reading the full evidence base. Companions:
+`docs/documentation/amr_action_plan.md` (the action list, authoritative on current numbers; rewritten 2026-08-18 to incorporate this review and its audits) and
+`docs/documentation/amr_block_batching.md` (the chronological research log). Where this document and
+the action plan disagree on a number, the action plan wins; this document's job is synthesis,
+critique, and a prioritized path forward.
+
+**Revised 2026-08-18 (same day) after an audit of this document's own arithmetic.** One claim made
+in the first draft — that the `rhs` bracket is 62-74% GPU-busy and batching's ceiling is ~1.13x — was
+WRONG: it charged the coarse-grid `s_compute_rhs` (which has its own `PH_COARSE` bracket) to the fine
+`PH_RHS` bracket. Corrected numbers are in section 3; the batching prize is about twice what that
+draft said. The error was a cross-run composition, which is the campaign's own documented failure
+mode, and it is the reason section 7 now opens with two direct measurements instead of an argument.
+
+---
+
+## 1. Verdict
+
+**The diagnosis is done, and it is correct.** The problem was never "one bug to find," and that is
+precisely why weeks of increasingly good instrumentation kept producing nulls. What the evidence
+shows is a **design property, not a defect**: MFC's AMR arm advances the hierarchy one block at a
+time through a host-orchestrated, fully synchronous pipeline, and every per-block operation — kernel
+launch, argument mapping, grid-state swap, metadata sync, blocking gather — carries a fixed host
+toll of order 15-260 us that a 70-110 us kernel cannot hide. The cost is smeared across thousands of
+operations per step of roughly five different kinds. There is no single culprit because **the sum is
+the culprit.**
+
+AMReX shows the same shape from the other side, and the QUALITATIVE contrast is what to carry: it
+also launches per-box, but its communication is aggregated per level and its per-box host work is a
+pointer capture rather than a global grid-state reconfiguration, so its per-launch dead time is
+roughly two orders of magnitude below ours.
+
+**Do not quote the specific figures that once expressed this** — "1,237 us dead per launch",
+"2,582 vs 14,091 launches/step", "443x more dead time". All are from the cap-32-vs-cap-64 mismatch
+described in section 2, and at matched block size the excess is 2.03x, not 7.64x. The mechanism
+survived the correction; those numbers did not.
+
+**The campaign made real progress even though it felt like none:**
+
+- cap 32 -> 64: **2.32x wall** on the same physical problem, lower memory (Tier 0.1, landed logic);
+- `flux_n`/`flux_gsrc_n` deletion: **-25% wall** (724ef4fd);
+- hllc + weno `map(alloc:)`: **-26.4% wall** cumulative on the 3D AMR case, byte-identical;
+- the loop-invariant halo hoist (~2.4x on its case), the regrid stash fix, the flat store;
+- and, critically, the headline gap itself collapsed under scrutiny: the "7.64x excess vs AMReX"
+ was an unmatched comparison (MFC at cap 32 vs AMReX at 64^3 blocks). **At matched cap 64 the
+ excess is 2.03x** (MFC 6.89x vs AMReX 3.40x, each vs its own uniform arm).
+
+**Recommendation in one line: stop diagnosing, build the level-batched advance pilot, and gate it
+on operation counts rather than wall.** The measurement machine is now better than the questions
+being asked of it; the decision-relevant uncertainty has moved to "does batching deliver in situ
+what the MWE promises," and only building it answers that.
+
+---
+
+## 2. The current numbers (retire the stale ones)
+
+Quoted numbers in circulation span three operating points and two eras of fixes. The ones to carry
+forward, each with its operating point stamped:
+
+| quantity | value | operating point |
+|---|---|---|
+| MFC tax vs own uniform | **6.37-6.89x** | cap 64, matched blob, regrid_int 2, np=8 |
+| AMReX tax vs own uniform | 3.40x | same, matched cap |
+| **MFC excess over AMReX** | **2.03x** | matched cap 64 (4.15x at matched cap 32) |
+| arithmetic term | **MFC 1.90x vs AMReX 1.92x — identical** | **cap 32**, union-of-intervals estimator |
+| per-cell coefficient a | 3.50 ns/cell at **cap 64**, **equal to uniform's 3.63** | 4-cap sweep, clean instrument |
+| per-box coefficient b | 6.29 -> 15.24 ms/box, **rises with cap** | same sweep; b is not a constant |
+| regrid-frequency asymmetry | MFC tax 27.2x -> 7.2x going int 2 -> 20; AMReX 8.57 -> 8.13 | cap 32, 400^3 |
+| per-regrid cost | MFC ~12 s constant; AMReX ~0.027 s | cap 32; MFC side is phase-measured |
+| GPU busy, AMR arm | 15.1% at cap 64 (8.8% at cap 32) | uniform arm ~80% |
+
+Consequences of the corrected picture:
+
+- **The gap to AMReX is a factor ~2, not ~8.** That changes the tone of the campaign from "something
+ is catastrophically broken" to "one structural factor of two remains, and we know where it lives."
+- **The per-cell penalty of AMR is already gone at cap 64** (a = 3.50 vs uniform 3.63). What remains
+ is entirely per-box/per-launch overhead plus the regrid path.
+- **Those two rows are the SAME physical quantity at different caps — reconcile them, do not read
+ them as a contradiction.** MFC's AMR arithmetic penalty is 1.90x at cap 32 and 0.96x at cap 64
+ (`a` is kernel time per cell: 0.944 s/step / 3.50 ns = 269.7M cells = 64M base + 205.9M
+ `fine_work`, an exact match, so `a` is kernel-based and directly comparable to the uniform arm's
+ 3.633). The arithmetic penalty is a pure block-size effect and it vanishes at the cap we would
+ ship. Any decomposition quoting `tax = 1.90x arithmetic x N idle` is a cap-32 statement.
+- **The tax metric structurally rewards heavier physics.** The matched case runs weno1 + LF, the
+ cheapest numerics MFC has, which maximizes the reported tax. Production numerics lower it while
+ changing nothing. Always quote both.
+- The regrid-frequency result suggests the practical gap at realistic operating points may already be
+ small — but that comparison is confounded (MFC's mesh lags at int=20, doing 2.78x less fine work),
+ so it is a hypothesis, not a claim. Experiment E1 in section 7 is designed to settle it.
+
+---
+
+## 3. The phase budget at the shipping cap, and what it does to the priorities
+
+Measured 2026-08-18, exclusive node, 400^3, np=8, 2 levels, `regrid_int=2`, 40 steps
+(`amr-bench/logs/rgbuild-0818_0914`). Cap 32 wall 656.975 s; cap 64 wall 293.730 s.
+
+| phase | cap 32 | cap 64 |
+|---|---|---|
+| **regrid** | 35.2% | **42.2%** |
+| gather + reflux + seam (per-box MPI) | 29.0% | 25.1% |
+| **rhs** (fine-block advance) | 23.1% | **18.7%** |
+| coarse (monolithic L0 RHS) | 2.6% | 4.9% |
+| halo / gfill / rk | 2.4% | 2.5% |
+| unbracketed | 7.6% | **6.7%** |
+
+**(a) Regrid's share RISES with the cap.** Wall falls 2.24x going 32 -> 64 but regrid falls only
+1.87x, so its share goes 35.2% -> 42.2%. Raising the cap remains the best single change made in this
+campaign, and it makes regrid relatively MORE dominant, not less.
+
+**(b) The `rhs` bracket is only about half GPU-busy, which bounds what batching can return.**
+Total kernel at cap 64 is 0.944 s/step of 6.238 (15.1%); the `s_compute_rhs` tree is 88.7-91.1% of
+kernel time; the coarse call is its own `PH_COARSE` bracket and accounts for ~0.233 s/step (the whole
+uniform 400^3 arm). So the fine `compute_rhs` inside `PH_RHS` is ~0.61-0.63 s/step against a
+1.374 s/step bracket:
+
+| | value |
+|---|---|
+| `PH_RHS` internal GPU-busy | **44-46%** |
+| removable overhead inside `PH_RHS` | **10.2-10.5% of wall** |
+| ceiling, perfect batching of `rhs` | **~1.11x** |
+| ceiling, + all unbracketed time | **~1.20x** |
+| for comparison: regrid alone | 1.73x |
+
+Sanity check that was not tuned to come out right: the same method gives `PH_COARSE` 65% busy
+(0.233 of 0.358 s/step), a sensible figure for a monolithic 400^3 advance.
+
+**CAVEAT, and it is why section 7 opens with a measurement.** This composes kernel time from the
+4-cap clean-instrument run (wall 6.238 s/step) with phase seconds from this run (7.343 s/step),
+violating the action plan's own "one clock per ratio" rule. The first draft of this document got
+the same calculation wrong by 2x by charging the coarse kernel to the wrong bracket — and a second
+audit found the CORRECTION itself used the uniform arm's WALL (0.2325 s/step) as the coarse KERNEL,
+when kernel measurements span 0.187-0.228 s/step across instruments, so the defensible band is
+**44-49% busy**, and the "PH_COARSE 65% busy" sanity figure is really 53-65%. A third weakness: the
+88.7-91.1% kernel share was profiled on a DIFFERENT case (the 256^3 flat-store campaign), so this
+estimate stacks two cross-run compositions. Three audits, three layers of the same defect. **Treat
+~45-50% as an estimate that must be replaced by a direct measurement, not as a result.**
+
+**(c) `PH_RHS` does not contain the thing batching exists to remove.** In `m_amr.fpp`,
+`s_amr_swap_to_fine()` is called BEFORE `s_phase_tic(PH_RHS)` while its partner
+`s_amr_restore_coarse()` is INSIDE the bracket — so the bracket is charged half a swap pair, and the
+per-block grid-state reconfiguration lands in the 6.7% unbracketed remainder. The Phase-3 `do islot`
+advance loop in `m_time_steppers.fpp` has no enclosing bracket at all. The time stepper's own
+comment at Phase 4 names that swap/restore round trip as what blocks batching. **The single largest
+claimed benefit of the batched design has never been measured, and cannot be read off any existing
+budget.**
+
+**(d) The operating point cuts both ways — do not over-read this table.** These runs use
+`regrid_int=2`, which this document argues elsewhere is unrealistic, and `weno_order=1` +
+Lax-Friedrichs, the cheapest numerics MFC has (chosen to match AMReX's linear advection). Both
+choices inflate the non-physics shares: at `regrid_int=20` regrid roughly halves and `rhs` roughly
+doubles, and production WENO5+HLLC multiplies kernel work per cell, raising `rhs` further. **So this
+table justifies neither "regrid first" nor "batching first" on its own** — the ordering genuinely
+flips between the AMReX-comparison point and the production point, and no budget exists at the
+production point. That is E0 and E1 in section 7.
+
+---
+
+## 4. What is established, with trust grades
+
+**Solid (multi-instrument, counts-based, or arithmetically closed):**
+
+1. Uniform MFC is healthy: ~80% GPU busy, rank-invariant launch counts. The tax is AMR machinery.
+2. The idle closes arithmetically: dead-time-per-launch x launches ~= the whole gap. Nothing large
+ is hiding.
+3. The host is the saturated resource, not the network and not the GPU: perf shows ~80% host CPU
+ busy (~51% Open MPI progress spinning + ~20% HSA runtime at np=8; pure HSA spinning at np=1).
+4. The mapped-entity law (controlled MWE, R^2 = 1.0000, cross-validated in situ): each private array
+ or assumed-shape dummy costs ~2 copies and ~31 us per launch; scalars, module-direct arrays and
+ explicit-shape dummies are free. Copy-count predictions transfer to MFC to within 0.4%.
+5. Every intervention that moved wall reduced toll x count: the cap change, the flux deletion, the
+ two `map(alloc:)` clauses. Every intervention that did not, didn't.
+6. The batched-kernel MWE: one kernel over all blocks = 433.5 -> 35.0 ms (**12.4x**), operations
+ 15,370 -> 250. The work-bound crossover is ~500 us of kernel work per region; MFC's mean AMR
+ kernel is ~109 us, so **batch >= 8 blocks pushes the mean kernel past the crossover.** Batch 8 is
+ not arbitrary; it is the physics of the toll.
+
+**Established negatives (dead levers — do not re-litigate without new evidence):**
+
+- `nowait` chains (213 vs 202 ms, no pipelining) and cross-chain concurrency (disproved in the
+ dedicated MWE).
+- All seven mapping-clause mechanisms (flat dummies, pointer dummies, present clauses, declare
+ mapper, module-scope scalar_field, ...); module scope for derived types is 3.5x WORSE.
+- Twelve runtime knob configurations (the harmful ones registered at 1.8-3.2x, which is what makes
+ the nulls on the rest meaningful).
+- Byte reduction (removing 12% of transferred bytes bought zero wall) and Waitall reduction alone
+ (removing 53.8% of Waitalls bought zero wall).
+- Load balancing (oracle ceiling 5.1% of wall; regrid imbalance 1.003).
+
+**Suspect — do not build on these without re-measuring:**
+
+- Anything measured at cap 32 (4.9x more boxes than we would ship) or quoted from shared-node runs.
+- Absolute s/step across sessions (10% level shifts between option-hash builds; ~12% single-run
+ noise floor on this node).
+- **"Caps 96 and 128 OOM."** Repeated in `amr_action_plan.md` as settled, but there is NO
+ from-scratch run at either cap anywhere in `amr-bench/logs` — the claim descends from the same
+ sweep table (`amr_block_batching.md`) that also lists cap 64 as OOM, and cap 64 demonstrably runs.
+ It may still be true for an independent reason: per-block solver scratch scales as cap^3, and
+ cap 64 already sits at 43.1 of 64 GiB per GCD, leaving only ~1.48x headroom. Worth ONE
+ from-scratch check, tempered by two countervailing signals — `b` (ms/box) rises with the cap, and
+ ~66 boxes over 8 ranks is poor granularity.
+- Anything derived by composing kernel time from one run with phase seconds from another (section 3b
+ is explicitly flagged; the first draft of this document got exactly this wrong by 2x).
+- The +24.8% widened-bridge penalty (n=3, arms converging — a settling transient, not a number).
+- Any MFC-vs-AMReX comparison at regrid_int=20 (mesh-lag confound, 2.78x work difference).
+
+---
+
+## 5. Why it "should have been straightforward" and was not
+
+Worth recording, because the feeling of no progress is itself diagnostic:
+
+1. **This is close to the hardest profiling regime there is.** Four abstraction layers (Fortran
+ runtime -> libomptarget -> HSA -> hardware queue), where every instrument distorts the layer
+ below it by 1.3-2.4x; run-to-run node noise up to 2.3x shared / 12% exclusive; and three distinct
+ transients (first-touch mapping decay, device-pool growth, mesh lag) that make any short window
+ lie. In every timing retraction of the campaign, the paired runs agreed in sign — noise
+ masquerading as corroboration.
+2. **The implicit model "find THE bottleneck" was wrong for this failure mode.** In a latency-bound
+ serial chain with several comparable toll terms, removing any one term produces a null, which
+ reads as "wrong hypothesis" when it actually means "right hypothesis, wrong granularity." The
+ nulls were evidence, correctly interpreted only in aggregate.
+3. **Operating-point drift.** The benchmark shipped regrid_int=2, making regrid look like the story
+ (37% of wall); at realistic intervals the advance dominates. Different sessions optimized
+ different denominators and their numbers contradicted each other while all being true. Hence the
+ standing rule: every phase budget and tax figure carries its operating point (cap, regrid_int,
+ np, fixes present).
+4. **A large fraction of the fortnight went into building the metrology** (counts-first gates, phase
+ brackets at 0.1% overhead, settled-tail protocol, from-scratch discipline, apparatus controls).
+ That was the price of admission, and it is paid now.
+
+---
+
+## 6. Hypothesis slate going forward
+
+**H1 (dominant, effectively the consensus of all instruments): host-issue-bound per-block advance.**
+Fix = fewer, larger units of GPU work per step: the level-batched advance. Design gates are passed
+(BC escape hatch exists and is honored; slots are uniform-shape; coordinates reduce to differentials
+on Cartesian grids), the widened bridge is built, and the MWE prices the mechanism at 12.4x. The
+batch also amortizes three watch-list costs for free: per-swap GPU_UPDATE metadata syncs, bridge
+staging (2 full block copies per block per stage today), and the in-order device queue's
+serialization of tiny operations.
+
+**But H1 now carries a bound it did not have.** Section 3 puts the ceiling at ~1.11x from the `rhs`
+bracket and ~1.20x including all unbracketed time, at cap 64 / `regrid_int=2` — well short of what
+"the main event" implies, and far short of the 12.4x the MWE returns. Two things could raise it and
+neither is measured: a realistic `regrid_int` roughly doubles `rhs`'s share, and the unbracketed
+per-block swap (section 3c) is unknown in size. **The 12.4x MWE figure is an UPPER BOUND** — its
+kernel ran over one plain contiguous array with no bridge staging, whereas MFC's batched path must
+still pay `s_amr_br_load_all`/`s_amr_br_store_all`.
+
+**H2: per-box blocking MPI is the second wall, currently hidden.** The Waitall-hoist null says the
+comms are not rate-limiting NOW — because the host is busy anyway. Once batching frees the host, the
+per-box gather/reflux/seam chains become the critical path. Plan the level-aggregated exchange
+(post-all, one drain per level — the FillPatch pattern) as stage 2, not never. Note it is smaller
+than it looked: cap 64 already removed 4.9x of the boxes.
+
+**H3: vendor-lane share — genuinely untested.** The per-operation toll is a property of amdflang +
+libomptarget + ROCm as much as of MFC. Nobody has run the AMR arm on another lane (Cray CCE offload,
+or OpenACC on an NVIDIA node). If the same code shows a several-fold cheaper launch path elsewhere,
+part of the residual tax is a vendor-runtime tax — which changes how much restructuring is worth
+versus waiting on ROCm, and matters for a code that gates on four compilers.
+
+**H4: clustering over-cover.** The split finder has no midpoint fallback, so a convex blob returns
+its bounding box (~91% over-cover for a sphere) and `amr_cluster_eff` is dead code (0.7/0.9/0.98
+give byte-identical box counts). The action plan correctly marks the break-even model VOID; the only
+way to price this is the direct experiment — add the fallback, measure wall on a fixed problem.
+
+**H5: the regrid path** is the same disease on a different limb (per-box, host-based end to end,
+~12 s per regrid vs AMReX's ~0.027 s), but its share is operating-point dependent (37% of wall at
+int=2, 18% at int=20). **Update, same day: the rb:mem vs rb:unpk discrimination landed (cap 32) and
+refuted BOTH code-derived candidates** — the per-box allocate/free brackets to 0.002 s and the
+unpack to 0.104 s, against a host half of ~64 s (rb:gath 109.4 s, rb:wait 45.7 s, 16.7% of wall,
+shares reproducing the previous session exactly). The planned scratch-hoist fix is dead before it
+was built — the third time in this campaign that a code-read attribution failed its bracket. The
+host cost lives in the still-unbracketed remainder of `s_amr_gather_coarse_patch`: the non-owner
+SEND-side packing loops (byte-proportional, which fits the observed near-flat cap scaling), the
+per-(box,source) geometry scan, and the send-pool reserve/drain. Next bracket goes there. The cap 64 arm confirms it (rb:mem 0.010 s, rb:unpk 0.026 s vs a ~25 s host remainder; rb:gath 46.5 s = 15.8% of wall) - both caps agree, the refutation is settled.
+
+**H4a: raise the cap again.** Cap 32 -> 64 returned 2.24x for zero code, per-cell efficiency
+saturates there, and the "96/128 OOM" claim is unverified (section 4). Cheap to test, plausible to
+fail on scratch scaling.
+
+**H6 (watch-list, post-batching):** single in-order device queue (kernel/copy overlap is exactly
+0.000 s today), residual mapped entities on the remaining hot regions, MPI progress spinning.
+
+---
+
+## 7. Experiments, in order of information per hour
+
+**E0 — two direct measurements that decide the ordering (hours, do these first).** Section 3's
+estimate of what batching can return rests on a cross-run composition, and an earlier draft of that
+same estimate was wrong by 2x. Both gaps close cheaply on the current binary:
+
+ 1. **Kernel time INSIDE `PH_RHS`.** One rocprofv3 kernel trace, intersected with the bracket. If
+ `rhs` is already ~45% busy the batching ceiling is ~1.11x at this operating point; if it is
+ launch-dominated as the cap-32-era numbers suggested, E3 is correctly prioritized. Nothing else
+ separates those two worlds.
+ 2. **Bracket the per-block swap.** Add a phase around `s_amr_swap_to_fine()` (and move
+ `s_amr_restore_coarse()` out of `PH_RHS`, or bracket it separately, so the pair is symmetric —
+ today the bracket is charged half a swap). This is the batched design's single largest claimed
+ benefit and it has never been measured.
+
+**E1 — the one missing baseline (highest priority among the campaign questions, ~half a day).** Cap 64, realistic regrid
+interval, landed fixes, both codes, one table — with the mesh-lag confound closed by scaling the
+error buffer (`amr_buf`) with the interval so fine coverage matches. **Make matched `fine_work` an
+iterated GATE, not a reported control, and report box count beside it**: `amr_buf` does double duty,
+since `m_amr_regrid.fpp` uses `thr = buff_size + 2*amr_buf` as the min-separation MERGE threshold, so
+raising it fuses boxes as well as growing coverage. Two arms can match on `fine_work` and still
+differ in box count, which is the quantity the tax is most sensitive to. This is the number the whole campaign is nominally about, and it does not
+exist yet. It also tests the cheerful hypothesis that MFC is already near parity at realistic
+operating points (at cap 32 the int=20 taxes were MFC 7.17x vs AMReX 8.13x — confounded, but
+suggestive).
+
+**E2 — DONE for cap 32 (see H5): both candidates refuted; scratch hoist cancelled.** Follow-up
+bracket: send-side pack + geometry scan inside the gather. Price any fix at a realistic regrid
+interval before celebrating.
+
+**E3 — the batching pilot (the main STRUCTURAL change; size it with E0 first).** Wire `s_amr_br_load_all` -> tall (m,n,p) -> one
+`s_compute_rhs` -> `s_amr_br_store_all` for a batch of 8, Cartesian-only, per-block path retained as
+fallback. Prerequisites, in order: run goldens on the widened bridge (never done); re-measure the
+bridge penalty with >= 8 interleaved pairs on an exclusive node (the +24.8% must not stand at n=3);
+sweep `amr_br_batch` 2/4/8 with the batched path still unused to separate a memory-driven penalty
+from a fixed mapping cost. **Note the tree currently carries the widened bridge uncommitted** — it
+allocates 8x the bridge (~880 MB at cap 64) while nothing calls the batched path, and goldens have
+never been run on it. If E0 defers E3, revert it rather than leave a measured-slower, untested hunk
+in place. **Gate the pilot on counts, not wall**: launches/step on the rhs family
+must fall ~batch-fold and GPU busy must rise; wall at pilot scale sits below the noise floor and a
+wall gate would produce a false negative.
+
+**E4 — np=1 of the matched case (cheap, explicitly missing).** Cleanly splits MPI-progress idle from
+local launch idle at the operating point that matters, and sets the expectation for what batching
+alone can recover at np=8.
+
+**E5 — split-finder midpoint fallback A/B (direct experiment, no model).** Fixes real dead code
+either way; on convex features it may buy a real fraction of the box count; on fronts and sheets it
+will matter more.
+
+**E5a — cap 96 from scratch (one run).** Settles the unverified "96/128 OOM" claim (section 4).
+Cap 32 -> 64 returned 2.24x for zero code; ghost overhead keeps falling ((132/128)^3 = 1.096 ->
+(196/192)^3 = 1.063) and cap 64 used LESS memory than cap 32. Expect it to be marginal: only ~1.48x
+memory headroom remains, per-block scratch scales as cap^3, and box granularity gets poor at ~66
+boxes over 8 ranks. Gate on the documented signature — exit 134 with
+`HSA_STATUS_ERROR_OUT_OF_RESOURCES`, not a hang.
+
+**E6 — cross-backend probe (if an allocation exists).** Same case on CCE offload or an NVIDIA lane;
+three numbers only: launches/step, dead time per launch, tax. Bounds the vendor share of the toll.
+
+---
+
+## 8. Process rules worth keeping
+
+The action plan's "Metric discipline" section is the canon; four additions from this review:
+
+- **Stamp every number with its operating point** (cap, regrid_int, np, fixes present, physics).
+ At least three of the campaign's internal contradictions were two true measurements of different
+ operating points arguing with each other.
+- **Prefer count gates to wall gates** for any intervention whose predicted wall effect is under
+ ~2x the in-session noise floor. Counts reproduced to ratio 1.000 across runs whose walls differed
+ by 52%.
+- **Never compose a ratio from two runs, including when reviewing.** Section 3b does it knowingly
+ and flags it; an earlier draft did it unknowingly and reported a 2x-wrong ceiling that argued
+ against the campaign's own main line. If the numerator and denominator cannot come from one run,
+ the honest output is an experiment, not an estimate.
+- **A null after removing one term of a sum is information, not refutation.** Bank it as "term N is
+ not independently rate-limiting" and keep the structural hypothesis alive until the structure
+ itself has been changed once. The campaign's one structural change at MWE scale (batching)
+ delivered 12.4x; none of the term-removals delivered more than 1.36x.
diff --git a/docs/documentation/case.md b/docs/documentation/case.md
index 83f5a50fd5..1858d1af5a 100644
--- a/docs/documentation/case.md
+++ b/docs/documentation/case.md
@@ -109,6 +109,7 @@ is equivalent to `"riemann_solver": 2`. Defined names appear in each parameter's
| ---: | :----: | :--- |
| `run_time_info` | Logical | Output run-time information |
| `rdma_mpi` | Logical | (GPUs) Enable RDMA for MPI communication. |
+| `active_box` | Logical | Enable causal-envelope active-box restriction of the RHS compute window. |
| `case_dir` | String | Case directory path |
| `old_grid` | Logical | Use grid from previous simulation |
| `old_ic` | Logical | Use initial conditions from previous simulation |
@@ -116,6 +117,7 @@ is equivalent to `"riemann_solver": 2`. Defined names appear in each parameter's
| `n_start_old` | Integer | Starting index from previous simulation |
- `run_time_info` generates a text file that includes run-time information including the CFL number(s) at each time-step.
+- `active_box` enables the causal-envelope active-box optimization, restricting the RHS compute window to the region where the solution deviates from a uniform ambient state. Single-rank only: more than one MPI rank is rejected at input check. A single global active region would leave the ranks it does not cover idle, so multi-rank support is a load-balancing problem and is deferred. Requires WENO reconstruction (`recon_type = 1`) and SSP-RK3 time stepping (`time_stepper = 3`). Incompatible with immersed boundaries, acoustic sources, body forces, Euler-Euler and Lagrangian bubbles, phase change, and the IGR solver.
- `rdma_mpi` optimizes data transfers between GPUs using Remote Direct Memory Access (RDMA).
The underlying MPI implementation and communication infrastructure must support this
feature, detecting GPU pointers and performing RDMA accordingly.
@@ -717,6 +719,27 @@ To restart the simulation from $k$-th time step, see @ref running "Restarting Ca
| `file_per_process` | Logical | Whether or not to write one IO file per process |
| `cons_vars_wrt` | Logical | Write conservative variables |
| `prim_vars_wrt` | Logical | Write primitive variables |
+| `load_weight_wrt` | Logical | Write per-cell load-weight diagnostic field |
+| `sfc_partition_wrt` | Logical | Report SFC-weighted load-balance partition |
+| `rank_time_wrt` | Logical | Report per-rank RHS compute-time imbalance (max/mean) |
+| `load_balance` | Logical | (Experimental/diagnostic) Weighted static Cartesian decomposition at init (requires `parallel_io = T`, >1 rank). Measured gain is small on CPU (~5%) and can be slower on GPU due to the occupancy floor; equal decomposition is near-optimal for uniform-cost workloads. |
+| `amr` | Logical | (Experimental) Enable block-structured AMR: a 2:1 refined level-1 block with gradient-based dynamic regrid, optional dt/2 subcycling, and conservative coupling with refluxing. Requires WENO reconstruction, SSP-RK3, model_eqns=2 or 3; num_fluids > 1 requires mpp_lim; supports physical viscosity. |
+| `amr_block_beg(i)` | Integer | Refined-block start cell index in direction $i$ (level-0 index space) |
+| `amr_block_end(i)` | Integer | Refined-block end cell index in direction $i$ (level-0 index space) |
+| `amr_regrid_int` | Integer | Steps between AMR regrid events (0 = static block, i.e. NO adaptivity). The tag sweep is per-cell and flat in block count, so a larger interval is cheap: 8 measured 1.39x faster than 2 in 3D. Raise it unless the refined feature moves quickly |
+| `amr_tag_eps` | Real | Relative density-gradient threshold for AMR refinement tagging (default 0.1) |
+| `amr_buf` | Integer | Coarse-cell padding around tagged cells when regridding (default 3) |
+| `amr_subcycle` | Logical | Advance the coarse level at the case dt and the fine level at dt/2 (two substeps; Berger-Colella refluxing). Requires `amr`; incompatible with `cfl_dt`. |
+| `amr_max_blocks` | Integer | Upper bound on the GLOBAL refined-block count. Sizes replicated per-rank METADATA (~11 kB/block); block slots themselves are allocated lazily for blocks a rank owns, so this is not N x device memory. Exceeding it silently truncates the refined region (the clusterer warns). Must be >= 1 (default 1024) |
+| `amr_max_grid_size` | Integer | Absolute cap on a refined block's coarse-cell extent per dimension, the AMReX max_grid_size concept; must be >= 2 when set (default 0). With 0 the cap is derived from the decomposition and so shrinks as ranks are added, which tiles a fixed feature into more blocks the further you scale and makes the box set depend on the rank count. Setting it pins the cap, so the box set is identical at every rank count. The value may exceed half a rank subdomain: the solver scratch is then sized to the cap rather than to the subdomain, so per-rank memory grows as the cap raised to the number of dimensions |
+| `amr_max_level` | Integer | Maximum AMR refinement depth (number of refined levels above L0); must be >= 1 (default 1). Multi-level nesting (>= 2) is supported: static AMR (`amr_regrid_int = 0`) nests up to level 2, dynamic regrid (`amr_regrid_int > 0`) nests deeper (see @ref amr_multilevel) |
+| `amr_cluster_eff` | Real | Berger-Rigoutsos min tag efficiency a clustered block box reaches before splitting stops; must satisfy 0 < eff <= 1 (default 0.7) |
+| `amr_blocking_factor` | Integer | Minimum block-box extent in coarse cells the Berger-Rigoutsos bisection may produce; raises the floor of 2 so clustering stops over-generating boxes that the min-separation merge then discards; must be >= 1 (default 4; 1 disables the minimum, which lets the bisection run to the block cap) |
+| `amr_ref_ratio` | Integer | AMR refinement ratio between coarse and fine levels; must be 2 or 4 (default 2). Only amr_ref_ratio = 2 is supported with multi-level AMR or subcycling (v1). |
+| `l0_ntile` | Integer | L0-as-blocks spike: tiles per dimension per rank the base grid is split into (0 = off, monolithic base grid; experimental) |
+| `l0_migrate_step` | Integer | L0-as-blocks spike: time step at which a forced test migration moves the last tile to rank 0 (0 = off; experimental) |
+| `l0_rebalance_interval` | Integer | L0-as-blocks spike: steps between measured-cost rebalance events that migrate tiles to level load (0 = off; experimental) |
+| `partition_tile_size` | Integer | Tile side for the SFC partitioner (default 8) |
| `alpha_rho_wrt(i)` | Logical | Add the partial density of the fluid $i$ to the database \|
| `rho_wrt` | Logical | Add the mixture density to the database |
| `mom_wrt(i)` | Logical | Add the $i$-direction momentum to the database |
@@ -799,6 +822,199 @@ This is useful for large domains where only a portion of the domain is of intere
It is not supported when `precision = 1` and `format = 1`.
It also cannot be enabled with `flux_wrt`, `heat_ratio_wrt`, `pres_inf_wrt`, `c_wrt`, `omega_wrt`, `ib`, `schlieren_wrt`, `qm_wrt`, or 'liutex_wrt'.
+### 7.1. Adaptive Mesh Refinement (AMR) {#sec-amr}
+
+MFC supports block-structured AMR (Experimental) via up to `amr_max_blocks` 2:1 refined level-1 blocks
+that coexists with the base-level solve.
+The fine block is initialized from the base grid by piecewise-linear interpolation and
+remains continuously coupled to the base solve through conservative ghost-cell exchange
+and flux refluxing at the coarse–fine interface.
+
+**Restrictions.**
+AMR requires WENO reconstruction (`recon_type = 1`, any order), SSP-RK3 time-stepping
+(`time_stepper = 3`), and the 5- or 6-equation model (`model_eqns = 2` or `3`; for 6-eq the per-stage pressure relaxation also runs on each fine block).
+Multiple fluids (`num_fluids > 1`) are supported and additionally require `mpp_lim`,
+whose volume-fraction clamp+renormalize maintains coarse/fine alpha consistency; the
+per-fluid masses are refluxed exactly, and volume fractions are prolonged with a
+sum-preserving closure (fine-level volume fractions sum to one by construction).
+Physical viscosity (`viscous = T`) is supported: the viscous stress/work travels through
+the momentum- and energy-equation source fluxes, which are captured into the same
+coarse–fine flux registers as the advective fluxes, so the interface is refluxed against
+the matched *total* (advective + viscous) flux and energy — including viscous work — is
+conserved. Fine-ghost velocity gradients at the coarse–fine boundary are taken from the
+conservative-linear prolongation of the coarse state (no special gradient reconstruction);
+that interface inconsistency is bounded and conservation is enforced by the flux-register
+matching. The density-gradient regrid tagger does not sense shear or boundary layers well,
+so viscous features may need a static or generously buffered block (error-estimator taggers
+are future work).
+Euler-Euler bubbles (`bubbles_euler = T`) are supported, including non-polytropic
+(`polytropic = F`) and polydisperse (`nb > 1`) configurations: the bubble moments — radius,
+velocity, and, for non-polytropic, partial pressure and vapor mass, per R0 bin — are all
+flux-based conserved variables refluxed through the same registers, so no separate side-state
+is carried on the fine level. Prolongation floors every positive moment (radius, and the
+non-polytropic partial-pressure / vapor-mass moments) while leaving the signed velocity moment
+free, so the reconstructed radius, number density, internal pressure, and vapor mass stay
+non-negative (realizability). QBMM (`qbmm = T`) is supported for the polytropic model: each R0
+bin's bivariate six-moment set lives entirely in the conserved variables (the pb/mv quadrature
+arrays are inert stubs when `polytropic = T`), and the whole moment block is prolonged
+piecewise-constant so every fine/ghost cell inherits the coarse cell's realizable moment set
+(the CHyQMOM inversion needs the radius variance c20 = m20/m00 - (m10/m00)^2 to stay positive, which a
+per-component minmod slope could break); the moments still reflux and restrict on the standard
+conservative path. Non-polytropic QBMM (`polytropic = F`) is fully supported: each block carries its own
+per-quadrature-node internal pressure and vapor mass
+(pb/mv), prolonged piecewise-constant for realizability, advanced with the block's own rhs
+scratch, and restricted back with the moments; dynamic regrid and `amr_subcycle` are both supported.
+Phase change (`relax`) is supported: the cell-local, mass/energy-conserving relaxation
+runs on the fine solution before restriction (matching the coarse once-per-step timing).
+Chemistry (`chemistry = T`) is supported for reactions and advection: the species partial
+densities are flux-based conserved variables refluxed through the same registers, the
+cell-local reaction source runs on the fine block through the shared RHS (matching the
+coarse per-stage timing), and prolongation rescales the species so their sum equals the
+continuity density (`sum(Y_k) = 1`, `Y_k >= 0` on the fine level by construction). Chemistry
+AMR runs single- and multi-rank: the fine block's cons->prim conversion widens over the ghost
+shell, so the temperature (the reacting-EOS Newton guess) is halo-exchanged with the coarse
+state at rank seams (mirroring the diffusion path) — without it the seam-ghost guess is
+uninitialized and the conversion diverges to NaN. Species mass diffusion (`chem_params%%diffusion
+= T`) is also supported: the mixture-averaged species mass fluxes (and the thermal-conduction +
+enthalpy energy flux) travel through the source-flux array and are captured into the same coarse–fine
+registers as the advective fluxes — like the viscous stress fluxes — so element mass and total
+energy conserve across the block boundary through refluxed, subcycled, and regridded advances.
+Static immersed boundaries (`ib = T`) are supported: each fine block carries its own
+fine-grid IB state (markers, ghost points, levelset, image points, interpolation coefficients)
+computed from the body geometry at fine resolution once at initialization, and the fine
+advance applies the ghost-cell IB state correction on the block after each RK update (mirroring
+the coarse per-stage timing). A fixed body placed inside a static block is thus resolved on the
+refined level. The IB forcing is non-conservative by construction (the ghost-cell method injects
+mass/momentum/energy at the body), so the conservation defect is nonzero in the body region while
+the flux reflux still conserves to machine precision away from it. A body in prescribed motion
+(`moving_ibm = 1`) is also supported: the fine block's IB markers/ghost points are rebuilt each fine
+RK substage at the body's sub-time position (the same linear time interpolation the subcycle applies
+to the fluid ghosts), so the refined body tracks its prescribed trajectory. Supports one or more
+non-STL bodies, static or in prescribed motion; with dynamic regrid every candidate box expands
+to fully contain each body at its live position plus a margin, the fine IB state is rebuilt from
+geometry after each regrid, and a per-substage guard aborts if a moving body reaches its block
+boundary between regrids (reduce `amr_regrid_int` or increase `amr_buf`). Force-driven motion
+(`moving_ibm = 2`) and STL geometry are gated pending validation. Under MPI a body contained within one rank's
+subdomain is bit-exact across decompositions; a body spanning a rank seam is rejected at startup
+(the fine-IB image-point stencil across the seam is not yet decomposition-exact), so keep the body
+inside a single rank's subdomain (use fewer ranks or reposition it).
+Lagrangian bubbles are supported with the cloud excluded from fine blocks: two-way coupling
+lives on the coarse grid, regrid suppresses tags and clips boxes around the cloud's padded
+bounding box, EL volume fractions prolong without the sum-to-one closure (their sum is the
+local liquid fraction, not 1), and a per-stage guard aborts if the cloud reaches an active
+block (reduce `amr_regrid_int` or increase `amr_buf`).
+The IGR solver is supported with restriction-only coarse/fine coupling: the fine block runs
+its own fixed-iteration sigma solve seeded and Dirichlet-bounded by the converged coarse
+sigma; seam conservation is truncation-order (no reflux capture from the fused IGR flux
+kernels), free-stream preservation is exact, and `amr_subcycle` is gated under IGR.
+AMR is incompatible with surface tension, 3D cylindrical
+coordinates (2D axisymmetric IS supported), 2D/3D MHD (measured: the coarse/fine seam is a
+continuous div(B) source that GLM cleaning cannot remove; 1D MHD/RMHD IS supported since
+div(B) = 0 by construction there), and Riemann-extrapolation
+boundaries (bc = -4). `active_box` is supported (single-rank): blocks must sit strictly inside the growing active window (init abort + regrid clamp), and the fine advance treats its whole block as active.Nonuniform grids ARE supported (grid stretching and the axisymmetric axis half-cell): the fine
+ghost-shell coordinates extend by exact parent-cell bisection and the spacing-dependent WENO
+coefficients are recomputed for the active grid on every block swap/restore, armed automatically
+when the grid is detected nonuniform at startup.
+Acoustic sources are supported on the coarse grid only: the support must not overlap the initial
+block (startup abort) and dynamic regrid keeps its boxes clear of the support.
+Multi-rank runs are supported: each block has a single owner rank, assigned by
+Morton-ordered work balancing at every regrid (with state migration), and the
+coarse-side coupling moves through point-to-point coarse↔fine gather/scatter — so the
+block may span rank boundaries and move freely across them under dynamic regrid.
+The block may cover at most about half of the global extent per dimension (the fine
+advance reuses the rank-local solver scratch); wider features tile into adjacent blocks.
+
+**AMR + surface tension (unsupported).**
+Surface tension (`surface_tension = T`) is prohibited under AMR. *What works:* the capillary
+contribution is a face flux captured into the same coarse–fine registers as the advective
+flux, so it is refluxed conservatively — conservation is structural (mass and energy defects
+stay at machine precision regardless of the fine-side treatment). *What fails:* the capillary
+stress is normalized (∝ 1/|∇c|), so it depends on the interface-normal *direction*, not the
+gradient magnitude. Across a 2:1 coarse/fine boundary the conservative-linearly-prolonged fine
+ghost color cannot reproduce the coarse solver's interface normal, producing a growing spurious
+seam current. Every fine-block fix attempted failed: opening the capillary reflux gate alone
+(~540x baseline seam velocity, exponential), a smoothstep ramp suppressing the fine capillary
+force near the seam (~27x, bounded-linear, width-invariant), and a coarse-spacing gradient blend
+of the prolonged color (~556x, growing) — all leave a force imbalance from the inconsistent
+interface normal rather than a curvature spike that can be damped. *What might fix it:* capturing
+the native coarse-computed capillary force Ω in a per-block band during the coarse RHS, prolonging
+it to the fine boundary layer, and blending the force there — large and uncertain, and the
+diffuse-interface 2:1 normal inconsistency may be fundamental.
+
+**Static vs. dynamic block.**
+Setting `amr_regrid_int = 0` fixes the block at the initial `amr_block_beg`/`amr_block_end`
+position for the entire run (useful for convergence studies or GPU correctness testing).
+Setting `amr_regrid_int > 0` triggers dynamic regrid every that many coarse steps:
+cells whose normalized density gradient exceeds `amr_tag_eps` are tagged, then clustered
+by a Berger–Rigoutsos recursive bisection into a list of separated block boxes (each grown
+by `amr_buf` coarse cells of buffer padding). Boxes whose padded extents would come within a
+ghost-cell buffer width of each other are merged, so separated features get their own refined
+box while nearby ones stay a single box (guaranteeing no fine–fine adjacency). Splitting stops once a
+box's tag efficiency (tagged/total cells) reaches `amr_cluster_eff`; the number of blocks
+is capped at `amr_max_blocks`.
+A positive `amr_tag_eps` and `amr_buf >= 1` are required whenever regridding is active.
+
+**Subcycling.**
+`amr_subcycle = T` enables Berger–Colella dt/2 subcycling: the coarse level advances
+one full step at the case `dt`, while the fine level takes two half-steps at `dt/2` with
+time-interpolated ghost values at the intermediate stage.
+Accumulated fine-level fluxes are applied back to the coarse level (reflux correction)
+after each coarse step.
+`amr_subcycle` is incompatible with `cfl_dt` (variable time step) and requires `amr = T`.
+
+**Block slots.**
+`amr_max_blocks` (default 4) sets the number of fixed refined-block slots preallocated
+for the run. Each slot is sized to the maximum block extent, so `N` slots require roughly
+`N` times the device memory of a single block; the goal is the compute win of refining
+separated features independently, and memory efficiency (compact per-block pools) is a
+follow-up. Dynamic regrid clusters the tagged cells into up to `amr_max_blocks` separated
+boxes (`amr_cluster_eff` sets the min tag efficiency each box reaches before splitting stops).
+
+**Multi-level nesting.**
+`amr_max_level` (default 1) sets the maximum refinement depth. With `amr_max_level > 1`,
+blocks nest recursively: a level-`l` block refines a region of its parent level-(`l-1`)
+block by a further `amr_ref_ratio`, so refinement tracks a moving feature to arbitrary depth.
+Multi-level nesting requires `amr_ref_ratio = 2` (the default) and `amr_max_blocks >= 2`; static
+AMR (`amr_regrid_int = 0`) nests up to level 2, dynamic regrid (`amr_regrid_int > 0`) nests
+deeper. See @ref amr_multilevel for the nesting and reflux details.
+
+**Restart.**
+Each save step writes a fine-level AMR restart file alongside the level-0 restart data
+(whose format is unchanged): the current — possibly regridded — block box and the fine
+solution, per rank (an `amr_fine.dat` in each rank's step directory, or a single shared
+`amr_*.dat` next to the level-0 MPI-IO restart file when `parallel_io` is on).
+Restarting (`t_step_start > 0`) restores the saved box and fine state seamlessly; with
+`parallel_io` the fine blocks are repartitioned across any rank count, while the serial
+(per-rank-file) path requires the same rank count as the run that wrote the file. Both
+paths require the same physics configuration — the number of conserved variables, which
+depends on `num_fluids`, `model_eqns`, and the enabled bubble/chemistry models — and
+abort with a clear message otherwise.
+On restart the AMR block geometry (block count and boxes) is read from the AMR restart
+file, not from the `amr_block_beg`/`amr_block_end` case parameters — so editing those
+parameters for a restart run has no effect. To re-derive the blocks from parameters,
+start fresh (`t_step_start = 0`).
+If the AMR file is absent (e.g., data from an older run), the run proceeds with a
+warning and re-initializes the fine level by prolongation from the coarse restart data,
+losing the accumulated fine-level accuracy.
+Note that level-0 output already contains the restricted (coarse-resolution) fine
+solution over the block, so existing visualization works unchanged; fine-resolution
+visualization output is future work.
+
+| Parameter | Type | Description |
+| ---: | :----: | :--- |
+| `amr` | Logical | Enable AMR (see prose above for requirements and restrictions) |
+| `amr_block_beg(i)` | Integer | Initial refined-block start cell index in direction $i$ (level-0 index space) |
+| `amr_block_end(i)` | Integer | Initial refined-block end cell index in direction \f$i\f$ (level-0 index space); must satisfy \f$2\,(e_i - b_i + 1) - 1 \le N_i\f$ |
+| `amr_regrid_int` | Integer | Coarse steps between regrid events (0 = static block) |
+| `amr_tag_eps` | Real | Normalized density-gradient threshold for refinement tagging; must be > 0 when `amr_regrid_int > 0` (default 0.1) |
+| `amr_buf` | Integer | Coarse-cell padding around tagged cells; must be >= 1 when `amr_regrid_int > 0` (default 3) |
+| `amr_subcycle` | Logical | Advance fine level at dt/2 (two substeps per coarse step) with Berger–Colella refluxing |
+| `amr_max_blocks` | Integer | Number of fixed refined-block slots preallocated (each max-block sized; ~N x device memory); must be >= 1 (default 4) |
+| `amr_max_grid_size` | Integer | Absolute cap on a refined block's coarse-cell extent per dimension, the AMReX max_grid_size concept; must be >= 2 when set (default 0). With 0 the cap is derived from the decomposition and so shrinks as ranks are added, which tiles a fixed feature into more blocks the further you scale and makes the box set depend on the rank count. Setting it pins the cap, so the box set is identical at every rank count. The value may exceed half a rank subdomain: the solver scratch is then sized to the cap rather than to the subdomain, so per-rank memory grows as the cap raised to the number of dimensions |
+| `amr_max_level` | Integer | Maximum AMR refinement depth (number of refined levels above L0); must be >= 1 (default 1). Multi-level nesting (>= 2) is supported: static AMR (`amr_regrid_int = 0`) nests up to level 2, dynamic regrid (`amr_regrid_int > 0`) nests deeper (see @ref amr_multilevel) |
+| `amr_cluster_eff` | Real | Berger-Rigoutsos min tag efficiency a clustered block box reaches before splitting stops; must satisfy 0 < eff <= 1 (default 0.7) |
+| `amr_blocking_factor` | Integer | Minimum block-box extent in coarse cells the Berger-Rigoutsos bisection may produce; raises the floor of 2 so clustering stops over-generating boxes that the min-separation merge then discards; must be >= 1 (default 4; 1 disables the minimum, which lets the bisection run to the block cap) |
+
### 8. Acoustic Source {#sec-acoustic-source}
| Parameter | Type | Description |
diff --git a/docs/documentation/readme.md b/docs/documentation/readme.md
index cbbcf5cfec..349726264a 100644
--- a/docs/documentation/readme.md
+++ b/docs/documentation/readme.md
@@ -26,6 +26,7 @@ Welcome to the Multi-component Flow Code (MFC) documentation.
- @ref architecture "Code Architecture" - How the source code is organized, data flow, and module map
- @ref expectedPerformance "Performance" - Optimization and benchmarks
+- @ref amr "Adaptive Mesh Refinement" - Block-structured AMR: algorithm, physics support, and parameters
- @ref gpuParallelization "GPU Parallelization" - GPU macro API (developer reference)
- @ref docker "Containers" - Docker usage
- @ref troubleshooting "Troubleshooting" - Debugging and common issues
diff --git a/docs/module_categories.json b/docs/module_categories.json
index 23a703fa26..2d4eab0cdd 100644
--- a/docs/module_categories.json
+++ b/docs/module_categories.json
@@ -1,103 +1,115 @@
[
- {
- "category": "Solver Core",
- "modules": [
- "m_rhs",
- "m_time_steppers",
- "m_weno",
- "m_riemann_solvers",
- "m_riemann_state",
- "m_riemann_solver_hlld",
- "m_riemann_solver_hll",
- "m_riemann_solver_lf",
- "m_riemann_solver_hllc",
- "m_riemann_solver_hypo_hlld",
- "m_muscl",
- "m_variables_conversion",
- "m_thinc"
- ]
- },
- {
- "category": "Physics Models",
- "modules": [
- "m_viscous",
- "m_hb_function",
- "m_surface_tension",
- "m_reactive_burn",
- "m_bubbles",
- "m_bubbles_EE",
- "m_bubbles_EL",
- "m_bubbles_EL_kernels",
- "m_qbmm",
- "m_hypoelastic",
- "m_phase_change",
- "m_chemistry",
- "m_acoustic_src",
- "m_body_forces",
- "m_pressure_relaxation",
- "m_collisions"
- ]
- },
- {
- "category": "Boundary Conditions",
- "modules": [
- "m_cbc",
- "m_compute_cbc",
- "m_boundary_common",
- "m_boundary_primitives",
- "m_boundary_io",
- "m_ibm",
- "m_particle_cloud",
- "m_igr",
- "m_ib_patches",
- "m_compute_levelset"
- ]
- },
- {
- "category": "I/O and Startup",
- "modules": [
- "m_start_up",
- "m_data_output",
- "m_data_input",
- "m_delay_file_access"
- ]
- },
- {
- "category": "Infrastructure",
- "modules": [
- "m_derived_types",
- "m_global_parameters",
- "m_global_parameters_common",
- "m_mpi_common",
- "m_mpi_proxy",
- "m_constants",
- "m_precision_select",
- "m_helper",
- "m_helper_basic",
- "m_compile_specific",
- "m_fftw",
- "m_nvtx",
- "m_model",
- "m_finite_differences",
- "m_checker",
- "m_checker_common",
- "m_sim_helpers",
- "m_derived_variables",
- "m_patch_geometries"
- ]
- },
- {
- "category": "Pre-Process",
- "modules": [
- "m_grid",
- "m_icpp_patches",
- "m_initial_condition",
- "m_assign_variables",
- "m_check_patches",
- "m_check_ib_patches",
- "m_perturbation",
- "m_simplex_noise",
- "m_boundary_conditions"
- ]
- }
+ {
+ "category": "Solver Core",
+ "modules": [
+ "m_rhs",
+ "m_time_steppers",
+ "m_weno",
+ "m_riemann_solvers",
+ "m_riemann_state",
+ "m_riemann_solver_hlld",
+ "m_riemann_solver_hll",
+ "m_riemann_solver_lf",
+ "m_riemann_solver_hllc",
+ "m_riemann_solver_hypo_hlld",
+ "m_muscl",
+ "m_variables_conversion",
+ "m_thinc",
+ "m_active_box"
+ ]
+ },
+ {
+ "category": "Physics Models",
+ "modules": [
+ "m_viscous",
+ "m_hb_function",
+ "m_surface_tension",
+ "m_reactive_burn",
+ "m_bubbles",
+ "m_bubbles_EE",
+ "m_bubbles_EL",
+ "m_bubbles_EL_kernels",
+ "m_qbmm",
+ "m_hypoelastic",
+ "m_phase_change",
+ "m_chemistry",
+ "m_acoustic_src",
+ "m_body_forces",
+ "m_pressure_relaxation",
+ "m_collisions"
+ ]
+ },
+ {
+ "category": "Boundary Conditions",
+ "modules": [
+ "m_cbc",
+ "m_compute_cbc",
+ "m_boundary_common",
+ "m_boundary_primitives",
+ "m_boundary_io",
+ "m_ibm",
+ "m_particle_cloud",
+ "m_igr",
+ "m_ib_patches",
+ "m_compute_levelset"
+ ]
+ },
+ {
+ "category": "I/O and Startup",
+ "modules": [
+ "m_start_up",
+ "m_data_output",
+ "m_data_input",
+ "m_delay_file_access",
+ "m_load_weight",
+ "m_load_balance",
+ "m_sfc_partition",
+ "m_rank_timing"
+ ]
+ },
+ {
+ "category": "Infrastructure",
+ "modules": [
+ "m_derived_types",
+ "m_global_parameters",
+ "m_global_parameters_common",
+ "m_mpi_common",
+ "m_mpi_proxy",
+ "m_constants",
+ "m_precision_select",
+ "m_helper",
+ "m_helper_basic",
+ "m_compile_specific",
+ "m_fftw",
+ "m_nvtx",
+ "m_model",
+ "m_finite_differences",
+ "m_checker",
+ "m_checker_common",
+ "m_sim_helpers",
+ "m_derived_variables",
+ "m_patch_geometries",
+ "m_box",
+ "m_amr",
+ "m_amr_regrid",
+ "m_amr_restart",
+ "m_amr_registers",
+ "m_amr_xchg_audit",
+ "m_phase_timing"
+ ]
+ },
+ {
+ "category": "Pre-Process",
+ "modules": [
+ "m_grid",
+ "m_icpp_patches",
+ "m_initial_condition",
+ "m_assign_variables",
+ "m_check_patches",
+ "m_check_ib_patches",
+ "m_perturbation",
+ "m_simplex_noise",
+ "m_boundary_conditions"
+ ]
+ }
]
diff --git a/examples/2D_amr_droplet/case.py b/examples/2D_amr_droplet/case.py
new file mode 100644
index 0000000000..23f9486c6c
--- /dev/null
+++ b/examples/2D_amr_droplet/case.py
@@ -0,0 +1,111 @@
+#!/usr/bin/env python3
+# 2D advected density droplet with block-structured AMR (see docs/documentation/amr.md).
+#
+# A dense circular droplet in pressure equilibrium is carried across the domain by a
+# uniform flow. Its sharp interface is the only feature worth resolving, so a 2:1 refined
+# block tracks the moving droplet by dynamic regridding (amr_regrid_int > 0), subcycled at
+# dt/2 (amr_subcycle), while the smooth surroundings stay coarse. This is the intended
+# use of AMR: a compact, interior feature refined locally at bounded cost. The four
+# required AMR settings are grouped at the bottom; delete that block for a uniform run.
+import json
+
+N = 128
+dx = 1.0 / N
+u = 0.8 # uniform advection velocity (+x)
+
+# Coarse-grid CFL step: max wave speed ~ u + sqrt(1.4 * 1 / 0.125) ~ 0.8 + 3.7. The fine
+# block subcycles at dt/2, so this coarse dt already satisfies the finest-cell CFL.
+dt = 0.1 * dx / 4.5
+
+# Initial refined block over the droplet, in level-0 cell indices (0-based, inclusive).
+# It sits well inside the domain (a block must stay >= buff_size cells from every
+# boundary) and spans at most half the grid per dimension.
+bx0, bx1 = int(0.20 * N), int(0.44 * N)
+by0, by1 = int(0.38 * N), int(0.62 * N)
+
+print(
+ json.dumps(
+ {
+ # Logistics
+ "run_time_info": "T",
+ # Computational domain
+ "x_domain%beg": 0.0,
+ "x_domain%end": 1.0,
+ "y_domain%beg": 0.0,
+ "y_domain%end": 1.0,
+ "m": N - 1,
+ "n": N - 1,
+ "p": 0,
+ "dt": dt,
+ "t_step_start": 0,
+ "t_step_stop": 600,
+ "t_step_save": 30,
+ # Simulation algorithm
+ "num_patches": 2,
+ "model_eqns": 2,
+ "num_fluids": 1,
+ "mpp_lim": "F",
+ "mixture_err": "F",
+ "time_stepper": 3,
+ "weno_order": 5,
+ "weno_eps": 1.0e-16,
+ "mapped_weno": "F",
+ "null_weights": "F",
+ "mp_weno": "F",
+ "riemann_solver": 2,
+ "wave_speeds": 1,
+ "avg_state": 2,
+ "bc_x%beg": -1,
+ "bc_x%end": -1,
+ "bc_y%beg": -1,
+ "bc_y%end": -1,
+ # Output
+ "format": 1,
+ "precision": 2,
+ "prim_vars_wrt": "T",
+ "parallel_io": "T",
+ # Patch 1: ambient gas in uniform +x flow
+ "patch_icpp(1)%geometry": 3,
+ "patch_icpp(1)%x_centroid": 0.5,
+ "patch_icpp(1)%y_centroid": 0.5,
+ "patch_icpp(1)%length_x": 1.0,
+ "patch_icpp(1)%length_y": 1.0,
+ "patch_icpp(1)%vel(1)": u,
+ "patch_icpp(1)%vel(2)": 0.0,
+ "patch_icpp(1)%alpha_rho(1)": 0.125,
+ "patch_icpp(1)%pres": 1.0,
+ "patch_icpp(1)%alpha(1)": 1.0,
+ # Patch 2: dense droplet (same pressure and velocity - a passive contact)
+ "patch_icpp(2)%geometry": 2,
+ "patch_icpp(2)%x_centroid": 0.3,
+ "patch_icpp(2)%y_centroid": 0.5,
+ "patch_icpp(2)%radius": 0.12,
+ "patch_icpp(2)%alter_patch(1)": "T",
+ "patch_icpp(2)%vel(1)": u,
+ "patch_icpp(2)%vel(2)": 0.0,
+ "patch_icpp(2)%alpha_rho(1)": 1.0,
+ "patch_icpp(2)%pres": 1.0,
+ "patch_icpp(2)%alpha(1)": 1.0,
+ # Fluid (ideal gas, gamma = 1.4)
+ "fluid_pp(1)%gamma": 1.0 / (1.4 - 1.0),
+ "fluid_pp(1)%pi_inf": 0.0,
+ # --- AMR: the four required settings ---
+ # amr + an initial block are mandatory; amr_regrid_int > 0 turns on dynamic
+ # regridding (density-gradient tagging), amr_subcycle advances the fine block at
+ # dt/2. Delete this block for a uniform-grid run.
+ "amr": "T",
+ "amr_block_beg(1)": bx0,
+ "amr_block_end(1)": bx1,
+ "amr_block_beg(2)": by0,
+ "amr_block_end(2)": by1,
+ "amr_regrid_int": 10,
+ "amr_tag_eps": 0.1,
+ "amr_buf": 4,
+ "amr_max_blocks": 16,
+ # A closed interface tags a thin ring; a looser clustering efficiency lets the
+ # Berger-Rigoutsos clusterer cover it with a few boxes instead of many small tiles.
+ "amr_cluster_eff": 0.35,
+ "amr_subcycle": "T",
+ }
+ )
+)
diff --git a/src/common/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp
index aec33edb35..4a4aac2ce2 100644
--- a/src/common/include/2dHardcodedIC.fpp
+++ b/src/common/include/2dHardcodedIC.fpp
@@ -21,6 +21,10 @@
real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
real(wp) :: bottom_blend_u, bottom_blend_T
+ ! # 299 - scattered blobs for AMR load-balance benchmarking
+ real(wp) :: blob_cx, blob_cy, blob_r, blob_amp, blob_seed, blob_d2
+ integer :: blob_n, blob_i
+
! # 207
real(wp) :: sigma, gauss1, gauss2
@@ -536,6 +540,35 @@
q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (E_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
end if
+ case (299) ! AMR load-balance benchmark: blob_n blobs scattered over the whole domain
+ ! Exists so one build yields an unlimited family of refinement topologies. An ANALYTIC patch would bake each expression
+ ! into case.fpp and cost a rebuild per variation; the knobs below are read at run time, so box count and placement can be
+ ! swept freely. Purpose is to stress the BALANCER: scattered features give many disjoint tag clusters, hence many boxes
+ ! per level, which is the regime where an owner mapping can actually differ from another.
+ !
+ ! a(2) = blob count, a(3) = seed, a(4) = blob radius (domain fraction), a(5) = density/pressure amplitude.
+ !
+ ! Centres come from an additive-irrational (Weyl) sequence, NOT random_number. Each rank fills only its own cells, so the
+ ! IC must be a pure function of position or ranks disagree across the seam and the decomposition stops being exact. The
+ ! golden-ratio increments give a low-discrepancy spread with no integer overflow and no RNG state.
+ blob_n = max(int(patch_icpp(patch_id)%a(2)), 1)
+ blob_seed = patch_icpp(patch_id)%a(3)
+ blob_r = patch_icpp(patch_id)%a(4)
+ blob_amp = patch_icpp(patch_id)%a(5)
+ if (blob_r <= 0._wp) blob_r = 0.02_wp
+ if (blob_amp <= 0._wp) blob_amp = 4._wp
+ do blob_i = 1, blob_n
+ blob_cx = mod(0.5_wp + real(blob_i, wp)*0.6180339887498949_wp + blob_seed*0.7548776662466927_wp, 1._wp)
+ blob_cy = mod(0.5_wp + real(blob_i, wp)*0.3819660112501051_wp + blob_seed*0.5698402909980532_wp, 1._wp)
+ blob_cx = x_domain%beg + blob_cx*(x_domain%end - x_domain%beg)
+ blob_cy = y_domain%beg + blob_cy*(y_domain%end - y_domain%beg)
+ blob_d2 = (x_cc(i) - blob_cx)**2 + (y_cc(j) - blob_cy)**2
+ if (blob_d2 <= blob_r*blob_r) then
+ q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = blob_amp
+ q_prim_vf(eqn_idx%E)%sf(i, j, 0) = blob_amp
+ exit ! overlapping blobs must not compound - first hit wins, keeping the field bounded
+ end if
+ end do
case (291) ! Isothermal Flat Plate
T_inf = 1125.0_wp
T_wall = 600.0_wp
diff --git a/src/common/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp
index fd8101e944..1b62ad7cc1 100644
--- a/src/common/include/3dHardcodedIC.fpp
+++ b/src/common/include/3dHardcodedIC.fpp
@@ -258,6 +258,12 @@
& j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
+ case (306) ! Smooth density blob on a uniform background (the AMR S0/matched benchmark IC)
+ ! VERBATIM the codegen output for the analytic form "1 + 4*exp(-(cos(pi*x)**2 + cos(pi*y)**2 + cos(pi*z)**2)/0.15)"
+ ! (same literals, same parenthesization) so the field is bit-identical to the analytic-IC path while the case dict
+ ! stays codegen-free - benchmark cases stop rewriting case.fpp and forcing a rebuild on every case switch
+ q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
+ & k) = 1 + 4*exp((-(cos(pi*x_cc(i))**2 + cos(pi*y_cc(j))**2 + cos(pi*z_cc(k))**2))/0.15)
case (370) ! 3D extrusion of 2D profile from external data
! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
@: HardcodedReadValues()
diff --git a/src/common/include/macros.fpp b/src/common/include/macros.fpp
index a221fcf8c5..5f2a12a079 100644
--- a/src/common/include/macros.fpp
+++ b/src/common/include/macros.fpp
@@ -121,6 +121,26 @@
#endif
#:enddef
+! Cray-specific GPU pointer teardown for scalar fields - exact inverse of ACC_SETUP_SFs. Removes the
+! present-table entries ACC_SETUP_SFs added (the scalar_field descriptor and its %sf copyin). REQUIRED when
+! an ACC_SETUP'd field is freed MID-RUN (e.g. AMR slot free on regrid/restart): Cray 'exit data delete'
+! decrements the reference counter, so the lone @:DEALLOCATE(arg%sf) only undoes the @:ALLOCATE create ref
+! and leaves the descriptor + the ACC_SETUP %sf copyin dangling. Call BEFORE @:DEALLOCATE(arg%sf).
+#:def ACC_TEARDOWN_SFs(*args)
+#ifdef _CRAYFTN
+ block
+ @:LOG({'@:ACC_TEARDOWN_SFs(${', '.join(args)}$)'})
+
+ #:for arg in args
+ if (associated(${arg}$%sf)) then
+ $:GPU_EXIT_DATA(delete=('[' + arg + '%sf]'))
+ end if
+ $:GPU_EXIT_DATA(delete=('[' + arg + ']'))
+ #:endfor
+ end block
+#endif
+#:enddef
+
! Cray-specific GPU pointer setup for acoustic source spatials
#:def ACC_SETUP_source_spatials(*args)
#ifdef _CRAYFTN
diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp
index 2f86c027e1..faf07ef21c 100644
--- a/src/common/m_boundary_common.fpp
+++ b/src/common/m_boundary_common.fpp
@@ -96,6 +96,8 @@ contains
type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
type(scalar_field), optional, intent(inout) :: q_T_sf
+ if (amr_in_fine_advance) return ! AMR fine block: ghosts pre-filled from the coarse level
+
call s_populate_bc_direction(1, -1, bc_x, bc_type(1, 1), q_prim_vf, pb_in, mv_in, q_T_sf)
call s_populate_bc_direction(1, 1, bc_x, bc_type(1, 2), q_prim_vf, pb_in, mv_in, q_T_sf)
diff --git a/src/common/m_box.fpp b/src/common/m_box.fpp
new file mode 100644
index 0000000000..746030cf32
--- /dev/null
+++ b/src/common/m_box.fpp
@@ -0,0 +1,109 @@
+!>
+!!@file
+!!@brief Contains module m_box
+
+#:include 'macros.fpp'
+
+!> @brief Owned domain-decomposition Box abstraction and partition arithmetic (v1: one box per rank).
+module m_box
+
+ use m_derived_types, only: t_box
+ use m_global_parameters, only: wp
+
+ implicit none
+
+ private
+ public :: t_box, f_equal_splits, f_weighted_splits, f_box_from_splits, f_morton
+
+contains
+
+ !> Cumulative equal-cell offsets for g cells over n_parts ranks: off(r) = r*(g/n_parts) + min(r, mod(g,n_parts)). Exactly
+ !! reproduces MFC's block distribution (remainder to the first ranks). Pure integer path.
+ pure function f_equal_splits(g, n_parts) result(off)
+
+ integer, intent(in) :: g, n_parts
+ integer, dimension(0:n_parts) :: off
+ integer :: q, rem, r
+
+ q = g/n_parts
+ rem = mod(g, n_parts)
+ do r = 0, n_parts
+ off(r) = r*q + min(r, rem)
+ end do
+
+ end function f_equal_splits
+
+ !> Cumulative offsets splitting marginal w into n_parts contiguous chunks of near-equal weight, each >= l_min cells. off(0)=0,
+ !! off(n_parts)=size(w). Feasibility (size(w) >= n_parts*l_min) is the caller's responsibility (pure; no abort). A degenerate
+ !! marginal (sum(w) <= 0) falls back to the equal split.
+ pure function f_weighted_splits(w, n_parts, l_min) result(off)
+
+ real(wp), dimension(0:), intent(in) :: w
+ integer, intent(in) :: n_parts, l_min
+ integer, dimension(0:n_parts) :: off
+ real(wp) :: csum, total
+ integer :: g, i, r
+
+ g = size(w)
+ off(0) = 0
+ off(n_parts) = g
+ if (n_parts == 1) return
+ total = sum(w)
+ if (total <= 0._wp) then
+ off = f_equal_splits(g, n_parts)
+ return
+ end if
+ r = 1
+ csum = 0._wp
+ do i = 0, g - 1
+ csum = csum + w(i)
+ do while (r < n_parts .and. csum >= real(r, wp)*total/real(n_parts, wp))
+ off(r) = i + 1
+ r = r + 1
+ end do
+ end do
+ do while (r < n_parts)
+ off(r) = g; r = r + 1
+ end do
+ ! Enforce the l_min floor: gap push first (off(0)=0 makes it imply off(r) >= r*l_min inductively), then the upper
+ ! clamp - which cannot re-break the gap, since off(r-1) <= g - (n_parts-r+1)*l_min after its own pass.
+ do r = 1, n_parts - 1
+ if (off(r) < off(r - 1) + l_min) off(r) = off(r - 1) + l_min
+ if (off(r) > g - (n_parts - r)*l_min) off(r) = g - (n_parts - r)*l_min
+ end do
+
+ end function f_weighted_splits
+
+ !> Assemble this rank's box from per-axis cumulative offsets and the rank's 0-based Cartesian coords: lo(d) = off_d(coords(d));
+ !! hi(d) = off_d(coords(d)+1) - 1. Works for collapsed axes (off_d = [0,1] -> lo=hi=0).
+ pure function f_box_from_splits(off_x, off_y, off_z, coords) result(box)
+
+ integer, dimension(0:), intent(in) :: off_x, off_y, off_z
+ integer, intent(in) :: coords(3)
+ type(t_box) :: box
+
+ box%lo(1) = off_x(coords(1)); box%hi(1) = off_x(coords(1) + 1) - 1
+ box%lo(2) = off_y(coords(2)); box%hi(2) = off_y(coords(2) + 1) - 1
+ box%lo(3) = off_z(coords(3)); box%hi(3) = off_z(coords(3) + 1) - 1
+
+ end function f_box_from_splits
+
+ !> 3D Morton (Z-order) key interleaving the bits of (ix, iy, iz); collapsed dims contribute 0. 21 bits/dim (fits a 64-bit key
+ !! for grids up to 2^21 cells/dim). Shared by the AMR block partition (m_amr) and the SFC-partition diagnostic
+ !! (m_sfc_partition); negative coords clamp to 0.
+ pure integer(kind=8) function f_morton(ix, iy, iz) result(key)
+ integer, intent(in) :: ix, iy, iz
+ integer :: b
+ integer(kind=8) :: xx, yy, zz
+
+ xx = int(max(ix, 0), 8); yy = int(max(iy, 0), 8); zz = int(max(iz, 0), 8)
+ key = 0_8
+ do b = 0, 20
+ key = ior(key, ishft(iand(ishft(xx, -b), 1_8), 3*b))
+ key = ior(key, ishft(iand(ishft(yy, -b), 1_8), 3*b + 1))
+ key = ior(key, ishft(iand(ishft(zz, -b), 1_8), 3*b + 2))
+ end do
+
+ end function f_morton
+
+end module m_box
diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp
index 0e4e6d49ec..f91b52fed3 100644
--- a/src/common/m_chemistry.fpp
+++ b/src/common/m_chemistry.fpp
@@ -318,13 +318,16 @@ contains
end subroutine s_chemistry_reaction_substep
!> Compute species mass diffusion fluxes at cell interfaces using mixture-averaged diffusivities.
- subroutine s_compute_chemistry_diffusion_flux(idir, q_prim_qp, flux_src_vf, irx, iry, irz, q_T_sf)
+ subroutine s_compute_chemistry_diffusion_flux(idir, q_prim_qp, flux_src_flat, irx, iry, irz, q_T_sf)
- type(scalar_field), dimension(sys_size), intent(in) :: q_prim_qp
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
- type(int_bounds_info), intent(in) :: irx, iry, irz
- integer, intent(in) :: idir
- type(scalar_field), intent(in) :: q_T_sf
+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_qp
+ !> Flat (x, y, z, var) source-flux buffer. m_chemistry lives in src/common, which carries no per-target guards and so cannot
+ !! `use m_riemann_state` -- hence a plain-array dummy rather than reading the module array directly. Still far cheaper per
+ !! launch than the scalar_field dummy it replaces.
+ real(wp), dimension(-1:,-1:,-1:,1:), intent(inout) :: flux_src_flat
+ type(int_bounds_info), intent(in) :: irx, iry, irz
+ integer, intent(in) :: idir
+ type(scalar_field), intent(in) :: q_T_sf
#:if not MFC_CASE_OPTIMIZATION and USING_AMD
real(wp), dimension(10) :: Xs_L, Xs_R, Xs_cell, Ys_L, Ys_R, Ys_cell
@@ -467,12 +470,12 @@ contains
Mass_Diffu_Energy = lambda_Cell*dT_dxi + Mass_Diffu_Energy
! Update flux arrays
- flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy
+ flux_src_flat(x, y, z, eqn_idx%E) = flux_src_flat(x, y, z, eqn_idx%E) - Mass_Diffu_Energy
$:GPU_LOOP(parallelism='[seq]')
do eqn = eqn_idx%species%beg, eqn_idx%species%end
- flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, &
- & z) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1)
+ flux_src_flat(x, y, z, eqn) = flux_src_flat(x, y, z, &
+ & eqn) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1)
end do
end do
end do
@@ -559,12 +562,12 @@ contains
Mass_Diffu_Energy = rho_cell*diffusivity_cell*dh_dxi
! Update flux arrays
- flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy
+ flux_src_flat(x, y, z, eqn_idx%E) = flux_src_flat(x, y, z, eqn_idx%E) - Mass_Diffu_Energy
$:GPU_LOOP(parallelism='[seq]')
do eqn = eqn_idx%species%beg, eqn_idx%species%end
- flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, &
- & z) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1)
+ flux_src_flat(x, y, z, eqn) = flux_src_flat(x, y, z, &
+ & eqn) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1)
end do
end do
end do
diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp
index 8fc53f1ac4..573aa61017 100644
--- a/src/common/m_constants.fpp
+++ b/src/common/m_constants.fpp
@@ -14,6 +14,8 @@ module m_constants
real(wp), parameter :: small_alf = 1.e-11_wp !< Small alf tolerance
real(wp), parameter :: pi = 3.141592653589793_wp !< Pi
real(wp), parameter :: verysmall = 1.e-12_wp !< Very small number
+ !> Residual modulus fraction below which a damaged state's elastic energy is dropped (cont_damage)
+ real(wp), parameter :: damage_energy_cutoff = 1.e-3_wp
!> Radius cutoff to avoid division by zero for 3D spherical harmonic patch (geometry 14)
real(wp), parameter :: small_radius = 1.e-32_wp
integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils
@@ -40,6 +42,22 @@ module m_constants
integer, parameter :: dflt_num_igr_warm_start_iters = 50 !< default number of iterations for IGR elliptic solve
real(wp), parameter :: dflt_alf_factor = 10._wp !< scaling factor for IGR alpha
integer, parameter :: gp_layers = 3 !< Number of ghost point layers for IBM
+ ! Load-weight relative cost coefficients (calibrated against measured RHS-time imbalance; base RHS cell = 1).
+ ! Shared by the m_load_weight diagnostic and the AMR block-owner cost weighting.
+ real(wp), parameter :: K_bub = 50._wp !< per local Lagrangian bubble (stiff adaptive ODE)
+ real(wp), parameter :: K_ib = 2._wp !< per IB ghost/interior cell
+ real(wp), parameter :: K_pc = 3._wp !< per phase-change Newton iteration
+ !> AMR fine-level restart per-block header size, in integers: region box (6) + amr_block_level (1).
+ !> The writer (m_amr:s_write_amr_restart) and BOTH readers (m_amr:s_read_amr_restart and
+ !> m_data_input:s_read_amr_data) must agree on this layout - a mismatch silently misaligns every
+ !> per-block record (see the post-process off-by-one that read the level field as the x-extent).
+ integer, parameter :: amr_restart_blk_hdr_ints = 7
+ !> AMR restart FORMAT v2 per-block ownership record: [owner + 1, m, n, p]. v1 wrote a 3*num_procs extent vector per block, of
+ !! which only the owner's triple was ever nonzero -- O(blocks x ranks) in the FILE and in memory (7.4 GB of header at 75k ranks
+ !! x 8192 blocks). v2 stores the same information in 4 ints. A v2 file is marked by a NEGATIVE rank count in the 3-int global
+ !! header, which a v1 reader rejects with its existing rank-mismatch error rather than misparsing. owner is stored +1 so that
+ !! rank 0 is distinguishable from an unwritten slot under a MAX reduction.
+ integer, parameter :: amr_restart_blk_own_ints = 4
!> color function gradient magnitude at which to apply the surface tension fluxes
real(wp), parameter :: capillary_cutoff = 1.e-6
!> Spatial support width of acoustic source, used in s_source_spatial
diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp
index 2fd61794b8..d9f292a26c 100644
--- a/src/common/m_derived_types.fpp
+++ b/src/common/m_derived_types.fpp
@@ -573,4 +573,11 @@ module m_derived_types
real(wp), dimension(1:num_fluids_max) :: perturb_dens_scale
real(wp), dimension(1:num_fluids_max,3) :: perturb_dens_offset
end type simplex_noise_params
+
+ !> An index-space rectangle in global cell indices. In v1, one t_box = one rank's subdomain. Flat leaf: no allocatable/pointer
+ !! components, host-only, never namelist/broadcast.
+ type t_box
+ integer :: lo(3) !< global low cell index per axis (x,y,z)
+ integer :: hi(3) !< global high cell index per axis
+ end type t_box
end module m_derived_types
diff --git a/src/common/m_global_parameters_common.fpp b/src/common/m_global_parameters_common.fpp
index 28b4f00d90..6f0529c91e 100644
--- a/src/common/m_global_parameters_common.fpp
+++ b/src/common/m_global_parameters_common.fpp
@@ -68,6 +68,10 @@ module m_global_parameters_common
$:GPU_DECLARE(create='[sys_size, eqn_idx]')
$:GPU_DECLARE(create='[shear_num, shear_indices, shear_BC_flip_num, shear_BC_flip_indices]')
+ !> Set only by the simulation's AMR fine-level advance; .false. everywhere else. Declared here rather than in the simulation so
+ !! that src/common/m_boundary_common can read it without a stage ifdef.
+ logical :: amr_in_fine_advance = .false.
+
!> @name Processor coordinates and parallel-IO addressing (identical declaration across all three targets)
!> @{
integer, allocatable, dimension(:) :: proc_coords !< Processor coordinates in MPI_CART_COMM
@@ -266,6 +270,11 @@ contains
allocate (proc_coords(1:num_dims))
+ ! start_idx is read by decomposition-aware features (amr, sfc_partition_wrt) in ALL builds;
+ ! the serial/single-rank offset is 0 and the MPI decomposition overwrites it
+ allocate (start_idx(1:num_dims))
+ start_idx = 0
+
if (parallel_io .neqv. .true.) return
#ifdef MFC_MPI
@@ -277,8 +286,6 @@ contains
! Option for UNIX file system (Hooke/Thomson) WRITE(mpiiofs, '(A)') '/ufs_' mpiiofs = TRIM(mpiiofs) mpi_info_int =
! MPI_INFO_NULL
-
- allocate (start_idx(1:num_dims))
#endif
end subroutine s_initialize_parallel_io_common
@@ -289,12 +296,7 @@ contains
impure subroutine s_finalize_global_parameters_common
deallocate (proc_coords)
-
-#ifdef MFC_MPI
- if (parallel_io) then
- deallocate (start_idx)
- end if
-#endif
+ deallocate (start_idx)
end subroutine s_finalize_global_parameters_common
@@ -378,6 +380,8 @@ contains
file_per_process = .false.
down_sample = .false.
fft_wrt = .false.
+ load_weight_wrt = .false.
+ sfc_partition_wrt = .false.
! Mixture conversion and sound-speed behavior
avg_state = dflt_int
diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp
index 061d8f1d6a..6450f4ef93 100644
--- a/src/common/m_mpi_common.fpp
+++ b/src/common/m_mpi_common.fpp
@@ -18,6 +18,7 @@ module m_mpi_common
use ieee_arithmetic
use m_nvtx
use m_constants, only: recon_type_weno
+ use m_box, only: t_box, f_equal_splits, f_box_from_splits
implicit none
@@ -427,6 +428,38 @@ contains
end subroutine s_mpi_allreduce_integer_sum
+ !> Reduce a local integer value to its global minimum across all MPI ranks.
+ impure subroutine s_mpi_allreduce_integer_min(var_loc, var_glb)
+
+ integer, intent(in) :: var_loc
+ integer, intent(out) :: var_glb
+
+#ifdef MFC_MPI
+ integer :: ierr !< Generic flag used to identify and report MPI errors
+
+ call MPI_ALLREDUCE(var_loc, var_glb, 1, MPI_INTEGER, MPI_MIN, MPI_COMM_WORLD, ierr)
+#else
+ var_glb = var_loc
+#endif
+
+ end subroutine s_mpi_allreduce_integer_min
+
+ !> Reduce a local integer value to its global maximum across all MPI ranks.
+ impure subroutine s_mpi_allreduce_integer_max(var_loc, var_glb)
+
+ integer, intent(in) :: var_loc
+ integer, intent(out) :: var_glb
+
+#ifdef MFC_MPI
+ integer :: ierr !< Generic flag used to identify and report MPI errors
+
+ call MPI_ALLREDUCE(var_loc, var_glb, 1, MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ierr)
+#else
+ var_glb = var_loc
+#endif
+
+ end subroutine s_mpi_allreduce_integer_max
+
!> Reduce a local real value to its global minimum across all MPI ranks.
impure subroutine s_mpi_allreduce_min(var_loc, var_glb)
@@ -455,6 +488,22 @@ contains
end subroutine s_mpi_allreduce_max
+ !> In-place elementwise max-reduction of a real array across all ranks. Assembles a rank-partitioned global array: each element
+ !! written (identically) by its owner(s), sentinel-low elsewhere, so MAX recovers the exact global array with no
+ !! double-counting.
+ impure subroutine s_mpi_allreduce_array_max(arr, arr_len)
+
+ integer, intent(in) :: arr_len
+ real(wp), dimension(arr_len), intent(inout) :: arr
+
+#ifdef MFC_MPI
+ integer :: ierr
+
+ call MPI_ALLREDUCE(MPI_IN_PLACE, arr, arr_len, mpi_p, MPI_MAX, MPI_COMM_WORLD, ierr)
+#endif
+
+ end subroutine s_mpi_allreduce_array_max
+
!> Reduce a local real value to its global minimum across all ranks
impure subroutine s_mpi_reduce_min(var_loc)
@@ -556,7 +605,7 @@ contains
type(int_bounds_info) :: boundary_conditions(1:3)
integer :: beg_end(1:2), grid_dims(1:3)
integer :: dst_proc, src_proc, recv_tag, send_tag
- logical :: beg_end_geq_0, qbmm_comm, chem_diff_comm
+ logical :: beg_end_geq_0, qbmm_comm, chem_T_comm
integer :: pack_offset, unpack_offset
type(scalar_field), optional, intent(inout) :: q_T_sf
@@ -566,7 +615,7 @@ contains
call nvtxStartRange("RHS-COMM-PACKBUF")
qbmm_comm = .false.
- chem_diff_comm = .false.
+ chem_T_comm = .false.
if (present(pb_in) .and. present(mv_in) .and. qbmm .and. .not. polytropic) then
qbmm_comm = .true.
@@ -577,7 +626,7 @@ contains
! Consumers that convert over ghost-inclusive bounds request temperature exchange for every chemistry run.
! The temperature Newton guess must be valid at rank seams even when diffusion is disabled:
! an unexchanged seam ghost is an uninitialized guess -> NaN T/pres/c in the output
- chem_diff_comm = .true.
+ chem_T_comm = .true.
v_size = nVar + 1
buffer_counts = (/buff_size*v_size*(n + 1)*(p + 1), buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
& buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1)/)
@@ -633,7 +682,7 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- if (chem_diff_comm) then
+ if (chem_T_comm) then
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
do l = 0, p
do k = 0, n
@@ -691,7 +740,7 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- if (chem_diff_comm) then
+ if (chem_T_comm) then
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
do l = 0, p
do k = 0, buff_size - 1
@@ -752,7 +801,7 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- if (chem_diff_comm) then
+ if (chem_T_comm) then
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
do l = 0, buff_size - 1
do k = -buff_size, n + buff_size
@@ -859,7 +908,7 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- if (chem_diff_comm) then
+ if (chem_T_comm) then
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
do l = 0, p
do k = 0, n
@@ -929,7 +978,7 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- if (chem_diff_comm) then
+ if (chem_T_comm) then
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
do l = 0, p
do k = -buff_size, -1
@@ -1002,7 +1051,7 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- if (chem_diff_comm) then
+ if (chem_T_comm) then
$:GPU_PARALLEL_LOOP(collapse=3,private='[r]')
do l = -buff_size, -1
do k = -buff_size, n + buff_size
@@ -1350,7 +1399,7 @@ contains
recon_order = muscl_order
end if
- if (num_procs == 1 .and. parallel_io) then
+ if (num_procs == 1) then
do i = 1, num_dims
start_idx(i) = 0
end do
@@ -1508,15 +1557,6 @@ contains
nidx(3)%end = 1
end if
- ! Beginning and end sub-domain boundary locations
- if (parallel_io) then
- if (proc_coords(3) < rem_cells) then
- start_idx(3) = (p + 1)*proc_coords(3)
- else
- start_idx(3) = (p + 1)*proc_coords(3) + rem_cells
- end if
- end if
-
! 2D Cartesian Processor Topology
else
! Initial estimate of optimal processor topology
@@ -1592,15 +1632,6 @@ contains
nidx(2)%end = 1
end if
- ! Beginning and end sub-domain boundary locations
- if (parallel_io) then
- if (proc_coords(2) < rem_cells) then
- start_idx(2) = (n + 1)*proc_coords(2)
- else
- start_idx(2) = (n + 1)*proc_coords(2) + rem_cells
- end if
- end if
-
! 1D Cartesian Processor Topology
else
! Optimal processor topology
@@ -1613,22 +1644,37 @@ contains
call MPI_CART_COORDS(MPI_COMM_CART, proc_rank, 1, proc_coords, ierr)
end if
- ! Global Parameters for x-direction
+ ! Global Parameters for x-direction - equal split via the box layer (byte-identical with inline arithmetic)
+ block
+ integer, allocatable :: off_x(:), off_y(:), off_z(:)
+ integer :: coords3(3)
+ type(t_box) :: box
+ ! Explicit allocate before assignment (not allocate-on-assignment): Intel defaults to
+ ! -assume norealloc_lhs, under which assigning to an unallocated allocatable is undefined.
+ ! Guard collapsed dims: num_procs_y/z are uninitialized locals (pre/post) when n/p_glb==0.
+ allocate (off_x(0:num_procs_x)); off_x = f_equal_splits(m_glb + 1, num_procs_x)
+ if (n_glb > 0) then
+ allocate (off_y(0:num_procs_y)); off_y = f_equal_splits(n_glb + 1, num_procs_y)
+ else
+ allocate (off_y(0:1)); off_y = [integer::0,1]
+ end if
+ if (p_glb > 0) then
+ allocate (off_z(0:num_procs_z)); off_z = f_equal_splits(p_glb + 1, num_procs_z)
+ else
+ allocate (off_z(0:1)); off_z = [integer::0,1]
+ end if
+ coords3 = 0
+ coords3(1:num_dims) = proc_coords
+ box = f_box_from_splits(off_x, off_y, off_z, coords3)
+ rem_cells = mod(m_glb + 1, num_procs_x)
+ m = box%hi(1) - box%lo(1)
+ start_idx(1) = box%lo(1)
+ if (n_glb > 0) then; n = box%hi(2) - box%lo(2); start_idx(2) = box%lo(2); end if
+ if (p_glb > 0) then; p = box%hi(3) - box%lo(3); start_idx(3) = box%lo(3); end if
+ end block
- ! Number of remaining cells
- rem_cells = mod(m + 1, num_procs_x)
rem_cells_by_dim(1) = rem_cells
- ! Optimal number of cells per processor
- m = (m + 1)/num_procs_x - 1
-
- ! Distributing the remaining cells
- do i = 1, rem_cells
- if (proc_coords(1) == i - 1) then
- m = m + 1; exit
- end if
- end do
-
call s_update_cell_bounds(cells_bounds, m, n, p)
! Boundary condition at the beginning
@@ -1647,15 +1693,6 @@ contains
nidx(1)%end = 1
end if
- ! Beginning and end sub-domain boundary locations
- if (parallel_io) then
- if (proc_coords(1) < rem_cells) then
- start_idx(1) = (m + 1)*proc_coords(1)
- else
- start_idx(1) = (m + 1)*proc_coords(1) + rem_cells
- end if
- end if
-
call s_apply_decomposition_policies((/num_procs_x, num_procs_y, num_procs_z/), rem_cells_by_dim, (/m, n, p/), (/m_glb, &
& n_glb, p_glb/), write_silo_ghost_offsets, &
& adjust_local_domains .and. (.not. parallel_io), output_offsets, local_domains)
@@ -1677,6 +1714,29 @@ contains
end subroutine s_mpi_decompose_computational_domain
+ !> Override this rank's local extents and starting indices from cumulative Cartesian split-plane offsets, leaving the MPI_CART
+ !! topology and BC neighbors (which stay proc_coords-derived) untouched. Each off_d is a cumulative cell-boundary array
+ !! (off_d(0)=0, off_d(num_procs_d)=G_d).
+ subroutine s_apply_weighted_offsets(off_x, off_y, off_z)
+
+ integer, dimension(0:), intent(in) :: off_x, off_y, off_z
+
+#ifdef MFC_MPI
+ m = off_x(proc_coords(1) + 1) - off_x(proc_coords(1)) - 1
+ start_idx(1) = off_x(proc_coords(1))
+ if (num_dims >= 2) then
+ n = off_y(proc_coords(2) + 1) - off_y(proc_coords(2)) - 1
+ start_idx(2) = off_y(proc_coords(2))
+ end if
+ if (num_dims >= 3) then
+ p = off_z(proc_coords(3) + 1) - off_z(proc_coords(3)) - 1
+ start_idx(3) = off_z(proc_coords(3))
+ end if
+ call s_update_cell_bounds(cells_bounds, m, n, p)
+#endif
+
+ end subroutine s_apply_weighted_offsets
+
!> Apply executable-configured output and local-domain policies after the shared Cartesian decomposition.
subroutine s_apply_decomposition_policies(proc_counts, remainders, local_cells, global_cells, write_silo_ghost_offsets, &
& adjust_local_domains, output_offsets, local_domains)
diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp
index b56c9a6ecf..fad30473ad 100644
--- a/src/common/m_phase_change.fpp
+++ b/src/common/m_phase_change.fpp
@@ -19,7 +19,8 @@ module m_phase_change
implicit none
private
- public :: s_initialize_phasechange_module, s_relaxation_solver, s_infinite_relaxation_k, s_finalize_relaxation_solver_module
+ public :: s_initialize_phasechange_module, s_relaxation_solver, s_infinite_relaxation_k, s_finalize_relaxation_solver_module, &
+ & pc_iter_count
!> @name Parameters for the first order transition phase change
!> @{
@@ -32,6 +33,11 @@ module m_phase_change
integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid
!> @}
+ !> Per-cell Newton-iteration count for the current step; allocated only when relax .and. (load_weight_wrt .or.
+ !! sfc_partition_wrt).
+ real(stp), allocatable :: pc_iter_count(:,:,:)
+ $:GPU_DECLARE(create='[pc_iter_count]')
+
contains
!> Dispatch to the correct relaxation solver. Replaces the procedure pointer, which CCE is breaking on.
@@ -44,8 +50,23 @@ contains
end subroutine s_relaxation_solver
- !> Initialize the phase change module (no module-level state to set up; the pT/pTg relaxation solvers are self-contained)
- impure subroutine s_initialize_phasechange_module
+ !> Initialize the phase change module. pc_count_ub carries the iteration-count field's upper bounds as an initialization policy
+ !! (src/common carries no stage guards): simulation passes its allocation extents (m_alloc/n_alloc/p_alloc - the AMR fine
+ !! advance swaps m/n/p to fine-block extents before s_amr_relax_fine writes the field) when the load-weight/SFC writers need it;
+ !! other targets, and simulation runs without those writers, pass -1 = no field.
+ impure subroutine s_initialize_phasechange_module(pc_count_ub)
+
+ integer, intent(in) :: pc_count_ub(3)
+
+ if (pc_count_ub(1) >= 0) then
+ @:ALLOCATE(pc_iter_count(0:pc_count_ub(1), 0:pc_count_ub(2), 0:pc_count_ub(3)))
+ ! zeroed here because s_compute_load_weight reads it on the FIRST s_write_data_files, which for a run
+ ! saving at t_step_start precedes any relaxation sweep -- the only writer is the count_pc_iters branch.
+ ! The DEVICE copy is the one that matters: the reader (m_load_weight) is a GPU_PARALLEL_LOOP and the
+ ! writer is inside a device region, so a host-only assignment would never reach either.
+ pc_iter_count = 0._stp
+ $:GPU_UPDATE(device='[pc_iter_count]')
+ end if
end subroutine s_initialize_phasechange_module
@@ -69,6 +90,8 @@ contains
!> Generic loop iterators
integer :: i, j, k, l
+ integer :: ns_pc, ns_tmp !< per-cell Newton-iteration accumulators for load-weight diagnostic
+ logical :: count_pc_iters !< host-evaluated kernel guard (a device copy of the wrt flags is never synced)
#ifdef _CRAYFTN
#ifdef MFC_OpenACC
@@ -79,8 +102,10 @@ contains
! starting equilibrium solver
+ count_pc_iters = load_weight_wrt .or. sfc_partition_wrt
+
$:GPU_PARALLEL_LOOP(collapse=3, private='[i, j, k, l, p_infpT, sk, hk, gk, ek, rhok, pS, TS, rhoe, dynE, rhos, rho, rM, &
- & m1, m2, MCT, TvF]')
+ & m1, m2, MCT, TvF, ns_pc, ns_tmp]', copyin='[count_pc_iters]')
do j = 0, m
do k = 0, n
do l = 0, p
@@ -121,7 +146,7 @@ contains
! Calling pT-equilibrium for either finishing phase-change module, or as an IC for the pTg-equilibrium for this
! case, MFL cannot be either 0 or 1, so I chose it to be 2
- call s_infinite_pt_relaxation_k(j, k, l, 2, pS, p_infpT, q_cons_vf, rhoe, TS)
+ call s_infinite_pt_relaxation_k(j, k, l, 2, pS, p_infpT, q_cons_vf, rhoe, TS, ns_pc)
! Check if pTg-equilibrium needed; only partial densities require updating
if ((relax_model == 6) .and. ((q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, &
@@ -136,7 +161,8 @@ contains
q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = m1
q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = m2
- call s_infinite_ptg_relaxation_k(j, k, l, pS, rhoe, q_cons_vf, TS)
+ call s_infinite_ptg_relaxation_k(j, k, l, pS, rhoe, q_cons_vf, TS, ns_tmp)
+ ns_pc = ns_pc + ns_tmp
end if
! Calculations AFTER equilibrium
@@ -175,6 +201,10 @@ contains
! Total entropy
rhos = rhos + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*sk(i)
end do
+
+ ! Accumulate Newton iteration count for the load-weight diagnostic (matches the
+ ! allocation condition; no-op when neither writer is enabled).
+ if (count_pc_iters) pc_iter_count(j, k, l) = real(ns_pc, stp)
end do
end do
end do
@@ -184,7 +214,7 @@ contains
!> Apply pT-equilibrium relaxation for N fluids
!! @param MFL flag: 0=gas, 1=liquid, 2=mixture
- subroutine s_infinite_pt_relaxation_k(j, k, l, MFL, pS, p_infpT, q_cons_vf, rhoe, TS)
+ subroutine s_infinite_pt_relaxation_k(j, k, l, MFL, pS, p_infpT, q_cons_vf, rhoe, TS, ns_out)
$:GPU_ROUTINE(function_name='s_infinite_pt_relaxation_k', parallelism='[seq]', cray_noinline=True)
@@ -195,6 +225,7 @@ contains
type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
real(wp), intent(in) :: rhoe
real(wp), intent(out) :: TS
+ integer, intent(out) :: ns_out !< Newton iteration count for this call
real(wp) :: gp, gpp, hp, pO, mCP, mQ !< variables for the Newton Solver
real(wp) :: p_infpT_sum
integer :: i, ns !< generic loop iterators
@@ -233,6 +264,7 @@ contains
! temperature
TS = 0.0_wp
+ ns_out = 0
return
end if
end if
@@ -277,6 +309,7 @@ contains
! common temperature
TS = (rhoe + pS - mQ)/mCP
+ ns_out = ns
end subroutine s_infinite_pt_relaxation_k
@@ -330,7 +363,7 @@ contains
!! rhoe-relative branch). Every step is projected onto the physical bounds 0 <= ml <= mT, pS > pmin. This converges in a handful
!! of iterations with a bounded, uniform count (no GPU warp divergence), unlike the former fixed 1e-3 underrelaxation that
!! stalled far from the root.
- subroutine s_infinite_ptg_relaxation_k(j, k, l, pS, rhoe, q_cons_vf, TS)
+ subroutine s_infinite_ptg_relaxation_k(j, k, l, pS, rhoe, q_cons_vf, TS, ns_out)
$:GPU_ROUTINE(function_name='s_infinite_ptg_relaxation_k', parallelism='[seq]', cray_noinline=True)
@@ -339,6 +372,7 @@ contains
real(wp), intent(in) :: rhoe
type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
real(wp), intent(inout) :: TS
+ integer, intent(out) :: ns_out !< Newton iteration count for this call
real(wp), dimension(2, 2) :: Jac, InvJac
real(wp), dimension(2) :: R2D, R2D_try, DeltamP
real(wp) :: mCP, mCPD, mCVGP, mCVGP2, mQ
@@ -422,6 +456,7 @@ contains
q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = mT - ml
TS = (rhoe + pS - mQ)/mCP
+ ns_out = ns
end subroutine s_infinite_ptg_relaxation_k
@@ -468,6 +503,10 @@ contains
!> Finalize the phase change module
impure subroutine s_finalize_relaxation_solver_module
+ if (allocated(pc_iter_count)) then
+ @:DEALLOCATE(pc_iter_count)
+ end if
+
end subroutine s_finalize_relaxation_solver_module
end module m_phase_change
diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp
index 051a5a6d34..49da1dfdea 100644
--- a/src/common/m_variables_conversion.fpp
+++ b/src/common/m_variables_conversion.fpp
@@ -26,7 +26,7 @@ module m_variables_conversion
& s_convert_species_to_mixture_variables_kernel, s_convert_conservative_to_primitive_variables, &
& s_convert_primitive_to_conservative_variables, s_convert_primitive_to_flux_variables, s_compute_pressure, &
& s_compute_species_fraction, s_compute_speed_of_sound, s_compute_fast_magnetosonic_speed, &
- & s_finalize_variables_conversion_module, gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps
+ & s_finalize_variables_conversion_module, gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, enforce_density_floor_vc
real(wp), allocatable, dimension(:) :: Gs_vc
integer, allocatable, dimension(:) :: bubrs_vc
diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90
index 64b3fa9fff..ec0997e034 100644
--- a/src/post_process/m_data_input.f90
+++ b/src/post_process/m_data_input.f90
@@ -11,6 +11,7 @@ module m_data_input
use m_derived_types
use m_global_parameters
+ use m_constants, only: amr_restart_blk_hdr_ints, amr_restart_blk_own_ints
use m_mpi_proxy
use m_mpi_common
use m_compile_specific
@@ -21,7 +22,7 @@ module m_data_input
implicit none
private; public :: s_initialize_data_input_module, s_read_data_files, s_read_serial_data_files, s_read_parallel_data_files, &
- & s_finalize_data_input_module
+ & s_read_amr_data, s_free_amr_data, s_finalize_data_input_module
abstract interface
@@ -43,6 +44,17 @@ end subroutine s_read_abstract_data_files
! type(scalar_field), public :: ib_markers !<
type(integer_field), public :: ib_markers
+ !> One AMR fine-block piece owned by this rank, held for visualization overlay of the refined solution.
+ type, public :: amr_fine_block
+ integer :: lo(3), hi(3) !< global coarse-index region bounds of the parent block
+ integer :: m, n, p !< local fine extents (interior 0:m, 0:n, 0:p)
+ real(wp), allocatable, dimension(:) :: x_cb, y_cb, z_cb !< reconstructed fine cell boundaries
+ type(scalar_field), allocatable, dimension(:) :: q_cons !< fine conservative state
+ end type amr_fine_block
+
+ type(amr_fine_block), allocatable, dimension(:), public :: amr_fine !< this rank's owned block pieces
+ integer, public :: amr_num_fine !< number of block pieces this rank owns (<= file's block count)
+
procedure(s_read_abstract_data_files), pointer :: s_read_data_files => null()
contains
@@ -545,6 +557,369 @@ impure subroutine s_finalize_data_input_module
s_read_data_files => null()
+ call s_free_amr_data()
+
end subroutine s_finalize_data_input_module
+ !> Reconstruct fine cell boundaries fcb(-1:nfine) by rr-way subdivision of the coarse cells of pcb, starting at this rank's
+ !! LOCAL coarse index lo_local. Mirrors s_build_level_coords (m_amr) but keeps only the boundaries needed by the mesh. At rr=2
+ !! the result is bit-identical to the original bisection (kk=0 gives the old midpoint; kk=1 gives xr; fcb(-1)=xl).
+ pure subroutine s_amr_reconstruct_fine_cb(pcb, pcb_lb, lo_local, nfine, rr, fcb)
+
+ real(wp), intent(in) :: pcb(:)
+ integer, intent(in) :: pcb_lb, lo_local, nfine, rr
+ real(wp), allocatable, intent(inout) :: fcb(:)
+ integer :: fi, c, off, kk
+ real(wp) :: xl, xr
+
+ off = 1 - pcb_lb ! pcb(j) = coarse_cb(j + pcb_lb - 1); coarse_cb(c) = pcb(c + off)
+ fcb(-1) = pcb(lo_local - 1 + off) ! left boundary of the fine region
+ do fi = 0, nfine
+ c = lo_local + fi/rr
+ xl = pcb(c - 1 + off); xr = pcb(c + off)
+ kk = mod(fi, rr)
+ if (kk == rr - 1) then
+ fcb(fi) = xr ! coarse-cell right edge (exact)
+ else
+ fcb(fi) = (real(rr - 1 - kk, wp)*xl + real(kk + 1, wp)*xr)/real(rr, wp)
+ end if
+ end do
+
+ end subroutine s_amr_reconstruct_fine_cb
+
+ !> Populate block slot `k` metadata, allocate its conservative fields, and reconstruct its fine coordinates from the coarse cell
+ !! boundaries (x_cb/y_cb/z_cb, already read for this t_step). isect_lo is the block's global coarse origin; sidx is this rank's
+ !! global coarse origin (0 for a single-rank/no-MPI run). rr is the refinement factor for this block (amr_ref_ratio**level).
+ impure subroutine s_setup_amr_block(k, reg, isect_lo, sidx, fm, fn, fp, rr)
+
+ integer, intent(in) :: k, reg(6), isect_lo(3), sidx(3), fm, fn, fp, rr
+ integer :: i
+
+ amr_fine(k)%lo = reg(1:3)
+ amr_fine(k)%hi = reg(4:6)
+ amr_fine(k)%m = fm; amr_fine(k)%n = fn; amr_fine(k)%p = fp
+
+ allocate (amr_fine(k)%q_cons(1:sys_size))
+ do i = 1, sys_size
+ allocate (amr_fine(k)%q_cons(i)%sf(0:fm,0:fn,0:fp))
+ end do
+
+ ! isect_lo is GLOBAL; sidx is this rank's global origin (0 for a single-rank/no-MPI run), so
+ ! isect_lo - sidx is the LOCAL coarse index whose x_cb slice the rr-way subdivision reads.
+ allocate (amr_fine(k)%x_cb(-1:fm))
+ call s_amr_reconstruct_fine_cb(x_cb, lbound(x_cb, 1), isect_lo(1) - sidx(1), fm, rr, amr_fine(k)%x_cb)
+ if (n > 0) then
+ allocate (amr_fine(k)%y_cb(-1:fn))
+ call s_amr_reconstruct_fine_cb(y_cb, lbound(y_cb, 1), isect_lo(2) - sidx(2), fn, rr, amr_fine(k)%y_cb)
+ end if
+ if (p > 0) then
+ allocate (amr_fine(k)%z_cb(-1:fp))
+ call s_amr_reconstruct_fine_cb(z_cb, lbound(z_cb, 1), isect_lo(3) - sidx(3), fp, rr, amr_fine(k)%z_cb)
+ end if
+
+ end subroutine s_setup_amr_block
+
+ !> Read the AMR fine-level restart file for t_step (mirrors s_read_amr_restart in m_amr, serial and parallel branches) and store
+ !! this rank's owned block pieces for the post-process overlay. No-op when amr is off or the file is absent.
+ impure subroutine s_read_amr_data(t_step)
+
+ integer, intent(in) :: t_step
+ character(LEN=path_len + 3*name_len) :: file_loc
+ logical :: file_exist
+ integer :: k, i, nblk, ghdr(3), reg(6), lvl, rm, rn, rp, cw
+ logical :: v2
+ integer :: nvar_f
+ integer :: np_old, orec, fmf, fnf, fpf, foff(3), fcnt(3)
+ integer :: sidx(3), ext(3), isect_lo(3), isect_hi(3), fm, fn, fp, d, rr
+ integer :: have_loc, have_glb
+ logical :: owns
+
+#ifdef MFC_MPI
+ integer :: ifile, ierr, cnt, idx, fi, fj, fk, ibytes, sbytes
+ integer :: bhdr(amr_restart_blk_hdr_ints)
+ integer :: fown(amr_restart_blk_own_ints)
+ integer :: myext(3)
+ integer, allocatable :: wext(:), rext(:)
+ integer, dimension(MPI_STATUS_SIZE) :: status
+ integer(kind=MPI_OFFSET_KIND) :: my_cnt, my_off, tot_cnt, disp0, ddisp
+ real(stp), allocatable :: buf(:)
+#endif
+
+ call s_free_amr_data()
+ if (.not. amr) return
+
+ ! this rank's subdomain in global coarse indices (mirror s_amr_compute_isect's sidx/ext). start_idx is
+ ! allocated only under MPI; for a single-rank/no-MPI run the global origin is 0.
+ sidx = 0; ext = 0
+ ext(1) = m
+ if (n > 0) ext(2) = n
+ if (p > 0) ext(3) = p
+#ifdef MFC_MPI
+ sidx(1) = start_idx(1)
+ if (n > 0) sidx(2) = start_idx(2)
+ if (p > 0) sidx(3) = start_idx(3)
+#endif
+
+ if (.not. parallel_io) then
+ write (file_loc, '(A,I0,A,I0,A)') trim(case_dir) // '/p_all/p', proc_rank, '/', t_step, '/amr_fine.dat'
+ else
+ write (file_loc, '(A,I0,A)') 'amr_', t_step, '.dat'
+ file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
+ end if
+ inquire (FILE=trim(file_loc), EXIST=file_exist)
+ ! all ranks must agree: in serial (per-rank-file) mode a partially present p_all tree would
+ ! otherwise mix fine-overlay and coarse-only ranks with no message unless rank 0 was the
+ ! missing one (mirrors the sim reader's allreduce-min agreement)
+ have_loc = merge(1, 0, file_exist)
+ call s_mpi_allreduce_integer_min(have_loc, have_glb)
+ if (have_glb == 0) then
+ if (proc_rank == 0 .and. file_exist) print '(A,I0,A)', ' [amr] post: AMR fine-block file(s) at t_step ', t_step, &
+ & ' are missing on some ranks; writing the coarse mesh only'
+ if (proc_rank == 0 .and. .not. file_exist) print '(A,I0,A)', ' [amr] post: no AMR fine-block file at t_step ', &
+ & t_step, '; writing the coarse mesh only'
+ return
+ end if
+
+ ! post_process deliberately runs with a LARGER sys_size than the simulation for 5eq Lagrange
+ ! bubbles: m_global_parameters (post) appends beta_idx = sys_size + 1 as a post-only output slot
+ ! (see the "post-only: beta_idx increment" note in m_global_parameters_common). The AMR file records
+ ! the SIMULATION's count, so comparing it against post's inflated sys_size rejected valid files --
+ ! every AMR + Lagrange-bubbles case died with "a different number of conserved variables". Compare
+ ! against, and read, the count the writer actually used.
+ nvar_f = sys_size
+ if (model_eqns == model_eqns_5eq .and. bubbles_lagrange) nvar_f = sys_size - 1
+
+ if (.not. parallel_io) then
+ open (2, FILE=trim(file_loc), form='unformatted', ACTION='read', STATUS='old')
+ read (2) ghdr
+ ! the layout offsets depend on both: a stale file from a different run configuration
+ ! would otherwise misalign every record (mirrors the sim reader's header validation)
+ if (ghdr(1) /= num_procs) then
+ call s_mpi_abort('amr post: the AMR fine-block file was written with a different rank count; ' &
+ & // 'run post_process with the same number of ranks as the simulation')
+ end if
+ if (ghdr(3) /= nvar_f) then
+ call s_mpi_abort('amr post: the AMR fine-block file was written with a different number of ' &
+ & // 'conserved variables; the physics configuration must match the simulation')
+ end if
+ nblk = ghdr(2)
+ allocate (amr_fine(nblk))
+ amr_num_fine = 0
+ do k = 1, nblk
+ read (2) reg, lvl, rm, rn, rp ! header: region(6) + amr_block_level(1) + m,n,p (mirrors s_write_amr_restart)
+ do d = 1, 3
+ isect_lo(d) = max(reg(d), sidx(d))
+ isect_hi(d) = min(reg(3 + d), sidx(d) + ext(d))
+ end do
+ owns = isect_lo(1) <= isect_hi(1)
+ if (n > 0) owns = owns .and. isect_lo(2) <= isect_hi(2)
+ if (p > 0) owns = owns .and. isect_lo(3) <= isect_hi(3)
+ if (.not. owns) cycle ! writer emitted no data record for a block this rank does not own
+ ! Use the file's authoritative per-block fine extent (rm/rn/rp); derive rr = amr_ref_ratio**level
+ ! from the ratio of fine cells to coarse cells (2 for L1, 4 for L2, etc.).
+ fm = rm; fn = rn; fp = rp
+ cw = max(isect_hi(1) - isect_lo(1) + 1, 1)
+ rr = (fm + 1)/cw
+ ! fail-closed: a well-formed header has level >= 1 and a fine x-extent that is an integer
+ ! (>= 2) refinement of the coarse footprint. Reading the level field as an extent (the
+ ! post/writer header-layout drift) makes rr collapse to 0 and trips this.
+ if (lvl < 1 .or. rr < 2 .or. mod(fm + 1, &
+ & cw) /= 0) &
+ & call s_mpi_abort('amr post: malformed fine-block header (level/extent inconsistent); the AMR restart ' &
+ & // 'writer and reader header layouts have drifted')
+ amr_num_fine = amr_num_fine + 1
+ call s_setup_amr_block(amr_num_fine, reg, isect_lo, sidx, fm, fn, fp, rr)
+ do i = 1, nvar_f
+ read (2) amr_fine(amr_num_fine)%q_cons(i)%sf(0:fm,0:fn,0:fp)
+ end do
+ end do
+ close (2)
+ else
+#ifdef MFC_MPI
+ ibytes = storage_size(0)/8; sbytes = storage_size(0._stp)/8
+ call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
+ call MPI_FILE_READ_AT_ALL(ifile, int(0, MPI_OFFSET_KIND), ghdr, 3, MPI_INTEGER, status, ierr)
+ ! FORMAT: a NEGATIVE rank count marks v2 (mirrors s_read_amr_restart in m_amr_restart). v2 stores one
+ ! CONTIGUOUS data chunk per block, written by that block's single owner, plus a 4-int
+ ! (owner + 1, m, n, p) record giving the block's FULL fine extent. v1 stores per-rank slices with a
+ ! 3*np_old extent vector, so its layout -- and only its layout -- depends on the writer's rank count.
+ v2 = ghdr(1) < 0
+ np_old = abs(ghdr(1))
+ orec = merge(amr_restart_blk_own_ints, 3*np_old, v2)
+ if (.not. v2 .and. ghdr(1) /= num_procs) then
+ call s_mpi_abort('amr post: the AMR fine-block file was written with a different rank count; ' &
+ & // 'run post_process with the same number of ranks as the simulation')
+ end if
+ if (ghdr(3) /= nvar_f) then
+ call s_mpi_abort('amr post: the AMR fine-block file was written with a different number of ' &
+ & // 'conserved variables; the physics configuration must match the simulation')
+ end if
+ nblk = ghdr(2)
+ allocate (amr_fine(nblk))
+ allocate (wext(3*num_procs), rext(3*num_procs))
+ amr_num_fine = 0
+ disp0 = int(3*ibytes, MPI_OFFSET_KIND)
+ do k = 1, nblk
+ ! per-block header is amr_restart_blk_hdr_ints ints: region(6) + amr_block_level(1), single-sourced
+ ! in m_constants so this mirrors s_write_amr_restart (and m_amr:s_read_amr_restart) exactly.
+ call MPI_FILE_READ_AT_ALL(ifile, disp0, bhdr, amr_restart_blk_hdr_ints, MPI_INTEGER, status, ierr)
+ reg = bhdr(1:6); lvl = bhdr(amr_restart_blk_hdr_ints)
+ if (.not. v2) then
+ call MPI_FILE_READ_AT_ALL(ifile, disp0 + int(amr_restart_blk_hdr_ints*ibytes, MPI_OFFSET_KIND), wext, &
+ & 3*num_procs, MPI_INTEGER, status, ierr)
+ end if
+ do d = 1, 3
+ isect_lo(d) = max(reg(d), sidx(d))
+ isect_hi(d) = min(reg(3 + d), sidx(d) + ext(d))
+ end do
+ owns = isect_lo(1) <= isect_hi(1)
+ if (n > 0) owns = owns .and. isect_lo(2) <= isect_hi(2)
+ if (p > 0) owns = owns .and. isect_lo(3) <= isect_hi(3)
+
+ if (v2) then
+ ! v2: one contiguous chunk per block, written by that block's single owner. The 4-int record
+ ! carries the owner (+1) and the block's FULL fine extent, so every rank can size and stride
+ ! the file without any collective -- no EXSCAN, and no per-rank layout check to drift.
+ call MPI_FILE_READ_AT_ALL(ifile, disp0 + int(amr_restart_blk_hdr_ints*ibytes, MPI_OFFSET_KIND), fown, &
+ & amr_restart_blk_own_ints, MPI_INTEGER, status, ierr)
+ fmf = fown(2); fnf = fown(3); fpf = fown(4)
+ ! DATA PRESENCE COMES FROM THE FILE, not from geometry: a block with no owner has no chunk.
+ if (fown(1) <= 0) owns = .false.
+ cw = max(reg(4) - reg(1) + 1, 1)
+ rr = 1
+ if (fown(1) > 0) rr = (fmf + 1)/cw
+ if (owns) then
+ if (lvl < 1 .or. rr < 2 .or. mod(fmf + 1, cw) /= 0) then
+ call s_mpi_abort('amr post: malformed fine-block header (level/extent inconsistent); ' &
+ & // 'the AMR restart writer and reader header layouts have drifted')
+ end if
+ end if
+ cnt = 0
+ if (owns) cnt = nvar_f*(fmf + 1)*(fnf + 1)*(fpf + 1)
+ ddisp = disp0 + int((amr_restart_blk_hdr_ints + orec)*ibytes, MPI_OFFSET_KIND)
+ allocate (buf(max(cnt, 1)))
+ ! collective: every rank calls it, non-participants with count 0. Overlapping ranks read the
+ ! same bytes, which is fine for a read, and each keeps only its own intersection below.
+ call MPI_FILE_READ_AT_ALL(ifile, ddisp, buf, cnt*mpi_io_type, mpi_io_p, status, ierr)
+ if (owns) then
+ ! this rank keeps the intersection sub-box, in FINE cells relative to the block origin,
+ ! so s_setup_amr_block still reconstructs coordinates from a LOCAL coarse index
+ foff = 0; fcnt = 1
+ do d = 1, 3
+ foff(d) = (isect_lo(d) - reg(d))*rr
+ fcnt(d) = (isect_hi(d) - isect_lo(d) + 1)*rr
+ end do
+ if (n == 0) then; foff(2) = 0; fcnt(2) = 1; end if
+ if (p == 0) then; foff(3) = 0; fcnt(3) = 1; end if
+ fm = fcnt(1) - 1; fn = fcnt(2) - 1; fp = fcnt(3) - 1
+ amr_num_fine = amr_num_fine + 1
+ call s_setup_amr_block(amr_num_fine, reg, isect_lo, sidx, fm, fn, fp, rr)
+ ! writer order is i -> fk -> fj -> fi with fi fastest, over the FULL block extent
+ do i = 1, nvar_f
+ do fk = 0, fp
+ do fj = 0, fn
+ do fi = 0, fm
+ idx = (i - 1)*(fpf + 1)*(fnf + 1)*(fmf + 1) + (fk + foff(3))*(fnf + 1)*(fmf + 1) + (fj &
+ & + foff(2))*(fmf + 1) + (fi + foff(1)) + 1
+ amr_fine(amr_num_fine)%q_cons(i)%sf(fi, fj, fk) = buf(idx)
+ end do
+ end do
+ end do
+ end do
+ end if
+ deallocate (buf)
+ ! stride past the OWNER's whole chunk; a block with no owner contributed no data at all
+ tot_cnt = int(0, MPI_OFFSET_KIND)
+ if (fown(1) > 0) then
+ tot_cnt = int(nvar_f, MPI_OFFSET_KIND)*int(fmf + 1, MPI_OFFSET_KIND)*int(fnf + 1, &
+ & MPI_OFFSET_KIND)*int(fpf + 1, MPI_OFFSET_KIND)
+ end if
+ disp0 = ddisp + tot_cnt*int(sbytes, MPI_OFFSET_KIND)
+ cycle
+ end if
+ ! Use the file's authoritative per-rank fine extents from wext; derive rr per block.
+ fm = 0; fn = 0; fp = 0; rr = 1
+ if (owns) then
+ fm = wext(3*proc_rank + 1)
+ if (n > 0) fn = wext(3*proc_rank + 2)
+ if (p > 0) fp = wext(3*proc_rank + 3)
+ cw = max(isect_hi(1) - isect_lo(1) + 1, 1)
+ rr = (fm + 1)/cw
+ ! fail-closed: mirror the serial path's header sanity check (see s_read_amr_data serial branch)
+ if (lvl < 1 .or. rr < 2 .or. mod(fm + 1, &
+ & cw) /= 0) &
+ & call s_mpi_abort('amr post: malformed fine-block header (level/extent inconsistent); the AMR restart ' &
+ & // 'writer and reader header layouts have drifted')
+ end if
+ ! validate the writer's per-rank layout against this run's decomposition (catches a
+ ! load_balance simulation, whose weighted splits post never reproduces)
+ myext = 0
+ if (owns) myext = [fm, fn, fp]
+ call MPI_ALLGATHER(myext, 3, MPI_INTEGER, rext, 3, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ if (any(rext /= wext)) then
+ call s_mpi_abort('amr post: the per-rank fine-block layout in the file does not match this ' &
+ & // 'decomposition (e.g. the simulation used load_balance); the AMR overlay ' &
+ & // 'requires the writing decomposition')
+ end if
+ cnt = nvar_f*(fm + 1)*(fn + 1)*(fp + 1)
+ if (.not. owns) cnt = 0
+ my_cnt = int(cnt, MPI_OFFSET_KIND)
+ my_off = int(0, MPI_OFFSET_KIND)
+ call MPI_EXSCAN(my_cnt, my_off, 1, MPI_OFFSET, MPI_SUM, MPI_COMM_WORLD, ierr)
+ if (proc_rank == 0) my_off = int(0, MPI_OFFSET_KIND)
+ call MPI_ALLREDUCE(my_cnt, tot_cnt, 1, MPI_OFFSET, MPI_SUM, MPI_COMM_WORLD, ierr)
+ ddisp = disp0 + int((amr_restart_blk_hdr_ints + 3*num_procs)*ibytes, MPI_OFFSET_KIND)
+ allocate (buf(max(cnt, 1)))
+ call MPI_FILE_READ_AT_ALL(ifile, ddisp + my_off*int(sbytes, MPI_OFFSET_KIND), buf, cnt*mpi_io_type, mpi_io_p, &
+ & status, ierr)
+ if (owns) then
+ amr_num_fine = amr_num_fine + 1
+ call s_setup_amr_block(amr_num_fine, reg, isect_lo, sidx, fm, fn, fp, rr)
+ idx = 0
+ do i = 1, nvar_f
+ do fk = 0, fp
+ do fj = 0, fn
+ do fi = 0, fm
+ idx = idx + 1
+ amr_fine(amr_num_fine)%q_cons(i)%sf(fi, fj, fk) = buf(idx)
+ end do
+ end do
+ end do
+ end do
+ end if
+ deallocate (buf)
+ disp0 = ddisp + tot_cnt*int(sbytes, MPI_OFFSET_KIND)
+ end do
+ call MPI_FILE_CLOSE(ifile, ierr)
+#endif
+ end if
+
+ if (proc_rank == 0) print '(A,I0,A,I0,A)', ' [amr] post: read ', ghdr(2), ' fine block(s) (', amr_num_fine, &
+ & ' owned by rank 0)'
+
+ end subroutine s_read_amr_data
+
+ !> Release the stored AMR fine-block pieces.
+ impure subroutine s_free_amr_data()
+
+ integer :: k, i
+
+ if (allocated(amr_fine)) then
+ do k = 1, amr_num_fine
+ if (allocated(amr_fine(k)%q_cons)) then
+ do i = 1, sys_size
+ if (associated(amr_fine(k)%q_cons(i)%sf)) deallocate (amr_fine(k)%q_cons(i)%sf)
+ end do
+ deallocate (amr_fine(k)%q_cons)
+ end if
+ if (allocated(amr_fine(k)%x_cb)) deallocate (amr_fine(k)%x_cb)
+ if (allocated(amr_fine(k)%y_cb)) deallocate (amr_fine(k)%y_cb)
+ if (allocated(amr_fine(k)%z_cb)) deallocate (amr_fine(k)%z_cb)
+ end do
+ deallocate (amr_fine)
+ end if
+ amr_num_fine = 0
+
+ end subroutine s_free_amr_data
+
end module m_data_input
diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp
index 1d5ddfedba..811944f282 100644
--- a/src/post_process/m_data_output.fpp
+++ b/src/post_process/m_data_output.fpp
@@ -5,6 +5,10 @@
!> @brief Writes post-processed grid and flow-variable data to Silo-HDF5 or binary database files
module m_data_output
+#ifdef MFC_MPI
+ use mpi
+#endif
+
use m_derived_types
use m_global_parameters
use m_derived_variables
@@ -12,6 +16,8 @@ module m_data_output
use m_compile_specific
use m_helper
use m_variables_conversion
+ use m_chemistry, only: s_compute_q_T_sf
+ use m_data_input, only: amr_fine, amr_num_fine
use m_constants, only: model_eqns_gamma_law, model_eqns_5eq, model_eqns_6eq, format_silo, format_binary, precision_single
implicit none
@@ -20,8 +26,8 @@ module m_data_output
& s_open_intf_data_file, s_open_energy_data_file, s_write_grid_to_formatted_database_file, &
& s_write_variable_to_formatted_database_file, s_write_lag_bubbles_results_to_text, &
& s_write_lag_bubbles_to_formatted_database_file, s_write_ib_state_files, s_write_intf_data_file, &
- & s_write_energy_data_file, s_write_ib_bodies_to_formatted_database_file, s_close_formatted_database_file, &
- & s_close_intf_data_file, s_close_energy_data_file, s_finalize_data_output_module, out
+ & s_write_energy_data_file, s_write_ib_bodies_to_formatted_database_file, s_write_amr_to_formatted_database_file, &
+ & s_close_formatted_database_file, s_close_intf_data_file, s_close_energy_data_file, s_finalize_data_output_module, out
! Include Silo-HDF5 interface library
include 'silo_f9x.inc'
@@ -672,6 +678,182 @@ contains
end subroutine s_write_variable_to_formatted_database_file
+ !> Overlay the AMR refined solution. Each owned fine block is written as an extra rectilinear quadmesh (Silo) or an appended
+ !! block record (binary), carrying the primitive fields (mixture density, velocities, pressure, volume fractions) at true fine
+ !! resolution. On rank 0 the Silo block meshes/vars are registered into the /root 'amr_blocks' multimesh and 'amr_'
+ !! multivars so VisIt/ParaView overlays them on the coarse 'rectilinear_grid'. Guarded by `amr` at the caller; a no-op when no
+ !! fine blocks are present. Binary layout per rank: an integer block count, then per block a header [lo(3), hi(3), m, n, p,
+ !! nvars], the fine cell boundaries (x_cb, then y_cb/z_cb if active), then per variable a [name, field] record (same convention
+ !! as the coarse binary variables).
+ impure subroutine s_write_amr_to_formatted_database_file(t_step)
+
+ integer, intent(in) :: t_step
+ character(LEN=name_len), allocatable :: vnames(:)
+ real(wp), allocatable, dimension(:,:,:) :: vbuf
+ type(scalar_field), allocatable, dimension(:) :: q_prim_blk
+ type(scalar_field) :: q_T_blk
+ type(int_bounds_info) :: ibnd(3)
+ character(LEN=4*name_len), allocatable :: entry(:)
+ integer, allocatable :: etypes(:), counts(:)
+ character(LEN=4*name_len) :: mname, mvar
+ integer :: db_real, ndims, dims(3), vdims(3), nvars, nadv
+ integer :: k, i, ii, d, fm, fn, fp, ierr, r, kk, tot, e
+
+ db_real = merge(DB_DOUBLE, DB_FLOAT, wp == dp)
+
+ ! Variable list (same order used both for writing and for the /root multivar registration).
+ nadv = eqn_idx%adv%end - eqn_idx%adv%beg + 1
+ nvars = 2 + num_dims + nadv
+ allocate (vnames(nvars))
+ vnames(1) = 'rho'; vnames(2) = 'pres'
+ do d = 1, num_dims
+ write (vnames(2 + d), '(A,I0)') 'vel', d
+ end do
+ do i = 1, nadv
+ write (vnames(2 + num_dims + i), '(A,I0)') 'alpha', i
+ end do
+
+ if (format == format_binary) write (out%dbfile) amr_num_fine
+
+ do k = 1, amr_num_fine
+ fm = amr_fine(k)%m; fn = amr_fine(k)%n; fp = amr_fine(k)%p
+
+ ! Convert this block's fine conservative state to primitives (same routine as the coarse path).
+ allocate (q_prim_blk(1:sys_size))
+ do i = 1, sys_size
+ allocate (q_prim_blk(i)%sf(0:fm,0:fn,0:fp))
+ end do
+ allocate (q_T_blk%sf(0:fm,0:fn,0:fp))
+ ibnd(1)%beg = 0; ibnd(1)%end = fm
+ ibnd(2)%beg = 0; ibnd(2)%end = fn
+ ibnd(3)%beg = 0; ibnd(3)%end = fp
+ ! seed the temperature guess from the fine conservative state (the reacting-EOS cons->prim
+ ! uses q_T as its Newton initial guess); without this q_T_blk is uninitialized -> NaN under
+ ! bounds-checked/NaN-init builds, mirroring the coarse path (m_start_up: s_compute_q_T_sf)
+ if (chemistry) call s_compute_q_T_sf(q_T_blk, amr_fine(k)%q_cons, ibnd)
+ call s_convert_conservative_to_primitive_variables(amr_fine(k)%q_cons, q_T_blk, q_prim_blk, ibnd)
+
+ if (fp > 0) then
+ ndims = 3
+ else if (fn > 0) then
+ ndims = 2
+ else
+ ndims = 1
+ end if
+ dims = (/fm + 2, fn + 2, fp + 2/) ! cell-boundary counts per active dim
+ vdims = (/fm + 1, fn + 1, fp + 1/) ! zone counts per active dim
+
+ write (mname, '(A,I0,A,I0)') 'amr_blk', proc_rank, '_', k
+
+ if (format == format_silo) then
+ if (ndims == 3) then
+ err = DBPUTQM(out%dbfile, trim(mname), len_trim(mname), 'x', 1, 'y', 1, 'z', 1, amr_fine(k)%x_cb, &
+ & amr_fine(k)%y_cb, amr_fine(k)%z_cb, dims, 3, db_real, DB_COLLINEAR, DB_F77NULL, ierr)
+ else if (ndims == 2) then
+ err = DBPUTQM(out%dbfile, trim(mname), len_trim(mname), 'x', 1, 'y', 1, 'z', 1, amr_fine(k)%x_cb, &
+ & amr_fine(k)%y_cb, DB_F77NULL, dims, 2, db_real, DB_COLLINEAR, DB_F77NULL, ierr)
+ else
+ err = DBPUTQM(out%dbfile, trim(mname), len_trim(mname), 'x', 1, 'y', 1, 'z', 1, amr_fine(k)%x_cb, DB_F77NULL, &
+ & DB_F77NULL, dims, 1, db_real, DB_COLLINEAR, DB_F77NULL, ierr)
+ end if
+ else
+ write (out%dbfile) amr_fine(k)%lo, amr_fine(k)%hi, fm, fn, fp, nvars
+ write (out%dbfile) amr_fine(k)%x_cb
+ if (fn > 0) write (out%dbfile) amr_fine(k)%y_cb
+ if (fp > 0) write (out%dbfile) amr_fine(k)%z_cb
+ end if
+
+ allocate (vbuf(0:fm,0:fn,0:fp))
+ do ii = 1, nvars
+ if (ii == 1) then
+ vbuf = 0._wp
+ do i = eqn_idx%cont%beg, eqn_idx%cont%end
+ vbuf = vbuf + real(amr_fine(k)%q_cons(i)%sf(0:fm,0:fn,0:fp), wp)
+ end do
+ else if (ii == 2) then
+ vbuf = real(q_prim_blk(eqn_idx%E)%sf, wp)
+ else if (ii <= 2 + num_dims) then
+ vbuf = real(q_prim_blk(eqn_idx%mom%beg + (ii - 3))%sf, wp)
+ else
+ vbuf = real(q_prim_blk(eqn_idx%adv%beg + (ii - 3 - num_dims))%sf, wp)
+ end if
+ call s_put_amr_block_variable(trim(vnames(ii)))
+ end do
+ deallocate (vbuf)
+
+ do i = 1, sys_size
+ deallocate (q_prim_blk(i)%sf)
+ end do
+ deallocate (q_prim_blk, q_T_blk%sf)
+ end do
+
+ ! Register the block meshes/vars in the /root collection so they appear alongside the coarse multimesh (Silo only).
+ if (format == format_silo) then
+ allocate (counts(0:num_procs - 1))
+#ifdef MFC_MPI
+ call MPI_GATHER(amr_num_fine, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+#else
+ counts(0) = amr_num_fine
+#endif
+ if (proc_rank == 0) then
+ tot = sum(counts)
+ if (tot > 0) then
+ allocate (entry(tot), etypes(tot))
+ e = 0
+ do r = 0, num_procs - 1
+ do kk = 1, counts(r)
+ e = e + 1
+ write (entry(e), '(A,I0,A,I0,A,I0,A,I0)') '../p', r, '/', t_step, '.silo:amr_blk', r, '_', kk
+ end do
+ end do
+ etypes = DB_QUAD_RECT
+ err = DBSET2DSTRLEN(len(entry(1)))
+ err = DBPUTMMESH(out%dbroot, 'amr_blocks', 10, tot, entry, len_trim(entry), etypes, DB_F77NULL, ierr)
+ etypes = DB_QUADVAR
+ do ii = 1, nvars
+ e = 0
+ do r = 0, num_procs - 1
+ do kk = 1, counts(r)
+ e = e + 1
+ write (entry(e), '(A,I0,A,I0,A,A,A,I0,A,I0)') '../p', r, '/', t_step, '.silo:', trim(vnames(ii)), &
+ & '_amr', r, '_', kk
+ end do
+ end do
+ write (mvar, '(A,A)') 'amr_', trim(vnames(ii))
+ err = DBSET2DSTRLEN(len(entry(1)))
+ err = DBPUTMVAR(out%dbroot, trim(mvar), len_trim(mvar), tot, entry, len_trim(entry), etypes, DB_F77NULL, &
+ & ierr)
+ end do
+ deallocate (entry, etypes)
+ end if
+ end if
+ deallocate (counts)
+ end if
+
+ deallocate (vnames)
+
+ contains
+
+ !> Write the already-filled `vbuf` for the current block `k` as variable `nm`: a Silo quadvar on the block mesh, or a [name,
+ !! field] binary record. Object names are unique per rank+block (`_amr_`).
+ impure subroutine s_put_amr_block_variable(nm)
+
+ character(LEN=*), intent(in) :: nm
+ character(LEN=4*name_len) :: vn
+ integer :: ie
+
+ write (vn, '(A,A,I0,A,I0)') nm, '_amr', proc_rank, '_', k
+ if (format == format_silo) then
+ ie = DBPUTQV1(out%dbfile, trim(vn), len_trim(vn), trim(mname), len_trim(mname), vbuf, vdims, ndims, DB_F77NULL, &
+ & 0, db_real, DB_ZONECENT, DB_F77NULL, ierr)
+ else
+ write (out%dbfile) vn, vbuf
+ end if
+
+ end subroutine s_put_amr_block_variable
+
+ end subroutine s_write_amr_to_formatted_database_file
+
!> Write the post-processed results in the folder 'lag_bubbles_data'
impure subroutine s_write_lag_bubbles_results_to_text(t_step)
diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp
index a5151f2df1..cf36e05ddd 100644
--- a/src/post_process/m_global_parameters.fpp
+++ b/src/post_process/m_global_parameters.fpp
@@ -190,6 +190,9 @@ contains
t_save = dflt_real
t_stop = dflt_real
+ ! AMR: post_process overlays the refined fine blocks when this is on (default off)
+ amr = .false.
+
bc_io = .false.
num_bc_patches = dflt_int
diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp
index 9c697c0eab..8e98da25c3 100644
--- a/src/post_process/m_start_up.fpp
+++ b/src/post_process/m_start_up.fpp
@@ -155,6 +155,8 @@ contains
call s_read_data_files(t_step)
+ if (amr) call s_read_amr_data(t_step)
+
! seed the chemistry temperature over the INTERIOR only (mirrors the simulation,
! m_start_up): the ghost q_cons is unread at this point, so a ghost-inclusive sweep
! would Newton-iterate on garbage (NaN under NaN-init builds) at rank seams and
@@ -644,6 +646,8 @@ contains
if (ib_state_wrt) call s_write_ib_bodies_to_formatted_database_file(t_step)
+ if (amr) call s_write_amr_to_formatted_database_file(t_step)
+
if (sim_data .and. proc_rank == 0) then
call s_close_intf_data_file()
call s_close_energy_data_file()
diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp
index 04e3997378..e755c1ab8f 100644
--- a/src/pre_process/m_start_up.fpp
+++ b/src/pre_process/m_start_up.fpp
@@ -484,7 +484,7 @@ contains
call s_initialize_perturbation_module()
call s_initialize_assign_variables_module()
call s_initialize_boundary_common_module()
- if (relax) call s_initialize_phasechange_module()
+ if (relax) call s_initialize_phasechange_module([-1, -1, -1])
! Create the D directory if it doesn't exit, to store the serial data files
call s_create_directory('D')
diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp
index c478405d7d..fab775874f 100644
--- a/src/simulation/m_acoustic_src.fpp
+++ b/src/simulation/m_acoustic_src.fpp
@@ -13,12 +13,17 @@ module m_acoustic_src
use m_variables_conversion
use m_helper_basic
use m_constants
+ use m_mpi_common, only: s_mpi_allreduce_integer_min, s_mpi_allreduce_integer_max
implicit none
- private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations
+ private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations, &
+ & acoustic_supp_lo, acoustic_supp_hi
- integer, allocatable, dimension(:) :: pulse, support
+ !> Global (level-0 index space) bounding box of each source's spatial support, reduced over ranks. The AMR dynamic regrid keeps
+ !! fine blocks clear of these (the source acts on the coarse grid only). Allocated/filled only when amr with acoustic_source.
+ integer, allocatable, dimension(:,:) :: acoustic_supp_lo, acoustic_supp_hi !< (1:3, 1:num_source)
+ integer, allocatable, dimension(:) :: pulse, support
$:GPU_DECLARE(create='[pulse, support]')
logical, allocatable, dimension(:) :: dipole
@@ -120,6 +125,9 @@ contains
@:ALLOCATE(mom_src(1:num_vels, 0:m, 0:n, 0:p))
@:ALLOCATE(E_src(0:m, 0:n, 0:p))
+ ! host-only helper for the AMR regrid's source-exclusion clipping (filled by the precompute)
+ if (amr) allocate (acoustic_supp_lo(1:3,1:num_source), acoustic_supp_hi(1:3,1:num_source))
+
end subroutine s_initialize_acoustic_src
!> Compute mass, momentum, and energy acoustic source terms and add to the RHS
@@ -395,6 +403,7 @@ contains
integer :: j, k, l, ai
integer :: count
integer :: dim
+ integer :: sidx_supp(3), lo_loc, hi_loc, kb
real(wp) :: source_spatial, angle, xyz_to_r_ratios(3)
real(wp), parameter :: threshold = 1.e-10_wp
@@ -456,6 +465,53 @@ contains
call s_mpi_abort('Fatal Error: Inconsistent allocation of source_spatials')
end if
+ ! The AMR fine advance skips the acoustic source (the spatials above are coarse-grid
+ ! cell indices), so a static fine block overlapping the support would silently drop
+ ! the source inside the block - abort instead. Emitted waves still enter the block
+ ! through the coarse/fine coupling; only the support itself must stay coarse-only.
+ ! sidx_supp is the bounds-safe start offset: start_idx is allocated (1:num_dims) and
+ ! Fortran .or. does not short-circuit, so raw start_idx(2:3) reads are out of bounds
+ ! in 1D/2D.
+ if (amr) then
+ sidx_supp = 0
+ sidx_supp(1) = start_idx(1)
+ if (n_glb > 0) sidx_supp(2) = start_idx(2)
+ if (p_glb > 0) sidx_supp(3) = start_idx(3)
+ ! check every ACTIVE block region (this covers the user-placed initial block AND
+ ! restart-restored regridded boxes - a source moved between write and restart could
+ ! otherwise overlap a restored block and silently drop the source inside it)
+ do kb = 1, amr_num_blocks
+ ! a level-0 L0 tile is the base grid itself, not a refined region: every source
+ ! necessarily lies inside one, so testing tiles would reject all coexist runs
+ if (amr_block_level(kb) == 0) cycle
+ do j = 1, count
+ if (int(source_spatials(ai)%coord(1, j)) + sidx_supp(1) >= amr_region_lo_all(1, &
+ & kb) .and. int(source_spatials(ai)%coord(1, j)) + sidx_supp(1) <= amr_region_hi_all(1, &
+ & kb) .and. (n_glb == 0 .or. (int(source_spatials(ai)%coord(2, &
+ & j)) + sidx_supp(2) >= amr_region_lo_all(2, kb) .and. int(source_spatials(ai)%coord(2, &
+ & j)) + sidx_supp(2) <= amr_region_hi_all(2, &
+ & kb))) .and. (p_glb == 0 .or. (int(source_spatials(ai)%coord(3, &
+ & j)) + sidx_supp(3) >= amr_region_lo_all(3, kb) .and. int(source_spatials(ai)%coord(3, &
+ & j)) + sidx_supp(3) <= amr_region_hi_all(3, kb)))) then
+ call s_mpi_abort('amr with acoustic_source: the source support overlaps a fine block; ' &
+ & // 'the source acts on the coarse grid only - move the source or the block apart')
+ end if
+ end do
+ end do
+
+ ! global support bounding box (all ranks agree): the dynamic regrid suppresses tags
+ ! and clips candidate boxes against it so fine blocks never cover the source
+ do j = 1, 3
+ lo_loc = huge(1); hi_loc = -huge(1)
+ do k = 1, count
+ lo_loc = min(lo_loc, int(source_spatials(ai)%coord(j, k)) + sidx_supp(j))
+ hi_loc = max(hi_loc, int(source_spatials(ai)%coord(j, k)) + sidx_supp(j))
+ end do
+ call s_mpi_allreduce_integer_min(lo_loc, acoustic_supp_lo(j, ai))
+ call s_mpi_allreduce_integer_max(hi_loc, acoustic_supp_hi(j, ai))
+ end do
+ end if
+
if (count > 0) then
$:GPU_UPDATE(device='[source_spatials(ai)%coord]')
$:GPU_UPDATE(device='[source_spatials(ai)%val]')
diff --git a/src/simulation/m_active_box.fpp b/src/simulation/m_active_box.fpp
new file mode 100644
index 0000000000..54903c0039
--- /dev/null
+++ b/src/simulation/m_active_box.fpp
@@ -0,0 +1,185 @@
+!>
+!!@file
+!!@brief Contains module m_active_box
+
+#:include 'macros.fpp'
+
+!> @brief Causal-envelope active-box restriction of the RHS compute window.
+module m_active_box
+
+ use m_derived_types
+ use m_global_parameters
+ use m_mpi_proxy
+
+ implicit none
+
+ private
+ public :: s_initialize_active_box_module, s_finalize_active_box_module, s_initialize_active_box, s_grow_active_box, &
+ & s_check_active_box_envelope, ab_x, ab_y, ab_z, ab_active, ab_ambient
+
+ type(int_bounds_info) :: ab_x, ab_y, ab_z !< Active-box interior cell ranges
+ logical :: ab_active = .false. !< Whether the optimization is engaged
+ real(wp), allocatable :: ab_ambient(:) !< Uniform ambient conserved state
+ real(wp), parameter :: tol_ab = 1.e-10_wp !< Ambient-deviation threshold
+
+ $:GPU_DECLARE(create='[ab_x, ab_y, ab_z, ab_active]')
+
+contains
+
+ impure subroutine s_initialize_active_box_module
+
+ @:ALLOCATE(ab_ambient(1:sys_size))
+ ab_x%beg = 0; ab_x%end = m
+ ab_y%beg = 0; ab_y%end = n
+ ab_z%beg = 0; ab_z%end = p
+ ab_active = .false.
+ $:GPU_UPDATE(device='[ab_x, ab_y, ab_z, ab_active]')
+
+ end subroutine s_initialize_active_box_module
+
+ impure subroutine s_finalize_active_box_module
+
+ @:DEALLOCATE(ab_ambient)
+
+ end subroutine s_finalize_active_box_module
+
+ !> Detect the ambient state and set the initial active-box bounds from the IC support.
+ impure subroutine s_initialize_active_box(q_cons_vf)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
+ integer :: i, j, k, l
+ integer :: ib, ie, jb, je, kb, ke
+ logical :: deviates
+
+ ! num_procs > 1 is rejected in s_check_inputs (m_checker), so only the plain off-switch is left here.
+
+ if (.not. active_box) then
+ ab_active = .false.
+ $:GPU_UPDATE(device='[ab_active]')
+ return
+ end if
+
+ ! Ambient = the (0,0,0) interior corner cell, assumed in the undisturbed region.
+ do i = 1, sys_size
+ ab_ambient(i) = q_cons_vf(i)%sf(0, 0, 0)
+ end do
+
+ ! Bounding box of cells deviating from ambient.
+ ib = m + 1; ie = -1; jb = n + 1; je = -1; kb = p + 1; ke = -1
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ deviates = .false.
+ do i = 1, sys_size
+ if (abs(q_cons_vf(i)%sf(j, k, l) - ab_ambient(i)) > tol_ab) then
+ deviates = .true.; exit
+ end if
+ end do
+ if (deviates) then
+ ib = min(ib, j); ie = max(ie, j)
+ jb = min(jb, k); je = max(je, k)
+ kb = min(kb, l); ke = max(ke, l)
+ end if
+ end do
+ end do
+ end do
+
+ ! Empty deviation set -> nothing to do; disable.
+ if (ie < ib) then
+ ab_active = .false.
+ $:GPU_UPDATE(device='[ab_active]')
+ return
+ end if
+
+ ! Dilate by the reconstruction stencil and clamp to the interior.
+ ab_x%beg = max(0, ib - buff_size); ab_x%end = min(m, ie + buff_size)
+ ab_y%beg = max(0, jb - buff_size); ab_y%end = min(n, je + buff_size)
+ ab_z%beg = max(0, kb - buff_size); ab_z%end = min(p, ke + buff_size)
+
+ ! Box already covers the whole domain -> no benefit; disable.
+ ab_active = .not. (ab_x%beg == 0 .and. ab_x%end == m .and. ab_y%beg == 0 .and. ab_y%end == n .and. ab_z%beg == 0 &
+ & .and. ab_z%end == p)
+
+ $:GPU_UPDATE(device='[ab_x, ab_y, ab_z, ab_active]')
+
+#ifdef MFC_DEBUG
+ if (ab_active) then
+ print *, '[active_box] init box x[', ab_x%beg, ':', ab_x%end, '] y[', ab_y%beg, ':', ab_y%end, '] z[', ab_z%beg, ':', &
+ & ab_z%end, ']'
+ end if
+#endif
+
+ end subroutine s_initialize_active_box
+
+ !> Grow the active box by one light-cone step and refresh the device copy.
+ impure subroutine s_grow_active_box()
+
+ integer :: g
+
+ if (.not. ab_active) return
+
+ ! Growth by buff_size cells/step outruns the physical front (stable run: CFL <= ~1.4
+ ! cells/step), so the box edge leads the disturbance and sits in the exponentially-decaying,
+ ! sub-tolerance numerical precursor. Agreement to round-off (~1e-14), not bit-identical,
+ ! which the spec requires. Caveat: a finite-horizon round-off guarantee, not strict
+ ! numerical-light-cone containment. A bit-identical variant would grow nstage*(weno_polyn+1)
+ ! = ~9 cells/step (full numerical domain of dependence) for a looser box and lower speedup -
+ ! future option. Under-growth (CFL > buff_size) implies an already-diverging run.
+ g = buff_size
+
+ ab_x%beg = max(0, ab_x%beg - g); ab_x%end = min(m, ab_x%end + g)
+ ab_y%beg = max(0, ab_y%beg - g); ab_y%end = min(n, ab_y%end + g)
+ ab_z%beg = max(0, ab_z%beg - g); ab_z%end = min(p, ab_z%end + g)
+
+ ! Once the box fills the domain, disable (full-domain is correct and avoids the bookkeeping).
+ if (ab_x%beg == 0 .and. ab_x%end == m .and. ab_y%beg == 0 .and. ab_y%end == n .and. ab_z%beg == 0 .and. ab_z%end == p) then
+ ab_active = .false.
+ end if
+
+ $:GPU_UPDATE(device='[ab_x, ab_y, ab_z, ab_active]')
+
+ end subroutine s_grow_active_box
+
+ !> Abort in debug builds if the disturbance has reached the active-box boundary (under-growth).
+ impure subroutine s_check_active_box_envelope(q_cons_vf)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
+
+#ifdef MFC_DEBUG
+ integer :: i, j, k, l
+ logical :: in_margin
+ if (.not. ab_active) return
+#ifdef MFC_GPU
+ ! Refresh host copy before reading conserved fields on CPU.
+ do i = 1, sys_size
+ $:GPU_UPDATE(host='[q_cons_vf(i)%sf]')
+ end do
+#endif
+ ! Check the buff_size-thick layer just INSIDE each box face. The RK loop updates these cells,
+ ! so a front reaching them means the reconstruction margin is compromised (box under-grown).
+ ! The exterior layer is frozen-ambient by construction and cannot detect under-growth.
+ ! Degenerate dims (n=0/p=0) contribute no faces. A face clamped to the domain edge has no
+ ! frozen exterior: the disturbance may legitimately reach it (reflection/outflow), so its
+ ! margin is exempt.
+ do l = ab_z%beg, ab_z%end
+ do k = ab_y%beg, ab_y%end
+ do j = ab_x%beg, ab_x%end
+ in_margin = (ab_x%beg > 0 .and. j <= ab_x%beg + buff_size - 1) .or. (ab_x%end < m .and. j >= ab_x%end &
+ & - buff_size + 1)
+ if (n > 0) in_margin = in_margin .or. (ab_y%beg > 0 .and. k <= ab_y%beg + buff_size - 1) .or. (ab_y%end < n &
+ & .and. k >= ab_y%end - buff_size + 1)
+ if (p > 0) in_margin = in_margin .or. (ab_z%beg > 0 .and. l <= ab_z%beg + buff_size - 1) .or. (ab_z%end < p &
+ & .and. l >= ab_z%end - buff_size + 1)
+ if (.not. in_margin) cycle
+ do i = 1, sys_size
+ @:ASSERT(abs(q_cons_vf(i)%sf(j, k, l) - ab_ambient(i)) <= tol_ab, &
+ & "active_box: disturbance reached the box boundary (under-grown)")
+ end do
+ end do
+ end do
+ end do
+#endif
+
+ end subroutine s_check_active_box_envelope
+
+end module m_active_box
diff --git a/src/simulation/m_amr.fpp b/src/simulation/m_amr.fpp
new file mode 100644
index 0000000000..1e27b3348e
--- /dev/null
+++ b/src/simulation/m_amr.fpp
@@ -0,0 +1,10060 @@
+!>
+!!@file
+!!@brief Contains module m_amr
+
+#:include 'macros.fpp'
+
+!> @brief Block-structured AMR: up to amr_max_blocks refined blocks (2:1 or 4:1 per amr_ref_ratio), optionally nested to
+!! amr_max_level, advanced with the shared solver via grid-state swap and conservatively coupled to each block's parent level (ghost
+!! prolongation, Berger-Colella flux reflux, restriction); optional dt/2 subcycling and dynamic regrid.
+module m_amr
+
+#ifdef MFC_MPI
+ use mpi !< MPI-IO for the parallel_io AMR restart file
+#endif
+
+ use m_derived_types ! scalar_field, t_box, int_bounds_info
+ use m_box, only: f_morton ! shared 3D Morton key (single-sourced with m_sfc_partition)
+ use m_global_parameters
+ use m_constants, only: num_fluids_max, model_eqns_6eq, mapCells, K_ib, K_pc, BC_GHOST_EXTRAP
+ use m_pressure_relaxation, only: s_pressure_relaxation_procedure
+ use m_mpi_proxy, only: s_mpi_abort
+ use m_mpi_common, only: s_mpi_allreduce_integer_min, s_mpi_allreduce_integer_max, s_mpi_allreduce_sum, s_mpi_allreduce_min, &
+ & s_mpi_allreduce_max, s_mpi_allreduce_integer_sum, s_mpi_sendrecv_variables_buffers, s_mpi_allreduce_array_max
+ use m_rhs, only: s_compute_rhs, q_prim_qp
+ use m_variables_conversion, only: s_convert_species_to_mixture_variables_kernel, s_compute_pressure, enforce_density_floor_vc
+ use m_phase_change, only: s_infinite_relaxation_k, pc_iter_count
+ use m_amr_registers, only: s_amr_zero_fine_registers, s_amr_reflux_apply_faces, s_amr_parent_foot, freg, creg, &
+ & s_amr_reg_prepare, f_amr_face_is_seam
+ use m_rank_timing, only: s_rank_time_tic, s_rank_time_toc
+ use m_phase_timing
+ use m_amr_xchg_audit ! I1a: per-call-site accounting of every AMR p2p transfer (s_xa_rec + XA_* site ids)
+ use m_ibm, only: s_ibm_alloc_fine, s_ibm_setup_fine, s_ibm_swap_to_fine, s_ibm_restore_from_fine, s_ibm_correct_state, &
+ & s_update_mib, moving_immersed_boundary_flag, num_gps, ib_markers
+ use m_hypoelastic, only: s_hypoelastic_update_fd_coeffs
+ use m_weno, only: s_compute_weno_coefficients
+ use m_active_box, only: ab_active
+ use m_bubbles_EL, only: s_lag_cloud_bbox_local
+ use m_igr, only: jac, jac_old
+
+ implicit none
+
+ private
+ public :: t_level, amr_maxc, amr_maxc_fit, s_initialize_amr_module, s_populate_amr_fine, s_interpolate_coarse_to_fine, &
+ & s_restrict_fine_to_coarse, s_finalize_amr_module, s_amr_stage_fill_wave, s_amr_parent_fill_wave, &
+ & s_amr_fine_stage_advance, s_amr_fine_fine_halo, s_amr_advance_fine_subcycle_all, s_set_amr_fine_geometry, &
+ & s_amr_relax_fine, s_amr_setup_ib, s_amr_p2p_reflux_faces, s_amr_reflux_faces_wave, s_amr_freg_wave, &
+ & s_amr_restrict_wave, s_amr_convert_prim_batch, amr_prim_batch, s_amr_reflux_to_parent, s_l0_tiles_init, &
+ & s_l0_advance_stage, s_l0_advance_stage_rhs, s_l0_advance_stage_rk, s_l0_copy_coarse_to_tiles, &
+ & s_l0_scatter_tiles_to_coarse, s_l0_add_reflux_to_tiles, s_l0_restrict_to_tiles, s_l0_tiles_finalize, s_l0_forced_remap, &
+ & s_l0_rebalance, s_l0_fill_tiles_from_coarse
+ ! s_amr_swap_to_fine / s_amr_restore_coarse / s_amr_fill_fine_ghosts / amr_dt_fine are internal (no external caller); keeping
+ ! them private makes "the swap has exactly these audited call sites" a compiler guarantee, not a convention.
+ !> Block/slot state and fine-distribution services consumed by m_amr_regrid and m_amr_restart (the drivers split out of this
+ !! module). State stays HERE - only the drivers moved.
+ public :: s_amr_br_load_all, s_amr_br_store_all, amr_br_w, amr_br_batch, amr_rg_gather
+ public :: s_amr_build_gather_plan, amr_gpl_valid
+ public :: s_amr_gather_chunk_post, s_amr_gather_chunk_send, s_amr_gather_consume_box, amr_gath_chunk, s_amr_cov_note, &
+ & amr_cad_tot, amr_cad_esc, amr_cad_armed
+ public :: amr_slots, amr_cons_st, amr_stor_st, amr_loc_of, amr_seam_pairs_dirty, amr_mesh_epoch, amr_tag_base, &
+ & amr_xchg_coarse_ghosts, amr_cpat_mar, s_amr_alloc_slot, s_amr_alloc_slot_stash, s_amr_prereserve_stash, &
+ & s_amr_free_slot, s_amr_reconcile_slots, s_amr_reduce_xchg_flag, s_amr_assign_block_owners, s_amr_gather_coarse_patch, &
+ & s_amr_gather_send_flush, s_amr_gather_coarse_patch_pbmv, s_amr_prolong_pbmv, s_amr_exchange_coarse_cons_halo, &
+ & s_lag_phys_to_cells, s_amr_body_bbox, s_amr_expand_box_over_bodies, s_amr_tile_box, f_amr_seam_dim, &
+ & f_amr_boxes_overlap, f_l0_slot
+
+ !> Fine-level time step for subcycling (= 0.5*dt after init; 0 when amr is off).
+ real(wp) :: amr_dt_fine = 0._wp
+
+ !> Realizability floor for prolonged Euler-Euler bubble POSITIVE moments (radius nR, non-polytropic partial pressure npb / vapor
+ !! mass nmv): a positive fraction of the coarse parent so derived R = nR/n, pb, mv stay >= 0. Minmod keeps a positive field
+ !! positive, so this fires only under floating-point edge cases (conservation defect ~0 otherwise).
+ real(wp), parameter :: bub_pos_frac = 1.0e-10_wp
+
+ !> One refined level: its own grid + conservative fields. Field arrays are device-resident (@:ALLOCATE); coords/metadata
+ !! host-only.
+ type t_level
+ integer :: amr_ref_ratio
+ type(t_box) :: region !< block extent in parent (level-0) cell indices
+ integer :: m, n, p !< this level's interior extents
+ integer :: buff_size
+ type(int_bounds_info) :: idwbuff(3)
+ real(wp), allocatable :: x_cb(:), x_cc(:), dx(:)
+ real(wp), allocatable :: y_cb(:), y_cc(:), dy(:)
+ real(wp), allocatable :: z_cb(:), z_cc(:), dz(:)
+ !> conserved state lives in the FLAT STORE amr_cons_st, indexed by this slot's dense local index amr_loc_of - not here.
+ !> SSP-RK stage storage lives in the FLAT STORE amr_stor_st, indexed by this slot's amr_loc_of.
+ type(scalar_field), allocatable :: q_prim(:) !< primitive stage (fine advance, same bounds)
+ type(scalar_field), allocatable :: rhs(:) !< RHS (fine interior only: 0:m, 0:n, 0:p)
+ !> non-polytropic QBMM quadrature side-state on the block (nnode x nb per cell). pb/mv evolve cell-locally (their rhs reads
+ !! only the local cell + the block's own moment fluxes), so the fine treatment is prolong -> advance -> restrict with no
+ !! reflux; ghosts feed the widened-idwint conversions and are prolonged piecewise-constant (CHyQMOM realizability, like the
+ !! moments).
+ type(pres_field) :: pb_f, mv_f !< fine pb/mv (ghost-inclusive)
+ type(pres_field) :: pb_stor, mv_stor !< SSP-RK step-entry backup (also the regrid bounce)
+ !> subcycle ghost-lerp sources at coarse t^n / t^{n+1} (ghost shell only): ghost pb feeds the mixture pressure in the
+ !! widened conversion, so it needs the same time fidelity as q_cons
+ type(pres_field) :: pb_ghost_a, mv_ghost_a
+ type(pres_field) :: pb_ghost_b, mv_ghost_b
+ end type t_level
+
+ !> Fixed pool of refined-block slots (at init one slot is active; dynamic regrid activates up to amr_max_blocks). The working
+ !! slot amr_cur (m_global_parameters) selects which slot every per-block routine operates on.
+ type(t_level), allocatable :: amr_slots(:)
+
+ !> DENSE LOCAL INDEX for live slots. `amr_slots` is indexed by GLOBAL block index and allocated lazily, so live slots are SPARSE
+ !! across 1:amr_max_blocks (1024 by default). A contiguous per-block field store - the layout AMReX's MultiFab uses and the
+ !! prerequisite for batching one kernel over all blocks - must be indexed DENSELY by a local index instead, or it would have to
+ !! be sized for the whole global pool. `amr_loc_of(g)` is the local index of global slot g (0 if not live), `amr_loc_n` is the
+ !! high-water mark, and freed indices are recycled through `amr_loc_free` so the dense range stays tight under regrid churn.
+ !! Pure bookkeeping: nothing reads it yet.
+ integer, allocatable :: amr_loc_of(:) !< global slot -> dense local index, 0 if not live
+ integer, allocatable :: amr_loc_free(:) !< stack of recycled local indices
+ integer :: amr_loc_n = 0 !< high-water mark of local indices handed out
+ !> Last high-water REPORTED by the store trip-wire. Module scope (not `save`) so the wire prints one line per NEW high-water
+ !! instead of one per slot alloc (~224/regrid/rank would both flood stderr and perturb the run).
+ integer :: amr_st_hw = 0
+ !> TRACK S instrumentation: bytes each rank ALLOCATES for, and RECEIVES from, global collectives during one regrid. These are
+ !! the quantities that must stay O(1) in problem size; wall time at a single problem size cannot see them (rg:clus measured
+ !! 0.6%% of wall), so they are counted explicitly. amr_gb_tag counted the level-1 tag ALLGATHERV and is now permanently 0: S3.1
+ !! deleted that collective, so a nonzero value means the gather came back. amr_gb_win = the gwin-pair ALLGATHERVs (levels >= 2,
+ !! still live -- S3.3), amr_gb_cost = the per-box cost ALLREDUCE.
+ integer(8) :: amr_gb_tag = 0, amr_gb_win = 0, amr_gb_cost = 0
+ !> Bytes each rank RECEIVES from the two box-list ALLGATHERVs per regrid: the clusterer's accepted-box union (m_amr_regrid.fpp
+ !! `gbx(6,ntot)`) and the nesting pass's child list (`gch(7,ntot_ch)`). These are what keeps the block metadata replicated, and
+ !! they are O(GLOBAL BOXES) -- the "limit 3" that amr_per_level_distribution.md audited on 2026-07-31 and deferred with an
+ !! explicit bar: "do not trade that away without a measurement showing it binds". That doc priced limit 3 as MEMORY (5.6 MB/rank
+ !! at 1e5 boxes); this counter prices the GATHER that maintains it every regrid, which is the term that actually binds. Judge
+ !! the SLOPE across np, not the value.
+ integer(8) :: amr_gb_box = 0
+ !> S3.0a/S3.0b instrumentation: shape and reduction cost of the Berger-Rigoutsos clustering tree (`s_amr_cluster`). Named
+ !! amr_cl_ (clustering), NOT amr_br_ -- that prefix already means the batched BRIDGE in this module. Tree DEPTH decides whether
+ !! S3 can fuse one collective per tree LEVEL; BR splits at signature holes, not midpoints, so the tree is not balanced by
+ !! construction and depth must be measured. TWO independent maxima are kept: one running max with a tie-break would pair a deep
+ !! tiny subtree with the wrong leaf count and could fake either verdict. amr_cl_maxdep / amr_cl_maxdep_leaf = the DEEPEST call
+ !! and its leaf count (catches a one-box-at-a-time peel chain). amr_cl_lmax / amr_cl_ldepth = the LARGEST call and its depth
+ !! (the tree that actually dominates the cost). amr_cl_nodes = nodes visited = the collectives a per-node distributed recursion
+ !! pays. amr_cl_rb = bytes that recursion would ALLREDUCE: one fused reduction per node carrying the 1D signature of every
+ !! splittable axis. Sized on the UNTRIMMED box, because trim only shrinks to the contained tags own bbox, so the trimmed
+ !! signature is a slice of the untrimmed one and that single reduction serves trim, count AND split.
+ integer :: amr_cl_maxdep = 0, amr_cl_maxdep_leaf = 0, amr_cl_lmax = 0, amr_cl_ldepth = 0
+ integer(8) :: amr_cl_nodes = 0, amr_cl_rb = 0, amr_cl_rb_now = 0
+ !> S3.2a: does a tree node's box fit inside ONE rank's subdomain? If so the owning rank holds every tag in the subtree and the
+ !! whole remaining subtree needs NO communication -- that is the property the S3.2 design rests on, and this measures how much
+ !! of the tree has it. shr = nodes spanning >1 rank (must be exchanged), loc = rank-local (free). amr_cl_shr_maxdep is the depth
+ !! of the deepest node still shared, i.e. the number of levels S3.2 must communicate. SPLIT BY PATH. The level-2 forest clusters
+ !! inside a parent window, so its boxes are small and mostly rank-local BY CONSTRUCTION; folding it in with the level-1 tree
+ !! would inflate the local fraction and make S3.2's premise look true even if level-1 -- the only path that reduces today -- is
+ !! mostly shared. `_r` = the reducing (level-1) path.
+ integer(8) :: amr_cl_shr_nodes = 0, amr_cl_shr_rb = 0, amr_cl_loc_nodes = 0, amr_cl_loc_rb = 0
+ integer(8) :: amr_cl_shr_nodes_r = 0, amr_cl_shr_rb_r = 0, amr_cl_loc_nodes_r = 0, amr_cl_loc_rb_r = 0
+ integer :: amr_cl_shr_maxdep = 0, amr_cl_shr_maxdep_r = 0
+ !> S3.2a-2: what the shallow phase would cost THIS rank. shr_rb_r counts every shared node and so prices the ALLREDUCE form,
+ !! where each node's whole signature lands on every rank. Under S3.2's sparse per-depth exchange a rank touches only the shared
+ !! nodes its own subdomain OVERLAPS, so these count that subset -- the quantity that has to be sublinear in P for W4.
+ integer(8) :: amr_cl_me_nodes_r = 0, amr_cl_me_rb_r = 0
+ !> S3.2b-2b: bytes this rank ACTUALLY received settling the clustering tree -- the wide batch (which every rank receives in
+ !! full) plus only the narrow slices addressed to it. amr_cl_me_rb_r is a PREDICTION of what scoping should cost; this is the
+ !! measurement, and the two agreeing is what says the exchange delivers what the design claims.
+ integer(8) :: amr_cl_wire_r = 0
+ !> TRACK T (T0b gate): regrid migration volume. An old block is ISENT to EVERY new-owner rank whose box overlaps it, so the cost
+ !! is fan-out x block bytes, not one send per block. amr_mig_blk counts blocks that had to move at all, amr_mig_snd counts the
+ !! sends, amr_gb_mig the bytes. fan-out = snd/blk is the reducible quantity: if it is ~1 the volume is inherent and hysteresis
+ !! buys nothing.
+ integer(8) :: amr_gb_mig = 0, amr_mig_snd = 0, amr_mig_blk = 0
+ public :: amr_gb_tag, amr_gb_win, amr_gb_cost, amr_gb_box
+ public :: amr_cl_maxdep, amr_cl_maxdep_leaf, amr_cl_lmax, amr_cl_ldepth, amr_cl_nodes, amr_cl_rb, amr_cl_rb_now
+ public :: amr_cl_shr_nodes, amr_cl_shr_rb, amr_cl_loc_nodes, amr_cl_loc_rb, amr_cl_shr_maxdep
+ public :: amr_cl_shr_nodes_r, amr_cl_shr_rb_r, amr_cl_loc_nodes_r, amr_cl_loc_rb_r, amr_cl_shr_maxdep_r
+ public :: amr_cl_me_nodes_r, amr_cl_me_rb_r, amr_cl_wire_r
+ public :: s_amr_ranks_overlapping !< exported for the S3.2a scope measurement in m_amr_regrid
+ public :: f_amr_overlap_count, f_amr_rank_overlaps !< S3.2b-2b: node width and membership without the O(P) enumeration
+ public :: amr_my_blk, amr_n_my, s_amr_refresh_my_blocks !< S3.3c: the regrid pass-1 scan needs the owned-block list too
+ public :: s_amr_fw_szi !< S3.2b-2: the clusterer's per-depth signature batch grows with the same doubling helper
+ public :: amr_gb_mig, amr_mig_snd, amr_mig_blk
+ integer :: amr_loc_nfree = 0 !< depth of the recycle stack
+
+ !> FLAT PER-BLOCK FIELD STORE, indexed (x, y, z, var, LOCAL slot) by the dense index above. One contiguous module array
+ !! replacing a per-slot vector of independently allocated scalar_fields: the layout AMReX's MultiFab uses, and the prerequisite
+ !! for running ONE kernel over every live block instead of one kernel per block. Every slot's arrays carry the same mbuf
+ !! extents, so a single array serves them all. The ghost pair exists only under amr_subcycle. Sized by s_amr_st_reserve.
+ real(stp), allocatable, dimension(:,:,:,:,:) :: amr_cons_st, amr_stor_st, amr_gst_a, amr_gst_b
+ $:GPU_DECLARE(create='[amr_cons_st, amr_stor_st, amr_gst_a, amr_gst_b]')
+ !> local slots the store is sized for; grows and never shrinks, but plateaus at the rebuild-transient high-water because
+ !! s_amr_compact_store re-densifies the index space every reconcile
+ integer :: amr_st_cap = 0
+
+ !> 2a PRIM LANDING ZONE for the batched cons->prim conversion (s_amr_convert_prim_batch): the COMPUTED prim vars only - the
+ !! contiguous eqn_idx%mom%beg..eqn_idx%E range (velocities + pressure), var dim 1..num_vels+1. The aliased prim vars (cont, adv,
+ !! c, psi) ride the cons copy-in inside s_compute_rhs as always. Per-STAGE scratch: rewritten by every batch call, so store
+ !! growth discards it (no staging round trip). Sized with the store in s_amr_st_reserve, only under the amr_prim_batch gate.
+ real(stp), allocatable, dimension(:,:,:,:,:) :: amr_prim_st
+ $:GPU_DECLARE(create='[amr_prim_st]')
+ !> per-dense-slot batch metadata: participating fine slot + its idwbuff window (host-filled each batch call)
+ integer, allocatable :: amr_bt_lo(:,:), amr_bt_hi(:,:) !< (3, loc)
+ logical, allocatable :: amr_bt_on(:)
+ $:GPU_DECLARE(create='[amr_bt_lo, amr_bt_hi, amr_bt_on]')
+ !> 2a master gate, derived once at init: the batched conversion covers the plain multi-fluid configs (5/6-eq, WENO, with/without
+ !! viscous); every feature that adds conversion write-set members or changes its inputs (igr, chemistry, relativity,
+ !! hypoelasticity, mhd, cont_damage, ib, Lagrangian bubbles, subcycle) falls back to the per-block conversion path unchanged.
+ logical :: amr_prim_batch = .false.
+
+ !> COPY BRIDGE to the shared solver. s_compute_rhs, s_ibm_correct_state, s_pressure_relaxation_procedure and
+ !! s_infinite_relaxation_k all take type(scalar_field), dimension(sys_size) and serve the monolithic path too, so the flat store
+ !! cannot be handed to them; a pointer view into the store is not attachable on the OpenMP-offload backend (measured - see
+ !! docs/documentation/amr_block_batching.md). One block-shaped scalar_field array bridges instead: load it from the store, call,
+ !! store it back. All four dummies are intent(inout) - s_compute_rhs writes the buffer region through
+ !! s_populate_variables_buffers - so BOTH directions are required at every crossing.
+ !> DEVICE-DECLARED because `@:ALLOCATE` expands to `allocate` FOLLOWED BY `GPU_ENTER_DATA(create=)`, i.e. an `omp target enter
+ !! data map` on the variable itself. Mapping a module allocatable that was never `declare target` has no device descriptor to
+ !! attach to: Cray CCE aborts at runtime with `lib-4425 UNRECOVERABLE library error: Unitialized descriptor for ALLOCATE
+ !! statement argument`, while amdflang's runtime tolerates it and creates the mapping implicitly. The fix is the `move_alloc` +
+ !! GPU_ENTER_DATA pair at the allocation site; do NOT add a GPU_DECLARE on top of it (see amr_scr_prim below).
+ type(scalar_field), allocatable :: amr_cons_br(:)
+ !> Batched-bridge geometry. amr_br_w is one block's buffered k-width; block loc of a batch sits at k-offset (loc-1)*amr_br_w,
+ !! carrying its own ghost shell, so consecutive blocks are separated by TWO ghost shells and no block's stencil can reach
+ !! another's interior - the property the batched advance's correctness rests on.
+ integer :: amr_br_w = 0, amr_br_nblk = 0
+ !> P1 pooled advance scratch: the fused per-block fine advance (rhs then rk on ONE block, s_amr_fine_stage_advance) leaves no
+ !! cross-block q_prim/rhs lifetime, so every fine block shares this one slot-shaped pair instead of carrying per-slot arrays
+ !! (~2x105 MiB per live slot at the S0 point - the np>=8 live-footprint blocker AND the alloc/free churn that fed the
+ !! libomptarget retention plateau). Same shared-scratch pattern as amr_rhs_pb_f/amr_cg. L0 tile slots are the exception and keep
+ !! per-slot arrays (see s_amr_alloc_slot).
+ type(scalar_field), allocatable :: amr_scr_prim(:), amr_scr_rhs(:)
+ !> NOT device-declared. A GPU_DECLARE(create=) on a module allocatable binds a present-table entry to the descriptor at program
+ !! init; the `move_alloc` below then swaps that descriptor out and every later kernel lookup misses, which failed all 36 AMR
+ !! tests on Frontier CCE gpu-acc with `find_in_present_table failed`. The `move_alloc` + GPU_ENTER_DATA pair at the allocation
+ !! site is what fixes the lib-4425 descriptor abort, and it is sufficient on its own - `amr_cg` has used exactly that shape,
+ !! with no declare, on every lane.
+ !> True only while the REGRID path is inside s_amr_gather_coarse_patch, so the WAITALL bracket attributes to rb:wait rather than
+ !! mixing in the per-step gather that shares this routine.
+ logical :: amr_rg_gather = .false.
+ !> Blocks per batched call. BOUNDED on purpose. Sizing the bridge per-block (one slot for every block) OOMed the device on the
+ !! 400^3 case: a buffered block is ~110 MB at cap 64 and the slot cap grows geometrically and never shrinks, so the bridge alone
+ !! reached multiple GB against a working set already near 43 GiB/GCD. A fixed window keeps bridge memory O(1) in the block count
+ !! - which the exascale goal requires anyway - and still collapses launches by this factor.
+ !> 1 = the batched path is DORMANT. G0.2 measured PH_RHS at 54-57%% GPU-busy, so batching the fine advance is a ~1.09x item
+ !! (plan rule: >50%% -> Track B waits for Track R); a batch >1 would allocate 8x the bridge for nothing.
+ integer, parameter :: amr_br_batch = 1
+ integer :: amr_maxc(3) !< max coarse block cells per dim: (m_glb+1)/2 etc.; 1 for collapsed dims
+
+ !> Per-slot field-array sizing (module-scope, used by s_amr_alloc_slot/s_amr_free_slot): max fine cells per dim (2*maxc_loc-1)
+ !! and the buffered array bounds. amr_slot_live(k) tracks whether slot k's field arrays are allocated - lazy owned-only sizing
+ !! keeps a rank's fine memory ~1/num_procs of the pool.
+ integer :: max_f1, max_f2, max_f3
+ integer :: mbuf1_lo, mbuf1_hi, mbuf2_lo, mbuf2_hi, mbuf3_lo, mbuf3_hi
+ logical, allocatable :: amr_slot_live(:)
+ !! cached same-level adjacent-seam list (3, npairs) = (xb, yb, seam-dim), so s_amr_fine_fine_halo iterates O(#seams) instead of
+ !! rescanning all O(nblocks^2) pairs every RK stage. Block topology changes only at regrid/restart, so the list is rebuilt only
+ !! when amr_seam_pairs_dirty is set (or the block count changes - a tripwire).
+ integer, allocatable :: amr_seam_pairs(:,:)
+ integer :: amr_num_seam_pairs, amr_seam_pairs_nblk
+ logical :: amr_seam_pairs_dirty
+ !! amr_mesh_epoch now lives in m_global_parameters (m_amr_registers keys its participation-map rebuild on it and
+ !! cannot use m_amr); it is use-associated here and re-exported, so importers of m_amr are unchanged.
+ !! per-family plan message tag bases (families F1..F7, amr_plan_based_exchange.md): amr_max_blocks + 100*f keeps
+ !! the plan tag space disjoint from the legacy per-box space (tags in [1..amr_max_blocks]) while families convert;
+ !! the epoch is folded in as base + mod(amr_mesh_epoch, 100). The init MPI_TAG_UB assert is the scale tripwire, and its
+ !! headroom is an implementation property that must be MEASURED, not assumed: this comment previously asserted a 2**21 ceiling
+ !! (~2.1e6 blocks, ~28k ranks) and called it the second scaling wall after W4. Measured 2026-08-28: Open MPI 4.1.8 reports
+ !! MPI_TAG_UB = 2**31 - 1 and Frontier's Cray MPICH reports 2**29 - 1 = 536870911, i.e. ~537e6 global blocks or ~7.2e6 ranks at
+ !! ~75 boxes/rank -- about 95x headroom over Frontier's ~75k GCDs. So the tag space is NOT a wall on either MPI we target.
+ !! The amr_max_blocks term can only go once NO family uses per-box tags. Verified 2026-08-27: 19 of 41 AMR p2p call sites
+ !! still tag per box (F1's unconverted path uses amr_cur, migration uses the column index), and the subcycle sites are an
+ !! EXPLICIT deferral to increment I8, not I7 -- I7's own boundary is that any family left per-box keeps its tables.
+ integer :: amr_tag_base(7) = 0
+ !! cached per-block P2P overlap-rank lists (rebuilt with the seam list - same dirty flag): amr_ovl_gather(:,k) = ranks whose
+ !! owned coarse range (s_amr_rank_coarse_range) intersects block k's amr_cpat_mar-padded patch box (gather contributors);
+ !! amr_ovl_scatter(:,k) = ranks whose coarse interior (s_amr_rank_interior) intersects block k's region box (restrict-scatter
+ !! destinations). Built by O(overlap) inversion (s_amr_ranks_overlapping), rank-ASCENDING and NOT owner-excluded (consumers keep
+ !! their owner skip), so iterating a list reproduces the replaced per-call 0..num_procs-1 scan's MPI send/recv order exactly.
+ !> (max-overlap, amr_max_blocks); sized in s_amr_build_seam_pairs
+ integer, allocatable :: amr_ovl_gather(:,:), amr_ovl_scatter(:,:)
+ !> W1a: the block indices THIS rank owns, ascending. The stage-path waves used to scan the whole GLOBAL block list (`do k = 1,
+ !! amr_num_blocks`) and filter to their own ~75 -- ~48 such scans per step under RK3, so ~360 M predicate evaluations per rank
+ !! per step at 1e5 ranks, linear in P while the real work is fixed. Iterating this list instead is O(local). Built ASCENDING in
+ !! s_amr_assign_block_owners, which is the single authority for ownership (regrid, init and both restart paths all route through
+ !! it), so skipping the non-owned blocks a converted loop would have `cycle`d anyway leaves the iteration ORDER identical --
+ !! which the paired MPI_SENDRECVs depend on.
+ integer, allocatable :: amr_my_blk(:)
+ integer :: amr_n_my = 0
+ !> Set wherever amr_block_owner is WRITTEN. s_amr_assign_block_owners is NOT the only writer -- a tiled level-2 block inherits
+ !! its parent's owner (s_amr_add_l2_tile), and the restart/migration paths assign directly -- so a list built only in the
+ !! assigner goes stale and a converted loop then visits the wrong blocks. Caught by the tiled-L2 multi-level dynamic-regrid
+ !! golden, which is the one test that exercises the inherit path.
+ logical :: amr_myblk_dirty = .true.
+ integer, allocatable :: amr_ovl_gather_n(:), amr_ovl_scatter_n(:) !< per-block list lengths
+ !> Rebuild gather PLAN (gather-batching step 1): the whole rebuild's gather message set, derived up front by
+ !! s_amr_build_gather_plan from the replicated caches. Per level-1 slot: contributor count/ranks/message sizes (owner excluded,
+ !! list order = amr_ovl_gather order). Per level>=2 slot: the parent-owner source rank (-1 when co-located, no message) and its
+ !! message size. The per-box gather ASSERTS its inline derivation against this plan (guarded on amr_rg_gather + amr_gpl_valid,
+ !! so per-step gathers never consult it); the chunked exchange of step 2 may trust the plan only because those asserts prove it
+ !! reproduces today's message set exactly.
+ integer, allocatable :: amr_gpl_nsrc(:), amr_gpl_src(:,:), amr_gpl_sz(:,:), amr_gpl_psrc(:), amr_gpl_psz(:)
+ logical :: amr_gpl_valid = .false. !< true only between plan build and the end of the rebuild box loop
+ !> Chunked rebuild gather (step 2, amr_regrid_gather_batching.md): the rebuild box loop runs in chunks of amr_gath_chunk boxes -
+ !! every owned box's recvs (level-1 contributor slices AND split level>=2 parent patches) are pre-posted from the plan into one
+ !! flat pool, this rank's sends are issued (level>=2 only when the parent was consumed in an EARLIER chunk - a same-chunk
+ !! parent's store is unbuilt until its own consume, so that send stays at the child's consume position), then boxes are consumed
+ !! in order with a per-box wait. Requests are appended in box order, so each box's recvs are the contiguous run amr_gcr_r0 :
+ !! +amr_gcr_nr-1. The pool/request arrays grow monotonically and are reusable across chunks ONLY because the consume phase waits
+ !! every owned box's requests unconditionally inside its own chunk.
+ integer, parameter :: amr_gath_chunk = 32 !< boxes per chunk: staging memory vs message batching
+ real(wp), allocatable :: amr_gcr_pool(:) !< flat recv staging for one chunk
+ integer, allocatable :: amr_gcr_req(:), amr_gcr_off(:) !< request handle + pool offset per posted recv
+ integer :: amr_gcr_r0(amr_gath_chunk), amr_gcr_nr(amr_gath_chunk) !< per chunk-local box: first recv, count
+ logical :: amr_gcr_sent(amr_gath_chunk) !< chunk-local: level>=2 send already issued in the send phase
+ integer :: amr_gcr_n = 0 !< posted recvs in the current chunk
+ !> I2a stage-fill WAVE (plan-based exchange, amr_plan_based_exchange.md I2): the non-subcycle level-1 per-stage fill's F1 q_cons
+ !! + F3 pb/mv gathers as ONE per-(peer, family) aggregated exchange per RK stage, replacing the per-box owner-WAITALL /
+ !! contributor-flush rendezvous chain. Transfer records are SoA flat arrays (no derived types); the wire layout of each peer
+ !! message is the ascending-box concatenation of [XA_NH header | slab], which sender and receiver derive independently from the
+ !! replicated caches (rank coarse ranges x patch boxes), so no metadata is exchanged. Plans are rebuilt every wave (caching on
+ !! amr_mesh_epoch is increment I6). All scratch is high-water and its contents never survive a wave; the rank-indexed build
+ !! counters (amr_fw_map/nx/pq/pp) are re-zeroed for touched ranks after each build so they stay all-zero between builds.
+ integer :: amr_fw_snx = 0, amr_fw_rnx = 0, amr_fw_snp = 0, amr_fw_rnp = 0
+ integer, allocatable :: amr_fw_sblk(:), amr_fw_sbl(:,:), amr_fw_sbh(:,:), amr_fw_spi(:), amr_fw_sqo(:), amr_fw_spo(:)
+ integer, allocatable :: amr_fw_rblk(:), amr_fw_rbl(:,:), amr_fw_rbh(:,:), amr_fw_rpi(:), amr_fw_rqo(:), amr_fw_rpo(:)
+ integer, allocatable :: amr_fw_sprank(:), amr_fw_sqsz(:), amr_fw_spsz(:), amr_fw_snxp(:), amr_fw_sqbase(:), amr_fw_spbase(:)
+ integer, allocatable :: amr_fw_rprank(:), amr_fw_rqsz(:), amr_fw_rpsz(:), amr_fw_rnxp(:), amr_fw_rqbase(:), amr_fw_rpbase(:)
+ integer, allocatable :: amr_fw_map(:), amr_fw_nx(:), amr_fw_pq(:), amr_fw_pp(:) !< rank-indexed build scratch (0:num_procs-1)
+ real(wp), allocatable :: amr_fw_sq(:), amr_fw_sp(:), amr_fw_rq(:), amr_fw_rp(:) !< wire pools (live across the ISENDs)
+ integer, allocatable :: amr_fw_req(:), amr_fw_reqw(:) !< requests + expected recv word counts (-1 for sends; debug check)
+ !> [amr-cov] dead-byte accounting (expert-audit increment, amr_action_plan.md 2026-08-22): partition each gather family's patch
+ !! words into live vs provably-dead. (1) step-fill: the ghost-fill kernel reads only floor(f/rr) +- 1, so the patch's interior
+ !! core (region shrunk by 1 per face) is never read. (2) rebuild level-1: the same-level carry-forward overwrites prolonged
+ !! cells covered by old blocks (shrunk by 1 for the minmod stencil - a conservative under-count). (3) rebuild level>=2: no
+ !! carry-forward exists, so the patch is live by construction. Deterministic - identical across reruns; decides ring/coverage
+ !! clipping vs T1 (pre-registered: dead > 50% on either family promotes clipping).
+ !> 1=step-fill, 2=rebuild L1, 3=rebuild L>=2 [amr-cad] regrid-cadence containment audit: level-1 tags counted at each regrid,
+ !! and how many fell OUTSIDE the pre-regrid level-1 coverage (a feature that evolved unrefined since the last regrid - the tag
+ !! buffer amr_buf did not cover its drift). Zero escaped validates the (amr_regrid_int, amr_buf) pair for that run; the case
+ !! validator only warns (the CFL <= 1 worst case is too strict for low-CFL cases). Incremented by m_amr_regrid, reported by
+ !! s_amr_cov_report.
+ integer(8) :: amr_cov_tot(3) = 0, amr_cov_dead(3) = 0
+ integer(8) :: amr_cad_tot = 0, amr_cad_esc = 0
+ logical :: amr_cad_armed = .false. !< first regrid (hierarchy population) is skipped - see s_amr_cad_count
+ !> (0:num_procs-1) SFC Morton-key upper bound per rank from the cost-weighted split; owner = cut-search (f_amr_owner). The O(P)
+ !! computed replacement for the O(global_blocks) amr_block_owner table (validated against it during bring-up).
+ integer(kind=8), allocatable :: amr_owner_cut(:)
+ !> (0:num_procs-1, 1:amr_max_level) companion cuts for FINE-block (level>=1) owners: ONE INDEPENDENT CUT PER LEVEL. Each level's
+ !! boxes are balanced across all ranks on their own weight, so a deep refinement tower no longer pins its whole subtree to one
+ !! rank. Per level rather than one mixed cut because same-level boxes are disjoint and so have DISTINCT Morton keys, which the
+ !! cut-point binary search requires; a mixed cut would let a child share its parent's region_lo and make the search ambiguous.
+ !! In no-tile AMR level 1's cut also mirrors amr_owner_cut, but in coexist amr_owner_cut is overwritten by the TILE cut, so the
+ !! fine cuts are kept here for f_amr_owner (fine blocks straddle tiles and cannot be derived from the tile cut).
+ integer(kind=8), allocatable :: amr_fine_cut(:,:)
+
+ !> Regrid box size cap per dim (fixed for the run, identical on all ranks; 1 in collapsed dims): a box of at most min-over-ranks
+ !! of (local extent + 1)/2 cells intersects EVERY rank in at most (its extent + 1)/2 cells, so the per-rank scratch constraint
+ !! 2*(isect cells) - 1 <= local extent holds by construction. Equals amr_maxc at np=1.
+ integer :: amr_maxc_fit(3) = 1
+
+ !> SWAP CONTRACT (s_amr_swap_to_fine / s_amr_restore_coarse). The fine advance runs the shared solver on a fine block by
+ !! swapping these coarse-grid globals to the block's values and restoring after: m/n/p, idwint/idwbuff, the nine coordinate
+ !! arrays (sw_x_cb..sw_dz below), acoustic_source, ab_active; WENO/hypoelastic/IGR spacing coefficients are recomputed for the
+ !! active grid rather than saved. RULE for anyone adding grid-dependent state: any module-level variable DERIVED from
+ !! m/n/p/idwint/idwbuff/coords that a kernel reads on the fine grid must be swapped here OR refreshed on every fine call at its
+ !! use site - and if GPU_DECLARE'd, its DEVICE copy too. A stale device copy of coarse bounds reads out of range on the fine
+ !! grid under CCE OpenACC (the ab_int regression, fixed by a per-call GPU_UPDATE in s_compute_rhs; see m_rhs.fpp and
+ !! .claude/rules/common-pitfalls.md). amr_swap_depth makes the swap re-entrant and guards against an unpaired restore.
+ !> Saved coarse-level global state for swap/restore
+ integer :: sw_m, sw_n, sw_p
+ type(int_bounds_info) :: sw_idwint(3), sw_idwbuff(3)
+ logical :: sw_acoustic_source
+ logical :: sw_ab_active
+
+ !> IGR sigma-state bounce (igr only): the fine solve reuses the module jac/jac_old arrays at fine indices (the extent guard
+ !! keeps fine bounds inside), so the coarse contents - jac_old is the Jacobi warm start persisting across steps - are saved here
+ !! across the fine advance.
+ real(wp), allocatable :: sw_jac(:,:,:), sw_jac_old(:,:,:)
+ $:GPU_DECLARE(create='[sw_jac, sw_jac_old]')
+
+ !> Per-fine-cell radial volume weight for cyl_coord restriction (axisymmetric): the fold-back must be volume-weighted and cell
+ !! volume ~ radius, so a fine child is weighted by its own cell-center radius y_cc. Filled from the active block's fine y_cc
+ !! each restriction, read IDENTICALLY by the device kernel and host scatter path so np=1 == np>=2 stays element-exact. Allocated
+ !! only for cyl_coord. Its DEVICE copy is refreshed (GPU_UPDATE) only in s_restrict_fine_to_coarse; s_amr_restrict_to_parent
+ !! reads it WITHOUT refreshing, safe ONLY because m_checker.fpp forbids cyl_coord with amr_max_level > 1 - lifting that gate
+ !! makes this an ab_int-class stale-device bug (the parent fold needs a fresh per-block radius table). See the SWAP CONTRACT
+ !! note above.
+ real(wp), allocatable :: amr_rvw(:)
+ $:GPU_DECLARE(create='[amr_rvw]')
+
+ !> Non-polytropic QBMM fine rhs scratch, shared across slots (slots advance sequentially). Module-level raw arrays mirror the
+ !! coarse rhs_pb/rhs_mv pattern: derived-type component actuals here tripped nvfortran's component-section data clauses on
+ !! device.
+ real(wp), allocatable :: amr_rhs_pb_f(:,:,:,:,:), amr_rhs_mv_f(:,:,:,:,:)
+ $:GPU_DECLARE(create='[amr_rhs_pb_f, amr_rhs_mv_f]')
+
+ !> Swap nesting depth. Only the OUTERMOST swap saves the coarse state into the sw_* bounce buffers, and only its matching
+ !! restore puts it back; an inner swap re-installs and an inner restore is a no-op. Every nested swap site swaps to the same
+ !! slot (amr_cur), so the enclosing frame's view is unchanged either way. Replaces the old paired-swap logical, whose assert
+ !! forbade nesting outright - the nested sites in the RK pass are what block hoisting the restore across blocks (see
+ !! docs/documentation/amr_block_batching.md).
+ integer :: amr_swap_depth = 0
+ !> True when the coarse grid is nonuniform (stretched grids, or 2D-axisymmetric's half-width axis cell): the spacing-dependent
+ !! WENO coefficients are then recomputed for the ACTIVE grid on every block swap (the fine block's grid is itself nonuniform
+ !! under stretching) and restored after. False on fully uniform grids - the recompute is skipped, behavior bit-identical.
+ logical :: amr_weno_coef_recompute = .false.
+ logical :: amr_grid_stretched = .false. !< stretched coarse spacing (beyond the axisym axis half-cell; set at init)
+ !> Persistent GLOBAL coarse cell-boundary arrays (indices -1:X_glb), assembled once at init. The fine-distribution owner
+ !! reconstructs whole-block fine coordinates from these (its fine cells cover coarse cells it does not own the coordinate slice
+ !! for). Exact on any grid.
+ real(wp), allocatable :: amr_gxcb(:), amr_gycb(:), amr_gzcb(:)
+ real(wp), allocatable :: sw_x_cb(:), sw_x_cc(:), sw_dx(:)
+ real(wp), allocatable :: sw_y_cb(:), sw_y_cc(:), sw_dy(:)
+ real(wp), allocatable :: sw_z_cb(:), sw_z_cc(:), sw_dz(:)
+
+ !> Conservation-defect baselines (level-0 interior integrals at init; per-fluid masses + energy)
+
+ !> True (identically on all ranks) iff some rank's fine ghost-fill stencil reads its coarse GHOST cells - the solver populates
+ !! only PRIM ghosts, so the CONS ghosts the fill prolongs from must be halo-exchanged first. Never true at np=1 (block faces sit
+ !! >= buff_size inside the domain).
+ logical :: amr_xchg_coarse_ghosts = .false.
+ !> local (un-reduced) accumulator behind amr_xchg_coarse_ghosts. s_set_amr_fine_geometry ORs each block's answer in here and
+ !! s_amr_reduce_xchg_flag performs ONE allreduce for the whole scan. Previously the reduction sat inside the routine, so a
+ !! regrid over nboxes blocks issued nboxes global collectives - the dominant term in the assignment's cost at scale, and one
+ !! measured at 7.4-13 ms per call because it absorbs the spread in the owner-only work that precedes it.
+ integer :: amr_xchg_bad = 0
+
+ !> Per-block gathered coarse patch (fine-level distribution). The block owner may not hold the coarse cells its block refines,
+ !! so before each prolongation/ghost-fill the coarse patch spanning region_lo-amr_cpat_mar : region_hi+amr_cpat_mar (the full
+ !! coarse-cell reach of every prolongation stencil) is gathered here POINT-TO-POINT from the coarse-owners
+ !! (s_amr_gather_coarse_patch). Stored in amr_cg as stp scalar_fields (a drop-in for the coarse q_cons in the prolong/ghost-fill
+ !! kernels) in a block-LOCAL frame: amr_cg cell 0 is GLOBAL coarse cell amr_cpat_off(d). Messages carry wp, cast to stp
+ !! (identity for stp coarse), so at np=1 (owner copies its own coarse) the patch equals the local coarse read bit-for-bit. Sized
+ !! to the largest block.
+ type(scalar_field), allocatable :: amr_cg(:)
+ integer :: amr_cpat_mar = 0 !< coarse-cell stencil reach = (buff_size+1)/2 + 1 (matches nmar)
+ integer :: amr_cpat_hi(3) = 0 !< amr_cg upper local bounds per dim (0 in collapsed dims)
+
+ !> Deferred-send pool for the per-box coarse-patch gather.
+ !!
+ !! The gather is called once per BOX (794 of them at 400^3) and the non-owner side used a BLOCKING MPI_SEND, so every rank had
+ !! to rendezvous with the owner 794 times per rebuild, in lockstep. That serialisation was measured at 45% of regrid and ~25%
+ !! of total runtime across this routine's two call sites. Sends are now non-blocking and completed in batches, so a rank that
+ !! only contributes data can run ahead instead of blocking on each box.
+ !!
+ !! The pool owns the buffers because MPI_ISEND requires them to stay live until completion - the old code deallocated sbuf
+ !! immediately after the blocking send, which is exactly what must NOT happen here.
+ integer, parameter :: amr_gsnd_max = 64 !< pending sends before a forced drain (bounds pool memory)
+ real(wp), allocatable :: amr_gsnd_pool(:,:)
+ integer, allocatable :: amr_gsnd_req(:)
+ integer :: amr_gsnd_n = 0
+ integer :: amr_cpat_off(3) = 0 !< GLOBAL coarse index of amr_cg local cell 0 (region_lo - amr_cpat_mar)
+ !> Gathered coarse pb/mv patch for non-polytropic QBMM (analogue of amr_cg): the block's coarse-side pb/mv side-state,
+ !! P2P-gathered from the coarse-cell owners into the block owner in the amr_cg patch-local frame (cell 0 == amr_cpat_off). Read
+ !! by the pb/mv prolong + ghost-fill so np>=2 couples to the correct coarse rank. Allocated only for non-polytropic QBMM.
+ real(stp), allocatable, dimension(:,:,:,:,:) :: amr_cg_pb, amr_cg_mv
+ $:GPU_DECLARE(create='[amr_cg_pb, amr_cg_mv]')
+
+ !> L0-AS-BLOCKS SPIKE (l0_ntile > 0, amr off). Feasibility probe for AMReX-style dynamic load balancing: tile the base grid into
+ !! l0_ntile**num_dims base-resolution (refinement-ratio-1) blocks and advance each through the SAME swap-based per-block solver
+ !! the AMR fine overlay uses, with tile-tile same-level seam halos (s_amr_fine_fine_halo, fmul=1) at interior faces and the
+ !! physical BC at domain-edge faces. Correctness bar: l0_ntile>0 must be BYTE-IDENTICAL to l0_ntile=0 (monolithic). Reuses the
+ !! full amr_slots/region/owner/seam machinery; the tiles ARE level-1 blocks with amr_ref_ratio 1. Off (l0_ntile=0) => no effect.
+ integer :: l0_ntiles_tot = 0 !< total tiles = l0_ntile**num_dims (0 when off)
+ integer :: l0_nt(3) = 1 !< tiles per dim (1 in collapsed dims)
+ ! Unification pool layout (amr_max_fine, l0_slot_off) lives in m_global_parameters beside amr_num_blocks/amr_max_blocks, so
+ ! m_amr_regrid (a separate module) sees it too.
+ !> per-dim global periodicity, allreduced from periodic_bc in s_l0_tiles_init (periodic_bc is set on rank 0 only -
+ !! s_read_input_file is rank-0-guarded - so it must be made consistent for the wrap-seam decision in f_amr_seam /
+ !! s_l0_edge_bc_tile, which every rank must agree on)
+ logical :: l0_periodic(3) = .false.
+ !> tiles are persistent: L0 seeds them ONCE (first timestep); set at init, cleared after fill
+ logical :: l0_tiles_need_fill = .false.
+ !> rank owning each tile's L0 STORAGE cells (fixed = init owner); scatter routes the compute-owner's interior back to this rank
+ !! when a tile has MIGRATED (owner != l0_owner)
+ integer, allocatable :: amr_tile_l0_owner(:)
+ !> accumulated MEASURED compute time per owned tile since the last rebalance (GPU-synced wall time); allreduced to a replicated
+ !! cost vector that drives s_l0_rebalance, then reset
+ real(wp), allocatable :: amr_tile_cost(:)
+ !> per-tile exponential moving average of the (replicated) measured cost, smoothed across rebalance windows so GPU
+ !! launch-latency timing noise does not drive churn
+ real(wp), allocatable :: amr_tile_cost_ema(:)
+
+contains
+
+ !> Build the static refined level-1 block. No-op unless amr. Called after the level-0 grid (x_cb/dx ready) and time-steppers
+ !! (sys_size/buff_size set). Per-slot fine arrays allocated lazily (s_amr_reconcile_slots) - only the blocks a rank owns.
+ impure subroutine s_initialize_amr_module()
+
+ integer :: i, d, islot
+ integer :: sidx(3), ext(3), maxc_loc(3), bad_loc, bad_glb, fit_d
+ integer :: blk_lo(3), blk_hi(3)
+ type(scalar_field), allocatable :: tmp_cg(:)
+
+ ! shared-pool layout: tiles are a fixed level-0 prefix; fine blocks follow. Both this init and s_l0_tiles_init read this, so
+ ! it runs before the amr early-return below (this routine always executes first, per m_start_up.fpp).
+
+ if (l0_ntile > 0) then
+ l0_nt = 1; l0_nt(1) = l0_ntile
+ if (n_glb > 0) l0_nt(2) = l0_ntile
+ if (p_glb > 0) l0_nt(3) = l0_ntile
+ l0_ntiles_tot = num_procs*l0_nt(1)*l0_nt(2)*l0_nt(3)
+ l0_slot_off = l0_ntiles_tot
+ end if
+
+ if (.not. amr) return
+
+ amr_dt_fine = 0.5_wp*dt
+
+ ! 2a gate (see amr_prim_batch's declaration). bubbles_euler is checker-prohibited under amr; every listed
+ ! feature either extends the conversion write set beyond mom..E or changes its inputs, and falls back to
+ ! the per-block conversion.
+ ! 2a VERDICT (2026-08-26, ledger 27): OFF by default. The batched conversion kernel is cheap on
+ ! device (0.5 s / 5-step probe) and byte-identical, but the per-block PRIM BRIDGE-LOADS that land
+ ! its output in the m_rhs scratch cost ~4x wall on the amdflang offload host path (launch/mapping
+ ! burden; a flag-off build with the kernel still compiled in prices at baseline, so it is not
+ ! codegen poisoning). Bridge loads are exactly what full 2b deletes - partial batching through a
+ ! bridge is negative value, so the machinery stays for the 2b store-native consumption experiment
+ ! and this gate stays false until then.
+ amr_prim_batch = .false.
+
+ ! Fine-block cap = the case amr_max_blocks; the shared pool adds the L0 tile prefix (l0_slot_off, 0 when l0_ntile=0) ahead
+ ! of
+ ! it, so both AMR fine blocks and any L0 tiles draw from one amr_slots allocation.
+ amr_max_fine = amr_max_blocks ! fine/regrid cap = the case budget
+ amr_max_blocks = l0_slot_off + amr_max_fine ! total shared pool (l0_slot_off=0 when no tiles -> unchanged)
+
+ ! fixed pool of amr_max_blocks slots; init activates exactly one (amr_cur = f_l0_slot(1), the initial fine-block slot);
+ ! regrid clusters into up to amr_max_blocks
+ allocate (amr_slots(1:amr_max_blocks))
+ call s_amr_loc_index_init()
+ allocate (amr_region_lo_all(3, amr_max_blocks), amr_region_hi_all(3, amr_max_blocks))
+ allocate (amr_isect_lo_all(3, amr_max_blocks), amr_isect_hi_all(3, amr_max_blocks))
+ allocate (amr_owns_all(amr_max_blocks))
+ allocate (amr_touch(amr_max_blocks)); amr_touch = .false. !< halo probe, see m_global_parameters
+ allocate (amr_block_owner(amr_max_blocks))
+ allocate (amr_owner_cut(0:num_procs - 1)); amr_owner_cut = -1_8
+ allocate (amr_fine_cut(0:num_procs - 1,1:max(amr_max_level, 1))); amr_fine_cut = -1_8
+ allocate (amr_block_level(amr_max_blocks))
+ ! amr_ovl_gather/scatter (the 2D rank lists) are allocated to the computed max overlap in s_amr_build_seam_pairs; only the
+ ! per-block counts are sized here.
+ allocate (amr_ovl_gather_n(amr_max_blocks), amr_ovl_scatter_n(amr_max_blocks))
+ amr_region_lo_all = 0; amr_region_hi_all = 0; amr_isect_lo_all = 0; amr_isect_hi_all = 0; amr_owns_all = .false.
+ amr_block_owner = 0
+ amr_block_level = 1 ! init default (level-1); regrid re-tags each block's level for nesting
+ amr_num_levels = 1
+ amr_num_blocks = f_l0_slot(1)
+ amr_cur = f_l0_slot(1)
+
+ ! fine-level load balance is capped at min(num blocks, amr_max_blocks) ranks: the SFC map spreads whole blocks, so with
+ ! fewer
+ ! blocks than ranks some ranks own no fine work. Warn when the pool itself is the limit (raise amr_max_blocks).
+ if (proc_rank == 0 .and. num_procs > amr_max_fine) then
+ print '(A,I0,A,I0,A)', ' [amr] WARNING: amr_max_blocks (', amr_max_blocks, ') < num_procs (', num_procs, &
+ & '): the fine level can occupy at most amr_max_blocks ranks - raise amr_max_blocks for better fine-level balance'
+ end if
+
+ ! Lock-step advances every fine block at the coarse dt, but a level-l cell is amr_ref_ratio**l smaller, so its CFL limit is
+ ! amr_ref_ratio**amr_max_level tighter than the coarse grid's. The dt (fixed, or the coarse-only cfl_dt estimate) is NOT
+ ! scaled for that, so a coarse-CFL dt silently runs the finest block unstable (subcycling instead advances each level at
+ ! dt/amr_ref_ratio and is stable by construction). The true CFL is unknown at init, so warn rather than abort - a small
+ ! enough dt is valid.
+ if (proc_rank == 0 .and. .not. amr_subcycle .and. (amr_ref_ratio > 2 .or. amr_max_level > 1)) then
+ print '(A,I0,A)', &
+ & ' [amr] WARNING: lock-step (amr_subcycle = F) advances fine blocks at the coarse dt, but the ' &
+ & // 'finest cell is amr_ref_ratio**amr_max_level = ', amr_ref_ratio**amr_max_level, &
+ & 'x smaller - ensure dt satisfies the FINEST cell CFL (roughly the coarse-stable dt divided by that ' &
+ & // 'factor), or enable amr_subcycle, else the fine block may go unstable'
+ end if
+
+ ! CONFIGURATION ADVISORIES. Measured 2026-08-02 (3D, np=8, cap-64 optimum); see
+ ! @ref amr_per_level_distribution, "Configuration guidance". These are ADVICE, not constraints -
+ ! every setting below is legal and sometimes correct, so they warn rather than abort.
+ if (proc_rank == 0) then
+ ! amr_regrid_int = 0 is STATIC AMR: the block set never changes. That is a legitimate mode
+ ! (and the only one supported above amr_max_level = 2), but a user who set `amr = T` expecting
+ ! adaptivity gets none, silently.
+ if (amr_regrid_int == 0) then
+ print '(A)', &
+ & ' [amr] NOTE: amr_regrid_int = 0 - the block set is STATIC and never adapts. ' &
+ & // 'Set amr_regrid_int > 0 (4-8 is a reasonable start) for adaptive refinement.'
+ end if
+ ! The derived cap is the min-over-ranks local half-extent, so it SHRINKS as ranks are added -
+ ! the wrong direction for strong scaling, and it makes the box set (hence the answer, within
+ ! tolerance) depend on the rank count. Measured 3.0x slower than a pinned cap of 64 in 3D.
+ if (amr_max_grid_size == 0 .and. num_procs > 1) then
+ print '(A)', &
+ & ' [amr] NOTE: amr_max_grid_size = 0 derives the block cap from the ' &
+ & // 'decomposition, so it SHRINKS as ranks are added and the box set depends on rank ' &
+ & // 'count. Pinning it (64 measured best in 3D on MI250X, memory-bounded) was 3.0x ' &
+ & // 'faster and makes the box set rank-invariant.'
+ end if
+ ! Lock-step integrates the COARSE level at the finest-stable dt, i.e. amr_ref_ratio**level
+ ! times more often than its own stability requires. Measured 1.55x at amr_max_level = 2.
+ ! NB this changes the time integration - it is not a free optimization.
+ if (.not. amr_subcycle .and. amr_max_level >= 1 .and. amr_regrid_int > 0) then
+ print '(A,I0,A)', ' [amr] NOTE: amr_subcycle = F integrates the coarse level ', amr_ref_ratio**amr_max_level, &
+ & 'x more often than its own CFL requires. ' &
+ & // 'amr_subcycle = T was 1.55x faster per unit physical time (it is a DIFFERENT ' &
+ & // 'time integration, not a drop-in).'
+ end if
+
+ ! Frequent regridding is dominated by the per-cell tag sweep, which is flat in box count.
+ if (amr_regrid_int > 0 .and. amr_regrid_int < 4) then
+ print '(A,I0,A)', ' [amr] NOTE: amr_regrid_int = ', amr_regrid_int, &
+ & ' regrids often; the tag sweep is per-CELL and flat in box count, so interval 8 ' &
+ & // 'measured 1.39x faster. Raise it unless the refined feature moves quickly.'
+ end if
+ end if
+
+ ! Mirror decomposition: each rank holds the fine cells covering block /\ its own subdomain (np=1: the intersection is the
+ ! whole block). buff_size is not available at checker time, so the geometric aborts below must live here.
+ sidx = 0; ext = 0
+ sidx(1) = start_idx(1); ext(1) = m
+ if (n_glb > 0) then; sidx(2) = start_idx(2); ext(2) = n; end if
+ if (p_glb > 0) then; sidx(3) = start_idx(3); ext(3) = p; end if
+ call s_amr_compute_isect(amr_block_beg, amr_block_end)
+
+ ! the fine ghost shell and reflux outside cells must stay inside the global domain (identical inputs on all ranks; every
+ ! rank takes the same branch)
+ if (amr_block_beg(1) < buff_size .or. amr_block_end(1) > m_glb - buff_size .or. (n_glb > 0 .and. (amr_block_beg(2) &
+ & < buff_size .or. amr_block_end(2) > n_glb - buff_size)) .or. (p_glb > 0 .and. (amr_block_beg(3) < buff_size &
+ & .or. amr_block_end(3) > p_glb - buff_size))) then
+ call s_mpi_abort('amr block must lie at least buff_size cells inside the domain boundaries')
+ end if
+
+ ! Scratch constraint: the fine advance reuses the solver scratch (m_rhs/WENO/Riemann work arrays) and the global coordinate
+ ! arrays, all sized to THIS rank's local grid. Fine-level distribution gives a block WHOLE to its owner, so the WHOLE
+ ! block's fine extent (2*block-1) must fit every rank's local extent (a big block cannot be whole-owned; it must be split
+ ! into <= local-half boxes - the mirror model instead split the block ACROSS ranks). Checked on the replicated block box so
+ ! all ranks agree. (np=1: local extent = global, so 2*block-1 <= m_glb always holds.) non-IB: the block is TILED into <=
+ ! amr_maxc_fit sub-blocks (each fits every rank's scratch), so no cap is needed. IB keeps a single contiguous block per
+ ! body,
+ ! so an IB block must itself fit a rank's local half-extent.
+ bad_loc = 0
+ if (ib) then
+ if (amr_ref_ratio*(amr_block_end(1) - amr_block_beg(1) + 1) - 1 > m) bad_loc = 1
+ if (n_glb > 0 .and. amr_ref_ratio*(amr_block_end(2) - amr_block_beg(2) + 1) - 1 > n) bad_loc = 1
+ if (p_glb > 0 .and. amr_ref_ratio*(amr_block_end(3) - amr_block_beg(3) + 1) - 1 > p) bad_loc = 1
+ end if
+ call s_mpi_allreduce_integer_max(bad_loc, bad_glb)
+ if (bad_glb == 1) then
+ call s_mpi_abort('amr fine extent exceeds a rank local grid (solver scratch is local-sized): an immersed-body block ' &
+ & // 'is owned whole and un-tiled, so it may cover at most about half of any rank subdomain per ' &
+ & // 'dimension; shrink the body region or use fewer ranks')
+ end if
+
+ ! max coarse block cells per dim (upper bound for any future regrid box); 1 for collapsed dims
+ amr_maxc(1) = (m_glb + 1)/amr_ref_ratio
+ amr_maxc(2) = 1; amr_maxc(3) = 1
+ if (n_glb > 0) amr_maxc(2) = (n_glb + 1)/amr_ref_ratio
+ if (p_glb > 0) amr_maxc(3) = (p_glb + 1)/amr_ref_ratio
+
+ ! regrid size cap. Default (amr_max_grid_size == 0): min over ranks of the local half-extent (= amr_maxc at np=1), so any
+ ! clamped box satisfies every rank's scratch constraint and can move freely across ranks. That cap SHRINKS as ranks are
+ ! added, which tiles a fixed feature into more and more blocks the further you scale - and per-block cost is ~fixed
+ ! regardless of block size, so the block count is what costs. It also makes the box set (and so the answer, within
+ ! tolerance) depend on the rank count. Setting amr_max_grid_size > 0 pins the cap to an absolute number of coarse cells
+ ! instead, exactly like AMReX's max_grid_size: the box set is then IDENTICAL at every rank count.
+ amr_maxc_fit = amr_maxc
+ do d = 1, num_dims
+ call s_mpi_allreduce_integer_min((ext(d) + 1)/amr_ref_ratio, fit_d)
+ if (amr_max_grid_size > 0) then
+ ! Rank-independent cap, INDEPENDENT of fit_d. The fine advance still borrows this rank's solver scratch, but that
+ ! scratch is now sized to the cap rather than to the subdomain (idwbuff_alloc and m/n/p_alloc in
+ ! m_global_parameters give it amr_ref_ratio*amr_max_grid_size - 1 fine cells plus the ghost shell), so a block at
+ ! the cap fits however small the subdomain becomes. This is what decouples the box set from the rank count:
+ ! without it the cap could only ever shrink as ranks grow, which is backwards for strong scaling.
+ ! Cost: per-rank scratch is O(cap**num_dims), constant in rank count - bounded by choosing the cap, which is
+ ! precisely what this parameter is for.
+ amr_maxc_fit(d) = min(amr_maxc(d), amr_max_grid_size)
+ else
+ amr_maxc_fit(d) = min(amr_maxc(d), fit_d)
+ end if
+ end do
+
+ ! preallocation cap for MY fine arrays: a block is owned WHOLE, so any rank must hold an entire block. regrid clamps every
+ ! box to amr_maxc_fit, so amr_maxc_fit (NOT the global-half amr_maxc) is the true max block a rank can own; sizing to it
+ ! right-sizes the fine/coord arrays. At np=1 amr_maxc_fit == amr_maxc, so the sizing (and everything) is unchanged.
+ ! NOTE amr_maxc_fit is no longer bounded by the local half-extent when amr_max_grid_size > 0: the solver scratch is sized to
+ ! the cap instead (see above), so a rank can own a block LARGER than half its own subdomain. Derived-cap runs
+ ! (amr_max_grid_size = 0) still take the min-over-ranks local-half and are unaffected.
+ maxc_loc = amr_maxc_fit
+
+ ! max fine extents and buffered bounds for preallocation
+ max_f1 = amr_ref_ratio*maxc_loc(1) - 1
+ max_f2 = 0; max_f3 = 0
+ if (n_glb > 0) max_f2 = amr_ref_ratio*maxc_loc(2) - 1
+ if (p_glb > 0) max_f3 = amr_ref_ratio*maxc_loc(3) - 1
+
+ amr_seam_pairs_dirty = .true.; amr_seam_pairs_nblk = -1 ! force a seam-list build on the first fine-fine halo
+ amr_mesh_epoch = amr_mesh_epoch + 1
+ mbuf1_lo = -buff_size; mbuf1_hi = max_f1 + buff_size
+ mbuf2_lo = 0; mbuf2_hi = 0; mbuf3_lo = 0; mbuf3_hi = 0
+ if (n_glb > 0) then; mbuf2_lo = -buff_size; mbuf2_hi = max_f2 + buff_size; end if
+ if (p_glb > 0) then; mbuf3_lo = -buff_size; mbuf3_hi = max_f3 + buff_size; end if
+ ! with tiles, s_l0_tiles_init's mbuf UNION below may still enlarge these - the scratch waits for it (see s_amr_scr_init)
+ if (l0_ntile == 0) call s_amr_scr_init()
+
+ ! MEMORY DEMAND, reported not guessed. There is no portable way to ask how much device (or
+ ! host) memory is available - hipMemGetInfo / cudaMemGetInfo / nothing-on-CPU across four
+ ! compilers and three offload backends - so do NOT try to pick a cap from a memory budget.
+ ! What IS exactly known here is the DEMAND: a block costs 2 per-slot field families (q_cons,
+ ! q_cons_stor; q_prim/rhs are POOLED - one shared scratch pair, not per block) plus, under
+ ! amr_subcycle only, 2 more in the flat store (amr_gst_a/amr_gst_b, sized per LOCAL slot)
+ ! x sys_size arrays on the mbuf extents. Print it
+ ! and let the reader compare against hardware they know.
+ !
+ ! Why this matters more than a default: the OPTIMAL cap is set by the largest slot that
+ ! fits, and slot volume goes as cap**num_dims - so the best cap measured 1024 in 2D and 64
+ ! in 3D, a 16x difference, while the SLOT VOLUMES agreed to 1.7x. One number cannot serve
+ ! both dimensions; the volume is the invariant. Exceeding it aborts inside
+ ! __tgt_target_data_begin_mapper, which PRESENTS AS A HANG (one rank dies, the rest block in
+ ! MPI), so a silent over-large cap is expensive to diagnose.
+ if (proc_rank == 0) then
+ block
+ real(wp) :: slot_gib, cells, nfam
+ cells = real(mbuf1_hi - mbuf1_lo + 1, wp)
+ if (n_glb > 0) cells = cells*real(mbuf2_hi - mbuf2_lo + 1, wp)
+ if (p_glb > 0) cells = cells*real(mbuf3_hi - mbuf3_lo + 1, wp)
+ nfam = 2._wp; if (amr_subcycle) nfam = 4._wp
+ slot_gib = cells*real(sys_size, wp)*nfam*real(storage_size(1._wp)/8, wp)/1024._wp**3
+ print '(A,I0,A,I0,A,ES10.3,A,F8.3,A)', ' [amr] per-block slot: ', nint(cells), ' cells x sys_size x ', &
+ & nint(nfam), ' fields = ', cells*real(sys_size, wp)*nfam, ' words (', slot_gib, ' GiB per owned block)'
+ print '(A,F9.2,A,I0,A)', ' [amr] worst case if one rank owned every block: ', slot_gib*real(amr_max_blocks, &
+ & wp), ' GiB (amr_max_blocks = ', amr_max_blocks, '). Typical is amr_max_blocks/num_procs blocks per rank.'
+ end block
+ end if
+
+ ! bounce buffers for copy-based coord swap (GPU-safe; same bounds as the base-level global arrays, which are sized on
+ ! *_alloc - these are whole-array assigned to/from x_cb etc., so the shapes must agree)
+ allocate (sw_x_cb(-1 - buff_size:m_alloc + buff_size))
+ allocate (sw_x_cc(-buff_size:m_alloc + buff_size))
+ allocate (sw_dx(-buff_size:m_alloc + buff_size))
+ if (n_glb > 0) then
+ allocate (sw_y_cb(-1 - buff_size:n_alloc + buff_size))
+ allocate (sw_y_cc(-buff_size:n_alloc + buff_size))
+ allocate (sw_dy(-buff_size:n_alloc + buff_size))
+ end if
+ if (p_glb > 0) then
+ allocate (sw_z_cb(-1 - buff_size:p_alloc + buff_size))
+ allocate (sw_z_cc(-buff_size:p_alloc + buff_size))
+ allocate (sw_dz(-buff_size:p_alloc + buff_size))
+ end if
+ if (igr) then
+ @:ALLOCATE(sw_jac(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(sw_jac_old(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ end if
+ if (cyl_coord .and. n_glb > 0) then
+ @:ALLOCATE(amr_rvw(0:max_f2))
+ end if
+
+ ! Grid uniformity policy. Both spacing-uniformity consumers are handled exactly: fine-block ghost-shell coordinates extend
+ ! by exact parent-cell bisection (reads sw_*_cb), and the spacing-dependent WENO reconstruction coefficients are recomputed
+ ! for the active grid on every swap/restore when the grid is nonuniform anywhere (stretched grids, or 2D-axisymmetric's
+ ! half-width axis cell dy(0) = dy/2). Tolerance is epsilon-scaled: an absolute 1e-12 would sit below single-precision grid
+ ! roundoff and classify every grid as stretched (spuriously tripping the stretched-combo gates). On uniform grids the flag
+ ! stays false and behavior is bit-identical to the reuse path. The stretch_* flags are pre_process-only, so the grid itself
+ ! is checked (this also catches externally generated grids).
+ if (maxval(dx(0:m)) - minval(dx(0:m)) > 1.e3_wp*epsilon(1._wp)*maxval(dx(0:m))) then
+ amr_weno_coef_recompute = .true.; amr_grid_stretched = .true.
+ end if
+ if (n_glb > 0) then
+ ! interior nonuniformity is stretching; a lone dy(0) deviation is stretching only when it is NOT the axisymmetric
+ ! half-width axis cell
+ if (n > 0 .and. maxval(dy(1:n)) - minval(dy(1:n)) > 1.e3_wp*epsilon(1._wp)*maxval(dy(1:n))) then
+ amr_weno_coef_recompute = .true.; amr_grid_stretched = .true.
+ end if
+ if (abs(dy(0) - dy(min(1, n))) > 1.e3_wp*epsilon(1._wp)*dy(min(1, n))) then
+ amr_weno_coef_recompute = .true.
+ if (.not. cyl_coord) amr_grid_stretched = .true.
+ end if
+ end if
+ if (p_glb > 0) then
+ if (maxval(dz(0:p)) - minval(dz(0:p)) > 1.e3_wp*epsilon(1._wp)*maxval(dz(0:p))) then
+ amr_weno_coef_recompute = .true.; amr_grid_stretched = .true.
+ end if
+ end if
+ if (weno_order == 1 .or. igr) amr_weno_coef_recompute = .false. ! order 1 / IGR: no grid-dependent WENO coefficients
+
+ ! persistent global coarse boundaries: the fine-distribution owner rebuilds whole-block fine coordinates from these (needed
+ ! once the fine level is decoupled from the coarse decomposition; harmless otherwise)
+ call s_amr_build_global_cb()
+ ! Fail closed on stretched grid + Lagrangian/IB-dynamic-regrid. TWO independent blockers (both confirmed by experiment):
+ ! (1) the position->global-cell-index conversions here use int((x-beg)/dx(0)), inexact on a stretched grid and
+ ! rank-inconsistent (dx(0) is rank-local). FIXABLE: assemble the global cell-boundary arrays (allreduce-MAX of owned
+ ! boundaries) and bisection-search them - correct on any grid, identical on every rank.
+ ! (2) THE HARDER BLOCKER: IB/Lagrangian floor buff_size (10/6), but s_amr_recompute_weno_coefs (armed only on nonuniform
+ ! grids) indexes poly_coef_cb* over -buff_size:m+buff_size while m_weno sized those arrays with a smaller buff_size at
+ ! init -> OOB write in s_compute_weno_coefficients (gfortran bounds trap at m_weno.fpp weno5 branch). Needs the WENO
+ ! coefficient arrays sized to the final buff_size (or the recompute clamped to the module's true bounds) before this
+ ! gate can lift. Fix (1) alone is insufficient.
+ if (amr_grid_stretched .and. (bubbles_lagrange .or. (ib .and. amr_regrid_int > 0))) then
+ call s_mpi_abort('amr on a stretched grid does not support ' &
+ & // 'Lagrangian bubbles or dynamic regrid with immersed bodies: their ' &
+ & // 'position-to-cell-index conversions assume uniform spacing')
+ end if
+
+ ! per-slot field arrays are allocated by s_amr_alloc_slot / freed by s_amr_free_slot (sized to the max buffered block). The
+ ! lazy owned-only reconcile that keeps a rank's fine memory ~1/num_procs of the pool follows. The QBMM RHS scratch
+ ! (amr_rhs_pb_f/mv_f) is single - allocate once.
+ allocate (amr_slot_live(amr_max_blocks)); amr_slot_live = .false.
+ if (qbmm .and. .not. polytropic) then
+ @:ALLOCATE(amr_rhs_pb_f(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:nnode, 1:nb))
+ @:ALLOCATE(amr_rhs_mv_f(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:nnode, 1:nb))
+ end if
+ ! per-slot field arrays are allocated lazily by s_amr_reconcile_slots once ownership is known (after the block setup +
+ ! s_amr_assign_block_owners below), so a rank holds only its owned blocks' fine arrays - not all amr_max_blocks slots.
+
+ ! fine-level distribution: coarse-patch gather buffer (see decl). Sized to the largest block's coarse footprint (block
+ ! coarse
+ ! cells + 2*nmar halo, block-local frame). Device-mapped so the runtime ghost-fill reads it on the owner.
+ amr_cpat_mar = (buff_size + amr_ref_ratio - 1)/amr_ref_ratio + 1
+ amr_cpat_hi = 0
+ amr_cpat_hi(1) = maxc_loc(1) - 1 + 2*amr_cpat_mar
+ if (n_glb > 0) amr_cpat_hi(2) = maxc_loc(2) - 1 + 2*amr_cpat_mar
+ if (p_glb > 0) amr_cpat_hi(3) = maxc_loc(3) - 1 + 2*amr_cpat_mar
+ ! CCE OpenMP-offload leaves a bare module-scope derived-type (scalar_field) allocatable's descriptor uninitialized, so a
+ ! direct allocate(amr_cg(1:sys_size)) aborts with lib-4425 at program start (verified by an early module-init probe; a LOCAL
+ ! scalar_field array and a GPU_DECLARE'd module one like q_prim_vf both allocate fine - only this bare module array does
+ ! not). Allocate a local, which gets a valid descriptor, and hand it to the module variable via move_alloc, then map.
+ ! OpenACC is unaffected but takes the same path correctly.
+ allocate (tmp_cg(1:sys_size))
+ call move_alloc(tmp_cg, amr_cg)
+ $:GPU_ENTER_DATA(create='[amr_cg]')
+ do i = 1, sys_size
+ @:ALLOCATE(amr_cg(i)%sf(0:amr_cpat_hi(1), 0:amr_cpat_hi(2), 0:amr_cpat_hi(3)))
+ amr_cg(i)%sf = 0._stp ! padding beyond a block's valid patch extent is never read; keep it finite for the device copy
+ @:ACC_SETUP_SFs(amr_cg(i))
+ end do
+
+ ! non-polytropic QBMM: gathered coarse pb/mv patch (analogue of amr_cg, same footprint + trailing (nnode, nb) dims). Plain
+ ! 5D
+ ! arrays (amr_rhs_pb_f idiom): the module GPU_DECLARE + @:ALLOCATE handle device mapping - no @:ACC_SETUP_SFs.
+ if (qbmm .and. .not. polytropic) then
+ @:ALLOCATE(amr_cg_pb(0:amr_cpat_hi(1), 0:amr_cpat_hi(2), 0:amr_cpat_hi(3), 1:nnode, 1:nb))
+ @:ALLOCATE(amr_cg_mv(0:amr_cpat_hi(1), 0:amr_cpat_hi(2), 0:amr_cpat_hi(3), 1:nnode, 1:nb))
+ amr_cg_pb = 0._stp; amr_cg_mv = 0._stp
+ end if
+
+ ! the coarse decomposition (each rank's coarse start_idx + local m/n/p) is a structured cartesian split, computed O(1) per
+ ! rank by s_amr_rank_decomp - no replicated table, no allgather. Validate the formula against this rank's actual values.
+ call s_amr_validate_decomp()
+
+ ! per-slot fine-grid IB marker fields (static-body AMR); sized to the same max buffered fine extents as q_cons so the fine
+ ! IB pipeline can resolve the body on the block
+ if (ib) call s_ibm_alloc_fine(amr_max_blocks, mbuf1_lo, mbuf1_hi, mbuf2_lo, mbuf2_hi, mbuf3_lo, mbuf3_hi)
+
+ ! set geometry (region, m/n/p, idwbuff, coordinates) for the initial block (amr_cur = f_l0_slot(1), the initial fine-block
+ ! slot). Under dynamic regrid with bodies
+ ! the initial block gets the same body-containment expansion regrid boxes get (the moving-body containment guard requires it
+ ! from step 1); for a static block (amr_regrid_int = 0) the user's placement is authoritative. max_grid_size tiling: the
+ ! initial block splits into <= amr_maxc_fit sub-blocks (at np=1 amr_maxc_fit == amr_maxc so a normal block stays a single
+ ! tile - unchanged), one per slot; IB keeps a single contiguous block.
+ blk_lo = amr_block_beg; blk_hi = amr_block_end
+ if (ib .and. amr_regrid_int > 0) call s_amr_expand_box_over_bodies(blk_lo, blk_hi)
+ block
+ type(t_box), allocatable :: tiled(:)
+ integer :: nt, capt, kk
+ allocate (tiled(amr_max_blocks)); nt = 0; capt = 0
+ if (ib) then
+ nt = 1; tiled(1)%lo = blk_lo; tiled(1)%hi = blk_hi
+ else
+ call s_amr_tile_box(blk_lo, blk_hi, tiled, nt, amr_max_fine, capt)
+ end if
+ amr_num_blocks = f_l0_slot(nt) ! fine blocks occupy [l0_slot_off+1 .. l0_slot_off+nt] in the shared pool
+ ! set block regions FIRST so the owner assignment (reads amr_region_*_all) runs BEFORE the owner-dependent geometry -
+ ! else s_set_amr_fine_geometry would size the whole-block owner from a stale (default) amr_block_owner
+ do kk = 1, nt
+ amr_region_lo_all(:,f_l0_slot(kk)) = tiled(kk)%lo; amr_region_hi_all(:,f_l0_slot(kk)) = tiled(kk)%hi
+ end do
+ call s_amr_assign_block_owners() ! assign each block's single owner rank (fine-dist map)
+ call s_amr_reconcile_slots() ! allocate this rank's owned initial blocks (owner-guarded geometry writes below)
+ do kk = 1, nt
+ amr_cur = f_l0_slot(kk)
+ call s_set_amr_fine_geometry(tiled(kk)%lo, tiled(kk)%hi)
+ end do
+ call s_amr_reduce_xchg_flag()
+ call s_amr_select_slot(f_l0_slot(1)) ! refresh the per-block mirrors (geometry loop left them on the last tile)
+ deallocate (tiled)
+ end block
+
+ ! plan-based exchange (I0): per-family tag bases sit above the legacy per-box tag space so both can coexist
+ ! while families convert one increment at a time.
+ block
+ integer :: f
+ do f = 1, size(amr_tag_base)
+ amr_tag_base(f) = amr_max_blocks + 100*f
+ end do
+ end block
+#ifdef MFC_MPI
+ block
+ integer(kind=MPI_ADDRESS_KIND) :: tag_ub
+ logical :: tag_ub_set
+ integer :: ierr
+ call MPI_Comm_get_attr(MPI_COMM_WORLD, MPI_TAG_UB, tag_ub, tag_ub_set, ierr)
+ @:ASSERT(tag_ub_set, "MPI_TAG_UB attribute unavailable")
+ @:ASSERT(amr_tag_base(size(amr_tag_base)) + 100 <= tag_ub, &
+ & "AMR tag space exceeds MPI_TAG_UB: amr_max_blocks is too large for this MPI's tag range")
+ end block
+#endif
+
+ end subroutine s_initialize_amr_module
+
+ !> Fill level-1 fcb/fcc/fdx by bisecting parent cells; pcb_lb is lbound(parent_cb, 1). Passing pcb as assumed-shape resets
+ !! lbound to 1; pcb_lb + idx_offset recovers original indexing. Arrays preallocated at max size; only 0..nfine filled.
+ subroutine s_build_level_coords(pcb, pcb_lb, lo, nfine, fcb, fcc, fdx)
+
+ real(wp), intent(in) :: pcb(:)
+ integer, intent(in) :: pcb_lb, lo, nfine
+ real(wp), allocatable, intent(inout) :: fcb(:), fcc(:), fdx(:)
+ integer :: fi, c, idx_offset, k, rr
+ real(wp) :: xl, xr
+ ! pcb(k) = parent_cb(k + pcb_lb - 1); to access parent_cb(j): k = j - pcb_lb + 1
+
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ idx_offset = 1 - pcb_lb
+ ! fine cell fi (0..nfine) subdivides coarse cell c = lo + fi/rr into rr equal parts
+ fcb(-1) = pcb(lo - 1 + idx_offset) ! left boundary of the fine region
+ do fi = 0, nfine
+ c = lo + fi/rr
+ xl = pcb(c - 1 + idx_offset) ! left boundary of coarse cell c
+ xr = pcb(c + idx_offset) ! right boundary of coarse cell c
+ k = mod(fi, rr) ! fi >= 0, so mod gives the sub-position in [0, rr-1]
+ if (k == rr - 1) then
+ fcb(fi) = xr ! right edge of parent cell c
+ else
+ fcb(fi) = (real(rr - 1 - k, wp)*xl + real(k + 1, wp)*xr)/real(rr, wp)
+ end if
+ end do
+ do fi = 0, nfine
+ fdx(fi) = fcb(fi) - fcb(fi - 1)
+ fcc(fi) = 0.5_wp*(fcb(fi - 1) + fcb(fi))
+ end do
+
+ end subroutine s_build_level_coords
+
+ !> Fine cell coordinates of block k in dimension d, rebuilt from the GLOBAL coarse boundaries gcb by replaying k's ancestor
+ !! chain - touching no other block's slot arrays. A level-l block's grid is l nested midpoint subdivisions of the L0 boundaries,
+ !! and every box in the chain is known from REPLICATED metadata (amr_region_*_all + the global amr_ref_ratio), so any rank can
+ !! reproduce it. Bit-identical to bisecting the parent's stored coords, because that array is itself the same subdivision.
+ !!
+ !! This exists because the direct form - bisecting amr_slots(parent)%x_cb - reads the PARENT's slot, which is
+ !! ALLOCATED ONLY ON THE PARENT'S OWNER. Under tower co-location the child's owner was always the parent's owner too, so it
+ !! worked; under per-level distribution a level>=2 block can be owned by a rank holding no part of its parent, and bisecting an
+ !! unallocated array there produced garbage cell widths and NaNs a few steps later.
+ impure subroutine s_amr_build_block_coords(k, gcb, fcb, fcc, fdx, d)
+
+ integer, intent(in) :: k, d
+ real(wp), intent(in) :: gcb(:) !< global L0 cell boundaries, lbound -1
+ real(wp), allocatable, intent(inout) :: fcb(:), fcc(:), fdx(:)
+ integer :: chain(0:amr_max_level), lev, j, a, lo, nf, span, rr, plo(3), phi(3)
+ real(wp), allocatable :: cur(:), scb(:), scc(:), sdx(:)
+
+ rr = amr_ref_ratio
+ lev = amr_block_level(k)
+ a = k
+ do j = lev, 1, -1 ! chain(j) = k's ancestor at level j; chain(lev) = k
+ chain(j) = a
+ if (j > 1) a = f_amr_parent_block(a)
+ end do
+
+ cur = gcb ! level 0: the global coarse boundaries (allocatable assignment carries lbound -1)
+ do j = 1, lev
+ a = chain(j)
+ span = amr_region_hi_all(d, a) - amr_region_lo_all(d, a) + 1 ! L0 cells the box covers
+ nf = rr**j*span - 1 ! its fine extent at level j
+ if (j == 1) then
+ lo = amr_region_lo_all(d, a) ! global L0 index of the box's low corner
+ else
+ call s_amr_parent_foot(a, chain(j - 1), plo, phi) ! low corner in the parent's fine frame
+ lo = plo(d)
+ end if
+ if (j == lev) then
+ call s_build_level_coords(cur, -1, lo, nf, fcb, fcc, fdx)
+ else
+ if (allocated(scb)) deallocate (scb, scc, sdx)
+ allocate (scb(-1:nf), scc(0:nf), sdx(0:nf))
+ call s_build_level_coords(cur, -1, lo, nf, scb, scc, sdx)
+ cur = scb
+ end if
+ end do
+ if (allocated(scb)) deallocate (scb, scc, sdx)
+
+ end subroutine s_amr_build_block_coords
+
+ !> Compute this rank's per-dim intersection of the box lo:hi with its subdomain (GLOBAL indices, mirrored to amr_isect_lo/hi)
+ !! and whether it holds fine cells (amr_rank_owns_block: nonempty in all active dims). Must be called with the COARSE grid state
+ !! in m/n/p (never from inside the fine advance).
+ !> Assemble the persistent global coarse cell-boundary arrays. Each rank writes the boundaries of the cells it owns (shared
+ !! inter-rank faces written identically by both neighbours) into a sentinel-filled global array; an elementwise MAX allreduce
+ !! recovers the exact global array on every rank. Grid fixed for the run, so this runs once.
+ impure subroutine s_amr_build_global_cb()
+
+ integer :: j
+ real(wp), parameter :: sentinel = -huge(1._wp)
+
+ allocate (amr_gxcb(-1:m_glb)); amr_gxcb = sentinel
+ do j = -1, m
+ amr_gxcb(start_idx(1) + j) = x_cb(j)
+ end do
+ call s_mpi_allreduce_array_max(amr_gxcb, m_glb + 2)
+ if (n_glb > 0) then
+ allocate (amr_gycb(-1:n_glb)); amr_gycb = sentinel
+ do j = -1, n
+ amr_gycb(start_idx(2) + j) = y_cb(j)
+ end do
+ call s_mpi_allreduce_array_max(amr_gycb, n_glb + 2)
+ end if
+ if (p_glb > 0) then
+ allocate (amr_gzcb(-1:p_glb)); amr_gzcb = sentinel
+ do j = -1, p
+ amr_gzcb(start_idx(3) + j) = z_cb(j)
+ end do
+ call s_mpi_allreduce_array_max(amr_gzcb, p_glb + 2)
+ end if
+
+ end subroutine s_amr_build_global_cb
+
+ !> Fine-level distribution: assemble the current block's coarse patch on its owner. The patch covers GLOBAL coarse cells
+ !! region_lo-amr_cpat_mar : region_hi+amr_cpat_mar (the full reach of every prolongation/ghost-fill stencil) for all sys_size
+ !! variables, stored in amr_cg in a block-LOCAL frame (cell 0 == global amr_cpat_off). POINT-TO-POINT: the owner receives the
+ !! patch cells it does not hold from exactly the (SFC-local) coarse-owners that hold them - each rank's contribution is the
+ !! patch intersected with its contiguous owned coarse range (s_amr_rank_coarse_range, = the f_amr_own_coarse set, computed from
+ !! the cartesian decomposition). Non-participants send/recv nothing (no global collective). At np=1 the owner just copies its
+ !! own coarse over the patch, bit-for-bit. Runtime (pull_host) packs/unpacks the overlap boxes on the DEVICE (q_coarse
+ !! device-current with valid ghosts); init/regrid fills from the host (host-current with valid ghosts). Packed data is wp, cast
+ !! to stp into amr_cg (identity for stp coarse), device-current on exit. INVARIANT: "coarse" here means the block's PARENT level
+ !! (level l-1), NOT the base grid (level 0). For a level-1 block the parent IS L0, but a level>=2 block folds to/from its parent
+ !! block's fine array; the C<->F prolong/restrict/gather routines all operate in the parent-fine frame, not the L0 frame. TWIN
+ !! s_amr_gather_coarse_patch_pbmv (q<->pb/mv): same P2P skeleton (rank-range, intersection, pack/send/recv/unpack) and
+ !! patch-local frame - keep lockstep.
+ !> Make room for one more pending gather send, draining the pool first if it is full. Draining is a WAITALL, so the pool size
+ !! sets how far a contributing rank may run ahead of the owners.
+ impure subroutine s_amr_gsnd_reserve(slotsz)
+
+ integer, intent(in) :: slotsz
+
+ if (.not. allocated(amr_gsnd_pool)) then
+ allocate (amr_gsnd_pool(slotsz, amr_gsnd_max), amr_gsnd_req(amr_gsnd_max))
+ amr_gsnd_n = 0
+ else if (size(amr_gsnd_pool, 1) < slotsz) then
+ call s_amr_gather_send_flush() ! outstanding sends reference the old buffer - complete them before resizing
+ deallocate (amr_gsnd_pool)
+ allocate (amr_gsnd_pool(slotsz, amr_gsnd_max))
+ end if
+ if (amr_gsnd_n >= amr_gsnd_max) call s_amr_gather_send_flush()
+
+ end subroutine s_amr_gsnd_reserve
+
+ !> Complete every pending gather send. MUST be called before the send buffers are reused or the routine returns to a caller that
+ !! will free them - an ISEND whose buffer is overwritten in flight silently corrupts the receiver's patch.
+ impure subroutine s_amr_gather_send_flush()
+
+ integer :: ierr
+
+ if (amr_gsnd_n == 0) return
+#ifdef MFC_MPI
+ call MPI_WAITALL(amr_gsnd_n, amr_gsnd_req(1:amr_gsnd_n), MPI_STATUSES_IGNORE, ierr)
+#endif
+ amr_gsnd_n = 0
+
+ end subroutine s_amr_gather_send_flush
+
+ !> Gather-batching step 1: derive the ENTIRE rebuild gather message set up front - per level-1 box its contributor ranks and
+ !! message sizes, per level>=2 box its parent source and size - from the same replicated caches the per-box path reads
+ !! (amr_region_*_all, amr_ovl_gather, amr_block_owner, rank coarse ranges, s_amr_parent_foot). Exchange behavior is UNCHANGED by
+ !! this step: the per-box gather asserts against the plan, box by box (see amr_gpl_* declarations). Caller
+ !! (s_amr_regrid_rebuild_slots) clears amr_gpl_valid when its box loop ends.
+ impure subroutine s_amr_build_gather_plan(nboxes)
+
+ integer, intent(in) :: nboxes
+ integer :: k, ks, idx, r, nsrc, mo, pblk
+ integer :: v1hi, v2hi, v3hi, plo(3), phi(3), crlo(3), crhi(3), bl(3), bh(3), w(3)
+
+ ! the per-box path lazily rebuilds the overlap lists inside the first gather; force the SAME rebuild here so the plan
+ ! and the boxes read identical lists
+
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+ mo = size(amr_ovl_gather, 1)
+ if (allocated(amr_gpl_src)) then
+ if (size(amr_gpl_src, 1) < mo) deallocate (amr_gpl_src, amr_gpl_sz)
+ end if
+ if (.not. allocated(amr_gpl_nsrc)) allocate (amr_gpl_nsrc(amr_max_blocks), amr_gpl_psrc(amr_max_blocks), &
+ & amr_gpl_psz(amr_max_blocks))
+ if (.not. allocated(amr_gpl_src)) allocate (amr_gpl_src(mo, amr_max_blocks), amr_gpl_sz(mo, amr_max_blocks))
+ do k = 1, nboxes
+ ks = f_l0_slot(k)
+ amr_gpl_nsrc(ks) = 0; amr_gpl_psrc(ks) = -1; amr_gpl_psz(ks) = 0
+ if (amr_block_level(ks) >= 2) then
+ pblk = f_amr_parent_block(ks)
+ if (amr_block_owner(pblk) /= amr_block_owner(ks)) then
+ call s_amr_parent_foot(ks, pblk, plo, phi)
+ w = 0
+ w(1) = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ if (n_glb > 0) w(2) = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w(3) = (phi(3) - plo(3)) + 2*amr_cpat_mar
+ amr_gpl_psrc(ks) = amr_block_owner(pblk)
+ amr_gpl_psz(ks) = sys_size*(w(1) + 1)*(w(2) + 1)*(w(3) + 1)
+ end if
+ else
+ ! level-1 patch box: same arithmetic as the gather's patch-frame block (collapsed dims stay 0)
+ plo = 0
+ plo(1) = amr_region_lo_all(1, ks) - amr_cpat_mar
+ if (n_glb > 0) plo(2) = amr_region_lo_all(2, ks) - amr_cpat_mar
+ if (p_glb > 0) plo(3) = amr_region_lo_all(3, ks) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, ks) - amr_region_lo_all(1, ks)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, ks) - amr_region_lo_all(2, ks)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, ks) - amr_region_lo_all(3, ks)) + 2*amr_cpat_mar
+ phi(1) = plo(1) + v1hi; phi(2) = plo(2) + v2hi; phi(3) = plo(3) + v3hi
+ nsrc = 0
+ do idx = 1, amr_ovl_gather_n(ks)
+ r = amr_ovl_gather(idx, ks)
+ if (r == amr_block_owner(ks)) cycle
+ call s_amr_rank_coarse_range(r, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ nsrc = nsrc + 1
+ amr_gpl_src(nsrc, ks) = r
+ amr_gpl_sz(nsrc, ks) = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ end do
+ amr_gpl_nsrc(ks) = nsrc
+ end if
+ end do
+ amr_gpl_valid = .true.
+
+ end subroutine s_amr_build_gather_plan
+
+ !> Step-2 phase A: pre-post every recv this rank needs for boxes [c_lo, c_hi] - level-1 contributor slices and split level>=2
+ !! parent patches - straight from the plan into the flat chunk pool, tag = slot, appended in box order so box k's requests are
+ !! one contiguous run. Ownership from amr_block_owner ONLY (amr_owns_all / amr_rank_owns_block still mirror the previous
+ !! generation until the consume phase's geometry call). Contains no MPI waits; reallocating the pool here is safe because every
+ !! recv posted for the previous chunk was completed inside that chunk's consume phase.
+ impure subroutine s_amr_gather_chunk_post(c_lo, c_hi)
+
+ integer, intent(in) :: c_lo, c_hi
+ integer :: k, ks, cb, idx, need, nreq, off, ierr
+
+ @:ASSERT(amr_gpl_valid, "chunk gather: no plan")
+ call s_phase_tic(PH_RBPOST)
+ need = 0; nreq = 0
+ do k = c_lo, c_hi
+ ks = f_l0_slot(k)
+ if (amr_block_owner(ks) /= proc_rank) cycle
+ ! + XA_NH per message: the I1b identity header rides ahead of each payload (zero in production)
+ if (amr_block_level(ks) >= 2) then
+ if (amr_gpl_psrc(ks) >= 0) then
+ need = need + amr_gpl_psz(ks) + XA_NH; nreq = nreq + 1
+ end if
+ else
+ do idx = 1, amr_gpl_nsrc(ks)
+ need = need + amr_gpl_sz(idx, ks) + XA_NH
+ end do
+ nreq = nreq + amr_gpl_nsrc(ks)
+ end if
+ end do
+ if (allocated(amr_gcr_pool)) then
+ if (size(amr_gcr_pool) < need) deallocate (amr_gcr_pool)
+ end if
+ if (need > 0 .and. .not. allocated(amr_gcr_pool)) allocate (amr_gcr_pool(need))
+ if (allocated(amr_gcr_req)) then
+ if (size(amr_gcr_req) < nreq) deallocate (amr_gcr_req, amr_gcr_off)
+ end if
+ if (nreq > 0 .and. .not. allocated(amr_gcr_req)) allocate (amr_gcr_req(nreq), amr_gcr_off(nreq))
+
+ amr_gcr_n = 0; off = 0
+ amr_gcr_nr(:) = 0; amr_gcr_sent(:) = .false.
+ do k = c_lo, c_hi
+ ks = f_l0_slot(k)
+ cb = k - c_lo + 1
+ amr_gcr_r0(cb) = amr_gcr_n + 1
+ if (amr_block_owner(ks) /= proc_rank) cycle
+#ifdef MFC_MPI
+ if (amr_block_level(ks) >= 2) then
+ if (amr_gpl_psrc(ks) >= 0) then
+ amr_gcr_n = amr_gcr_n + 1
+ amr_gcr_off(amr_gcr_n) = off
+ call s_xa_rec(XA_F2_RCV, 2, amr_gpl_psz(ks), ks)
+ call MPI_IRECV(amr_gcr_pool(off + 1), amr_gpl_psz(ks) + XA_NH, mpi_p, amr_gpl_psrc(ks), ks, MPI_COMM_WORLD, &
+ & amr_gcr_req(amr_gcr_n), ierr)
+ off = off + amr_gpl_psz(ks) + XA_NH
+ amr_gcr_nr(cb) = 1
+ end if
+ else
+ do idx = 1, amr_gpl_nsrc(ks)
+ amr_gcr_n = amr_gcr_n + 1
+ amr_gcr_off(amr_gcr_n) = off
+ call s_xa_rec(XA_F1_RCV, 2, amr_gpl_sz(idx, ks), ks)
+ call MPI_IRECV(amr_gcr_pool(off + 1), amr_gpl_sz(idx, ks) + XA_NH, mpi_p, amr_gpl_src(idx, ks), ks, &
+ & MPI_COMM_WORLD, amr_gcr_req(amr_gcr_n), ierr)
+ off = off + amr_gpl_sz(idx, ks) + XA_NH
+ end do
+ amr_gcr_nr(cb) = amr_gpl_nsrc(ks)
+ end if
+#endif
+ end do
+ call s_phase_toc(PH_RBPOST)
+
+ end subroutine s_amr_gather_chunk_post
+
+ !> Step-2 phase B: issue this rank's sends for boxes [c_lo, c_hi]. Level-1: pack the host slice of q_coarse (host is truth
+ !! during rebuild) and ISEND through the deferred pool - the per-box contributor path verbatim, driven by the plan. Level>=2
+ !! split pairs: send ONLY when the parent was consumed in an earlier chunk (pblk < f_l0_slot(c_lo), monotone slot map) - a
+ !! same-chunk parent's new-generation store is not built until its own consume iteration, so that send stays at the child's
+ !! consume position, where parents-first ordering guarantees the parent is complete. Geometry from the replicated caches only:
+ !! no s_set_amr_fine_geometry swap, no amr_cur.
+ impure subroutine s_amr_gather_chunk_send(q_coarse, c_lo, c_hi)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: c_lo, c_hi
+ integer :: k, ks, cb, idx, i, g1, g2, g3, o1, o2, o3, boxsz, maxsz, pblk, ierr
+ integer :: v1hi, v2hi, v3hi, plo(3), phi(3), crlo(3), crhi(3), bl(3), bh(3)
+ logical :: contrib
+
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ do k = c_lo, c_hi
+ ks = f_l0_slot(k)
+ cb = k - c_lo + 1
+ if (amr_block_level(ks) >= 2) then
+ if (amr_gpl_psrc(ks) < 0) cycle ! co-located: no message
+ pblk = f_amr_parent_block(ks)
+ if (amr_block_owner(pblk) /= proc_rank) cycle ! not the sender
+ if (pblk >= f_l0_slot(c_lo)) cycle ! same-chunk parent: send at the child's consume position
+ call s_phase_tic(PH_PGSEND)
+ call s_amr_gather_from_parent_field_cons(ks, pblk, amr_loc_of(pblk), .true.)
+ call s_phase_toc(PH_PGSEND)
+ amr_gcr_sent(cb) = .true.
+ else
+ if (amr_block_owner(ks) == proc_rank) cycle ! the owner receives
+ contrib = .false.
+ do idx = 1, amr_gpl_nsrc(ks)
+ if (amr_gpl_src(idx, ks) == proc_rank) contrib = .true.
+ end do
+ if (.not. contrib) cycle
+ ! same patch-frame arithmetic as the plan builder and the per-box gather
+ plo = 0
+ plo(1) = amr_region_lo_all(1, ks) - amr_cpat_mar
+ if (n_glb > 0) plo(2) = amr_region_lo_all(2, ks) - amr_cpat_mar
+ if (p_glb > 0) plo(3) = amr_region_lo_all(3, ks) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, ks) - amr_region_lo_all(1, ks)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, ks) - amr_region_lo_all(2, ks)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, ks) - amr_region_lo_all(3, ks)) + 2*amr_cpat_mar
+ phi(1) = plo(1) + v1hi; phi(2) = plo(2) + v2hi; phi(3) = plo(3) + v3hi
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ maxsz = sys_size*(v1hi + 1)*(v2hi + 1)*(v3hi + 1)
+ call s_phase_tic(PH_RBRSV)
+ call s_amr_gsnd_reserve(maxsz + XA_NH)
+ call s_phase_toc(PH_RBRSV)
+ amr_gsnd_n = amr_gsnd_n + 1
+ call s_phase_tic(PH_RBPACK)
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_gsnd_pool(:,amr_gsnd_n), XA_F1_SND, ks, bl, bh)
+ idx = XA_NH
+ do i = 1, sys_size
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ idx = idx + 1
+ amr_gsnd_pool(idx, amr_gsnd_n) = real(q_coarse(i)%sf(g1 - o1, g2 - o2, g3 - o3), wp)
+ end do
+ end do
+ end do
+ end do
+ call s_phase_toc(PH_RBPACK)
+#ifdef MFC_MPI
+ call s_phase_tic(PH_RBSEND)
+ call s_xa_rec(XA_F1_SND, 1, boxsz, ks)
+ call MPI_ISEND(amr_gsnd_pool(1, amr_gsnd_n), boxsz + XA_NH, mpi_p, amr_block_owner(ks), ks, MPI_COMM_WORLD, &
+ & amr_gsnd_req(amr_gsnd_n), ierr)
+ call s_phase_toc(PH_RBSEND)
+#endif
+ end if
+ end do
+
+ end subroutine s_amr_gather_chunk_send
+
+ !> Step-2 phase C: the per-box gather body with the exchange already in flight - fill amr_cg for the current box (amr_cur,
+ !! geometry already set by the caller) from the own slice plus the chunk pool's pre-posted recvs. Level-1 owner: own-box host
+ !! copy, one WAITALL on this box's contiguous request run, host unpack per contributor (plan order = posting order), device
+ !! push. Level>=2: co-located parent = local device copy; split parent = the parent owner packs and sends HERE when the parent
+ !! shares this chunk (amr_gcr_sent marks the ones phase B already covered), the child owner waits and device-unpacks its single
+ !! pre-posted recv. Every rank passes through for every box (the caller's owner-cycle comes after), which is what makes the
+ !! request arrays reusable next chunk.
+ impure subroutine s_amr_gather_consume_box(q_coarse, k, c_lo)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: k, c_lo
+ integer :: cb, idx, i, r, g1, g2, g3, o1, o2, o3, boxsz, pblk, w1, w2, w3, ierr, r0, nr, off
+ integer :: v1hi, v2hi, v3hi, plo(3), phi(3), crlo(3), crhi(3), bl(3), bh(3)
+
+ cb = k - c_lo + 1
+ r0 = amr_gcr_r0(cb); nr = amr_gcr_nr(cb)
+
+ if (amr_block_level(amr_cur) >= 2) then
+ call s_phase_tic(PH_PGALL)
+ pblk = f_amr_parent_block(amr_cur)
+ ! the deferred same-chunk send below reads the parent's store, valid ONLY because parents-first ordering already
+ ! consumed the parent (D1 in amr_regrid_gather_batching.md) - trip immediately if the ordering is ever violated
+ @:ASSERT(pblk < f_l0_slot(k), "chunk gather: parent box not before child")
+ if (amr_gpl_psrc(amr_cur) < 0) then
+ ! co-located: the owner's local device copy (the field routine detects co-location itself)
+ if (amr_block_owner(amr_cur) == proc_rank) then
+ call s_phase_tic(PH_PGSEND)
+ call s_amr_gather_from_parent_field_cons(amr_cur, pblk, amr_loc_of(pblk), .true.)
+ call s_phase_toc(PH_PGSEND)
+ end if
+ else if (amr_block_owner(pblk) == proc_rank) then
+ ! split, parent side: a same-chunk parent could not be packed in the send phase (its store was unbuilt);
+ ! parents-first ordering means it is complete now
+ if (.not. amr_gcr_sent(cb)) then
+ call s_phase_tic(PH_PGSEND)
+ call s_amr_gather_from_parent_field_cons(amr_cur, pblk, amr_loc_of(pblk), .true.)
+ call s_phase_toc(PH_PGSEND)
+ end if
+ else if (amr_block_owner(amr_cur) == proc_rank) then
+ ! split, child side: wait on the pre-posted parent patch and unpack on the device
+ call s_amr_parent_foot(amr_cur, pblk, plo, phi)
+ amr_cpat_off = 0
+ amr_cpat_off(1) = plo(1) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = plo(2) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = plo(3) - amr_cpat_mar
+ w1 = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ w2 = 0; w3 = 0
+ if (n_glb > 0) w2 = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w3 = (phi(3) - plo(3)) + 2*amr_cpat_mar
+#ifdef MFC_MPI
+ call s_phase_tic(PH_PGRECV)
+ call MPI_WAITALL(nr, amr_gcr_req(r0:r0 + nr - 1), MPI_STATUSES_IGNORE, ierr)
+ call s_phase_toc(PH_PGRECV)
+ off = amr_gcr_off(r0)
+ boxsz = amr_gpl_psz(amr_cur)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_gcr_pool(off + 1:off + XA_NH), XA_F2_SND, amr_cur, plo, phi)
+ call s_amr_unpack_parent_patch_device(w1, w2, w3, amr_gcr_pool(off + XA_NH + 1:off + XA_NH + boxsz), .true.)
+#endif
+ end if
+ call s_phase_toc(PH_PGALL)
+ return
+ end if
+
+ ! level-1: same patch frame and own fill as the per-box gather; the recvs are already posted
+ amr_cpat_off = 0
+ amr_cpat_off(1) = amr_region_lo_all(1, amr_cur) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = amr_region_lo_all(2, amr_cur) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = amr_region_lo_all(3, amr_cur) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, amr_cur) - amr_region_lo_all(1, amr_cur)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, amr_cur) - amr_region_lo_all(2, amr_cur)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, amr_cur) - amr_region_lo_all(3, amr_cur)) + 2*amr_cpat_mar
+ plo = amr_cpat_off
+ phi(1) = amr_cpat_off(1) + v1hi; phi(2) = amr_cpat_off(2) + v2hi; phi(3) = amr_cpat_off(3) + v3hi
+
+ if (amr_block_owner(amr_cur) /= proc_rank) return ! contributor sends were the send phase's job
+
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ call s_phase_tic(PH_RBOWN)
+ call s_amr_unpack_patch(q_coarse, bl, bh, o1, o2, o3)
+ call s_phase_toc(PH_RBOWN)
+#ifdef MFC_MPI
+ if (nr > 0) then
+ call s_phase_tic(PH_RBWAIT)
+ call MPI_WAITALL(nr, amr_gcr_req(r0:r0 + nr - 1), MPI_STATUSES_IGNORE, ierr)
+ call s_phase_toc(PH_RBWAIT)
+ call s_phase_tic(PH_RBUNPK)
+ do idx = 1, nr
+ ! plan order = posting order; recompute each contributor's slice box exactly as the plan builder did
+ call s_amr_rank_coarse_range(amr_gpl_src(idx, amr_cur), crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ off = amr_gcr_off(r0 + idx - 1)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_gcr_pool(off + 1:off + XA_NH), XA_F1_SND, amr_cur, bl, bh)
+ r = XA_NH
+ do i = 1, sys_size
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ r = r + 1
+ amr_cg(i)%sf(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), &
+ & g3 - amr_cpat_off(3)) = real(amr_gcr_pool(off + r), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ call s_phase_toc(PH_RBUNPK)
+ end if
+#endif
+ call s_phase_tic(PH_RBUPD)
+ do i = 1, sys_size
+ $:GPU_UPDATE(device='[amr_cg(i)%sf]')
+ end do
+ call s_phase_toc(PH_RBUPD)
+
+ end subroutine s_amr_gather_consume_box
+
+ !> [amr-cov]: accumulate the step-fill coverage split for the current block (owner calls, once per fill). The whole patch is
+ !! shipped/copied; the ghost-fill kernel reads only the margin plus ONE interior cell per face (floor(f/rr) +- 1), so the
+ !! interior core - the patch frame's region shrunk by 1 per face - is provably dead. Level>=2 blocks fill from the parent-fine
+ !! foot patch; same split in that frame.
+ impure subroutine s_amr_cov_note_fill()
+
+ integer :: r1, r2, r3, pblk, plo(3), phi(3)
+
+ if (amr_block_level(amr_cur) >= 2) then
+ pblk = f_amr_parent_block(amr_cur)
+ call s_amr_parent_foot(amr_cur, pblk, plo, phi)
+ r1 = phi(1) - plo(1) + 1
+ r2 = 1; r3 = 1
+ if (n_glb > 0) r2 = phi(2) - plo(2) + 1
+ if (p_glb > 0) r3 = phi(3) - plo(3) + 1
+ else
+ r1 = amr_region_hi_all(1, amr_cur) - amr_region_lo_all(1, amr_cur) + 1
+ r2 = 1; r3 = 1
+ if (n_glb > 0) r2 = amr_region_hi_all(2, amr_cur) - amr_region_lo_all(2, amr_cur) + 1
+ if (p_glb > 0) r3 = amr_region_hi_all(3, amr_cur) - amr_region_lo_all(3, amr_cur) + 1
+ end if
+ amr_cov_tot(1) = amr_cov_tot(1) + int(sys_size, 8)*int(r1 + 2*amr_cpat_mar, 8)*int(merge(r2 + 2*amr_cpat_mar, 1, &
+ & n_glb > 0), 8)*int(merge(r3 + 2*amr_cpat_mar, 1, p_glb > 0), 8)
+ amr_cov_dead(1) = amr_cov_dead(1) + int(sys_size, 8)*int(max(r1 - 2, 0), 8)*int(merge(max(r2 - 2, 0), 1, n_glb > 0), &
+ & 8)*int(merge(max(r3 - 2, 0), 1, p_glb > 0), 8)
+
+ end subroutine s_amr_cov_note_fill
+
+ !> [amr-cov]: accumulate the rebuild-gather coverage split for the current box (owner calls, once per owned box). Level-1: patch
+ !! words vs words prolonged into cells the same-level carry-forward overwrites (old same-level regions are disjoint, so the
+ !! intersections sum exactly; each shrunk by 1 per face for the minmod stencil - conservative). Level>=2: patch words only - no
+ !! carry-forward exists, the patch is live by construction.
+ impure subroutine s_amr_cov_note(old_np, old_ilo, old_ext, old_level)
+
+ integer, intent(in) :: old_np, old_ilo(:,:), old_ext(:,:), old_level(:)
+ integer :: kk, pblk, plo(3), phi(3), olo(3), ohi(3), bl(3), bh(3), r1, r2, r3
+ integer(8) :: words
+
+ if (amr_block_level(amr_cur) >= 2) then
+ pblk = f_amr_parent_block(amr_cur)
+ call s_amr_parent_foot(amr_cur, pblk, plo, phi)
+ r1 = phi(1) - plo(1) + 1
+ r2 = 1; r3 = 1
+ if (n_glb > 0) r2 = phi(2) - plo(2) + 1
+ if (p_glb > 0) r3 = phi(3) - plo(3) + 1
+ amr_cov_tot(3) = amr_cov_tot(3) + int(sys_size, 8)*int(r1 + 2*amr_cpat_mar, 8)*int(merge(r2 + 2*amr_cpat_mar, 1, &
+ & n_glb > 0), 8)*int(merge(r3 + 2*amr_cpat_mar, 1, p_glb > 0), 8)
+ return
+ end if
+ r1 = amr_region_hi_all(1, amr_cur) - amr_region_lo_all(1, amr_cur) + 1
+ r2 = 1; r3 = 1
+ if (n_glb > 0) r2 = amr_region_hi_all(2, amr_cur) - amr_region_lo_all(2, amr_cur) + 1
+ if (p_glb > 0) r3 = amr_region_hi_all(3, amr_cur) - amr_region_lo_all(3, amr_cur) + 1
+ amr_cov_tot(2) = amr_cov_tot(2) + int(sys_size, 8)*int(r1 + 2*amr_cpat_mar, 8)*int(merge(r2 + 2*amr_cpat_mar, 1, &
+ & n_glb > 0), 8)*int(merge(r3 + 2*amr_cpat_mar, 1, p_glb > 0), 8)
+ do kk = 1, old_np
+ if (old_level(kk) /= amr_block_level(amr_cur)) cycle
+ olo = old_ilo(:,kk)
+ ohi = olo
+ ohi(1) = olo(1) + (old_ext(1, kk) + 1)/amr_ref_ratio**old_level(kk) - 1
+ if (n_glb > 0) ohi(2) = olo(2) + (old_ext(2, kk) + 1)/amr_ref_ratio**old_level(kk) - 1
+ if (p_glb > 0) ohi(3) = olo(3) + (old_ext(3, kk) + 1)/amr_ref_ratio**old_level(kk) - 1
+ call s_amr_box_isect(amr_region_lo_all(:,amr_cur), amr_region_hi_all(:,amr_cur), olo, ohi, bl, bh)
+ if (bl(1) > bh(1) .or. bl(2) > bh(2) .or. bl(3) > bh(3)) cycle
+ words = int(max(bh(1) - bl(1) + 1 - 2, 0), 8)
+ if (n_glb > 0) words = words*int(max(bh(2) - bl(2) + 1 - 2, 0), 8)
+ if (p_glb > 0) words = words*int(max(bh(3) - bl(3) + 1 - 2, 0), 8)
+ amr_cov_dead(2) = amr_cov_dead(2) + int(sys_size, 8)*words
+ end do
+
+ end subroutine s_amr_cov_note
+
+ !> [amr-cov] report: SUM-allreduce the counters and print once on rank 0. Collective - the caller (s_finalize_amr_module) runs
+ !! it before the amr early-return so every rank participates (all-zero when amr is off).
+ impure subroutine s_amr_cov_report()
+
+ integer(8) :: tot(3), dead(3), cad(2), cadr(2)
+ integer :: ierr, f
+ character(len=8), parameter :: nm(3) = ["stepfill", "rb-L1 ", "rb-L2 "]
+
+ tot = amr_cov_tot; dead = amr_cov_dead
+ cad(1) = amr_cad_tot; cad(2) = amr_cad_esc; cadr = cad
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(amr_cov_tot, tot, 3, MPI_INTEGER8, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(amr_cov_dead, dead, 3, MPI_INTEGER8, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(cad, cadr, 2, MPI_INTEGER8, MPI_SUM, MPI_COMM_WORLD, ierr)
+#endif
+ if (proc_rank == 0) then
+ do f = 1, 3
+ if (tot(f) > 0) write (0, '(A,A,A,I0,A,I0,A,F6.3)') ' [amr-cov] ', nm(f), ' words ', tot(f), ' dead ', dead(f), &
+ & ' frac ', real(dead(f))/real(tot(f))
+ end do
+ ! cadence containment: escaped > 0 means a feature outran amr_buf between regrids (see the decl)
+ if (cadr(1) > 0) write (0, '(A,I0,A,I0,A,F6.3)') ' [amr-cad] L1 tags ', cadr(1), ' escaped ', cadr(2), ' frac ', &
+ & real(cadr(2))/real(cadr(1))
+ end if
+
+ end subroutine s_amr_cov_report
+
+ impure subroutine s_amr_gather_coarse_patch(q_coarse, pull_host)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ !> runtime callers pass .true. (coarse device-current); init/regrid pass .false. (host is truth)
+ logical, intent(in) :: pull_host
+ integer :: i, g1, g2, g3, o1, o2, o3, owner, r, idx, boxsz, maxsz, nsrc, ierr
+ integer :: v1hi, v2hi, v3hi, plo(3), phi(3), crlo(3), crhi(3), bl(3), bh(3)
+ real(wp), allocatable :: rbuf(:,:), sbuf(:)
+ integer, allocatable :: reqs(:), srank(:)
+
+ ! multi-level: a level>=2 block's coarse side is its PARENT block's fine cells, not the L0 base grid q_coarse - gather
+ ! amr_cg
+ ! from the parent's fine array in the parent-fine frame (isect already parent-fine from s_set_amr_fine_geometry). np=1 is a
+ ! local copy; the np>=2 P2P version (parent owner -> block owner, mirroring the L0 path) is future work.
+
+ if (amr_block_level(amr_cur) >= 2) then
+ if (amr_rg_gather) call s_phase_tic(PH_PGALL)
+ call s_amr_gather_from_parent(pull_host)
+ if (amr_rg_gather) call s_phase_toc(PH_PGALL)
+ return
+ end if
+
+ ! block-local patch frame (cell 0 == global region_lo-nmar; collapsed dims -> 0) + its GLOBAL cell range [plo:phi]
+ amr_cpat_off = 0
+ amr_cpat_off(1) = amr_region_lo_all(1, amr_cur) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = amr_region_lo_all(2, amr_cur) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = amr_region_lo_all(3, amr_cur) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, amr_cur) - amr_region_lo_all(1, amr_cur)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, amr_cur) - amr_region_lo_all(2, amr_cur)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, amr_cur) - amr_region_lo_all(3, amr_cur)) + 2*amr_cpat_mar
+ plo = amr_cpat_off
+ phi(1) = amr_cpat_off(1) + v1hi; phi(2) = amr_cpat_off(2) + v2hi; phi(3) = amr_cpat_off(3) + v3hi
+
+ owner = amr_block_owner(amr_cur)
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ maxsz = sys_size*(v1hi + 1)*(v2hi + 1)*(v3hi + 1)
+
+ ! np=1: the sole owner holds every covered coarse cell, so copy q_coarse->amr_cg on-device (same index map as
+ ! s_amr_unpack_patch), skipping the device->host->device round-trip. Only for pull_host; init/regrid (.not. pull_host) falls
+ ! through to the host path (device copy may be stale).
+ if (num_procs == 1 .and. pull_host) then
+ call s_amr_rank_coarse_range(owner, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ call s_amr_gather_own_box_device(q_coarse, bl, bh, o1, o2, o3) ! same kernel the np>1 owner path uses
+ return
+ end if
+
+ ! np>1 runtime (pull_host): NO full-field host pull - the owner's own-box copy, the non-owner pack, and the received-box
+ ! unpacks all run on the DEVICE over only the overlap boxes, so just the contiguous wire buffers cross PCIe (MPI stays on
+ ! host buffers). Init/regrid (.not. pull_host): host is truth, so the host pack/unpack paths below read it directly.
+
+ ! block set changed: rebuild the cached overlap-rank lists (same lazy trigger as s_amr_fine_fine_halo; local, replicated)
+ if (amr_rg_gather) call s_phase_tic(PH_RBSEAM)
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+ if (amr_rg_gather) call s_phase_toc(PH_RBSEAM)
+
+ if (proc_rank == owner) then
+ ! fill the cells this rank holds locally (own box), then receive the rest from the other coarse-owners
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (pull_host) then
+ ! runtime: q_coarse is device-current - copy the own box on the device (same index map/assignment as the host path)
+ call s_amr_gather_own_box_device(q_coarse, bl, bh, o1, o2, o3)
+ else
+ if (amr_rg_gather) call s_phase_tic(PH_RBOWN)
+ call s_amr_unpack_patch(q_coarse, bl, bh, o1, o2, o3) ! local read: q_coarse own frame -> amr_cg patch frame
+ if (amr_rg_gather) call s_phase_toc(PH_RBOWN)
+ end if
+ ! count + post recvs from every OTHER rank whose owned range overlaps the patch (cached list; every listed rank
+ ! overlaps by construction)
+ if (amr_rg_gather) call s_phase_tic(PH_RBPOST)
+ nsrc = 0
+ do idx = 1, amr_ovl_gather_n(amr_cur)
+ if (amr_ovl_gather(idx, amr_cur) /= owner) nsrc = nsrc + 1
+ end do
+ if (amr_rg_gather .and. amr_gpl_valid) then
+ @:ASSERT(nsrc == amr_gpl_nsrc(amr_cur), "gather plan: contributor count mismatch")
+ end if
+ if (amr_rg_gather) call s_phase_toc(PH_RBPOST)
+ if (nsrc > 0) then
+ if (amr_rg_gather) call s_phase_tic(PH_RBALLOC)
+ allocate (rbuf(maxsz + XA_NH, nsrc), reqs(nsrc), srank(nsrc))
+ if (amr_rg_gather) call s_phase_toc(PH_RBALLOC)
+ if (amr_rg_gather) call s_phase_tic(PH_RBPOST)
+ nsrc = 0
+ do idx = 1, amr_ovl_gather_n(amr_cur)
+ r = amr_ovl_gather(idx, amr_cur)
+ if (r == owner) cycle
+ call s_amr_rank_coarse_range(r, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ nsrc = nsrc + 1; srank(nsrc) = r
+ if (amr_rg_gather .and. amr_gpl_valid) then
+ @:ASSERT(amr_gpl_src(nsrc, amr_cur) == r .and. amr_gpl_sz(nsrc, amr_cur) == boxsz, &
+ & "gather plan: recv entry mismatch")
+ end if
+#ifdef MFC_MPI
+ call s_xa_rec(XA_F1_RCV, 2, boxsz, amr_cur)
+ call MPI_IRECV(rbuf(1, nsrc), boxsz + XA_NH, mpi_p, r, amr_cur, MPI_COMM_WORLD, reqs(nsrc), ierr)
+#endif
+ end do
+ if (amr_rg_gather) call s_phase_toc(PH_RBPOST)
+#ifdef MFC_MPI
+ if (amr_rg_gather) call s_phase_tic(PH_RBWAIT)
+ call MPI_WAITALL(nsrc, reqs, MPI_STATUSES_IGNORE, ierr)
+ if (amr_rg_gather) call s_phase_toc(PH_RBWAIT)
+#endif
+ if (amr_rg_gather) call s_phase_tic(PH_RBUNPK)
+ do idx = 1, nsrc
+ call s_amr_rank_coarse_range(srank(idx), crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (XA_NH > 0) call s_xa_hdr_check(rbuf(:,idx), XA_F1_SND, amr_cur, bl, bh)
+ if (pull_host) then
+ ! runtime: unpack ONLY this box's wire buffer on the device (same order/cast as the host unpack below)
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ call s_amr_unpack_box_device(bl, bh, rbuf(XA_NH + 1:XA_NH + boxsz,idx))
+ cycle
+ end if
+ ! unpack in the SAME (i, g3, g2, g1) order the sender packed; place at amr_cg patch-local index
+ r = XA_NH
+ do i = 1, sys_size
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ r = r + 1
+ amr_cg(i)%sf(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), g3 - amr_cpat_off(3)) = real(rbuf(r, &
+ & idx), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ if (amr_rg_gather) call s_phase_toc(PH_RBUNPK)
+ if (amr_rg_gather) call s_phase_tic(PH_RBALLOC)
+ deallocate (rbuf, reqs, srank)
+ if (amr_rg_gather) call s_phase_toc(PH_RBALLOC)
+ end if
+ ! host path only: the runtime device path wrote amr_cg on the device directly (host amr_cg stays stale, as at np=1 -
+ ! runtime consumers read the device copy)
+ if (.not. pull_host) then
+ if (amr_rg_gather) call s_phase_tic(PH_RBUPD)
+ do i = 1, sys_size
+ $:GPU_UPDATE(device='[amr_cg(i)%sf]')
+ end do
+ if (amr_rg_gather) call s_phase_toc(PH_RBUPD)
+ end if
+ else
+ ! non-owner: if my owned coarse range overlaps the patch, pack my slice (wp) and send it to the owner
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) then
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ if (amr_rg_gather .and. amr_gpl_valid) then
+ ! this rank must appear in the plan's contributor list for this box, with this exact size
+ nsrc = 0
+ do idx = 1, amr_gpl_nsrc(amr_cur)
+ if (amr_gpl_src(idx, amr_cur) == proc_rank .and. amr_gpl_sz(idx, amr_cur) == boxsz) nsrc = 1
+ end do
+ @:ASSERT(nsrc == 1, "gather plan: send entry mismatch")
+ end if
+ if (amr_rg_gather) call s_phase_tic(PH_RBRSV)
+ call s_amr_gsnd_reserve(maxsz + XA_NH)
+ if (amr_rg_gather) call s_phase_toc(PH_RBRSV)
+ amr_gsnd_n = amr_gsnd_n + 1
+ if (pull_host) then
+ ! runtime: pack the overlap box on the device straight into the pool slot (only the box crosses PCIe);
+ ! the slice leaves the I1b header words ahead of the data (kernel untouched)
+ call s_amr_pack_box_device(q_coarse, bl, bh, o1, o2, o3, amr_gsnd_pool(XA_NH + 1:,amr_gsnd_n))
+ else
+ if (amr_rg_gather) call s_phase_tic(PH_RBPACK)
+ idx = XA_NH
+ do i = 1, sys_size
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ idx = idx + 1
+ amr_gsnd_pool(idx, amr_gsnd_n) = real(q_coarse(i)%sf(g1 - o1, g2 - o2, g3 - o3), wp)
+ end do
+ end do
+ end do
+ end do
+ if (amr_rg_gather) call s_phase_toc(PH_RBPACK)
+ end if
+#ifdef MFC_MPI
+ ! NON-BLOCKING: the owner's per-box IRECV/WAITALL still orders the data correctly, but this rank no longer
+ ! rendezvouses on every box. Completed by s_amr_gather_send_flush (caller) or the drain in s_amr_gsnd_reserve.
+ if (amr_rg_gather) call s_phase_tic(PH_RBSEND)
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_gsnd_pool(:,amr_gsnd_n), XA_F1_SND, amr_cur, bl, bh)
+ call s_xa_rec(XA_F1_SND, 1, boxsz, amr_cur)
+ call MPI_ISEND(amr_gsnd_pool(1, amr_gsnd_n), boxsz + XA_NH, mpi_p, owner, amr_cur, MPI_COMM_WORLD, &
+ & amr_gsnd_req(amr_gsnd_n), ierr)
+ if (amr_rg_gather) call s_phase_toc(PH_RBSEND)
+#endif
+ end if
+ end if
+
+ end subroutine s_amr_gather_coarse_patch
+
+ !> Non-polytropic QBMM analogue of s_amr_gather_coarse_patch: gather the current block's coarse pb/mv patch into amr_cg_pb/mv
+ !! (patch frame, cell 0 == amr_cpat_off), P2P from the coarse-cell owners into the block owner. Per-cell payload = 2*nnode*nb
+ !! (pb block then mv block). Single-level only (level>=2 QBMM np>=2 is checker-gated); wire is wp, cast to stp on unpack
+ !! (identity for stp coarse), so at np=1 the owner copies its own coarse over the patch bit-for-bit. TWIN
+ !! s_amr_gather_coarse_patch (pb/mv<->q): mirrors the q_cons gather's P2P skeleton and patch-local frame - keep lockstep.
+ impure subroutine s_amr_gather_coarse_patch_pbmv(pb_coarse, mv_coarse, pull_host)
+
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_coarse, mv_coarse
+ !> runtime callers pass .true. (coarse device-current); init/regrid pass .false. (host is truth)
+ logical, intent(in) :: pull_host
+ integer :: q, ib_, g1, g2, g3, o1, o2, o3, owner, r, idx, boxsz, maxsz, nsrc, ierr
+ integer :: v1hi, v2hi, v3hi, plo(3), phi(3), crlo(3), crhi(3), bl(3), bh(3), cellsz
+ real(wp), allocatable :: rbuf(:,:), sbuf(:)
+ integer, allocatable :: reqs(:), srank(:)
+
+ ! single-level only: a level>=2 block's coarse side is its parent's fine pb/mv, distributed only at np=1 - the checker gate
+ ! keeps multi-level QBMM np>=2 fail-closed, so this must never be reached at level>=2.
+
+ if (amr_block_level(amr_cur) >= 2) return
+
+ cellsz = 2*nnode*nb
+
+ ! block-local patch frame (cell 0 == global region_lo-nmar; collapsed dims -> 0) + its GLOBAL cell range [plo:phi]
+ amr_cpat_off = 0
+ amr_cpat_off(1) = amr_region_lo_all(1, amr_cur) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = amr_region_lo_all(2, amr_cur) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = amr_region_lo_all(3, amr_cur) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, amr_cur) - amr_region_lo_all(1, amr_cur)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, amr_cur) - amr_region_lo_all(2, amr_cur)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, amr_cur) - amr_region_lo_all(3, amr_cur)) + 2*amr_cpat_mar
+ plo = amr_cpat_off
+ phi(1) = amr_cpat_off(1) + v1hi; phi(2) = amr_cpat_off(2) + v2hi; phi(3) = amr_cpat_off(3) + v3hi
+
+ owner = amr_block_owner(amr_cur)
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ maxsz = cellsz*(v1hi + 1)*(v2hi + 1)*(v3hi + 1)
+
+ ! np=1: the sole owner holds every covered coarse cell, so copy pb_coarse/mv_coarse->amr_cg_pb/mv on-device over the
+ ! in-domain patch. Only for pull_host; init/regrid (.not. pull_host) falls through to the host path (device copy may be
+ ! stale).
+ if (num_procs == 1 .and. pull_host) then
+ call s_amr_rank_coarse_range(owner, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ call s_amr_gather_own_box_pbmv_device(pb_coarse, mv_coarse, bl, bh, o1, o2, o3) ! same kernel the np>1 owner path uses
+ return
+ end if
+
+ ! np>1 runtime (pull_host): NO full-field host pull - the owner's own-box copy, the non-owner pack, and the received-box
+ ! unpacks all run on the DEVICE over only the overlap boxes (mirror of s_amr_gather_coarse_patch). Init/regrid
+ ! (.not. pull_host): host is truth, so the host pack/unpack paths below read it directly.
+
+ ! block set changed: rebuild the cached overlap-rank lists (same lazy trigger as s_amr_fine_fine_halo; local, replicated)
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+
+ if (proc_rank == owner) then
+ ! fill the cells this rank holds locally (own box), then receive the rest from the other coarse-owners
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (pull_host) then
+ ! runtime: pb/mv device-current - copy the own box on the device (same index map/assignment as the host path)
+ call s_amr_gather_own_box_pbmv_device(pb_coarse, mv_coarse, bl, bh, o1, o2, o3)
+ else
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ amr_cg_pb(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), g3 - amr_cpat_off(3), q, &
+ & ib_) = pb_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_)
+ amr_cg_mv(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), g3 - amr_cpat_off(3), q, &
+ & ib_) = mv_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_)
+ end do
+ end do
+ end do
+ end do
+ end do
+ end if
+ ! count + post recvs from every OTHER rank whose owned range overlaps the patch (cached list; every listed rank
+ ! overlaps by construction)
+ nsrc = 0
+ do idx = 1, amr_ovl_gather_n(amr_cur)
+ if (amr_ovl_gather(idx, amr_cur) /= owner) nsrc = nsrc + 1
+ end do
+ if (nsrc > 0) then
+ allocate (rbuf(maxsz + XA_NH, nsrc), reqs(nsrc), srank(nsrc))
+ nsrc = 0
+ do idx = 1, amr_ovl_gather_n(amr_cur)
+ r = amr_ovl_gather(idx, amr_cur)
+ if (r == owner) cycle
+ call s_amr_rank_coarse_range(r, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ boxsz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ nsrc = nsrc + 1; srank(nsrc) = r
+#ifdef MFC_MPI
+ call s_xa_rec(XA_F3_RCV, 2, boxsz, amr_cur)
+ call MPI_IRECV(rbuf(1, nsrc), boxsz + XA_NH, mpi_p, r, amr_cur, MPI_COMM_WORLD, reqs(nsrc), ierr)
+#endif
+ end do
+#ifdef MFC_MPI
+ call MPI_WAITALL(nsrc, reqs, MPI_STATUSES_IGNORE, ierr)
+#endif
+ do idx = 1, nsrc
+ call s_amr_rank_coarse_range(srank(idx), crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (XA_NH > 0) call s_xa_hdr_check(rbuf(:,idx), XA_F3_SND, amr_cur, bl, bh)
+ if (pull_host) then
+ ! runtime: unpack ONLY this box's wire buffer on the device (same order/cast as the host unpack below)
+ boxsz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ call s_amr_unpack_box_pbmv_device(bl, bh, rbuf(XA_NH + 1:XA_NH + boxsz,idx))
+ cycle
+ end if
+ ! unpack in the SAME (ib_, q, g3, g2, g1) order the sender packed - pb block then mv block
+ r = XA_NH
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ r = r + 1
+ amr_cg_pb(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), g3 - amr_cpat_off(3), q, &
+ & ib_) = real(rbuf(r, idx), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ r = r + 1
+ amr_cg_mv(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), g3 - amr_cpat_off(3), q, &
+ & ib_) = real(rbuf(r, idx), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ end do
+ deallocate (rbuf, reqs, srank)
+ end if
+ ! host path only: the runtime device path wrote amr_cg_pb/mv on the device directly (host copies stay stale, as at np=1
+ ! -
+ ! runtime consumers read the device copy)
+ if (.not. pull_host) then
+ $:GPU_UPDATE(device='[amr_cg_pb, amr_cg_mv]')
+ end if
+ else
+ ! non-owner: if my owned coarse range overlaps the patch, pack my slice (wp) and send it to the owner
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) then
+ boxsz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ allocate (sbuf(boxsz + XA_NH))
+ if (pull_host) then
+ ! runtime: pack the overlap box on the device straight into sbuf (only the box crosses PCIe);
+ ! the slice leaves the I1b header words ahead of the data (kernel untouched)
+ call s_amr_pack_box_pbmv_device(pb_coarse, mv_coarse, bl, bh, o1, o2, o3, sbuf(XA_NH + 1:))
+ else
+ idx = XA_NH
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ idx = idx + 1; sbuf(idx) = real(pb_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_), wp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ idx = idx + 1; sbuf(idx) = real(mv_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_), wp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ end if
+#ifdef MFC_MPI
+ if (XA_NH > 0) call s_xa_hdr_pack(sbuf, XA_F3_SND, amr_cur, bl, bh)
+ call s_xa_rec(XA_F3_SND, 1, boxsz, amr_cur)
+ call MPI_SEND(sbuf, boxsz + XA_NH, mpi_p, owner, amr_cur, MPI_COMM_WORLD, ierr)
+#endif
+ deallocate (sbuf)
+ end if
+ end if
+
+ ! host-consumer callers (init/regrid prolong) need the gathered patch on the host
+ if (.not. pull_host) then
+ $:GPU_UPDATE(host='[amr_cg_pb, amr_cg_mv]')
+ end if
+
+ end subroutine s_amr_gather_coarse_patch_pbmv
+
+ !> Multi-level gather: fill amr_cg (the current level>=2 block's coarse patch) from its PARENT block's fine array, in the
+ !! parent-fine cell frame (amr_isect_lo/hi already parent-fine from s_set_amr_fine_geometry). np=1 = a local copy on the owner
+ !! (which also owns the parent); the np>=2 P2P version (parent owner -> block owner) is future work.
+ impure subroutine s_amr_gather_from_parent(pull_host)
+
+ logical, intent(in) :: pull_host
+ integer :: pblk
+
+ pblk = f_amr_parent_block(amr_cur)
+ if (amr_rg_gather .and. amr_gpl_valid) then
+ if (amr_block_owner(pblk) == amr_block_owner(amr_cur)) then
+ @:ASSERT(amr_gpl_psrc(amr_cur) == -1, "gather plan: expected co-located parent")
+ else
+ @:ASSERT(amr_gpl_psrc(amr_cur) == amr_block_owner(pblk), "gather plan: parent source mismatch")
+ end if
+ end if
+ ! lock-step fill: gather from the parent's CURRENT fine state. pull_host stays in the signature for the level-1 path.
+ ! Owner-guard at the CALL SITE: the parent slot is allocated only on ITS owner, and passing its store slot on any
+ ! other rank would dereference an unallocated slot. So both participants enter - the parent's owner to pack and send, the
+ ! block's owner to receive - and every other rank stays out. When the two coincide (np=1, or a co-located tower) this is the
+ ! old local-copy path unchanged. to_host = .not. pull_host: init/regrid (pull_host=F) feed the host prolong/self-test;
+ ! runtime (pull_host=T) reads amr_cg on the device in the C/F ghost-fill, so skip the device->host copy.
+ if (amr_block_owner(pblk) == proc_rank) then
+ ! parent owner: local device copy when it also owns the block, otherwise pack and send.
+ if (amr_rg_gather) call s_phase_tic(PH_PGSEND)
+ call s_amr_gather_from_parent_field_cons(amr_cur, pblk, amr_loc_of(pblk), .not. pull_host)
+ if (amr_rg_gather) call s_phase_toc(PH_PGSEND)
+ else if (amr_rank_owns_block) then
+ ! block owner only: receive. Deliberately does NOT take the parent field - amr_slots(pblk) is unallocated here.
+ if (amr_rg_gather) call s_phase_tic(PH_PGRECV)
+ call s_amr_recv_parent_patch(pblk, .not. pull_host)
+ if (amr_rg_gather) call s_phase_toc(PH_PGRECV)
+ end if
+
+ end subroutine s_amr_gather_from_parent
+
+ !> Gather amr_cg (the current level>=2 block's coarse patch) from a SPECIFIC parent snapshot field qp, in the parent-fine cell
+ !! frame (amr_isect_lo/hi already parent-fine from s_set_amr_fine_geometry). The subcycle recursion calls this twice per parent
+ !! substep - qp = the parent slot's q_cons_stor (t^n bracket) then q_cons (t^{n+1} bracket) - to build the child's two
+ !! ghost-lerp sources. np=1 = a local copy on the owner (which also owns the parent); np>=2 P2P (parent owner -> block owner) is
+ !! future work. Two sources, one body: the parent's conserved state lives in the flat store (`_st`, keyed by its slot), its
+ !! SSP-RK stage backup q_cons_stor is still a per-slot scalar_field array (`_sf`).
+ #:for GSFX, GARR in [('cons', 'amr_cons_st'), ('stor', 'amr_stor_st')]
+ impure subroutine s_amr_gather_from_parent_field_${GSFX}$(cblk, pblk, qp, to_host)
+
+ !> the child block (explicit, NOT amr_cur: the chunked send phase calls this before the consume phase's geometry, when
+ !! amr_cur points at another box)
+ integer, intent(in) :: cblk
+ integer, intent(in) :: pblk
+ integer, intent(in) :: qp !< parent's flat-store slot
+ logical, intent(in) :: to_host !< host copy of amr_cg needed (init/regrid), not runtime
+ integer :: w1, w2, w3, powner, cowner, boxsz, ierr
+ integer :: plo(3), phi(3)
+
+ ! Patch box in the PARENT-FINE frame. Both the child owner and the parent owner must agree on it, so derive it from
+ ! REPLICATED metadata (amr_region_*_all + the global amr_ref_ratio) rather than from amr_isect_lo/hi, which is the empty
+ ! footprint on a non-owner of this block. On the child owner the two agree by construction (s_set_amr_fine_geometry).
+
+ call s_amr_parent_foot(cblk, pblk, plo, phi)
+ amr_cpat_off = 0
+ amr_cpat_off(1) = plo(1) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = plo(2) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = plo(3) - amr_cpat_mar
+ w1 = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ w2 = 0; w3 = 0
+ if (n_glb > 0) w2 = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w3 = (phi(3) - plo(3)) + 2*amr_cpat_mar
+
+ cowner = amr_block_owner(cblk); powner = amr_block_owner(pblk)
+ if (powner == cowner) then
+ ! co-located (always true at np=1, and under tower co-location): straight device copy, bit-for-bit as before.
+ call s_amr_copy_parent_patch_${GSFX}$(qp, w1, w2, w3, to_host)
+ return
+ end if
+
+#ifdef MFC_MPI
+ ! Split ownership, parent side: exactly one destination (the block's owner) and one box, so a blocking pair suffices -
+ ! no
+ ! overlap map and no collective, matching the L0<->L1 gather's "non-participants send/recv nothing" property.
+ ! NON-BLOCKING, via the same deferred pool the level-1 gather uses (see s_amr_gsnd_reserve). The old code used a
+ ! BLOCKING MPI_SEND here, so the parent's owner rendezvoused with the child's owner once per box, in lockstep - the
+ ! defect m_amr.fpp:256 records for the level-1 path and fixes there, never applied to this one. Level>=2 is the
+ ! MAJORITY of boxes (160 of 224 at cap 64), and it measured 420 ms per send / 8.6% of wall at the production point.
+ ! The pool owns the buffer because an ISEND requires it to stay live until completion; the drain is the existing
+ ! s_amr_gather_send_flush after the rebuild's box loop.
+ boxsz = sys_size*(w1 + 1)*(w2 + 1)*(w3 + 1)
+ ! guard on the plan alone, NOT amr_rg_gather (nothing sets it since the chunked rebuild landed): this is the ONE
+ ! step-1 assert on the chunked path's live route - a send packed short of the plan-sized recv completes short and
+ ! the consume unpacks stale pool bytes, the silent-wrong-answer class. amr_gpl_valid is false outside the rebuild
+ ! box loop, so subcycle/per-step calls never consult the plan.
+ if (amr_gpl_valid) then
+ @:ASSERT(amr_gpl_psz(cblk) == boxsz, "gather plan: parent send size mismatch")
+ end if
+ call s_amr_gsnd_reserve(boxsz + XA_NH)
+ amr_gsnd_n = amr_gsnd_n + 1
+ ! header written on the host AFTER the device pack lands (copyout) - data at XA_NH+1 via the slice
+ call s_amr_pack_parent_patch_device_${GSFX}$(qp, w1, w2, w3, amr_gsnd_pool(XA_NH + 1:,amr_gsnd_n))
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_gsnd_pool(:,amr_gsnd_n), XA_F2_SND, cblk, plo, phi)
+ call s_xa_rec(XA_F2_SND, 1, boxsz, cblk)
+ call MPI_ISEND(amr_gsnd_pool(1, amr_gsnd_n), boxsz + XA_NH, mpi_p, cowner, cblk, MPI_COMM_WORLD, &
+ & amr_gsnd_req(amr_gsnd_n), ierr)
+#endif
+
+ end subroutine s_amr_gather_from_parent_field_${GSFX}$
+ #:endfor
+
+ !> Receive side of the split-ownership parent gather: fill amr_cg from the parent's owner. Takes only pblk - the parent slot is
+ !! NOT allocated on this rank, so the parent field must not appear in the signature. Recomputes the patch box from the same
+ !! replicated metadata the sender uses, so the two agree without a handshake.
+ impure subroutine s_amr_recv_parent_patch(pblk, to_host)
+
+ integer, intent(in) :: pblk
+ logical, intent(in) :: to_host
+ integer :: w1, w2, w3, powner, boxsz, ierr, plo(3), phi(3)
+ real(wp), allocatable :: xbuf(:)
+
+ call s_amr_parent_foot(amr_cur, pblk, plo, phi)
+ amr_cpat_off = 0
+ amr_cpat_off(1) = plo(1) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = plo(2) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = plo(3) - amr_cpat_mar
+ w1 = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ w2 = 0; w3 = 0
+ if (n_glb > 0) w2 = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w3 = (phi(3) - plo(3)) + 2*amr_cpat_mar
+
+#ifdef MFC_MPI
+ powner = amr_block_owner(pblk)
+ boxsz = sys_size*(w1 + 1)*(w2 + 1)*(w3 + 1)
+ if (amr_rg_gather .and. amr_gpl_valid) then
+ @:ASSERT(amr_gpl_psrc(amr_cur) == powner .and. amr_gpl_psz(amr_cur) == boxsz, "gather plan: parent recv mismatch")
+ end if
+ allocate (xbuf(boxsz + XA_NH))
+ call s_xa_rec(XA_F2_RCV, 2, boxsz, amr_cur)
+ call MPI_RECV(xbuf, boxsz + XA_NH, mpi_p, powner, amr_cur, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+ if (XA_NH > 0) call s_xa_hdr_check(xbuf, XA_F2_SND, amr_cur, plo, phi)
+ call s_amr_unpack_parent_patch_device(w1, w2, w3, xbuf(XA_NH + 1:XA_NH + boxsz), to_host)
+ deallocate (xbuf)
+#endif
+
+ end subroutine s_amr_recv_parent_patch
+
+ !> DEVICE pack of the parent's fine patch into a flat buffer. Same index map as s_amr_copy_parent_patch, writing the send buffer
+ !! instead of amr_cg, so the two sides of the P2P gather cannot drift apart.
+ #:for GSFX, GARR in [('cons', 'amr_cons_st'), ('stor', 'amr_stor_st')]
+ #:set QP = lambda ix: GARR + '(g1 + o1, g2 + o2, g3 + o3, ' + ix + ', qp)'
+ impure subroutine s_amr_pack_parent_patch_device_${GSFX}$(qp, w1, w2, w3, buf)
+
+ integer, intent(in) :: qp !< parent's flat-store slot
+ integer, intent(in) :: w1, w2, w3
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: i, g1, g2, g3, o1, o2, o3, n1, n2, n3
+
+ o1 = amr_cpat_off(1); o2 = amr_cpat_off(2); o3 = amr_cpat_off(3)
+ n1 = w1 + 1; n2 = w2 + 1; n3 = w3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyout='[buf]')
+ do i = 1, sys_size
+ do g3 = 0, w3
+ do g2 = 0, w2
+ do g1 = 0, w1
+ buf(1 + g1 + n1*(g2 + n2*(g3 + n3*(i - 1)))) = real(${QP('i')}$, wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_pack_parent_patch_device_${GSFX}$
+ #:endfor
+
+ !> DEVICE unpack of a received parent patch into amr_cg. Inverse of s_amr_pack_parent_patch_device; to_host mirrors
+ !! s_amr_copy_parent_patch (init/regrid host consumers need the host copy, runtime reads amr_cg on the device).
+ impure subroutine s_amr_unpack_parent_patch_device(w1, w2, w3, buf, to_host)
+
+ integer, intent(in) :: w1, w2, w3
+ real(wp), intent(in), contiguous :: buf(:)
+ logical, intent(in) :: to_host
+ integer :: i, g1, g2, g3, n1, n2, n3
+
+ n1 = w1 + 1; n2 = w2 + 1; n3 = w3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do i = 1, sys_size
+ do g3 = 0, w3
+ do g2 = 0, w2
+ do g1 = 0, w1
+ amr_cg(i)%sf(g1, g2, g3) = buf(1 + g1 + n1*(g2 + n2*(g3 + n3*(i - 1))))
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ if (to_host) then
+ do i = 1, sys_size
+ $:GPU_UPDATE(host='[amr_cg(i)%sf]')
+ end do
+ end if
+
+ end subroutine s_amr_unpack_parent_patch_device
+
+ !> Device kernel for s_amr_gather_from_parent: copy the parent block's fine patch into amr_cg over [amr_cpat_off : + w]. amr_cg
+ !! is then synced to host for host consumers (init self-test's restrict-prolong check). Two sources, one body - see
+ !! s_amr_gather_from_parent_field_st/_sf.
+ #:for GSFX, GARR in [('cons', 'amr_cons_st'), ('stor', 'amr_stor_st')]
+ #:set QP = lambda ix: GARR + '(g1 + o1, g2 + o2, g3 + o3, ' + ix + ', qp)'
+ impure subroutine s_amr_copy_parent_patch_${GSFX}$(qp, w1, w2, w3, to_host)
+
+ integer, intent(in) :: qp !< parent's flat-store slot
+ integer, intent(in) :: w1, w2, w3
+ !> .true. only for the init/regrid HOST consumers (whole-block host prolong + restrict-prolong self-test). The runtime
+ !! C/F ghost-fill reads amr_cg on the DEVICE (filled by the kernel below), so no device->host copy is needed.
+ logical, intent(in) :: to_host
+ integer :: i, g1, g2, g3, o1, o2, o3
+
+ o1 = amr_cpat_off(1); o2 = amr_cpat_off(2); o3 = amr_cpat_off(3)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do g3 = 0, w3
+ do g2 = 0, w2
+ do g1 = 0, w1
+ amr_cg(i)%sf(g1, g2, g3) = ${QP('i')}$
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ ! amr_cg is now device-current for the runtime C/F ghost-fill. Sync to host only when a host consumer follows.
+ if (to_host) then
+ do i = 1, sys_size
+ $:GPU_UPDATE(host='[amr_cg(i)%sf]')
+ end do
+ end if
+
+ end subroutine s_amr_copy_parent_patch_${GSFX}$
+ #:endfor
+
+ !> Sub-box variants of the parent-patch pack/unpack/copy for the ring-clipped parent-fill wave (cons only - the wave ships
+ !! q_cons; pb/mv runs keep the full-patch contract). Bounds are PATCH-LOCAL cell ranges; the buffer holds the sub-box in the
+ !! same (g1 fastest, sys_size outermost) layout as the full-patch kernels, so both wire sides agree by construction.
+ impure subroutine s_amr_pack_parent_box_device_cons(qp, bl, bh, buf)
+
+ integer, intent(in) :: qp !< parent's flat-store slot
+ integer, intent(in) :: bl(3), bh(3)
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: i, g1, g2, g3, o1, o2, o3, n1, n2, n3, l1, l2, l3, u1, u2, u3
+
+ o1 = amr_cpat_off(1); o2 = amr_cpat_off(2); o3 = amr_cpat_off(3)
+ l1 = bl(1); l2 = bl(2); l3 = bl(3); u1 = bh(1); u2 = bh(2); u3 = bh(3)
+ n1 = u1 - l1 + 1; n2 = u2 - l2 + 1; n3 = u3 - l3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyout='[buf]')
+ do i = 1, sys_size
+ do g3 = l3, u3
+ do g2 = l2, u2
+ do g1 = l1, u1
+ buf(1 + (g1 - l1) + n1*((g2 - l2) + n2*((g3 - l3) + n3*(i - 1)))) = real(amr_cons_st(g1 + o1, g2 + o2, &
+ & g3 + o3, i, qp), wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_pack_parent_box_device_cons
+
+ impure subroutine s_amr_unpack_parent_box_device(bl, bh, buf)
+
+ integer, intent(in) :: bl(3), bh(3)
+ real(wp), intent(in), contiguous :: buf(:)
+ integer :: i, g1, g2, g3, n1, n2, n3, l1, l2, l3, u1, u2, u3
+
+ l1 = bl(1); l2 = bl(2); l3 = bl(3); u1 = bh(1); u2 = bh(2); u3 = bh(3)
+ n1 = u1 - l1 + 1; n2 = u2 - l2 + 1; n3 = u3 - l3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do i = 1, sys_size
+ do g3 = l3, u3
+ do g2 = l2, u2
+ do g1 = l1, u1
+ amr_cg(i)%sf(g1, g2, g3) = buf(1 + (g1 - l1) + n1*((g2 - l2) + n2*((g3 - l3) + n3*(i - 1))))
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_unpack_parent_box_device
+
+ impure subroutine s_amr_copy_parent_box_cons(qp, bl, bh)
+
+ integer, intent(in) :: qp !< parent's flat-store slot
+ integer, intent(in) :: bl(3), bh(3)
+ integer :: i, g1, g2, g3, o1, o2, o3, l1, l2, l3, u1, u2, u3
+
+ o1 = amr_cpat_off(1); o2 = amr_cpat_off(2); o3 = amr_cpat_off(3)
+ l1 = bl(1); l2 = bl(2); l3 = bl(3); u1 = bh(1); u2 = bh(2); u3 = bh(3)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do g3 = l3, u3
+ do g2 = l2, u2
+ do g1 = l1, u1
+ amr_cg(i)%sf(g1, g2, g3) = amr_cons_st(g1 + o1, g2 + o2, g3 + o3, i, qp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_copy_parent_box_cons
+
+ !> Rank r's coarse-grid decomposition (start_idx + local extent m/n/p), computed O(1) from its cartesian coords instead of the
+ !! replicated amr_decomp table. The domain cart is MPI_CART_CREATE(reorder=.false., dims=[num_procs_x,num_procs_y,num_procs_z]),
+ !! so ranks keep MPI_COMM_WORLD order and r's coords are row-major in r. The per-dim split is the integer split-with-remainder
+ !! on CELL INDICES, identical to s_mpi_decompose_computational_domain (independent of grid stretching, which changes coords not
+ !! indices).
+ pure subroutine s_amr_rank_decomp(r, sidx, ext)
+
+ integer, intent(in) :: r
+ integer, intent(out) :: sidx(3), ext(3)
+ integer :: coords(3), gd(3), pd(3), base, rem, d
+
+ gd(1) = m_glb; gd(2) = n_glb; gd(3) = p_glb
+ pd(1) = num_procs_x; pd(2) = num_procs_y; pd(3) = num_procs_z
+ ! row-major: r = cx*(py*pz) + cy*pz + cz (py=pz=1 when that dim is not decomposed)
+ coords(1) = r/(pd(2)*pd(3))
+ coords(2) = mod(r, pd(2)*pd(3))/pd(3)
+ coords(3) = mod(r, pd(3))
+ sidx = 0; ext = 0
+ do d = 1, 3
+ if (d == 2 .and. n_glb == 0) cycle
+ if (d == 3 .and. p_glb == 0) cycle
+ base = (gd(d) + 1)/pd(d)
+ rem = mod(gd(d) + 1, pd(d))
+ ext(d) = base - 1 + merge(1, 0, coords(d) < rem)
+ sidx(d) = coords(d)*base + min(coords(d), rem)
+ end do
+
+ end subroutine s_amr_rank_decomp
+
+ !> Permanent guard: the computed accessor must reproduce THIS rank's actual decomposition. Every rank checks its own entry, so
+ !! collectively the formula is proven for all r; fires immediately if it ever drifts from s_mpi_decompose_computational_domain.
+ !! O(1), always-on.
+ impure subroutine s_amr_validate_decomp()
+
+ integer :: sidx(3), ext(3)
+ logical :: ok
+
+ call s_amr_rank_decomp(proc_rank, sidx, ext)
+ ! nested guards, NOT a single .and./.or.: Fortran does not short-circuit, so start_idx(2)/start_idx(3) (start_idx is sized
+ ! num_dims) would be read out of bounds in 1D/2D even though the guard is false - a GNU-reldebug bounds abort.
+ ok = (sidx(1) == start_idx(1) .and. ext(1) == m)
+ if (n_glb > 0) then
+ if (sidx(2) /= start_idx(2) .or. ext(2) /= n) ok = .false.
+ end if
+ if (p_glb > 0) then
+ if (sidx(3) /= start_idx(3) .or. ext(3) /= p) ok = .false.
+ end if
+ if (.not. ok) then
+ call s_mpi_abort('s_amr_rank_decomp does not reproduce this rank''s decomposition - computed split disagrees with ' &
+ & // 's_mpi_decompose_computational_domain')
+ end if
+
+ end subroutine s_amr_validate_decomp
+
+ !> Closed-form inverse of the per-dim split-with-remainder used by s_amr_rank_decomp: the cart coord owning global coarse cell
+ !! g. base=(gd+1)/pd, rem=mod(gd+1,pd). Exact for g in [0,gd]; callers clamp to [0,pd-1] for out-of-range g (ghost reach).
+ !! base==0 (more ranks than cells) => the g Per-dim contiguous rank-coord range [clo:chi] whose owned coarse slab intersects box [blo:bhi], clamped to [0,pd-1]. The
+ !! boundary coords' coarse_range is extended by buff_size exactly at the domain edge (s_amr_rank_coarse_range), so this clamped
+ !! interior-frame range reproduces BOTH the interior (scatter) and the coarse_range (gather) intersection sets: a box reaching
+ !! the ghost zone clamps to the boundary coord whose extended slab contains it, and there is no rank beyond that coord.
+ !! Collapsed dims (n_glb==0 / p_glb==0) contribute coord 0.
+ pure subroutine s_amr_coord_range(blo, bhi, clo, chi)
+
+ integer, intent(in) :: blo(3), bhi(3)
+ integer, intent(out) :: clo(3), chi(3)
+ integer :: gd(3), pd(3), base, rem, d
+
+ gd(1) = m_glb; gd(2) = n_glb; gd(3) = p_glb
+ pd(1) = num_procs_x; pd(2) = num_procs_y; pd(3) = num_procs_z
+ clo = 0; chi = 0
+ do d = 1, 3
+ if (d == 2 .and. n_glb == 0) cycle
+ if (d == 3 .and. p_glb == 0) cycle
+ base = (gd(d) + 1)/pd(d)
+ rem = mod(gd(d) + 1, pd(d))
+ clo(d) = min(max(f_amr_cell_coord(blo(d), base, rem), 0), pd(d) - 1)
+ chi(d) = min(max(f_amr_cell_coord(bhi(d), base, rem), 0), pd(d) - 1)
+ end do
+
+ end subroutine s_amr_coord_range
+
+ !> Ascending rank list overlapping coarse box [blo:bhi]. Enumerates the coord brick cx->cy->cz so r = cx*(Py*Pz)+cy*Pz+cz is
+ !! monotonic => ascending, reproducing the r=0..num_procs-1 scan order. Owner NOT excluded (consumers keep their own owner
+ !! skip). Caller sizes ranks(:) >= f_amr_overlap_count(blo,bhi).
+ pure subroutine s_amr_ranks_overlapping(blo, bhi, ranks, nr)
+
+ integer, intent(in) :: blo(3), bhi(3)
+ integer, intent(out) :: ranks(:)
+ integer, intent(out) :: nr
+ integer :: clo(3), chi(3), cx, cy, cz, pyz
+
+ call s_amr_coord_range(blo, bhi, clo, chi)
+ pyz = num_procs_y*num_procs_z
+ nr = 0
+ do cx = clo(1), chi(1)
+ do cy = clo(2), chi(2)
+ do cz = clo(3), chi(3)
+ nr = nr + 1
+ ranks(nr) = cx*pyz + cy*num_procs_z + cz
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_ranks_overlapping
+
+ !> S3.2b-2b: does rank r's subdomain overlap coarse box [blo:bhi]? Answers membership WITHOUT enumerating the overlap set, which
+ !! s_amr_ranks_overlapping must do and which costs O(num_procs) writes on a box spanning the machine -- the clusterer asks this
+ !! of every node it walks, the root included, so the enumeration was itself an O(P) term.
+ pure logical function f_amr_rank_overlaps(blo, bhi, r) result(hit)
+
+ integer, intent(in) :: blo(3), bhi(3), r
+ integer :: clo(3), chi(3), c(3)
+
+ call s_amr_coord_range(blo, bhi, clo, chi)
+ c(1) = r/(num_procs_y*num_procs_z) ! same coord -> rank map the enumeration uses: r = cx*(Py*Pz) + cy*Pz + cz
+ c(2) = mod(r/num_procs_z, num_procs_y)
+ c(3) = mod(r, num_procs_z)
+ hit = all(c >= clo) .and. all(c <= chi)
+
+ end function f_amr_rank_overlaps
+
+ !> Overlap count only (allocation sizing), = product of the per-dim coord-range widths.
+ pure integer function f_amr_overlap_count(blo, bhi) result(nr)
+
+ integer, intent(in) :: blo(3), bhi(3)
+ integer :: clo(3), chi(3)
+
+ call s_amr_coord_range(blo, bhi, clo, chi)
+ nr = (chi(1) - clo(1) + 1)*(chi(2) - clo(2) + 1)*(chi(3) - clo(3) + 1)
+
+ end function f_amr_overlap_count
+
+ !> Rank r's contiguous owned coarse-cell range per dim from the computed decomposition (s_amr_rank_decomp): interior
+ !! [start:start+ext] plus its physical-boundary ghosts (buff_size cells only where the subdomain touches the domain edge). Equal
+ !! to the set where f_amr_own_coarse is true, but as one contiguous span so box intersections identify contributors without a
+ !! per-cell scan.
+ pure subroutine s_amr_rank_coarse_range(r, crlo, crhi)
+
+ integer, intent(in) :: r
+ integer, intent(out) :: crlo(3), crhi(3)
+ integer :: sidx(3), ext(3)
+
+ call s_amr_rank_decomp(r, sidx, ext)
+ crlo = 0; crhi = 0
+ crlo(1) = sidx(1); if (sidx(1) == 0) crlo(1) = -buff_size
+ crhi(1) = sidx(1) + ext(1); if (crhi(1) == m_glb) crhi(1) = crhi(1) + buff_size
+ if (n_glb > 0) then
+ crlo(2) = sidx(2); if (sidx(2) == 0) crlo(2) = -buff_size
+ crhi(2) = sidx(2) + ext(2); if (crhi(2) == n_glb) crhi(2) = crhi(2) + buff_size
+ end if
+ if (p_glb > 0) then
+ crlo(3) = sidx(3); if (sidx(3) == 0) crlo(3) = -buff_size
+ crhi(3) = sidx(3) + ext(3); if (crhi(3) == p_glb) crhi(3) = crhi(3) + buff_size
+ end if
+
+ end subroutine s_amr_rank_coarse_range
+
+ !> Per-dim intersection of two global boxes [alo:ahi] and [blo:bhi] -> [olo:ohi] (empty when olo > ohi in some dim).
+ pure subroutine s_amr_box_isect(alo, ahi, blo, bhi, olo, ohi)
+
+ integer, intent(in) :: alo(3), ahi(3), blo(3), bhi(3)
+ integer, intent(out) :: olo(3), ohi(3)
+
+ olo = max(alo, blo); ohi = min(ahi, bhi)
+
+ end subroutine s_amr_box_isect
+
+ !> Do two coarse-index boxes [alo:ahi] and [blo:bhi] overlap? Collapsed dims (n_glb/p_glb == 0) never disqualify.
+ pure logical function f_amr_boxes_overlap(alo, ahi, blo, bhi) result(ov)
+
+ integer, intent(in) :: alo(3), ahi(3), blo(3), bhi(3)
+
+ ov = alo(1) <= bhi(1) .and. ahi(1) >= blo(1)
+ if (n_glb > 0) ov = ov .and. alo(2) <= bhi(2) .and. ahi(2) >= blo(2)
+ if (p_glb > 0) ov = ov .and. alo(3) <= bhi(3) .and. ahi(3) >= blo(3)
+
+ end function f_amr_boxes_overlap
+
+ !> Multi-level nesting: index of the covering level-(level(k)-1) block that block k refines - its coarse parent - or 0 when
+ !! block k is level 1 (parent is the L0 base grid). Regions are in L0 cell indices at every level, so the parent is the
+ !! level-below block whose box contains k's; proper nesting guarantees exactly one, and the first overlap is returned.
+ pure integer function f_amr_parent_block(k) result(p)
+
+ integer, intent(in) :: k
+ integer :: j
+
+ p = 0
+ if (amr_block_level(k) <= 1) return
+ do j = 1, amr_num_blocks
+ if (amr_block_level(j) == amr_block_level(k) - 1 .and. f_amr_boxes_overlap(amr_region_lo_all(:,k), &
+ & amr_region_hi_all(:,k), amr_region_lo_all(:,j), amr_region_hi_all(:,j))) then
+ p = j
+ return
+ end if
+ end do
+
+ end function f_amr_parent_block
+
+ !> Copy this rank's own coarse cells (box [bl:bh] GLOBAL, read from q_coarse at its own start-idx frame o1/o2/o3) into amr_cg in
+ !! the block-local patch frame. stp -> stp, exact.
+ impure subroutine s_amr_unpack_patch(q_coarse, bl, bh, o1, o2, o3)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3
+ integer :: i, g1, g2, g3
+
+ do i = 1, sys_size
+ do g3 = bl(3), bh(3)
+ do g2 = bl(2), bh(2)
+ do g1 = bl(1), bh(1)
+ amr_cg(i)%sf(g1 - amr_cpat_off(1), g2 - amr_cpat_off(2), g3 - amr_cpat_off(3)) = q_coarse(i)%sf(g1 - o1, &
+ & g2 - o2, g3 - o3)
+ end do
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_unpack_patch
+
+ !> Runtime device analogue of s_amr_unpack_patch: copy the owner's own coarse box [bl:bh] GLOBAL from q_coarse (device) into
+ !! amr_cg (device) in the patch-local frame - no host round-trip. Same index map and direct stp assignment as the host path.
+ !! TWIN s_amr_gather_own_box_pbmv_device (q<->pb/mv): same own-box index map; keep lockstep.
+ impure subroutine s_amr_gather_own_box_device(q_coarse, bl, bh, o1, o2, o3)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3
+ integer :: i, g1, g2, g3, bl1, bl2, bl3, bh1, bh2, bh3, coff1, coff2, coff3
+
+ ! scalar copies: no host array may be referenced inside the device region (nvfortran/Cray demand it PRESENT)
+
+ bl1 = bl(1); bh1 = bh(1); bl2 = bl(2); bh2 = bh(2); bl3 = bl(3); bh3 = bh(3)
+ coff1 = amr_cpat_off(1); coff2 = amr_cpat_off(2); coff3 = amr_cpat_off(3)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do g3 = bl3, bh3
+ do g2 = bl2, bh2
+ do g1 = bl1, bh1
+ amr_cg(i)%sf(g1 - coff1, g2 - coff2, g3 - coff3) = q_coarse(i)%sf(g1 - o1, g2 - o2, g3 - o3)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_gather_own_box_device
+
+ !> Runtime device pack of the overlap box [bl:bh] GLOBAL from q_coarse (device) into the contiguous wire buffer buf (host, via
+ !! copyout) - only the box crosses PCIe, not the full field. Explicit-loop linear buf indexing (g1 fastest, then g2, g3, i) and
+ !! the wp cast match the host pack in s_amr_gather_coarse_patch element-for-element, so the receiver's unpack is layout- and
+ !! byte-identical (same discipline as s_amr_fine_slice: no array-section syntax near the device map). TWIN
+ !! s_amr_pack_box_pbmv_device (q<->pb/mv): same wire linear order + wp cast; keep lockstep.
+ impure subroutine s_amr_pack_box_device(q_coarse, bl, bh, o1, o2, o3, buf)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: i, g1, g2, g3, bl1, bl2, bl3, bh1, bh2, bh3, n1, n2, n3
+
+ bl1 = bl(1); bh1 = bh(1); bl2 = bl(2); bh2 = bh(2); bl3 = bl(3); bh3 = bh(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyout='[buf]')
+ do i = 1, sys_size
+ do g3 = bl3, bh3
+ do g2 = bl2, bh2
+ do g1 = bl1, bh1
+ buf(1 + (g1 - bl1) + n1*((g2 - bl2) + n2*((g3 - bl3) + n3*(i - 1)))) = real(q_coarse(i)%sf(g1 - o1, &
+ & g2 - o2, g3 - o3), wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_pack_box_device
+
+ !> Runtime device unpack of a received overlap box [bl:bh] GLOBAL from the contiguous wire buffer buf (host, via copyin) into
+ !! amr_cg (device) in the patch-local frame - only the box crosses PCIe. Same linear order and stp cast as the host unpack in
+ !! s_amr_gather_coarse_patch. TWIN s_amr_unpack_box_pbmv_device (q<->pb/mv): same wire linear order + stp cast; keep lockstep.
+ impure subroutine s_amr_unpack_box_device(bl, bh, buf)
+
+ integer, intent(in) :: bl(3), bh(3)
+ real(wp), intent(in), contiguous :: buf(:)
+ integer :: i, g1, g2, g3, bl1, bl2, bl3, bh1, bh2, bh3, n1, n2, n3, coff1, coff2, coff3
+
+ bl1 = bl(1); bh1 = bh(1); bl2 = bl(2); bh2 = bh(2); bl3 = bl(3); bh3 = bh(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ coff1 = amr_cpat_off(1); coff2 = amr_cpat_off(2); coff3 = amr_cpat_off(3)
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do i = 1, sys_size
+ do g3 = bl3, bh3
+ do g2 = bl2, bh2
+ do g1 = bl1, bh1
+ amr_cg(i)%sf(g1 - coff1, g2 - coff2, &
+ & g3 - coff3) = real(buf(1 + (g1 - bl1) + n1*((g2 - bl2) + n2*((g3 - bl3) + n3*(i - 1)))), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_unpack_box_device
+
+ !> Runtime device own-box copy for the pbmv gather: pb/mv (device) -> amr_cg_pb/mv (device) over [bl:bh] GLOBAL in the
+ !! patch-local frame. Same index map and direct stp assignment as the host path in s_amr_gather_coarse_patch_pbmv. TWIN
+ !! s_amr_gather_own_box_device (pb/mv<->q): q_cons sibling of this own-box copy; keep the index map lockstep.
+ impure subroutine s_amr_gather_own_box_pbmv_device(pb_coarse, mv_coarse, bl, bh, o1, o2, o3)
+
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_coarse, mv_coarse
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3
+ integer :: q, ib_, g1, g2, g3, bl1, bl2, bl3, bh1, bh2, bh3, coff1, coff2, coff3
+
+ bl1 = bl(1); bh1 = bh(1); bl2 = bl(2); bh2 = bh(2); bl3 = bl(3); bh3 = bh(3)
+ coff1 = amr_cpat_off(1); coff2 = amr_cpat_off(2); coff3 = amr_cpat_off(3)
+ $:GPU_PARALLEL_LOOP(collapse=5)
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl3, bh3
+ do g2 = bl2, bh2
+ do g1 = bl1, bh1
+ amr_cg_pb(g1 - coff1, g2 - coff2, g3 - coff3, q, ib_) = pb_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_)
+ amr_cg_mv(g1 - coff1, g2 - coff2, g3 - coff3, q, ib_) = mv_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_gather_own_box_pbmv_device
+
+ !> Runtime device pack for the pbmv gather: pb block then mv block of the overlap box [bl:bh] GLOBAL into the contiguous wire
+ !! buffer buf (host, via copyout). Linear order (g1 fastest, then g2, g3, q, ib_; mv offset by half the message) and wp cast
+ !! match the host pack in s_amr_gather_coarse_patch_pbmv element-for-element. TWIN s_amr_pack_box_device (pb/mv<->q): q_cons
+ !! sibling; keep the wire linear order + wp cast lockstep.
+ impure subroutine s_amr_pack_box_pbmv_device(pb_coarse, mv_coarse, bl, bh, o1, o2, o3, buf)
+
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_coarse, mv_coarse
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: q, ib_, g1, g2, g3, bl1, bl2, bl3, bh1, bh2, bh3, n1, n2, n3, half
+
+ bl1 = bl(1); bh1 = bh(1); bl2 = bl(2); bh2 = bh(2); bl3 = bl(3); bh3 = bh(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ half = n1*n2*n3*nnode*nb
+ $:GPU_PARALLEL_LOOP(collapse=5, copyout='[buf]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl3, bh3
+ do g2 = bl2, bh2
+ do g1 = bl1, bh1
+ buf(1 + (g1 - bl1) + n1*((g2 - bl2) + n2*((g3 - bl3) + n3*((q - 1) + nnode*(ib_ - 1))))) &
+ & = real(pb_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_), wp)
+ buf(half + 1 + (g1 - bl1) + n1*((g2 - bl2) + n2*((g3 - bl3) + n3*((q - 1) + nnode*(ib_ - 1))))) &
+ & = real(mv_coarse(g1 - o1, g2 - o2, g3 - o3, q, ib_), wp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_pack_box_pbmv_device
+
+ !> Runtime device unpack for the pbmv gather: received wire buffer buf (host, via copyin) -> amr_cg_pb/mv (device) over [bl:bh]
+ !! GLOBAL in the patch-local frame. Same linear order and stp cast as the host unpack in s_amr_gather_coarse_patch_pbmv. TWIN
+ !! s_amr_unpack_box_device (pb/mv<->q): q_cons sibling; keep the wire linear order + stp cast lockstep.
+ impure subroutine s_amr_unpack_box_pbmv_device(bl, bh, buf)
+
+ integer, intent(in) :: bl(3), bh(3)
+ real(wp), intent(in), contiguous :: buf(:)
+ integer :: q, ib_, g1, g2, g3, bl1, bl2, bl3, bh1, bh2, bh3, n1, n2, n3, half, coff1, coff2, coff3
+
+ bl1 = bl(1); bh1 = bh(1); bl2 = bl(2); bh2 = bh(2); bl3 = bl(3); bh3 = bh(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ half = n1*n2*n3*nnode*nb
+ coff1 = amr_cpat_off(1); coff2 = amr_cpat_off(2); coff3 = amr_cpat_off(3)
+ $:GPU_PARALLEL_LOOP(collapse=5, copyin='[buf]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g3 = bl3, bh3
+ do g2 = bl2, bh2
+ do g1 = bl1, bh1
+ amr_cg_pb(g1 - coff1, g2 - coff2, g3 - coff3, q, &
+ & ib_) = real(buf(1 + (g1 - bl1) + n1*((g2 - bl2) + n2*((g3 - bl3) + n3*((q - 1) &
+ & + nnode*(ib_ - 1))))), stp)
+ amr_cg_mv(g1 - coff1, g2 - coff2, g3 - coff3, q, &
+ & ib_) = real(buf(half + 1 + (g1 - bl1) + n1*((g2 - bl2) + n2*((g3 - bl3) + n3*((q - 1) &
+ & + nnode*(ib_ - 1))))), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_unpack_box_pbmv_device
+
+ !> True iff rank r is a reflux applier for the current block: it owns the coarse cell layer just OUTSIDE some block face AND its
+ !! subdomain overlaps the block transversely. Mirrors s_amr_reflux_face_flags, but parameterized by r's subdomain from the
+ !! computed decomposition (s_amr_rank_decomp, so the block owner can decide which ranks to send freg to, and each rank agrees on
+ !! whether it receives). Uses amr_region_lo/hi (the current block, set on every rank by s_amr_select_slot). NOTE: deliberately
+ !! NO f_amr_face_is_seam clip (unlike the flags) - and the participation-map build (s_amr_reg_prepare, m_amr_registers) copies
+ !! THIS unclipped formula for its clause (c), because both exchange paths gate their freg receives on it. Keep lockstep.
+ pure logical function f_amr_reflux_participates(r) result(part)
+
+ integer, intent(in) :: r
+ integer :: sidx(3), ext(3), d, t
+ logical :: tv(3), tvd
+
+ call s_amr_rank_decomp(r, sidx, ext)
+ tv(1) = amr_region_lo(1) <= sidx(1) + ext(1) .and. amr_region_hi(1) >= sidx(1)
+ tv(2) = (n_glb == 0) .or. (amr_region_lo(2) <= sidx(2) + ext(2) .and. amr_region_hi(2) >= sidx(2))
+ tv(3) = (p_glb == 0) .or. (amr_region_lo(3) <= sidx(3) + ext(3) .and. amr_region_hi(3) >= sidx(3))
+ part = .false.
+ do d = 1, num_dims
+ tvd = .true.
+ do t = 1, num_dims
+ if (t /= d) tvd = tvd .and. tv(t)
+ end do
+ if (tvd .and. amr_region_lo(d) - 1 >= sidx(d) .and. amr_region_lo(d) - 1 <= sidx(d) + ext(d)) part = .true.
+ if (tvd .and. amr_region_hi(d) + 1 >= sidx(d) .and. amr_region_hi(d) + 1 <= sidx(d) + ext(d)) part = .true.
+ end do
+
+ end function f_amr_reflux_participates
+
+ !> Per-face refinement of f_amr_reflux_participates: the faces of the CURRENT block that rank r actually APPLIES - it owns the
+ !! outside coarse layer with transverse overlap, minus fine-fine seam faces - mirroring s_amr_reflux_face_flags term for term
+ !! (same ownership formula, same f_amr_face_is_seam exclusion). The reflux-faces wave ships exactly these: sender and every
+ !! receiver derive the identical set from replicated data, so a face a rank never applies never rides the wire.
+ pure subroutine s_amr_reflux_faces_for(r, s_lo, s_hi)
+
+ integer, intent(in) :: r
+ logical, intent(out) :: s_lo(3), s_hi(3)
+ integer :: sidx(3), ext(3), d, t
+ logical :: tv(3), tvd
+
+ call s_amr_rank_decomp(r, sidx, ext)
+ tv(1) = amr_region_lo(1) <= sidx(1) + ext(1) .and. amr_region_hi(1) >= sidx(1)
+ tv(2) = (n_glb == 0) .or. (amr_region_lo(2) <= sidx(2) + ext(2) .and. amr_region_hi(2) >= sidx(2))
+ tv(3) = (p_glb == 0) .or. (amr_region_lo(3) <= sidx(3) + ext(3) .and. amr_region_hi(3) >= sidx(3))
+ s_lo = .false.; s_hi = .false.
+ do d = 1, num_dims
+ tvd = .true.
+ do t = 1, num_dims
+ if (t /= d) tvd = tvd .and. tv(t)
+ end do
+ s_lo(d) = tvd .and. amr_region_lo(d) - 1 >= sidx(d) .and. amr_region_lo(d) - 1 <= sidx(d) + ext(d) &
+ & .and. .not. f_amr_face_is_seam(d, -1)
+ s_hi(d) = tvd .and. amr_region_hi(d) + 1 >= sidx(d) .and. amr_region_hi(d) + 1 <= sidx(d) + ext(d) &
+ & .and. .not. f_amr_face_is_seam(d, 1)
+ end do
+
+ end subroutine s_amr_reflux_faces_for
+
+ !> Fine-level distribution: deliver the current block's fine flux registers freg (captured by the owner during the fine advance)
+ !! to exactly the (SFC-local) coarse-outside-owners that apply the reflux - POINT-TO-POINT, replacing the global broadcast. The
+ !! owner sends its whole freg slot (block-relative; each applier reads its own transverse slice) to every participant; non-owner
+ !! participants receive it. Device-resident: owner stages its slot to host, receivers push it back. No-op without MPI/at np=1.
+ impure subroutine s_amr_p2p_reflux_faces()
+
+#ifdef MFC_MPI
+ integer :: owner, r, ierr, nreq, cnt, idx, ncand
+ integer :: cand(num_procs), glo(3), ghi(3)
+ integer, allocatable :: reqs(:)
+
+ if (.not. amr) return
+ if (num_procs == 1) return
+ owner = amr_block_owner(amr_cur)
+ if (proc_rank == owner) then
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ $:GPU_UPDATE(host='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur), freg(' + str(D) &
+ & + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ #:endfor
+ ! participating ranks by O(overlap) inversion (region grown by 1) filtered by the UNCHANGED predicate, in place of the
+ ! O(P) rank scan. Ascending (owner-excluded at use), so the ISENDs match the receivers exactly as the scan did.
+ glo = 0; ghi = 0
+ glo(1) = amr_region_lo(1) - 1; ghi(1) = amr_region_hi(1) + 1
+ if (n_glb > 0) then; glo(2) = amr_region_lo(2) - 1; ghi(2) = amr_region_hi(2) + 1; end if
+ if (p_glb > 0) then; glo(3) = amr_region_lo(3) - 1; ghi(3) = amr_region_hi(3) + 1; end if
+ call s_amr_ranks_overlapping(glo, ghi, cand, ncand)
+ nreq = 0
+ do idx = 1, ncand
+ r = cand(idx)
+ if (r /= owner .and. f_amr_reflux_participates(r)) nreq = nreq + 1
+ end do
+ if (nreq > 0) then
+ allocate (reqs(2*num_dims*nreq))
+ nreq = 0
+ do idx = 1, ncand
+ r = cand(idx)
+ if (r == owner .or. .not. f_amr_reflux_participates(r)) cycle
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ nreq = nreq + 1
+ call s_xa_rec(XA_F5_FACE_SND, 1, cnt, ${2*D}$)
+ call MPI_ISEND(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, r, ${2*D}$, MPI_COMM_WORLD, reqs(nreq), &
+ & ierr)
+ nreq = nreq + 1
+ call s_xa_rec(XA_F5_FACE_SND, 1, cnt, ${2*D + 1}$)
+ call MPI_ISEND(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, r, ${2*D + 1}$, MPI_COMM_WORLD, &
+ & reqs(nreq), ierr)
+ end if
+ #:endfor
+ end do
+ call s_phase_tic(PH_RFWAIT)
+ call MPI_WAITALL(nreq, reqs, MPI_STATUSES_IGNORE, ierr)
+ call s_phase_toc(PH_RFWAIT)
+ deallocate (reqs)
+ end if
+ else if (f_amr_reflux_participates(proc_rank)) then
+ ! Post all 2*num_dims receives, then ONE wait. The blocking form serialised the six faces
+ ! against the owner's send order and cost 6.3%% of wall (rf:recv, 4010 calls). The slice
+ ! (:,:,:,amr_reg_cur) is contiguous - the dense register slot is the last dimension - and the owner side
+ ! already ISENDs the identical shape, so no temporary-buffer hazard is introduced.
+ call s_phase_tic(PH_RFRECV)
+ allocate (reqs(2*num_dims))
+ nreq = 0
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ nreq = nreq + 1
+ call s_xa_rec(XA_F5_FACE_RCV, 2, cnt, ${2*D}$)
+ call MPI_IRECV(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, owner, ${2*D}$, MPI_COMM_WORLD, reqs(nreq), ierr)
+ nreq = nreq + 1
+ call s_xa_rec(XA_F5_FACE_RCV, 2, cnt, ${2*D + 1}$)
+ call MPI_IRECV(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, owner, ${2*D + 1}$, MPI_COMM_WORLD, reqs(nreq), &
+ & ierr)
+ end if
+ #:endfor
+ call MPI_WAITALL(nreq, reqs, MPI_STATUSES_IGNORE, ierr)
+ deallocate (reqs)
+ ! Device update only AFTER the wait: the buffers hold nothing valid until then.
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur), freg(' + str(D) &
+ & + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ #:endfor
+ call s_phase_toc(PH_RFRECV)
+ end if
+#endif
+
+ end subroutine s_amr_p2p_reflux_faces
+
+ !> I5-F5a: the per-stage level-1 reflux-face exchange as ONE wave (amr_plan_based_exchange.md). The per-box form posted and
+ !! WAITALLed per box on both sides - an O(boxes) rendezvous chain. Here every rank walks the level-1 slots ascending: all
+ !! receives post first (ZERO-COPY, directly into the freg host mirrors - each box owns a register slot, so no pool is needed and
+ !! the message count is unchanged BY DESIGN), then the owners stage + multicast, then ONE waitall, then the receivers push to
+ !! device. All messages between a fixed (owner, participant) pair share tag amr_tag_base(5)+epoch and match by non-overtaking in
+ !! the (ascending box, ascending dim, lo-then-hi) order both sides derive from the same predicates the per-box form used
+ !! (amr_block_owner + the replicated region mirrors + the pure participation test). Under MFC_DEBUG the identity headers travel
+ !! as separate 8-word COMPANION messages, one per (box, peer) group ahead of its payloads (a prefix cannot ride a zero-copy
+ !! payload); they are never recorded in [amr-xa], so the family words stay exactly comparable. The register arrays are sized UP
+ !! FRONT: the apply can REALLOCATE them, so nothing may post into freg before s_amr_reg_prepare.
+ impure subroutine s_amr_reflux_faces_wave()
+
+#ifdef MFC_MPI
+ use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
+ integer :: k, r, ierr, nreq, cnt, idx, ncand, tq, nhr, nhs, j
+ integer :: cand(num_procs), glo(3), ghi(3)
+ logical :: s_lo(3), s_hi(3), u_lo(3), u_hi(3)
+ logical :: cl(3, num_procs), ch(3, num_procs)
+ real(wp) :: nanv
+
+ if (num_procs == 1) return
+ call s_amr_reg_prepare()
+ tq = amr_tag_base(5) + int(mod(amr_mesh_epoch, 50_8))
+ nanv = ieee_value(0._wp, ieee_quiet_nan)
+ nreq = 0; nhr = 0; nhs = 0
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ if (amr_block_owner(k) == proc_rank) cycle
+ if (.not. f_amr_reflux_participates(proc_rank)) cycle
+ ! face-selective multicast: receive exactly the faces THIS rank applies (s_amr_reflux_faces_for mirrors the
+ ! apply's own_lo/own_hi + seam gates); the owner derives the same set per participant, so the pairing is
+ ! exact with no metadata exchange. Debug arm: unreceived faces are NaN-flooded so any hidden reader aborts.
+ call s_amr_reflux_faces_for(proc_rank, s_lo, s_hi)
+ ! W1: record the block. The apply pass below iterates THIS list rather than rescanning every block in the machine
+ ! to re-derive the same order -- an O(global blocks) walk that ran on every RK stage. Built unconditionally: it
+ ! used to sit inside `XA_NH > 0`, which is 0 in a release build, so the list existed only under the audit.
+ nhr = nhr + 1
+ call s_amr_fw_szi(amr_fw_rblk, nhr)
+ amr_fw_rblk(nhr) = k
+ if (XA_NH > 0) then
+ call s_amr_fw_szr(amr_fw_rq, XA_NH*nhr)
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = XA_NH
+ call MPI_IRECV(amr_fw_rq(XA_NH*(nhr - 1) + 1), XA_NH, mpi_p, amr_block_owner(k), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ if (s_lo(${D}$)) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = cnt
+ call s_xa_rec(XA_F5W_FACE_RCV, 2, cnt, tq)
+ call MPI_IRECV(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, amr_block_owner(k), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+#ifdef MFC_DEBUG
+ ! amr_reg_cur is 0 when this rank holds NO register for the block (s_amr_select_slot's unmapped
+ ! sentinel). There is then no buffer to poison, and nothing that could read one. Only this DEBUG
+ ! branch ever met that case -- the receives above are posted under s_lo/s_hi, which are false for a
+ ! block this rank has no register for -- so release builds never indexed freg with 0 and only the
+ ! reldebug lane failed, with `Index '0' of dimension 4 of array 'freg'` (Intel reported the same
+ ! defect as `corrupted size vs. prev_size`). Predates the S3.2b/S3.3c work: reproduced at dc27e4a6~1.
+ else if (amr_reg_cur > 0) then
+ freg(${D}$)%lo(:,:,:,amr_reg_cur) = nanv
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur)]')
+#endif
+ end if
+ if (s_hi(${D}$)) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = cnt
+ call s_xa_rec(XA_F5W_FACE_RCV, 2, cnt, tq)
+ call MPI_IRECV(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, amr_block_owner(k), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+#ifdef MFC_DEBUG
+ else if (amr_reg_cur > 0) then
+ freg(${D}$)%hi(:,:,:,amr_reg_cur) = nanv
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%hi(:, :, :, amr_reg_cur)]')
+#endif
+ end if
+ end if
+ #:endfor
+ end do
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ if (amr_block_owner(k) /= proc_rank) cycle
+ glo = 0; ghi = 0
+ glo(1) = amr_region_lo(1) - 1; ghi(1) = amr_region_hi(1) + 1
+ if (n_glb > 0) then; glo(2) = amr_region_lo(2) - 1; ghi(2) = amr_region_hi(2) + 1; end if
+ if (p_glb > 0) then; glo(3) = amr_region_lo(3) - 1; ghi(3) = amr_region_hi(3) + 1; end if
+ call s_amr_ranks_overlapping(glo, ghi, cand, ncand)
+ ! face-selective multicast: each participant's ship set is its apply set (s_amr_reflux_faces_for), derived
+ ! here per candidate; the device->host pull covers only the UNION of shipped faces (previously every owned
+ ! block pulled all six faces every stage, participants or not).
+ u_lo = .false.; u_hi = .false.
+ do idx = 1, ncand
+ r = cand(idx)
+ cl(:,idx) = .false.; ch(:,idx) = .false.
+ if (r == proc_rank .or. .not. f_amr_reflux_participates(r)) cycle
+ call s_amr_reflux_faces_for(r, s_lo, s_hi)
+ cl(:,idx) = s_lo; ch(:,idx) = s_hi
+ u_lo = u_lo .or. s_lo; u_hi = u_hi .or. s_hi
+ end do
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ if (u_lo(${D}$)) then
+ $:GPU_UPDATE(host='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur)]')
+ end if
+ if (u_hi(${D}$)) then
+ $:GPU_UPDATE(host='[freg(' + str(D) + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ end if
+ #:endfor
+ do idx = 1, ncand
+ r = cand(idx)
+ if (r == proc_rank .or. .not. f_amr_reflux_participates(r)) cycle
+ if (XA_NH > 0) then
+ nhs = nhs + 1
+ call s_amr_fw_szr(amr_fw_sq, XA_NH*nhs)
+ call s_xa_hdr_pack(amr_fw_sq(XA_NH*(nhs - 1) + 1:XA_NH*nhs), XA_F5W_FACE_SND, k, [0, 0, 0], [0, 0, 0])
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(XA_NH*(nhs - 1) + 1), XA_NH, mpi_p, r, tq, MPI_COMM_WORLD, amr_fw_req(nreq), ierr)
+ end if
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ if (cl(${D}$, idx)) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = -1
+ call s_xa_rec(XA_F5W_FACE_SND, 1, cnt, tq)
+ call MPI_ISEND(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, r, tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ if (ch(${D}$, idx)) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = -1
+ call s_xa_rec(XA_F5W_FACE_SND, 1, cnt, tq)
+ call MPI_ISEND(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, r, tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ end if
+ #:endfor
+ end do
+ end do
+ if (nreq > 0) then
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call s_phase_tic(PH_RFWAIT)
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ call s_phase_toc(PH_RFWAIT)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "reflux-faces wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call s_phase_tic(PH_RFWAIT)
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+ call s_phase_toc(PH_RFWAIT)
+#endif
+ end if
+ call s_phase_tic(PH_RFRECV)
+ ! W1: the post pass recorded exactly the blocks this rank receives, in this order, so iterate that list. The
+ ! ASSERT this replaces checked that a second global scan re-derived the same order; that now holds by construction.
+ do j = 1, nhr
+ k = amr_fw_rblk(j)
+ call s_amr_select_slot(k)
+ if (XA_NH > 0) then
+ call s_xa_hdr_check(amr_fw_rq(XA_NH*(j - 1) + 1:XA_NH*j), XA_F5W_FACE_SND, k, [0, 0, 0], [0, 0, 0])
+ end if
+ ! push only the received faces; an unreceived face keeps its device content (never applied here - and
+ ! NaN-poisoned in debug, so any hidden reader aborts)
+ call s_amr_reflux_faces_for(proc_rank, s_lo, s_hi)
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ if (s_lo(${D}$)) then
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur)]')
+ end if
+ if (s_hi(${D}$)) then
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ end if
+ #:endfor
+ end do
+ call s_phase_toc(PH_RFRECV)
+#endif
+
+ end subroutine s_amr_reflux_faces_wave
+
+ !> I5-F5b: the split-ownership level>=2 freg exchange as ONE wave, run once before the reflux fold (the registers are final
+ !! after the advance, and the applies keep their per-box reverse-order position). Replaces one fully BLOCKING SEND/RECV pair per
+ !! dim per split child. Same zero-copy, companion-header, single-tag-by-order design as the faces wave; tag block
+ !! amr_tag_base(5)+50 keeps it disjoint from the faces wave's within the family. The subcycle path keeps its per-box exchange
+ !! inside s_amr_reflux_to_parent (do_xchg).
+ impure subroutine s_amr_freg_wave()
+
+#ifdef MFC_MPI
+ use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
+ integer :: k, ierr, nreq, cnt, pblk, cowner, powner, tq, nhr, nhs, j
+ real(wp) :: w_lo(3), w_hi(3), nanv
+
+ if (num_procs == 1) return
+ call s_amr_reg_prepare()
+ tq = amr_tag_base(5) + 50 + int(mod(amr_mesh_epoch, 50_8))
+ nanv = ieee_value(0._wp, ieee_quiet_nan)
+ nreq = 0; nhr = 0; nhs = 0
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) < 2) cycle
+ call s_amr_select_slot(k)
+ pblk = f_amr_parent_block(k)
+ cowner = amr_block_owner(k); powner = amr_block_owner(pblk)
+ if (cowner == powner .or. powner /= proc_rank) cycle
+ ! seam clip: a face weighted 0 by the sibling-seam rule is never consumed by the parent-side reflux apply
+ ! (s_amr_reflux_to_parent multiplies it away), so it never ships - both sides derive the identical skip from
+ ! s_amr_sibling_face_weights on replicated metadata. Debug arm: skipped-face mirrors are NaN-flooded so any
+ ! OTHER consumer of an unshipped face aborts within the step.
+ call s_amr_sibling_face_weights(k, pblk, w_lo, w_hi)
+ ! W1: same as the faces wave -- record the block so the apply pass need not rescan the machine's block list
+ nhr = nhr + 1
+ call s_amr_fw_szi(amr_fw_rblk, nhr)
+ amr_fw_rblk(nhr) = k
+ if (XA_NH > 0) then
+ call s_amr_fw_szr(amr_fw_rq, XA_NH*nhr)
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = XA_NH
+ call MPI_IRECV(amr_fw_rq(XA_NH*(nhr - 1) + 1), XA_NH, mpi_p, cowner, tq, MPI_COMM_WORLD, amr_fw_req(nreq), ierr)
+ end if
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ if (w_lo(${D}$) > 0._wp) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = cnt
+ call s_xa_rec(XA_F5W_FREG_RCV, 2, cnt, tq)
+ call MPI_IRECV(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, cowner, tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+#ifdef MFC_DEBUG
+ else if (amr_reg_cur > 0) then
+ freg(${D}$)%lo(:,:,:,amr_reg_cur) = nanv
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur)]')
+#endif
+ end if
+ if (w_hi(${D}$) > 0._wp) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = cnt
+ call s_xa_rec(XA_F5W_FREG_RCV, 2, cnt, tq)
+ call MPI_IRECV(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, cowner, tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+#ifdef MFC_DEBUG
+ else if (amr_reg_cur > 0) then
+ freg(${D}$)%hi(:,:,:,amr_reg_cur) = nanv
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%hi(:, :, :, amr_reg_cur)]')
+#endif
+ end if
+ end if
+ #:endfor
+ end do
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) < 2) cycle
+ call s_amr_select_slot(k)
+ pblk = f_amr_parent_block(k)
+ cowner = amr_block_owner(k); powner = amr_block_owner(pblk)
+ if (cowner == powner .or. cowner /= proc_rank) cycle
+ ! seam clip, send side: the identical weight derivation as the recv walk (replicated metadata), so the
+ ! posted sends pair the posted recvs exactly. Skipped faces also skip their device->host pulls.
+ call s_amr_sibling_face_weights(k, pblk, w_lo, w_hi)
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ if (w_lo(${D}$) > 0._wp) then
+ $:GPU_UPDATE(host='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur)]')
+ end if
+ if (w_hi(${D}$) > 0._wp) then
+ $:GPU_UPDATE(host='[freg(' + str(D) + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ end if
+ #:endfor
+ if (XA_NH > 0) then
+ nhs = nhs + 1
+ call s_amr_fw_szr(amr_fw_sq, XA_NH*nhs)
+ call s_xa_hdr_pack(amr_fw_sq(XA_NH*(nhs - 1) + 1:XA_NH*nhs), XA_F5W_FREG_SND, k, [0, 0, 0], [0, 0, 0])
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(XA_NH*(nhs - 1) + 1), XA_NH, mpi_p, powner, tq, MPI_COMM_WORLD, amr_fw_req(nreq), ierr)
+ end if
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ if (w_lo(${D}$) > 0._wp) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = -1
+ call s_xa_rec(XA_F5W_FREG_SND, 1, cnt, tq)
+ call MPI_ISEND(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, powner, tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ if (w_hi(${D}$) > 0._wp) then
+ nreq = nreq + 1
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ amr_fw_reqw(nreq) = -1
+ call s_xa_rec(XA_F5W_FREG_SND, 1, cnt, tq)
+ call MPI_ISEND(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, powner, tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ end if
+ #:endfor
+ end do
+ if (nreq > 0) then
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "freg wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+#endif
+ end if
+ ! W1: iterate the recorded receive list, as the faces wave does
+ do j = 1, nhr
+ k = amr_fw_rblk(j)
+ call s_amr_select_slot(k)
+ pblk = f_amr_parent_block(k)
+ cowner = amr_block_owner(k); powner = amr_block_owner(pblk)
+ if (XA_NH > 0) then
+ call s_xa_hdr_check(amr_fw_rq(XA_NH*(j - 1) + 1:XA_NH*j), XA_F5W_FREG_SND, k, [0, 0, 0], [0, 0, 0])
+ end if
+ ! push only the faces that shipped; a skipped face keeps its device content (dead under weight 0 - and
+ ! NaN-poisoned in debug, so any other reader aborts)
+ call s_amr_sibling_face_weights(k, pblk, w_lo, w_hi)
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ if (w_lo(${D}$) > 0._wp) then
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur)]')
+ end if
+ if (w_hi(${D}$) > 0._wp) then
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ end if
+ #:endfor
+ end do
+#endif
+
+ end subroutine s_amr_freg_wave
+
+ !> True iff this rank is the AUTHORITATIVE holder of global coarse cell g in one dimension (o = interior origin start_idx, ext =
+ !! interior extent m/n/p, glb = global last index). A cell is owned by exactly one rank: its interior owner, or - for a
+ !! physical-exterior ghost (g < 0 or g > glb) - the boundary-adjacent rank that holds it as a ghost. Inter-rank ghosts are
+ !! deliberately NOT claimed (the neighbour's interior owns them), so the sentinel-MAX gather has no double-contribution and
+ !! needs no coarse-ghost halo exchange for correctness across rank seams.
+ pure logical function f_amr_own_coarse(g, o, ext, glb) result(mine)
+
+ integer, intent(in) :: g, o, ext, glb
+ ! interior left physical ghost (leftmost rank)
+
+ mine = (g >= o .and. g <= o + ext) .or. (g < 0 .and. o == 0 .and. g >= -buff_size) .or. (g > glb .and. o + ext == glb &
+ & .and. g <= glb + buff_size) ! right physical ghost (rightmost rank)
+
+ end function f_amr_own_coarse
+
+ !> Per-block measured-cost weight over each block's LEVEL-0 footprint, replicated on every rank: each rank sums the load-weight
+ !! cost model (base 1 + K_ib per IB-marked cell + K_pc per phase-change Newton iteration, when that diagnostic array is live)
+ !! over its owned coarse cells inside the footprint, then one MPI_ALLREDUCE(SUM) makes the vector identical everywhere. No cost
+ !! signals -> cost(k) = footprint cell count exactly (pure-geometry fallback). The Lagrangian cloud is excluded from blocks by
+ !! construction, so K_bub never applies here; pc_iter_count is populated only when a load-weight diagnostic writer is on (enable
+ !! load_weight_wrt to make the balance phase-change-aware) - guarded by allocated().
+ impure subroutine s_amr_block_cost(cost)
+
+ real(wp), intent(out) :: cost(:)
+ integer :: k, j, kk, l, lo(3), hi(3)
+ real(wp) :: c
+
+#ifdef MFC_MPI
+ integer :: ierr
+#endif
+
+ ! one host refresh per regrid: both signal fields advance on the device between regrids
+ if (ib) then
+ $:GPU_UPDATE(host='[ib_markers%sf]')
+ end if
+ if (allocated(pc_iter_count)) then
+ $:GPU_UPDATE(host='[pc_iter_count]')
+ end if
+ do k = 1, amr_num_blocks
+ ! block footprint /\ this rank's coarse subdomain, in local interior indices (empty -> no-trip loops)
+ lo = 0; hi = 0
+ lo(1) = max(amr_region_lo_all(1, k) - start_idx(1), 0); hi(1) = min(amr_region_hi_all(1, k) - start_idx(1), m)
+ if (n_glb > 0) then
+ lo(2) = max(amr_region_lo_all(2, k) - start_idx(2), 0); hi(2) = min(amr_region_hi_all(2, k) - start_idx(2), n)
+ end if
+ if (p_glb > 0) then
+ lo(3) = max(amr_region_lo_all(3, k) - start_idx(3), 0); hi(3) = min(amr_region_hi_all(3, k) - start_idx(3), p)
+ end if
+ c = 0._wp
+ do l = lo(3), hi(3)
+ do kk = lo(2), hi(2)
+ do j = lo(1), hi(1)
+ c = c + 1._wp
+ if (ib) then
+ if (ib_markers%sf(j, kk, l) /= 0) c = c + K_ib
+ end if
+ if (allocated(pc_iter_count)) c = c + K_pc*real(pc_iter_count(j, kk, l), wp)
+ end do
+ end do
+ end do
+ cost(k) = c
+ end do
+#ifdef MFC_MPI
+ amr_gb_cost = amr_gb_cost + int(amr_num_blocks, 8)*8_8
+ call MPI_ALLREDUCE(MPI_IN_PLACE, cost, amr_num_blocks, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+#endif
+
+ end subroutine s_amr_block_cost
+
+ !> Cost-weighted SFC partition of n items into num_procs contiguous Morton-key ranges. Sorts item indices by ascending Morton
+ !! key (insertion sort - n is small), walks them accumulating wt, and advances the owner rank when the running weight crosses
+ !! the next even share of the total. Writes owner(1:n) (rank per item) and cut(0:num_procs-1) (running Morton upper bound per
+ !! rank; ranks that receive no item inherit the predecessor's bound so cut is non-decreasing, its top the global max key).
+ !! Shared by the fine-block anchor split and the L0-tile split so the two owner maps cannot drift.
+ subroutine s_amr_sfc_cut(keys, wt, n, cut, owner)
+
+ integer, intent(in) :: n
+ integer(kind=8), intent(in) :: keys(n)
+ real(wp), intent(in) :: wt(n)
+ integer(kind=8), intent(out) :: cut(0:num_procs - 1)
+ integer, intent(out) :: owner(n)
+ integer :: ord(n), mrg(n), k, r
+ integer :: width, lo_m, mid_m, hi_m, i_m, j_m, t_m
+ real(wp) :: total, cum, tgt, tol
+
+ cut = -1_8
+ if (n < 1) return
+
+ ! Sort item indices by Morton key. Bottom-up MERGE sort: O(n log n), STABLE (ties keep their original
+ ! order), iterative, and a pure function of the input - every rank must produce byte-identical
+ ! order or the assignment diverges and s_amr_validate_owner aborts. The previous insertion sort
+ ! was O(n^2) with the comment "n small"; that holds at the box counts benchmarked so far (512
+ ! boxes = 1.3e5 ops) and fails at the counts this design targets (1e5 boxes = 5e9 ops, seconds
+ ! per regrid), since the whole strategy is boxes_per_level >> num_procs.
+ do k = 1, n
+ ord(k) = k
+ end do
+ width = 1
+ do while (width < n)
+ lo_m = 1
+ do while (lo_m <= n - width)
+ mid_m = lo_m + width - 1
+ hi_m = min(lo_m + 2*width - 1, n)
+ i_m = lo_m; j_m = mid_m + 1; t_m = lo_m
+ do while (i_m <= mid_m .and. j_m <= hi_m)
+ ! <= keeps the left run first on ties: stability
+ if (keys(ord(i_m)) <= keys(ord(j_m))) then
+ mrg(t_m) = ord(i_m); i_m = i_m + 1
+ else
+ mrg(t_m) = ord(j_m); j_m = j_m + 1
+ end if
+ t_m = t_m + 1
+ end do
+ do while (i_m <= mid_m); mrg(t_m) = ord(i_m); i_m = i_m + 1; t_m = t_m + 1; end do
+ do while (j_m <= hi_m); mrg(t_m) = ord(j_m); j_m = j_m + 1; t_m = t_m + 1; end do
+ ord(lo_m:hi_m) = mrg(lo_m:hi_m)
+ lo_m = lo_m + 2*width
+ end do
+ width = 2*width
+ end do
+
+ total = 0._wp
+ do k = 1, n
+ total = total + wt(k)
+ end do
+
+ ! chains-on-chains over the items in SFC order; advance the owner rank when the cumulative weight crosses the next even
+ ! share.
+ ! All-real arithmetic on replicated weights in a fixed order, so every rank computes the identical assignment.
+ r = 0; cum = 0._wp
+ do k = 1, n
+ tgt = real(r + 1, wp)*total/real(num_procs, wp)
+ ! cum is an n-term ACCUMULATION while tgt is CLOSED FORM over another n-term sum, so at an exact share boundary the
+ ! two differ by rounding rather than by intent, and the comparison turns on 1 ULP. This was correct only by luck:
+ ! every cost term to date is integer-valued (footprint cells, K_ib, K_pc x integer counts), so the arithmetic was
+ ! exact. MEASURED with a fractional cost term: 32 IDENTICAL weights over 8 ranks split 5/3 instead of 4/4, reporting
+ ! max/mean 1.250 where the same case with integer weights reports exactly 1.000. Tolerance is the accumulated
+ ! rounding bound, O(n) ULP of the target; far from a boundary it is negligible and the greedy is unchanged.
+ tol = spacing(tgt)*real(n, wp)
+ if (cum >= tgt - tol .and. r < num_procs - 1) r = r + 1
+ owner(ord(k)) = r
+ cut(r) = keys(ord(k)) ! items visited in ascending Morton key => running upper bound for rank r
+ cum = cum + wt(ord(k))
+ end do
+ ! ranks that received no item (or trail the last-assigned rank) inherit the predecessor's bound so the search never lands on
+ ! them: cut is non-decreasing and its top equals the global max key.
+ do r = 1, num_procs - 1
+ if (cut(r) < cut(r - 1)) cut(r) = cut(r - 1)
+ end do
+
+ end subroutine s_amr_sfc_cut
+
+ !> Fine-level distribution map: assigns each active block a single owner rank by chains-on-chains balancing of fine-work weight
+ !! in Morton order of the block's low corner - the same SFC idea m_sfc_partition uses for the base grid, at block granularity.
+ !! Fine work = measured coarse-footprint cost (s_amr_block_cost) x the level's refinement factor per active dim, so blocks
+ !! concentrating IB or phase-change work weigh more than equal-size quiescent ones. The cost vector is allreduced (one
+ !! collective; every rank must call this), after which the assignment is deterministic and identical on every rank.
+ !! s_set_amr_fine_geometry applies it as amr_rank_owns_block = (amr_block_owner(amr_cur) == proc_rank).
+ !> W1a: refresh the owned-block list if any owner write has happened since the last refresh. Rebuilt lazily rather than in
+ !! s_amr_assign_block_owners because that routine is NOT the only writer of amr_block_owner.
+ impure subroutine s_amr_refresh_my_blocks()
+
+ integer :: b
+
+ if (.not. amr_myblk_dirty) return
+ if (allocated(amr_my_blk)) then
+ if (size(amr_my_blk) < amr_max_blocks) deallocate (amr_my_blk)
+ end if
+ if (.not. allocated(amr_my_blk)) allocate (amr_my_blk(amr_max_blocks))
+ amr_n_my = 0
+ do b = 1, amr_num_blocks
+ if (amr_block_owner(b) /= proc_rank) cycle
+ amr_n_my = amr_n_my + 1
+ amr_my_blk(amr_n_my) = b
+ end do
+ amr_myblk_dirty = .false.
+
+ end subroutine s_amr_refresh_my_blocks
+
+ impure subroutine s_amr_assign_block_owners()
+
+ integer :: k, a, lev, maxlev, na
+ ! heap, not stack: these are O(global boxes) and at 1e6 blocks the seven together are ~48 MB,
+ ! which overflows a default stack long before the box count itself becomes a problem
+ integer, allocatable :: aidx(:), aown(:)
+ integer(kind=8), allocatable :: key(:), akey(:)
+ real(wp), allocatable :: wt(:), cost(:), awt(:)
+
+ if (amr_num_blocks < 1) return
+
+ allocate (aidx(amr_num_blocks), aown(amr_num_blocks), key(amr_num_blocks), akey(amr_num_blocks), wt(amr_num_blocks), &
+ & cost(amr_num_blocks), awt(amr_num_blocks))
+
+ call s_amr_block_cost(cost)
+
+ ! per-block own fine-work weight = footprint cost x amr_ref_ratio**(level*active dims). A level-l block is amr_ref_ratio**l
+ ! finer than L0 per dim, so its work is the footprint cost x rr**(l*d). The level factor now only scales blocks WITHIN a
+ ! level relative to each other (each level is cut separately), but it stays because a level's boxes can differ in footprint.
+ ! With no cost signals this reduces to the fine cell count (geometry only).
+ do k = 1, amr_num_blocks
+ wt(k) = cost(k)*real(amr_ref_ratio, wp)**amr_block_level(k)
+ if (n_glb > 0) wt(k) = wt(k)*real(amr_ref_ratio, wp)**amr_block_level(k)
+ if (p_glb > 0) wt(k) = wt(k)*real(amr_ref_ratio, wp)**amr_block_level(k)
+ key(k) = f_morton(amr_region_lo_all(1, k), amr_region_lo_all(2, k), amr_region_lo_all(3, k))
+ end do
+
+ ! PER-LEVEL DISTRIBUTION: balance EVERY level independently, each block on its OWN weight. Tower co-location is gone - a
+ ! level-1 block and its descendants are assigned separately, so a deep tower no longer pins its whole subtree (weight
+ ! cost*rr**(l*d)) to one rank, which is what capped granularity at depth. The parent<->child gather/restrict/reflux paths
+ ! are P2P, so a split tower costs messages rather than correctness.
+ !
+ ! One cut PER LEVEL, not one mixed cut over all fine blocks: same-level boxes are disjoint and so have DISTINCT Morton
+ ! keys, which the cut-point binary search in f_amr_owner needs. Mixed, a level-2 block sharing its parent's region_lo would
+ ! collide with it and the search could not tell them apart.
+ !
+ ! Each level's cut goes into amr_fine_cut(:, lev): fine blocks straddle tiles, so their owner is not tile-cut-derivable and
+ ! f_amr_owner reads amr_fine_cut for them. amr_owner_cut mirrors LEVEL 1 only without tiles, where the two are the same
+ ! authority. Under coexist amr_owner_cut holds the TILE cut that s_l0_tiles_init built; overwriting it here is harmless at
+ ! init (the assigner runs first) but at REGRID time would clobber the tile cut.
+ ! Fine blocks occupy slots (l0_slot_off, amr_num_blocks]; slots [1, l0_slot_off] are the L0 TILE
+ ! prefix. At init the assigner runs BEFORE s_l0_tiles_init, so those prefix slots are still
+ ! uninitialized - level reads 1 and region_lo is all zeros, i.e. Morton key 0. Including them
+ ! fed 8 phantom key-0 "level-1 blocks" into the level-1 cut, which the cut then split across
+ ! ranks. A key-0 block can only ever resolve to rank 0 (cut is non-decreasing and the search
+ ! returns the first r with key <= cut(r)), so any phantom placed on a higher rank is
+ ! unrecoverable and s_amr_validate_owner aborts. This was latent: with the old weights all the
+ ! phantoms happened to land on rank 0 and the validator agreed by luck.
+ maxlev = maxval(amr_block_level(l0_slot_off + 1:amr_num_blocks))
+ do lev = 1, maxlev
+ na = 0
+ do k = l0_slot_off + 1, amr_num_blocks
+ if (amr_block_level(k) /= lev) cycle
+ na = na + 1
+ akey(na) = key(k); awt(na) = wt(k); aidx(na) = k
+ end do
+ if (na < 1) cycle
+ call s_amr_sfc_cut(akey, awt, na, amr_fine_cut(:,lev), aown)
+ do a = 1, na
+ amr_block_owner(aidx(a)) = aown(a); amr_myblk_dirty = .true.
+ end do
+ if (lev == 1 .and. l0_slot_off == 0) amr_owner_cut = amr_fine_cut(:,1)
+ end do
+
+ call s_amr_validate_owner()
+ call s_amr_report_balance(wt, maxlev)
+
+ deallocate (aidx, aown, key, akey, wt, cost, awt)
+
+ end subroutine s_amr_assign_block_owners
+
+ !> Per-level and total load-balance report: max/mean assigned block weight over ranks, the metric the balancer is actually
+ !! trying to minimise. Without it a distribution change can only be judged by end-to-end s/step, which cannot separate
+ !! "balanced" from "uniformly slow" - the step-4 A/B measured flat and was uninterpretable for exactly that reason.
+ !!
+ !! Needs no MPI: wt, amr_block_level and amr_block_owner are replicated and identical on every rank (the cost vector is
+ !! allreduced in s_amr_block_cost), so every rank computes the same numbers and rank 0 prints. ratio == 1 is perfect balance;
+ !! ratio == num_procs means one rank holds everything at that level. no_blocks_ranks counts ranks holding no block AT THIS
+ !! LEVEL, which is the granularity floor showing up directly: a level with fewer boxes than ranks CANNOT balance, however good
+ !! the cut is. It is NOT an idleness measure - those ranks still own level-0 work (level 0 covers every rank) and may own
+ !! blocks at other levels. Only m_rank_timing measures idleness; do not read this counter as one.
+ impure subroutine s_amr_report_balance(wt, maxlev)
+
+ real(wp), intent(in) :: wt(:)
+ integer, intent(in) :: maxlev
+ real(wp), allocatable :: rw(:), tw(:), rc(:)
+ real(wp) :: mx, mean, cmx, cmean
+ integer :: k, lev, nb, empty
+
+ if (.not. load_weight_wrt) return
+ if (proc_rank /= 0) return
+
+ ! heap, not automatic: these are num_procs long and this is the routine that runs AT SCALE - two automatic wp arrays would
+ ! put O(num_procs) on the stack, which is where the module already puts amr_owner_cut / amr_fine_cut on the heap instead
+ allocate (rw(0:num_procs - 1), tw(0:num_procs - 1), rc(0:num_procs - 1))
+ tw = 0._wp
+ do lev = 1, maxlev
+ rw = 0._wp; rc = 0._wp
+ nb = 0
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= lev) cycle
+ rw(amr_block_owner(k)) = rw(amr_block_owner(k)) + wt(k)
+ rc(amr_block_owner(k)) = rc(amr_block_owner(k)) + 1._wp
+ nb = nb + 1
+ end do
+ if (nb == 0) cycle
+ tw = tw + rw
+ mx = maxval(rw); mean = sum(rw)/real(num_procs, wp)
+ empty = count(rw <= 0._wp)
+ ! BOX COUNT imbalance beside weight imbalance. cost(k) is a footprint CELL count, but the measured per-block advance
+ ! costs ~1x a full monolithic step almost regardless of block size and does not amortize - so if per-block cost is
+ ! largely FIXED, a rank's true load tracks how many boxes it holds, not how many cells. Equal cells with unequal box
+ ! counts then reads as perfectly balanced and runs badly skewed, which is exactly the model/measured gap observed
+ ! (model 1.03 vs rank_time 1.26 at np=8). Printing both makes that hypothesis falsifiable in one run.
+ cmx = maxval(rc); cmean = sum(rc)/real(num_procs, wp)
+ ! NOT merge(): merge is a function, so BOTH arms are evaluated and the mean == 0 arm would still divide by zero - the
+ ! guard would not guard. no_blocks_ranks counts ranks holding no block AT THIS LEVEL; they are not idle (they still
+ ! own level-0 work and possibly other levels), they just take no share of this level's.
+ ! cmean cannot be zero here: nb >= 1, so sum(rc) = nb >= 1. No guard needed, and emphatically not merge().
+ if (mean > 0._wp) print '(A,I0,A,I0,A,I0,A,F8.3,A,F8.3,A,I0,A,I0)', ' [amr-balance] level ', lev, ': boxes ', nb, &
+ & '/ranks ', num_procs, ' max/mean ', mx/mean, ' boxes_max/mean ', cmx/cmean, ' no_blocks_ranks ', empty, ' of ', &
+ & num_procs
+ end do
+ ! per-rank WEIGHT (fine cells) and BOX COUNT, so rhs time can be regressed against actual load
+ if (proc_rank == 0) then
+ write (*, '(A)', advance='no') ' [amr-balance] per-rank fine_work :'
+ do k = 0, num_procs - 1; write (*, '(I12)', advance='no') nint(tw(k), kind=8); end do
+ write (*, '(A)') ''
+ end if
+ mean = sum(tw)/real(num_procs, wp)
+ ! fine_work = sum of the assigned weights = the FINE CELLS advanced per step (with no cost signals wt is exactly that).
+ ! Without it an AMR-vs-uniform wall-clock ratio is uninterpretable: 5x the time is the expected outcome of advancing 5x
+ ! the cells and the failure mode of 5x per-cell overhead, and the two are indistinguishable from the ratio alone.
+ if (mean > 0._wp) print '(A,F8.3,A,I0,A,I0)', ' [amr-balance] TOTAL : max/mean ', maxval(tw)/mean, &
+ & ' ranks_with_no_fine_block ', count(tw <= 0._wp), ' fine_work ', nint(sum(tw), kind=8)
+ deallocate (rw, tw, rc)
+
+ end subroutine s_amr_report_balance
+
+ !> Owner rank of block k from the O(num_procs) SFC cut-points: binary-search k's OWN Morton key in the owning authority's cut. A
+ !! level-0 TILE resolves against amr_owner_cut (the tile cut in tiled modes); a FINE block (level>=1) resolves against its own
+ !! level's cut amr_fine_cut(:, level) (level 1's == amr_owner_cut in no-tile AMR). No tower-anchor resolution: under per-level
+ !! distribution a block's owner depends on its own key and level alone. Reproduces s_amr_assign_block_owners' / the tile split's
+ !! cost-weighted SFC assignment exactly.
+ pure integer function f_amr_owner(k) result(r)
+
+ integer, intent(in) :: k
+ integer(kind=8) :: mk, cut(0:num_procs - 1)
+ integer :: a, lo, hi, mid
+
+ a = k
+ if (amr_block_level(k) == 0) then
+ cut = amr_owner_cut ! tile: own Morton key vs the tile cut
+ else
+ cut = amr_fine_cut(:,amr_block_level(k))
+ end if
+ mk = f_morton(amr_region_lo_all(1, a), amr_region_lo_all(2, a), amr_region_lo_all(3, a))
+ lo = 0; hi = num_procs - 1
+ do while (lo < hi)
+ mid = (lo + hi)/2
+ if (mk <= cut(mid)) then
+ hi = mid
+ else
+ lo = mid + 1
+ end if
+ end do
+ r = lo
+
+ end function f_amr_owner
+
+ !> TRANSITIONAL: the SFC cut-point accessor must reproduce the stored owner table exactly (removed once the table is deleted).
+ impure subroutine s_amr_validate_owner()
+
+ integer :: k
+
+ do k = 1, amr_num_blocks
+ ! Skip the L0 tile prefix when its cut has not been built yet (amr_owner_cut still -1): those
+ ! slots are uninitialized at assigner time and carry a stale level with Morton key 0. The
+ ! tile-init call site populates both cuts and validates them there.
+ if (k <= l0_slot_off .and. amr_owner_cut(num_procs - 1) < 0_8) cycle
+ ! every block resolves: tiles (level 0) via amr_owner_cut (tile cut), fine blocks (level>=1) via amr_fine_cut. The
+ ! caller
+ ! guarantees the relevant cut is populated for the blocks present at each call site (assigner: fine cut; tile init:
+ ! both).
+ if (f_amr_owner(k) /= amr_block_owner(k)) &
+ & call s_mpi_abort('SFC cut-point owner disagrees with amr_block_owner - cut capture or search is wrong')
+ end do
+
+ end subroutine s_amr_validate_owner
+
+ impure subroutine s_amr_compute_isect(lo, hi)
+
+ integer, intent(in) :: lo(3), hi(3)
+ integer :: sidx(3), ext(3), d
+
+ sidx = 0; ext = 0
+ sidx(1) = start_idx(1); ext(1) = m
+ if (n_glb > 0) then; sidx(2) = start_idx(2); ext(2) = n; end if
+ if (p_glb > 0) then; sidx(3) = start_idx(3); ext(3) = p; end if
+ do d = 1, 3
+ amr_isect_lo(d) = max(lo(d), sidx(d))
+ amr_isect_hi(d) = min(hi(d), sidx(d) + ext(d))
+ end do
+ amr_rank_owns_block = amr_isect_lo(1) <= amr_isect_hi(1)
+ if (n_glb > 0) amr_rank_owns_block = amr_rank_owns_block .and. amr_isect_lo(2) <= amr_isect_hi(2)
+ if (p_glb > 0) amr_rank_owns_block = amr_rank_owns_block .and. amr_isect_lo(3) <= amr_isect_hi(3)
+
+ end subroutine s_amr_compute_isect
+
+ !> Set the fine level's geometry (region, intersection, extents, bounds, coordinates) for the box lo:hi. Arrays are preallocated
+ !! at max size; this only updates metadata and refills coords. Collective: ALL ranks must call together (init and regrid do) -
+ !! it also refreshes the allreduced amr_xchg_coarse_ghosts flag for the new box. INVARIANT: a level-l block's fine extent is
+ !! amr_ref_ratio**l * (coarse-region width) - 1, NOT amr_ref_ratio*width. (amr_ref_ratio*width holds only for the level-1
+ !! initial block; nested boxes compound by amr_ref_ratio per level.) Every fine-extent computation - here, the restart-reader
+ !! check, the load-weight, the fmul - uses amr_ref_ratio**level; assuming amr_ref_ratio*width rejects level>=2 blocks as corrupt
+ !! (the exact bug that bit the multi-level restart reader).
+ impure subroutine s_set_amr_fine_geometry(lo, hi)
+
+ integer, intent(in) :: lo(3), hi(3)
+ integer :: sidx(3), ext(3), nmar, bad_loc, pblk, d, rr
+
+ amr_slots(amr_cur)%region%lo = lo; amr_slots(amr_cur)%region%hi = hi
+ amr_region_lo = lo; amr_region_hi = hi ! global mirror for m_amr_registers (no use-cycle)
+ amr_region_lo_all(:,amr_cur) = lo; amr_region_hi_all(:,amr_cur) = hi
+
+ ! FINE-LEVEL DISTRIBUTION: a block is owned WHOLE by amr_block_owner(k). The owner holds fine cells for the ENTIRE block;
+ ! every other rank holds none. amr_isect_lo/hi records the block's coarse footprint (= the whole block on the owner) - it
+ ! drives the coarse<->fine gather/scatter (which coarse cells the owner pulls in / pushes back). At np=1 the owner is rank 0
+ ! and the footprint is the whole domain-resident block, so this reduces exactly to the old mirror (block \cap subdomain ==
+ ! whole block).
+ amr_rank_owns_block = (amr_block_owner(amr_cur) == proc_rank)
+ pblk = 0
+ if (amr_rank_owns_block) then
+ amr_isect_lo = lo; amr_isect_hi = hi
+ if (amr_block_level(amr_cur) >= 2) then
+ ! multi-level: express the coarse footprint in the PARENT block's fine-cell frame (a level-l block's coarse side is
+ ! level l-1). parent-fine index of L0 cell c is rr*(c - R1.lo) where rr is the parent's amr_ref_ratio; the block
+ ! spans rr fine cells per parent-covered L0 cell. m below then gets amr_ref_ratio*(footprint) cells, as for a
+ ! level-1
+ ! block over L0. amr_cg / the prolong read this frame, so no other coupling code changes for the local (np=1) path.
+ ! rr is the GLOBAL amr_ref_ratio, not amr_slots(pblk)%amr_ref_ratio: that field is written by s_amr_alloc_slot,
+ ! which a rank owning this block but NOT its parent never calls for pblk, so it would read undefined. The two agree
+ ! wherever both are defined - only an L0 tile carries a per-slot ratio of 1, and a level>=2 block's parent is never
+ ! an L0 tile. This is the same footprint s_amr_parent_foot derives from replicated metadata.
+ pblk = f_amr_parent_block(amr_cur)
+ call s_amr_parent_foot(amr_cur, pblk, amr_isect_lo, amr_isect_hi)
+ end if
+ else
+ amr_isect_lo = 1; amr_isect_hi = 0 ! empty footprint
+ if (n_glb > 0) then; amr_isect_lo(2) = 1; amr_isect_hi(2) = 0; end if
+ if (p_glb > 0) then; amr_isect_lo(3) = 1; amr_isect_hi(3) = 0; end if
+ end if
+ amr_isect_lo_all(:,amr_cur) = amr_isect_lo; amr_isect_hi_all(:,amr_cur) = amr_isect_hi
+ amr_owns_all(amr_cur) = amr_rank_owns_block
+ ! fine extents cover the WHOLE block on the owner; -1 (empty) on non-owners
+ amr_slots(amr_cur)%m = amr_ref_ratio*max(amr_isect_hi(1) - amr_isect_lo(1) + 1, 0) - 1
+ amr_slots(amr_cur)%n = 0; amr_slots(amr_cur)%p = 0
+ if (n_glb > 0) amr_slots(amr_cur)%n = amr_ref_ratio*max(amr_isect_hi(2) - amr_isect_lo(2) + 1, 0) - 1
+ if (p_glb > 0) amr_slots(amr_cur)%p = amr_ref_ratio*max(amr_isect_hi(3) - amr_isect_lo(3) + 1, 0) - 1
+ amr_slots(amr_cur)%idwbuff(1)%beg = -buff_size; amr_slots(amr_cur)%idwbuff(1)%end = amr_slots(amr_cur)%m + buff_size
+ amr_slots(amr_cur)%idwbuff(2)%beg = 0; amr_slots(amr_cur)%idwbuff(2)%end = 0
+ amr_slots(amr_cur)%idwbuff(3)%beg = 0; amr_slots(amr_cur)%idwbuff(3)%end = 0
+ if (n_glb > 0) then
+ amr_slots(amr_cur)%idwbuff(2)%beg = -buff_size; amr_slots(amr_cur)%idwbuff(2)%end = amr_slots(amr_cur)%n + buff_size
+ end if
+ if (p_glb > 0) then
+ amr_slots(amr_cur)%idwbuff(3)%beg = -buff_size; amr_slots(amr_cur)%idwbuff(3)%end = amr_slots(amr_cur)%p + buff_size
+ end if
+ ! coord building only on ranks with fine cells (others never read their coord arrays)
+ if (amr_rank_owns_block) then
+ ! Every level builds the same way: replay the ancestor chain from the GLOBAL L0 boundaries. The owner may hold no part
+ ! of the coarse slice it refines, and (level>=2) may not own the parent at all, so neither the local coarse coords nor
+ ! the parent's slot can be read here. At level 1 the chain is one step and this is the previous global-boundary form.
+ call s_amr_build_block_coords(amr_cur, amr_gxcb, amr_slots(amr_cur)%x_cb, amr_slots(amr_cur)%x_cc, &
+ & amr_slots(amr_cur)%dx, 1)
+ if (n_glb > 0) call s_amr_build_block_coords(amr_cur, amr_gycb, amr_slots(amr_cur)%y_cb, amr_slots(amr_cur)%y_cc, &
+ & amr_slots(amr_cur)%dy, 2)
+ if (p_glb > 0) call s_amr_build_block_coords(amr_cur, amr_gzcb, amr_slots(amr_cur)%z_cb, amr_slots(amr_cur)%z_cc, &
+ & amr_slots(amr_cur)%dz, 3)
+ end if
+
+ ! Fine ghost prolongation reads up to nmar coarse cells past each face of the intersection; if that stencil leaves ANY
+ ! rank's
+ ! interior (block near/at/across a rank boundary), the coarse CONS ghosts it reads must be halo-exchanged before every fill
+ ! (the solver populates only PRIM ghosts). All ranks agree on the flag, so the pairwise exchanges are called consistently.
+ sidx = 0; ext = 0
+ sidx(1) = start_idx(1); ext(1) = m
+ if (n_glb > 0) then; sidx(2) = start_idx(2); ext(2) = n; end if
+ if (p_glb > 0) then; sidx(3) = start_idx(3); ext(3) = p; end if
+ nmar = (buff_size + amr_ref_ratio - 1)/amr_ref_ratio + 1
+ bad_loc = 0
+ if (amr_rank_owns_block) then
+ if (amr_isect_lo(1) - sidx(1) < nmar .or. sidx(1) + ext(1) - amr_isect_hi(1) < nmar) bad_loc = 1
+ if (n_glb > 0 .and. (amr_isect_lo(2) - sidx(2) < nmar .or. sidx(2) + ext(2) - amr_isect_hi(2) < nmar)) bad_loc = 1
+ if (p_glb > 0 .and. (amr_isect_lo(3) - sidx(3) < nmar .or. sidx(3) + ext(3) - amr_isect_hi(3) < nmar)) bad_loc = 1
+ end if
+ ! ACCUMULATE, do not reduce: the caller closes the scan with s_amr_reduce_xchg_flag. Every caller loops over blocks and
+ ! wants "does ANY block need the exchange", so a per-block collective was both O(nboxes) collectives and, at two call
+ ! sites, WRONG - those loops kept the LAST block's answer rather than the OR, so an earlier block needing the exchange
+ ! could be masked by a later one that did not.
+ amr_xchg_bad = max(amr_xchg_bad, bad_loc)
+
+ end subroutine s_set_amr_fine_geometry
+
+ !> Close a geometry scan: ONE allreduce of the accumulated flag, then reset so the next scan starts clean. Must be called after
+ !! every s_set_amr_fine_geometry loop (or single call) - the flag it sets is read by the fine advance
+ !! (s_amr_exchange_coarse_cons_halo).
+ impure subroutine s_amr_reduce_xchg_flag()
+
+ integer :: bad_glb
+
+ call s_mpi_allreduce_integer_max(amr_xchg_bad, bad_glb)
+ amr_xchg_coarse_ghosts = bad_glb == 1
+ amr_xchg_bad = 0
+
+ end subroutine s_amr_reduce_xchg_flag
+
+ !> Conservative-linear prolongation for a single variable pair. Reads coarse interior/ghost from qc; writes fine interior to qf.
+ !! Minmod-limited slopes.
+ impure subroutine s_prolong_one_var(qc, loc, ivar, pos, inject)
+
+ type(scalar_field), intent(in) :: qc
+ integer, intent(in) :: loc, ivar !< flat-store slot and variable of the fine target
+ logical, optional, intent(in) :: pos !< floor the child at bub_pos_frac*u0 (bubble radius-moment realizability)
+ logical, optional, intent(in) :: inject !< piecewise-constant (child = u0): QBMM moment realizability preservation
+ integer :: fi, fj, fk, ci, cj, ck, ox, oy, oz, rrat, mm, nn, pp, il1, il2, il3
+ real(wp) :: u0, sx, sy, sz, xix, xiy, xiz, child, bpf
+ logical :: floor_pos, pw_const, d2, d3
+
+ floor_pos = .false.; if (present(pos)) floor_pos = pos
+ pw_const = .false.; if (present(inject)) pw_const = inject
+
+ ! coarse source qc is the gathered block-local patch amr_cg (fine-level distribution): amr_isect_lo is GLOBAL and equals
+ ! region_lo on the owner, so amr_isect_lo + f/rr - amr_cpat_off = nmar + f/rr is the patch-local coarse index.
+ ! DEVICE kernel (device-side rebuild): reads the patch's device mirror (pushed once per prolong dispatch by
+ ! s_interpolate_coarse_to_fine), writes the fine slot in place - the per-slot full push at every caller is deleted.
+ ! CPU builds compile this to the identical plain loop, so CPU results are unchanged.
+ ox = amr_cpat_off(1); oy = amr_cpat_off(2); oz = amr_cpat_off(3)
+ rrat = amr_slots(amr_cur)%amr_ref_ratio
+ mm = amr_slots(amr_cur)%m; nn = amr_slots(amr_cur)%n; pp = amr_slots(amr_cur)%p
+ il1 = amr_isect_lo(1); il2 = amr_isect_lo(2); il3 = amr_isect_lo(3)
+ d2 = n_glb > 0; d3 = p_glb > 0
+ bpf = bub_pos_frac
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[ci, cj, ck, xix, xiy, xiz, u0, sx, sy, sz, child]')
+ do fk = 0, pp
+ do fj = 0, nn
+ do fi = 0, mm
+ ck = il3 + fk/rrat - oz; if (.not. d3) ck = 0
+ xiz = 0._wp; if (d3) xiz = (real(mod(fk, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ cj = il2 + fj/rrat - oy; if (.not. d2) cj = 0
+ xiy = 0._wp; if (d2) xiy = (real(mod(fj, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ ci = il1 + fi/rrat - ox
+ xix = (real(mod(fi, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ u0 = real(qc%sf(ci, cj, ck), wp)
+ sx = minmod(real(qc%sf(ci + 1, cj, ck), wp) - u0, u0 - real(qc%sf(ci - 1, cj, ck), wp))
+ sy = 0._wp
+ if (d2) sy = minmod(real(qc%sf(ci, cj + 1, ck), wp) - u0, u0 - real(qc%sf(ci, cj - 1, ck), wp))
+ sz = 0._wp
+ if (d3) sz = minmod(real(qc%sf(ci, cj, ck + 1), wp) - u0, u0 - real(qc%sf(ci, cj, ck - 1), wp))
+ if (pw_const) then
+ sx = 0._wp; sy = 0._wp; sz = 0._wp
+ end if
+ child = u0 + sx*xix + sy*xiy + sz*xiz
+ if (floor_pos) child = max(child, bpf*u0)
+ amr_cons_st(fi, fj, fk, ivar, loc) = child
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_prolong_one_var
+
+ !> Conservative-linear prolongation: fill amr_fine interior from coarse (level-0), minmod-limited. Symmetric child offsets
+ !! (+/-1/4 of a coarse cell) => the amr_ref_ratio^d children average to the coarse value. Multi-fluid volume fractions take the
+ !! sum-preserving closure path instead (single-fluid runs never branch, so their prolongation is untouched). TWIN
+ !! s_amr_prolong_pbmv (q<->pb/mv): pb/mv sibling of this prolongation (piecewise-constant there); keep the child-offset frame
+ !! and volume-fraction closure lockstep.
+ impure subroutine s_interpolate_coarse_to_fine()
+
+ integer :: i, bstride
+
+ ! the prolong kernels read the gathered patch's DEVICE mirror; the level-1 patch is host-filled by the gather
+ ! unpack, so push it once per dispatch (patch-sized - 8x smaller than the full-slot pushes this replaces; for a
+ ! level>=2 block the patch was device-produced and this re-push of the pulled bytes is redundant but harmless)
+
+ do i = 1, sys_size
+ $:GPU_UPDATE(device='[amr_cg(i)%sf]')
+ end do
+ bstride = 1
+ if (bubbles_euler) bstride = (eqn_idx%bub%end - eqn_idx%bub%beg + 1)/nb
+ do i = 1, sys_size
+ ! Lagrangian bubbles: alphas sum to the LOCAL liquid fraction beta (not 1), so the sum-to-one closure would corrupt the
+ ! EL state; each alpha prolongs plainly instead
+ if (num_fluids > 1 .and. (.not. bubbles_lagrange) .and. i >= eqn_idx%adv%beg .and. i <= eqn_idx%adv%end) cycle
+ if (chemistry .and. i >= eqn_idx%species%beg .and. i <= eqn_idx%species%end) cycle ! sum/positivity closure below
+ ! QBMM carries a bivariate 6-moment set per R0 bin whose CHyQMOM inversion requires realizability (variance c20 =
+ ! m20/m00 - (m10/m00)^2 > 0); per-component minmod prolongation can break that joint constraint, so the whole bub block
+ ! is injected piecewise-constant (each child inherits the coarse cell's realizable moment set exactly). Non-QBMM
+ ! Euler-Euler bubbles instead floor their POSITIVE moments (radius nR, non-polytropic partial pressure npb / vapor mass
+ ! nmv); the signed velocity moment nV (offset 1 in each bin's stride) prolongs freely.
+ call s_prolong_one_var(amr_cg(i), amr_loc_of(amr_cur), i, &
+ & pos=bubbles_euler .and. .not. qbmm .and. i >= eqn_idx%bub%beg .and. i <= eqn_idx%bub%end &
+ & .and. mod(i - eqn_idx%bub%beg, bstride) /= 1, &
+ & inject=qbmm .and. i >= eqn_idx%bub%beg .and. i <= eqn_idx%bub%end)
+ end do
+ if (num_fluids > 1 .and. (.not. bubbles_lagrange)) call s_prolong_alphas_closure(amr_cg, amr_loc_of(amr_cur))
+ if (chemistry) call s_prolong_species_closure(amr_cg, amr_loc_of(amr_cur))
+
+ end subroutine s_interpolate_coarse_to_fine
+
+ !> Sum-preserving volume-fraction prolongation (num_fluids > 1): fluids adv%beg..adv%end-1 are interpolated with minmod slopes
+ !! under a SHARED per-cell limiter switch (a sign change for ANY fluid in a dim zeroes that dim's slope for ALL fluids, so the
+ !! closure fluid's effective slope is limited consistently) and clamped to [0,1]; the last fluid closes alpha_n = 1 -
+ !! sum(others), so sum(alpha) = 1 on the fine level by construction. For two fluids the closure is also in [0,1]; for >2 fluids
+ !! any residual closure undershoot is handled by mpp_lim (required by the checker). Same fine/coarse index mapping as
+ !! s_prolong_one_var.
+ impure subroutine s_prolong_alphas_closure(qc, loc)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: qc
+ integer, intent(in) :: loc
+ integer :: fi, fj, fk, ci, cj, ck, ox, oy, oz, i
+ integer :: rrat, mm, nn, pp, il1, il2, il3, advb, adve
+ real(wp) :: xix, xiy, xiz, u0, sx, sy, sz, av, asum
+ logical :: shx, shy, shz, d2, d3
+
+ ! coarse source qc is the gathered block-local patch amr_cg (fine-level distribution): patch-frame offset.
+ ! DEVICE kernel (device-side rebuild); the shared limiter switch (s_alpha_shared_switch) is inlined verbatim.
+
+ ox = amr_cpat_off(1); oy = amr_cpat_off(2); oz = amr_cpat_off(3)
+ rrat = amr_slots(amr_cur)%amr_ref_ratio
+ mm = amr_slots(amr_cur)%m; nn = amr_slots(amr_cur)%n; pp = amr_slots(amr_cur)%p
+ il1 = amr_isect_lo(1); il2 = amr_isect_lo(2); il3 = amr_isect_lo(3)
+ d2 = n_glb > 0; d3 = p_glb > 0
+ advb = eqn_idx%adv%beg; adve = eqn_idx%adv%end
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[ci, cj, ck, xix, xiy, xiz, u0, sx, sy, sz, av, asum, shx, shy, shz, i]')
+ do fk = 0, pp
+ do fj = 0, nn
+ do fi = 0, mm
+ ck = il3 + fk/rrat - oz; if (.not. d3) ck = 0
+ xiz = 0._wp; if (d3) xiz = (real(mod(fk, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ cj = il2 + fj/rrat - oy; if (.not. d2) cj = 0
+ xiy = 0._wp; if (d2) xiy = (real(mod(fj, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ ci = il1 + fi/rrat - ox
+ xix = (real(mod(fi, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ ! shared per-cell limiter switch (inlined s_alpha_shared_switch): per dim, slopes stay on only if NO
+ ! fluid's centered differences change sign there (symmetric in the fluids, incl. the closure fluid)
+ shx = .true.; shy = d2; shz = d3
+ do i = advb, adve
+ u0 = real(qc(i)%sf(ci, cj, ck), wp)
+ if ((real(qc(i)%sf(ci + 1, cj, ck), wp) - u0)*(u0 - real(qc(i)%sf(ci - 1, cj, ck), &
+ & wp)) <= 0._wp) shx = .false.
+ if (d2) then
+ if ((real(qc(i)%sf(ci, cj + 1, ck), wp) - u0)*(u0 - real(qc(i)%sf(ci, cj - 1, ck), &
+ & wp)) <= 0._wp) shy = .false.
+ end if
+ if (d3) then
+ if ((real(qc(i)%sf(ci, cj, ck + 1), wp) - u0)*(u0 - real(qc(i)%sf(ci, cj, ck - 1), &
+ & wp)) <= 0._wp) shz = .false.
+ end if
+ end do
+ asum = 0._wp
+ do i = advb, adve - 1
+ u0 = real(qc(i)%sf(ci, cj, ck), wp)
+ sx = 0._wp
+ if (shx) sx = minmod(real(qc(i)%sf(ci + 1, cj, ck), wp) - u0, u0 - real(qc(i)%sf(ci - 1, cj, ck), wp))
+ sy = 0._wp
+ if (d2 .and. shy) sy = minmod(real(qc(i)%sf(ci, cj + 1, ck), wp) - u0, u0 - real(qc(i)%sf(ci, cj - 1, &
+ & ck), wp))
+ sz = 0._wp
+ if (d3 .and. shz) sz = minmod(real(qc(i)%sf(ci, cj, ck + 1), wp) - u0, u0 - real(qc(i)%sf(ci, cj, &
+ & ck - 1), wp))
+ av = min(max(u0 + sx*xix + sy*xiy + sz*xiz, 0._wp), 1._wp)
+ amr_cons_st(fi, fj, fk, i, loc) = av
+ asum = asum + av
+ end do
+ amr_cons_st(fi, fj, fk, adve, loc) = 1._wp - asum
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_prolong_alphas_closure
+
+ !> Species mass-fraction prolongation closure (chemistry): each partial density rho*Y_k is minmod-prolonged and clamped
+ !! non-negative, then all species are rescaled so sum_k(rho*Y_k) equals the (already prolonged) continuity density at the fine
+ !! cell. This keeps the fine species realizable (Y_k >= 0, and sum(Y_k) = 1 exactly under the cons->prim recovery rho = sum
+ !! rho*Y_k) and consistent with the continuity variable the reaction source reads. Same index mapping as s_prolong_one_var; cont
+ !! is prolonged in the main loop before this runs.
+ impure subroutine s_prolong_species_closure(qc, loc)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: qc
+ integer, intent(in) :: loc
+ integer :: fi, fj, fk, ci, cj, ck, ox, oy, oz, i
+ integer :: rrat, mm, nn, pp, il1, il2, il3, spb, spe, cte
+ real(wp) :: xix, xiy, xiz, u0, sx, sy, sz, av, rsum, rscale
+ logical :: d2, d3
+
+ ! coarse source qc is the gathered block-local patch amr_cg (fine-level distribution): patch-frame offset.
+ ! DEVICE kernel (device-side rebuild); the rescale re-reads only this thread's own cell, so the loop nest is safe.
+
+ ox = amr_cpat_off(1); oy = amr_cpat_off(2); oz = amr_cpat_off(3)
+ rrat = amr_slots(amr_cur)%amr_ref_ratio
+ mm = amr_slots(amr_cur)%m; nn = amr_slots(amr_cur)%n; pp = amr_slots(amr_cur)%p
+ il1 = amr_isect_lo(1); il2 = amr_isect_lo(2); il3 = amr_isect_lo(3)
+ d2 = n_glb > 0; d3 = p_glb > 0
+ spb = eqn_idx%species%beg; spe = eqn_idx%species%end; cte = eqn_idx%cont%end
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[ci, cj, ck, xix, xiy, xiz, u0, sx, sy, sz, av, rsum, rscale, i]')
+ do fk = 0, pp
+ do fj = 0, nn
+ do fi = 0, mm
+ ck = il3 + fk/rrat - oz; if (.not. d3) ck = 0
+ xiz = 0._wp; if (d3) xiz = (real(mod(fk, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ cj = il2 + fj/rrat - oy; if (.not. d2) cj = 0
+ xiy = 0._wp; if (d2) xiy = (real(mod(fj, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ ci = il1 + fi/rrat - ox
+ xix = (real(mod(fi, rrat), wp) - real(rrat - 1, wp)*0.5_wp)/real(rrat, wp)
+ rsum = 0._wp
+ do i = spb, spe
+ u0 = real(qc(i)%sf(ci, cj, ck), wp)
+ sx = minmod(real(qc(i)%sf(ci + 1, cj, ck), wp) - u0, u0 - real(qc(i)%sf(ci - 1, cj, ck), wp))
+ sy = 0._wp
+ if (d2) sy = minmod(real(qc(i)%sf(ci, cj + 1, ck), wp) - u0, u0 - real(qc(i)%sf(ci, cj - 1, ck), wp))
+ sz = 0._wp
+ if (d3) sz = minmod(real(qc(i)%sf(ci, cj, ck + 1), wp) - u0, u0 - real(qc(i)%sf(ci, cj, ck - 1), wp))
+ av = max(u0 + sx*xix + sy*xiy + sz*xiz, 0._wp)
+ amr_cons_st(fi, fj, fk, i, loc) = av
+ rsum = rsum + av
+ end do
+ rscale = real(amr_cons_st(fi, fj, fk, cte, loc), wp)/max(rsum, 1.e-30_wp)
+ do i = spb, spe
+ amr_cons_st(fi, fj, fk, i, loc) = real(amr_cons_st(fi, fj, fk, i, loc), wp)*rscale
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_prolong_species_closure
+
+ !> Disblock prolongation. Guard: no-op unless amr.
+ impure subroutine s_populate_amr_fine(q_cons_base)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_base
+ integer :: i, islot
+
+ if (.not. amr) return
+ ! Prolong EVERY block (max_grid_size tiling can make several) from its gathered coarse patch. The P2P gather pulls each
+ ! patch's inter-rank coarse cells from neighbour interiors, so no coarse-ghost halo exchange is needed; host q_cons_base
+ ! holds
+ ! the ICs here (this runs before s_initialize_gpu_vars). ALL ranks call the gather (P2P); only owners prolong.
+ do islot = f_l0_slot(1), amr_num_blocks
+ call s_amr_select_slot(islot)
+ call s_amr_gather_coarse_patch(q_cons_base, .false.)
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics
+ ! non-polytropic QBMM: gather the coarse pb/mv patch too (ALL ranks - P2P; owners prolong from it below)
+ if (qbmm .and. .not. polytropic) call s_amr_gather_coarse_patch_pbmv(pb_ts(1)%sf, mv_ts(1)%sf, .false.)
+ if (amr_rank_owns_block) then
+ ! the prolong is a device kernel now (writes the slot in place); no push - a host->device push here would
+ ! clobber the device result with the stale host mirror
+ call s_interpolate_coarse_to_fine()
+ ! non-polytropic QBMM: seed the block's quadrature side-state from the coarse fields
+ if (qbmm .and. .not. polytropic) call s_amr_prolong_pbmv()
+ end if
+ end do
+ if (amr_max_level >= 2) call s_amr_build_static_multilevel(q_cons_base)
+ call s_amr_select_slot(f_l0_slot(1))
+
+ end subroutine s_populate_amr_fine
+
+ !> Build the STATIC multi-level hierarchy (amr_regrid_int = 0): nest exactly one level-2 block inside level-1 block 1 by a fixed
+ !! geometric inset (a regrid would place it by sensor-on-fine instead), prolong the parent state into it, and keep it persistent
+ !! so the advance driver steps it every timestep. The restrict/reflux identity it relies on is protected by the static
+ !! multi-level goldens (75AD6885 et al.) and the runtime conservation-defect probe.
+ impure subroutine s_amr_build_static_multilevel(q_cons_base)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_base
+ integer :: L2, n1, i, par, inset(3)
+
+ if (amr_max_level < 2) return
+ n1 = amr_num_blocks
+ if (n1 < 1) return
+ ! the static hierarchy nests exactly one level-2 block; without pool room it would SILENTLY refine only to level 1 (an
+ ! under-resolved but "successful" run). n1 (the level-1 tile count) is only known here, not at checker time, so abort at the
+ ! point of failure. Replicated inputs -> every rank takes the same branch (collective-safe).
+ if (n1 + 1 > l0_slot_off + amr_max_fine) call s_mpi_abort('amr static multi-level (amr_max_level > 1, ' &
+ & // 'amr_regrid_int = 0): amr_max_blocks is too small to nest the level-2 block (need >= level-1 block count + 1); ' &
+ & // 'increase amr_max_blocks')
+ L2 = n1 + 1
+ ! PARENT is the first FINE block, f_l0_slot(1) - NOT slot 1, which under coexist is the first level-0 TILE. Insetting a
+ ! tile instead put the level-2 box in the wrong place and sized it off the tile: with one tile (the whole base grid) that
+ ! tripped the amr_maxc_fit cap below, and with two it produced a plausible-looking box that silently corrupted the run.
+ par = f_l0_slot(1)
+ inset = 0
+ inset(1) = max((amr_region_hi_all(1, par) - amr_region_lo_all(1, par) + 1)/4, amr_cpat_mar)
+ if (n_glb > 0) inset(2) = max((amr_region_hi_all(2, par) - amr_region_lo_all(2, par) + 1)/4, amr_cpat_mar)
+ if (p_glb > 0) inset(3) = max((amr_region_hi_all(3, par) - amr_region_lo_all(3, par) + 1)/4, amr_cpat_mar)
+ amr_region_lo_all(:,L2) = amr_region_lo_all(:,par) + inset
+ amr_region_hi_all(:,L2) = amr_region_hi_all(:,par) - inset
+ ! Guard the fixed-inset box against configs this single-block static builder cannot represent - the dynamic regrid path has
+ ! the analogous checks (proper-nesting skip + amr_maxc_fit/2 clamp), but the static path bypasses them. Replicated inputs ->
+ ! every rank takes the same branch (collective-safe). (a) a level-1 block smaller than 2*inset inverts the box; (b) a
+ ! level-2
+ ! L0-extent > amr_maxc_fit/2 makes its parent-fine transverse extent (2*L0) overrun the creg register (allocated
+ ! 0:amr_maxc_fit-1), a silent out-of-bounds device write in the L2->L1 reflux capture.
+ if (amr_region_lo_all(1, L2) > amr_region_hi_all(1, L2) .or. (n_glb > 0 .and. amr_region_lo_all(2, &
+ & L2) > amr_region_hi_all(2, L2)) .or. (p_glb > 0 .and. amr_region_lo_all(3, L2) > amr_region_hi_all(3, &
+ & L2))) call s_mpi_abort('amr static multi-level: level-1 block 1 is too small to nest a level-2 block (the fixed ' &
+ & // 'inset inverts the box); enlarge the base amr block or reduce amr_cpat_mar')
+ if (amr_ref_ratio*(amr_region_hi_all(1, L2) - amr_region_lo_all(1, &
+ & L2) + 1) > amr_maxc_fit(1) .or. (n_glb > 0 .and. amr_ref_ratio*(amr_region_hi_all(2, L2) - amr_region_lo_all(2, &
+ & L2) + 1) > amr_maxc_fit(2)) .or. (p_glb > 0 .and. amr_ref_ratio*(amr_region_hi_all(3, L2) - amr_region_lo_all(3, &
+ & L2) + 1) > amr_maxc_fit(3))) &
+ & call s_mpi_abort('amr static multi-level: the nested level-2 block exceeds the per-rank scratch cap ' &
+ & // '(2*L0-extent > amr_maxc_fit); static multi-level does not tile the level-2 block - use a smaller base amr ' &
+ & // 'block or the dynamic regrid path (amr_regrid_int > 0)')
+ amr_block_level(L2) = 2
+ amr_block_owner(L2) = amr_block_owner(par); amr_myblk_dirty = .true.
+ amr_num_blocks = L2; amr_num_levels = 2
+ call s_amr_reconcile_slots()
+ amr_cur = L2
+ call s_set_amr_fine_geometry(amr_region_lo_all(:,L2), amr_region_hi_all(:,L2))
+ call s_amr_reduce_xchg_flag()
+ call s_amr_gather_coarse_patch(q_cons_base, .false.) ! q_coarse ignored for level>=2 (reads the parent block); pass the
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics
+ ! always-allocated base field, not amr_slots(1) (the parent slot is unallocated on a non-owner rank at np>1)
+ if (amr_rank_owns_block) then
+ ! the prolong is a device kernel now: the persistent L2 block's device q_cons is valued in place (the historical
+ ! host-loop NaN hazard this site used to push against is gone; a push here would clobber the device result)
+ call s_interpolate_coarse_to_fine()
+ end if
+ ! persistent L2 block: KEEP the level-2 block in the active set (amr_num_blocks = L2, amr_num_levels = 2) so the advance
+ ! driver steps it across timesteps; no free/revert.
+ ! restore amr_cg + the patch frame (amr_cpat_off) to the first FINE block: the L2 gather above overwrote them with the
+ ! parent-fine frame, and the normal single-block conservation check that follows reads that block's frame. f_l0_slot(1),
+ ! not slot 1 - under coexist slot 1 is a level-0 TILE, and selecting it here left the grid globals describing tile
+ ! geometry for the rest of init, so s_initialize_weno_module (m_start_up, called after this) sized its device-mapped
+ ! coefficient tables off the wrong bounds and faulted in __tgt_target_data_begin_mapper.
+ call s_amr_select_slot(f_l0_slot(1))
+ call s_amr_gather_coarse_patch(q_cons_base, .false.)
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics
+
+ end subroutine s_amr_build_static_multilevel
+
+ !> Volume-weighted restriction: each covered coarse cell = volume-weighted average of its amr_ref_ratio^d fine children (equal
+ !! weight on Cartesian grids where children share a volume; radius-weighted by fine y_cc on cyl_coord, where cell volume ~
+ !! radius - amr_rvw, single-sourced so device and host paths agree bit-for-bit). Writes the caller's coarse target - in
+ !! production the level-0 state q_cons_ts(1)%vf (the deliberate fold-back of fine data each step, plus coarse pb/mv for
+ !! non-polytropic QBMM); init-time diagnostics pass a scratch buffer instead. Device kernel.
+ impure subroutine s_restrict_fine_to_coarse(coarse_tgt)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: coarse_tgt
+ integer :: nchild, rr, dj_hi, dk_hi, o1, o2, o3, owner, r, idx, boxsz, maxsz, nsrc, ierr
+ integer :: rlo(3), rhi(3), ilo(3), ihi(3), bl(3), bh(3)
+ real(wp), allocatable :: sbuf(:,:), rbuf(:)
+ integer, allocatable :: reqs(:), drank(:)
+
+ if (rank_time_wrt .and. amr_rank_owns_block) call s_rank_time_tic()
+
+ ! multi-level: a level>=2 block folds back into its PARENT block's fine array (the coarse side of level l is level l-1), not
+ ! the L0 coarse_tgt. Same restriction kernel, targeted at the parent in the parent-fine frame. When child and parent sit on
+ ! different ranks the fold is a P2P pair, so BOTH participants must enter or the receiver never posts.
+ if (amr_block_level(amr_cur) >= 2) then
+ if (amr_rank_owns_block .or. amr_block_owner(f_amr_parent_block(amr_cur)) == proc_rank) then
+ call s_amr_restrict_to_parent()
+ end if
+ if (rank_time_wrt .and. amr_rank_owns_block) call s_rank_time_toc()
+ return
+ end if
+
+ ! whole-block-per-rank fold-back: the block owner restricts its fine block to coarse averages over the covered cells
+ ! [region_lo:region_hi] and SCATTERS them POINT-TO-POINT to the coarse-cell owners - the owner overwrites the covered cells
+ ! it holds locally and SENDS each other coarse-owner exactly its covered slice (all sys_size in one message). Covered cells
+ ! are in-domain (no ghosts), so each is owned by exactly one interior owner. At np=1 the owner owns every covered cell,
+ ! sends
+ ! nothing, and overwrites locally with the same child-sum -> bit-identical.
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ nchild = rr; if (n_glb > 0) nchild = nchild*rr; if (p_glb > 0) nchild = nchild*rr
+ dj_hi = merge(rr - 1, 0, n_glb > 0); dk_hi = merge(rr - 1, 0, p_glb > 0)
+ rlo = 0; rhi = 0
+ rlo(1) = amr_region_lo_all(1, amr_cur); rhi(1) = amr_region_hi_all(1, amr_cur)
+ if (n_glb > 0) then; rlo(2) = amr_region_lo_all(2, amr_cur); rhi(2) = amr_region_hi_all(2, amr_cur); end if
+ if (p_glb > 0) then; rlo(3) = amr_region_lo_all(3, amr_cur); rhi(3) = amr_region_hi_all(3, amr_cur); end if
+ owner = amr_block_owner(amr_cur)
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ maxsz = sys_size*(rhi(1) - rlo(1) + 1)*(rhi(2) - rlo(2) + 1)*(rhi(3) - rlo(3) + 1)
+
+ ! cyl_coord: fine radial volume weights = this block's fine cell-center radii, pushed to device for the restriction kernels.
+ ! Only the owner restricts (device overwrite + device scatter pack), so only the owner needs them; single-sourced from y_cc
+ ! so the owner-local and scattered child-averages are bit-identical.
+ if (cyl_coord .and. proc_rank == owner) then
+ amr_rvw(0:amr_slots(amr_cur)%n) = amr_slots(amr_cur)%y_cc(0:amr_slots(amr_cur)%n)
+ $:GPU_UPDATE(device='[amr_rvw]')
+ end if
+
+ ! block set changed: rebuild the cached overlap-rank lists (same lazy trigger as s_amr_fine_fine_halo; local, replicated)
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+
+ if (proc_rank == owner) then
+ ! overwrite the covered cells this rank owns, then send each other coarse-owner its covered slice
+ call s_amr_rank_interior(proc_rank, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ if (num_procs == 1) then
+ ! np=1 device-native fold-back: restrict the fine block (device) into the coarse (device) over the COVERED cells
+ ! only - no host round-trip. The old path pulled fine to host, restricted on host, then pushed the WHOLE coarse
+ ! array back to the device (GPU_UPDATE device coarse_tgt), clobbering the device-advanced NON-covered coarse cells
+ ! with the stale host copy - a GPU-only divergence (invisible on CPU where host==device) that IGR/MHD/acoustic
+ ! amplify. The owner holds every covered cell at np=1.
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) call s_amr_restrict_overwrite_device_sf(coarse_tgt, &
+ & amr_loc_of(amr_cur), bl, bh, o1, o2, o3, rlo, rr, dj_hi, dk_hi, nchild)
+ if (qbmm .and. .not. polytropic .and. amr_rank_owns_block) call s_restrict_pbmv(pb_ts(1)%sf, mv_ts(1)%sf, &
+ & amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf)
+ if (rank_time_wrt .and. amr_rank_owns_block) call s_rank_time_toc()
+ return
+ end if
+ ! owner-local covered cells: restrict fine(device) -> coarse(device) touching ONLY those cells (no whole-coarse device
+ ! push, which clobbered the device-advanced non-covered coarse cells - the same GPU-only bug fixed at np=1)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) call s_amr_restrict_overwrite_device_sf(coarse_tgt, &
+ & amr_loc_of(amr_cur), bl, bh, o1, o2, o3, rlo, rr, dj_hi, dk_hi, nchild)
+ ! cached destination list (every listed rank's interior overlaps the region by construction)
+ nsrc = 0
+ do idx = 1, amr_ovl_scatter_n(amr_cur)
+ if (amr_ovl_scatter(idx, amr_cur) /= owner) nsrc = nsrc + 1
+ end do
+ if (nsrc > 0) then
+ allocate (sbuf(maxsz, nsrc), reqs(nsrc), drank(nsrc))
+ nsrc = 0
+ do idx = 1, amr_ovl_scatter_n(amr_cur)
+ r = amr_ovl_scatter(idx, amr_cur)
+ if (r == owner) cycle
+ call s_amr_rank_interior(r, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ nsrc = nsrc + 1; drank(nsrc) = r
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ ! pack this destination's covered slice on the DEVICE: restrict averages straight into the wire buffer (same
+ ! child-sum order and wp values as the device overwrite above) - no full-field host pull
+ call s_amr_restrict_pack_device(amr_loc_of(amr_cur), bl, bh, rlo, rr, dj_hi, dk_hi, nchild, sbuf(1:boxsz,nsrc))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_F7A_SND, 1, boxsz, amr_cur)
+ call MPI_ISEND(sbuf(1, nsrc), boxsz, mpi_p, r, amr_cur, MPI_COMM_WORLD, reqs(nsrc), ierr)
+#endif
+ end do
+#ifdef MFC_MPI
+ call MPI_WAITALL(nsrc, reqs, MPI_STATUSES_IGNORE, ierr)
+#endif
+ deallocate (sbuf, reqs, drank)
+ end if
+ else
+ ! coarse-owner: if I hold covered cells, receive my slice from the owner and overwrite my local coarse
+ call s_amr_rank_interior(proc_rank, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) then
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ allocate (rbuf(boxsz))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_F7A_RCV, 2, boxsz, amr_cur)
+ call MPI_RECV(rbuf, boxsz, mpi_p, owner, amr_cur, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ ! DEVICE unpack of the covered box, writing only those cells (a whole-array push would clobber the device-advanced
+ ! non-covered coarse cells with this rank's stale host copy - the GPU-only bug fixed at np=1). This must NOT be a
+ ! host unpack followed by a strided GPU_UPDATE(device=) of the box: a non-contiguous 3-D array section in an OpenMP
+ ! target update is copied by AMD flang as size(section) CONTIGUOUS elements, so only the first row lands on the
+ ! cells it names and the remainder overwrites neighbouring cells with stale host data - silently, and only at
+ ! np >= 2 with a block whose owner holds none of its covered cells. The wire layout (ci fastest, then cj, ck, i)
+ ! is exactly s_l0_pack_unpack_block's, so it unpacks s_amr_restrict_pack_device's buffer as-is.
+ call s_l0_pack_unpack_block_sf(coarse_tgt, bl(1) - o1, bl(2) - o2, bl(3) - o3, bh(1) - bl(1), bh(2) - bl(2), &
+ & bh(3) - bl(3), rbuf, .false.)
+ deallocate (rbuf)
+ end if
+ end if
+
+ ! non-polytropic QBMM: distributed pb/mv fold-back - the owner restricts the covered cells it holds and scatters each other
+ ! coarse-owner its slice (mirror of the q_cons scatter above). Called on ALL ranks so the P2P send/recv pair up (np=1
+ ! handled
+ ! by the direct s_restrict_pbmv in the num_procs==1 branch above, which returns before reaching here)
+ if (qbmm .and. .not. polytropic) call s_amr_scatter_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf)
+ if (rank_time_wrt .and. amr_rank_owns_block) call s_rank_time_toc()
+
+ end subroutine s_restrict_fine_to_coarse
+
+ !> Multi-level restriction: fold the current level>=2 block's fine averages back into its PARENT block's fine array over the
+ !! covered cells. Same child-sum kernel as the L0 fold-back, targeted at the parent in the parent-fine frame (amr_isect already
+ !! parent-fine; offset 0 = the parent's local fine indexing). np=1 local; the np>=2 P2P scatter is future work.
+ impure subroutine s_amr_restrict_to_parent()
+
+ integer :: pblk, rr, nchild, dj_hi, dk_hi, cowner, powner, boxsz, ierr
+ integer :: plo(3), phi(3)
+ real(wp), allocatable :: xbuf(:)
+
+ ! NOTE: reads amr_rvw's device copy without a GPU_UPDATE - safe only while cyl_coord + amr_max_level > 1 is checker-gated
+ ! (this path never runs under cyl_coord). If that gate lifts, refresh amr_rvw here first (see its declaration).
+
+ pblk = f_amr_parent_block(amr_cur)
+ cowner = amr_block_owner(amr_cur); powner = amr_block_owner(pblk)
+ if (proc_rank /= cowner .and. proc_rank /= powner) return ! not a participant
+
+ ! Same replicated-metadata box as the gather, so the folding child and the receiving parent agree without a handshake.
+ call s_amr_parent_foot(amr_cur, pblk, plo, phi)
+ if (plo(1) > phi(1) .or. plo(2) > phi(2) .or. plo(3) > phi(3)) return ! empty footprint
+
+ rr = amr_ref_ratio
+ nchild = rr; if (n_glb > 0) nchild = nchild*rr; if (p_glb > 0) nchild = nchild*rr
+ dj_hi = merge(rr - 1, 0, n_glb > 0); dk_hi = merge(rr - 1, 0, p_glb > 0)
+
+ if (powner == cowner) then
+ ! co-located (np=1, or a co-located tower): fold straight into the parent, bit-for-bit as before.
+ call s_amr_restrict_overwrite_device_st(amr_loc_of(pblk), amr_loc_of(amr_cur), plo, phi, 0, 0, 0, plo, rr, dj_hi, &
+ & dk_hi, nchild)
+ return
+ end if
+
+#ifdef MFC_MPI
+ ! Split ownership: the CHILD restricts locally and ships COARSE cells - rr**num_dims fewer values than shipping its fine
+ ! block - which restriction being an overwrite (not an accumulate) makes correct. Reuses the L0<->L1 scatter's pack and
+ ! unpack verbatim; their wire layout (ci fastest, then cj, ck, i) is already documented as compatible.
+ boxsz = sys_size*(phi(1) - plo(1) + 1)*(phi(2) - plo(2) + 1)*(phi(3) - plo(3) + 1)
+ allocate (xbuf(boxsz))
+ if (proc_rank == cowner) then
+ call s_amr_restrict_pack_device(amr_loc_of(amr_cur), plo, phi, plo, rr, dj_hi, dk_hi, nchild, xbuf)
+ call s_xa_rec(XA_F7B_SND, 1, boxsz, amr_cur)
+ call MPI_SEND(xbuf, boxsz, mpi_p, powner, amr_cur, MPI_COMM_WORLD, ierr)
+ else
+ call s_xa_rec(XA_F7B_RCV, 2, boxsz, amr_cur)
+ call MPI_RECV(xbuf, boxsz, mpi_p, cowner, amr_cur, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+ ! DEVICE unpack of just the covered box - never a host unpack plus a strided GPU_UPDATE (see the L0 scatter's note: AMD
+ ! flang copies a non-contiguous 3-D section as contiguous elements and silently corrupts neighbouring cells).
+ call s_l0_pack_unpack_block_st(amr_loc_of(pblk), plo(1), plo(2), plo(3), phi(1) - plo(1), phi(2) - plo(2), &
+ & phi(3) - plo(3), xbuf, .false.)
+ end if
+ deallocate (xbuf)
+#endif
+
+ end subroutine s_amr_restrict_to_parent
+
+ !> I5b: the lock-step restrict fold as plan-based waves (amr_plan_based_exchange.md). Replaces the per-box reverse fold loop on
+ !! the lock-step np>1 path: per level (finest first) the split-ownership child->parent folds become ONE aggregated message per
+ !! (child-owner, parent-owner) peer (s_amr_restrict_parent_wave), followed by the per-box reflux-to-parent applies (their freg
+ !! was already exchanged by s_amr_freg_wave); then the level-1 -> L0 covered-cell scatter becomes one aggregated message per
+ !! (owner, coarse-owner) peer (s_amr_restrict_l1_wave). Both sides derive identical transfer lists from replicated metadata (the
+ !! region-box x rank-interior intersections the per-box path already used), so the wire layout needs no handshake and F7 family
+ !! words stay EXACT; what is removed is the per-box ISEND+WAITALL / blocking-RECV chain, whose length scales with the GLOBAL
+ !! block count. Level order (finest first) preserves child-before-parent folding; within a level the covered targets are
+ !! disjoint, and the restrict/reflux interleave is order-free because sibling-shared faces carry weight 0
+ !! (s_amr_sibling_face_weights). Subcycle and np=1 keep the per-box loop (the per-box routines remain).
+ impure subroutine s_amr_restrict_wave(coarse_tgt, dt_reflux)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: coarse_tgt
+ real(wp), intent(in) :: dt_reflux
+ integer :: lev, k
+
+ do lev = amr_max_level, 2, -1
+ if (relax) then
+ do k = amr_num_blocks, 1, -1
+ if (amr_block_level(k) /= lev) cycle
+ call s_amr_select_slot(k)
+ call s_amr_relax_fine()
+ end do
+ end if
+ call s_phase_tic(PH_RESTR); call s_phase_tic(PH_RSREST)
+ call s_amr_restrict_parent_wave(lev)
+ call s_phase_toc(PH_RSREST); call s_phase_toc(PH_RESTR)
+ do k = amr_num_blocks, 1, -1
+ if (amr_block_level(k) /= lev) cycle
+ call s_amr_select_slot(k)
+ call s_phase_tic(PH_RESTR); call s_phase_tic(PH_RSRFP)
+ call s_amr_reflux_to_parent(dt_reflux, .false.)
+ call s_phase_toc(PH_RSRFP); call s_phase_toc(PH_RESTR)
+ end do
+ end do
+ if (relax) then
+ do k = amr_num_blocks, 1, -1
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ call s_amr_relax_fine()
+ end do
+ end if
+ call s_phase_tic(PH_RESTR); call s_phase_tic(PH_RSREST)
+ call s_amr_restrict_l1_wave(coarse_tgt)
+ call s_phase_toc(PH_RSREST); call s_phase_toc(PH_RESTR)
+ ! non-polytropic QBMM pb/mv fold-back keeps its per-box pairing (every rank walks the same reverse order, so the
+ ! blocking pairs match exactly as they did inside the per-box fold)
+ if (qbmm .and. .not. polytropic) then
+ do k = amr_num_blocks, 1, -1
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ call s_amr_scatter_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf)
+ end do
+ end if
+ call s_amr_select_slot(1)
+
+ end subroutine s_amr_restrict_wave
+
+ !> One per-level wave of the split-ownership level>=2 child->parent restrict folds (the F7B pairs). Co-located folds run inline
+ !! on the child-owner (bit-for-bit the per-box kernel); every cross-rank fold ships its parent-frame covered box in one
+ !! aggregated message per (child-owner, parent-owner) peer. Both sides walk the same replicated block list ascending with
+ !! per-peer running offsets, so the wire layout agrees with no metadata exchange.
+ impure subroutine s_amr_restrict_parent_wave(lev)
+
+ integer, intent(in) :: lev
+
+#ifdef MFC_MPI
+ integer :: k, pblk, cowner, powner, rr, nchild, dj_hi, dk_hi, ierr, ip, idx, r, cnt, boff, qbase, nreq, tq, kk
+ integer :: plo(3), phi(3)
+
+ rr = amr_ref_ratio
+ nchild = rr; if (n_glb > 0) nchild = nchild*rr; if (p_glb > 0) nchild = nchild*rr
+ dj_hi = merge(rr - 1, 0, n_glb > 0); dk_hi = merge(rr - 1, 0, p_glb > 0)
+ tq = amr_tag_base(7) + int(mod(amr_mesh_epoch, 50_8))
+ if (.not. allocated(amr_fw_map)) then
+ allocate (amr_fw_map(0:num_procs - 1), amr_fw_nx(0:num_procs - 1), amr_fw_pq(0:num_procs - 1), &
+ & amr_fw_pp(0:num_procs - 1))
+ amr_fw_map = 0; amr_fw_nx = 0; amr_fw_pq = 0; amr_fw_pp = 0
+ end if
+ ! send plan + co-located folds (child-owner side)
+ amr_fw_snx = 0; amr_fw_snp = 0
+ call s_amr_refresh_my_blocks()
+ do kk = 1, amr_n_my
+ k = amr_my_blk(kk)
+ if (amr_block_level(k) /= lev) cycle
+ cowner = amr_block_owner(k)
+ pblk = f_amr_parent_block(k)
+ powner = amr_block_owner(pblk)
+ call s_amr_parent_foot(k, pblk, plo, phi)
+ if (plo(1) > phi(1) .or. plo(2) > phi(2) .or. plo(3) > phi(3)) cycle
+ if (cowner == powner) then
+ call s_amr_restrict_overwrite_device_st(amr_loc_of(pblk), amr_loc_of(k), plo, phi, 0, 0, 0, plo, rr, dj_hi, &
+ & dk_hi, nchild)
+ cycle
+ end if
+ if (amr_fw_map(powner) == 0) then
+ amr_fw_snp = amr_fw_snp + 1
+ call s_amr_fw_szi(amr_fw_sprank, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqsz, amr_fw_snp)
+ call s_amr_fw_szi(amr_fw_snxp, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqbase, amr_fw_snp)
+ amr_fw_map(powner) = amr_fw_snp
+ amr_fw_sprank(amr_fw_snp) = powner
+ end if
+ cnt = sys_size*(phi(1) - plo(1) + 1)*(phi(2) - plo(2) + 1)*(phi(3) - plo(3) + 1)
+ amr_fw_snx = amr_fw_snx + 1
+ call s_amr_fw_szi(amr_fw_sblk, amr_fw_snx); call s_amr_fw_szi3(amr_fw_sbl, amr_fw_snx)
+ call s_amr_fw_szi3(amr_fw_sbh, amr_fw_snx); call s_amr_fw_szi(amr_fw_spi, amr_fw_snx)
+ call s_amr_fw_szi(amr_fw_sqo, amr_fw_snx); call s_amr_fw_szi(amr_fw_spo, amr_fw_snx)
+ amr_fw_sblk(amr_fw_snx) = k
+ amr_fw_sbl(:,amr_fw_snx) = plo; amr_fw_sbh(:,amr_fw_snx) = phi
+ amr_fw_spo(amr_fw_snx) = cnt
+ amr_fw_spi(amr_fw_snx) = amr_fw_map(powner)
+ amr_fw_sqo(amr_fw_snx) = amr_fw_pq(powner) + amr_fw_nx(powner)*XA_NH
+ amr_fw_pq(powner) = amr_fw_pq(powner) + cnt
+ amr_fw_nx(powner) = amr_fw_nx(powner) + 1
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_snp
+ r = amr_fw_sprank(ip)
+ amr_fw_snxp(ip) = amr_fw_nx(r)
+ amr_fw_sqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_sqbase(ip) = qbase; qbase = qbase + amr_fw_sqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_sq, qbase)
+ ! recv plan (parent-owner side): the same replicated walk, so per-peer transfer order matches the sender's
+ amr_fw_rnx = 0; amr_fw_rnp = 0
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= lev) cycle
+ pblk = f_amr_parent_block(k)
+ cowner = amr_block_owner(k); powner = amr_block_owner(pblk)
+ if (cowner == powner .or. proc_rank /= powner) cycle
+ call s_amr_parent_foot(k, pblk, plo, phi)
+ if (plo(1) > phi(1) .or. plo(2) > phi(2) .or. plo(3) > phi(3)) cycle
+ if (amr_fw_map(cowner) == 0) then
+ amr_fw_rnp = amr_fw_rnp + 1
+ call s_amr_fw_szi(amr_fw_rprank, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqsz, amr_fw_rnp)
+ call s_amr_fw_szi(amr_fw_rnxp, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqbase, amr_fw_rnp)
+ amr_fw_map(cowner) = amr_fw_rnp
+ amr_fw_rprank(amr_fw_rnp) = cowner
+ end if
+ cnt = sys_size*(phi(1) - plo(1) + 1)*(phi(2) - plo(2) + 1)*(phi(3) - plo(3) + 1)
+ amr_fw_rnx = amr_fw_rnx + 1
+ call s_amr_fw_szi(amr_fw_rblk, amr_fw_rnx); call s_amr_fw_szi3(amr_fw_rbl, amr_fw_rnx)
+ call s_amr_fw_szi3(amr_fw_rbh, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpi, amr_fw_rnx)
+ call s_amr_fw_szi(amr_fw_rqo, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpo, amr_fw_rnx)
+ amr_fw_rblk(amr_fw_rnx) = k
+ amr_fw_rbl(:,amr_fw_rnx) = plo; amr_fw_rbh(:,amr_fw_rnx) = phi
+ amr_fw_rpo(amr_fw_rnx) = cnt
+ amr_fw_rpi(amr_fw_rnx) = amr_fw_map(cowner)
+ amr_fw_rqo(amr_fw_rnx) = amr_fw_pq(cowner) + amr_fw_nx(cowner)*XA_NH
+ amr_fw_pq(cowner) = amr_fw_pq(cowner) + cnt
+ amr_fw_nx(cowner) = amr_fw_nx(cowner) + 1
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_rnp
+ r = amr_fw_rprank(ip)
+ amr_fw_rnxp(ip) = amr_fw_nx(r)
+ amr_fw_rqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rqbase(ip) = qbase; qbase = qbase + amr_fw_rqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_rq, qbase)
+ nreq = amr_fw_snp + amr_fw_rnp
+ if (nreq == 0) return
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ nreq = 0
+ do ip = 1, amr_fw_rnp
+ call s_xa_rec(XA_F7BW_RCV, 2, amr_fw_rqsz(ip) - amr_fw_rnxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = amr_fw_rqsz(ip)
+ call MPI_IRECV(amr_fw_rq(amr_fw_rqbase(ip) + 1), amr_fw_rqsz(ip), mpi_p, amr_fw_rprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+ do idx = 1, amr_fw_snx
+ cnt = amr_fw_spo(idx)
+ boff = amr_fw_sqbase(amr_fw_spi(idx)) + amr_fw_sqo(idx)
+ call s_amr_restrict_pack_device(amr_loc_of(amr_fw_sblk(idx)), amr_fw_sbl(:,idx), amr_fw_sbh(:,idx), amr_fw_sbl(:, &
+ & idx), rr, dj_hi, dk_hi, nchild, amr_fw_sq(boff + XA_NH + 1:boff + XA_NH + cnt))
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_fw_sq(boff + 1:boff + XA_NH), XA_F7BW_SND, amr_fw_sblk(idx), amr_fw_sbl(:,idx), &
+ & amr_fw_sbh(:,idx))
+ end do
+ do ip = 1, amr_fw_snp
+ call s_xa_rec(XA_F7BW_SND, 1, amr_fw_sqsz(ip) - amr_fw_snxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(amr_fw_sqbase(ip) + 1), amr_fw_sqsz(ip), mpi_p, amr_fw_sprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "restrict parent wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+#endif
+ do idx = 1, amr_fw_rnx
+ cnt = amr_fw_rpo(idx)
+ boff = amr_fw_rqbase(amr_fw_rpi(idx)) + amr_fw_rqo(idx)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_fw_rq(boff + 1:boff + XA_NH), XA_F7BW_SND, amr_fw_rblk(idx), amr_fw_rbl(:, &
+ & idx), amr_fw_rbh(:,idx))
+ ! DEVICE unpack of the covered box only (the strided-update flang trap - see s_restrict_fine_to_coarse)
+ call s_l0_pack_unpack_block_st(amr_loc_of(f_amr_parent_block(amr_fw_rblk(idx))), amr_fw_rbl(1, idx), amr_fw_rbl(2, &
+ & idx), amr_fw_rbl(3, idx), amr_fw_rbh(1, idx) - amr_fw_rbl(1, idx), amr_fw_rbh(2, &
+ & idx) - amr_fw_rbl(2, idx), amr_fw_rbh(3, idx) - amr_fw_rbl(3, idx), &
+ & amr_fw_rq(boff + XA_NH + 1:boff + XA_NH + cnt), .false.)
+ end do
+#endif
+
+ end subroutine s_amr_restrict_parent_wave
+
+ !> The level-1 -> L0 covered-cell scatter (F7A) as one wave: every owned level-1 block's covered slabs for every listed
+ !! coarse-owner ship in one aggregated message per peer; the owner-local covered overwrite and the (cyl_coord) amr_rvw push stay
+ !! grouped per block during the pack walk. The receiver plan is my-interior x region(k) over the level-1 blocks I do not own -
+ !! by construction (s_amr_ranks_overlapping) exactly the sender's list membership.
+ impure subroutine s_amr_restrict_l1_wave(coarse_tgt)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: coarse_tgt
+
+#ifdef MFC_MPI
+ integer :: k, owner, rr, nchild, dj_hi, dk_hi, ierr, ip, idx, r, cnt, boff, qbase, nreq, tq, o1, o2, o3, cur, kk
+ integer :: rlo(3), rhi(3), ilo(3), ihi(3), milo(3), mihi(3), bl(3), bh(3)
+
+ tq = amr_tag_base(7) + 50 + int(mod(amr_mesh_epoch, 50_8))
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ ! block set changed: rebuild the cached overlap-rank lists (same lazy trigger as the per-box path)
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+ if (.not. allocated(amr_fw_map)) then
+ allocate (amr_fw_map(0:num_procs - 1), amr_fw_nx(0:num_procs - 1), amr_fw_pq(0:num_procs - 1), &
+ & amr_fw_pp(0:num_procs - 1))
+ amr_fw_map = 0; amr_fw_nx = 0; amr_fw_pq = 0; amr_fw_pp = 0
+ end if
+ call s_amr_rank_interior(proc_rank, milo, mihi)
+ ! send plan (block-owner side): the same (interior x region) covered slabs the per-box path sent, k-grouped
+ amr_fw_snx = 0; amr_fw_snp = 0
+ call s_amr_refresh_my_blocks()
+ do kk = 1, amr_n_my
+ k = amr_my_blk(kk)
+ if (amr_block_level(k) /= 1) cycle
+ rlo = 0; rhi = 0
+ rlo(1) = amr_region_lo_all(1, k); rhi(1) = amr_region_hi_all(1, k)
+ if (n_glb > 0) then; rlo(2) = amr_region_lo_all(2, k); rhi(2) = amr_region_hi_all(2, k); end if
+ if (p_glb > 0) then; rlo(3) = amr_region_lo_all(3, k); rhi(3) = amr_region_hi_all(3, k); end if
+ do idx = 1, amr_ovl_scatter_n(k)
+ r = amr_ovl_scatter(idx, k)
+ if (r == proc_rank) cycle
+ call s_amr_rank_interior(r, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ if (bl(1) > bh(1) .or. bl(2) > bh(2) .or. bl(3) > bh(3)) cycle
+ if (amr_fw_map(r) == 0) then
+ amr_fw_snp = amr_fw_snp + 1
+ call s_amr_fw_szi(amr_fw_sprank, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqsz, amr_fw_snp)
+ call s_amr_fw_szi(amr_fw_snxp, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqbase, amr_fw_snp)
+ amr_fw_map(r) = amr_fw_snp
+ amr_fw_sprank(amr_fw_snp) = r
+ end if
+ cnt = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ amr_fw_snx = amr_fw_snx + 1
+ call s_amr_fw_szi(amr_fw_sblk, amr_fw_snx); call s_amr_fw_szi3(amr_fw_sbl, amr_fw_snx)
+ call s_amr_fw_szi3(amr_fw_sbh, amr_fw_snx); call s_amr_fw_szi(amr_fw_spi, amr_fw_snx)
+ call s_amr_fw_szi(amr_fw_sqo, amr_fw_snx); call s_amr_fw_szi(amr_fw_spo, amr_fw_snx)
+ amr_fw_sblk(amr_fw_snx) = k
+ amr_fw_sbl(:,amr_fw_snx) = bl; amr_fw_sbh(:,amr_fw_snx) = bh
+ amr_fw_spo(amr_fw_snx) = cnt
+ amr_fw_spi(amr_fw_snx) = amr_fw_map(r)
+ amr_fw_sqo(amr_fw_snx) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_pq(r) = amr_fw_pq(r) + cnt
+ amr_fw_nx(r) = amr_fw_nx(r) + 1
+ end do
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_snp
+ r = amr_fw_sprank(ip)
+ amr_fw_snxp(ip) = amr_fw_nx(r)
+ amr_fw_sqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_sqbase(ip) = qbase; qbase = qbase + amr_fw_sqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_sq, qbase)
+ ! recv plan (coarse-owner side): my interior x region(k) over level-1 blocks I do not own
+ amr_fw_rnx = 0; amr_fw_rnp = 0
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ owner = amr_block_owner(k)
+ if (owner == proc_rank) cycle
+ rlo = 0; rhi = 0
+ rlo(1) = amr_region_lo_all(1, k); rhi(1) = amr_region_hi_all(1, k)
+ if (n_glb > 0) then; rlo(2) = amr_region_lo_all(2, k); rhi(2) = amr_region_hi_all(2, k); end if
+ if (p_glb > 0) then; rlo(3) = amr_region_lo_all(3, k); rhi(3) = amr_region_hi_all(3, k); end if
+ call s_amr_box_isect(rlo, rhi, milo, mihi, bl, bh)
+ if (bl(1) > bh(1) .or. bl(2) > bh(2) .or. bl(3) > bh(3)) cycle
+ if (amr_fw_map(owner) == 0) then
+ amr_fw_rnp = amr_fw_rnp + 1
+ call s_amr_fw_szi(amr_fw_rprank, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqsz, amr_fw_rnp)
+ call s_amr_fw_szi(amr_fw_rnxp, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqbase, amr_fw_rnp)
+ amr_fw_map(owner) = amr_fw_rnp
+ amr_fw_rprank(amr_fw_rnp) = owner
+ end if
+ cnt = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ amr_fw_rnx = amr_fw_rnx + 1
+ call s_amr_fw_szi(amr_fw_rblk, amr_fw_rnx); call s_amr_fw_szi3(amr_fw_rbl, amr_fw_rnx)
+ call s_amr_fw_szi3(amr_fw_rbh, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpi, amr_fw_rnx)
+ call s_amr_fw_szi(amr_fw_rqo, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpo, amr_fw_rnx)
+ amr_fw_rblk(amr_fw_rnx) = k
+ amr_fw_rbl(:,amr_fw_rnx) = bl; amr_fw_rbh(:,amr_fw_rnx) = bh
+ amr_fw_rpo(amr_fw_rnx) = cnt
+ amr_fw_rpi(amr_fw_rnx) = amr_fw_map(owner)
+ amr_fw_rqo(amr_fw_rnx) = amr_fw_pq(owner) + amr_fw_nx(owner)*XA_NH
+ amr_fw_pq(owner) = amr_fw_pq(owner) + cnt
+ amr_fw_nx(owner) = amr_fw_nx(owner) + 1
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_rnp
+ r = amr_fw_rprank(ip)
+ amr_fw_rnxp(ip) = amr_fw_nx(r)
+ amr_fw_rqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rqbase(ip) = qbase; qbase = qbase + amr_fw_rqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_rq, qbase)
+ nreq = amr_fw_snp + amr_fw_rnp
+ call s_amr_fw_szi(amr_fw_req, max(nreq, 1)); call s_amr_fw_szi(amr_fw_reqw, max(nreq, 1))
+ nreq = 0
+ do ip = 1, amr_fw_rnp
+ call s_xa_rec(XA_F7W_RCV, 2, amr_fw_rqsz(ip) - amr_fw_rnxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = amr_fw_rqsz(ip)
+ call MPI_IRECV(amr_fw_rq(amr_fw_rqbase(ip) + 1), amr_fw_rqsz(ip), mpi_p, amr_fw_rprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+ ! owner-local covered overwrites + device packs, grouped per owned block: amr_rvw is a single device mirror, so a
+ ! block's (cyl_coord) radii push must immediately precede that block's overwrite/pack kernels; the transfer list is
+ ! k-grouped by construction, so a monotone cursor drains each block's sends inside its group
+ cur = 1
+ call s_amr_refresh_my_blocks()
+ do kk = 1, amr_n_my
+ k = amr_my_blk(kk)
+ if (amr_block_level(k) /= 1) cycle
+ rr = amr_slots(k)%amr_ref_ratio
+ nchild = rr; if (n_glb > 0) nchild = nchild*rr; if (p_glb > 0) nchild = nchild*rr
+ dj_hi = merge(rr - 1, 0, n_glb > 0); dk_hi = merge(rr - 1, 0, p_glb > 0)
+ if (cyl_coord) then
+ amr_rvw(0:amr_slots(k)%n) = amr_slots(k)%y_cc(0:amr_slots(k)%n)
+ $:GPU_UPDATE(device='[amr_rvw]')
+ end if
+ rlo = 0; rhi = 0
+ rlo(1) = amr_region_lo_all(1, k); rhi(1) = amr_region_hi_all(1, k)
+ if (n_glb > 0) then; rlo(2) = amr_region_lo_all(2, k); rhi(2) = amr_region_hi_all(2, k); end if
+ if (p_glb > 0) then; rlo(3) = amr_region_lo_all(3, k); rhi(3) = amr_region_hi_all(3, k); end if
+ call s_amr_box_isect(rlo, rhi, milo, mihi, bl, bh)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) call s_amr_restrict_overwrite_device_sf(coarse_tgt, &
+ & amr_loc_of(k), bl, bh, o1, o2, o3, rlo, rr, dj_hi, dk_hi, nchild)
+ do while (cur <= amr_fw_snx)
+ if (amr_fw_sblk(cur) /= k) exit
+ cnt = amr_fw_spo(cur)
+ boff = amr_fw_sqbase(amr_fw_spi(cur)) + amr_fw_sqo(cur)
+ call s_amr_restrict_pack_device(amr_loc_of(k), amr_fw_sbl(:,cur), amr_fw_sbh(:,cur), rlo, rr, dj_hi, dk_hi, &
+ & nchild, amr_fw_sq(boff + XA_NH + 1:boff + XA_NH + cnt))
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_fw_sq(boff + 1:boff + XA_NH), XA_F7W_SND, k, amr_fw_sbl(:,cur), &
+ & amr_fw_sbh(:,cur))
+ cur = cur + 1
+ end do
+ end do
+ do ip = 1, amr_fw_snp
+ call s_xa_rec(XA_F7W_SND, 1, amr_fw_sqsz(ip) - amr_fw_snxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(amr_fw_sqbase(ip) + 1), amr_fw_sqsz(ip), mpi_p, amr_fw_sprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+ if (nreq > 0) then
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "restrict L1 wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+#endif
+ end if
+ do idx = 1, amr_fw_rnx
+ cnt = amr_fw_rpo(idx)
+ boff = amr_fw_rqbase(amr_fw_rpi(idx)) + amr_fw_rqo(idx)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_fw_rq(boff + 1:boff + XA_NH), XA_F7W_SND, amr_fw_rblk(idx), amr_fw_rbl(:,idx), &
+ & amr_fw_rbh(:,idx))
+ ! DEVICE unpack of the covered box only (the strided-update flang trap - see s_restrict_fine_to_coarse)
+ call s_l0_pack_unpack_block_sf(coarse_tgt, amr_fw_rbl(1, idx) - o1, amr_fw_rbl(2, idx) - o2, amr_fw_rbl(3, idx) - o3, &
+ & amr_fw_rbh(1, idx) - amr_fw_rbl(1, idx), amr_fw_rbh(2, idx) - amr_fw_rbl(2, idx), &
+ & amr_fw_rbh(3, idx) - amr_fw_rbl(3, idx), &
+ & amr_fw_rq(boff + XA_NH + 1:boff + XA_NH + cnt), .false.)
+ end do
+#endif
+
+ end subroutine s_amr_restrict_l1_wave
+
+ !> Deliver the current level>=2 block's fine flux registers to its PARENT block's owner, which holds the matching creg and
+ !! applies the correction. One blocking send/recv pair per dimension, mirroring s_amr_p2p_reflux_faces:
+ !! freg(d)%lo/hi(:,:,:,slot) is CONTIGUOUS (trailing slot index fixed, leading dims full), so it goes on the wire with no pack
+ !! and its GPU_UPDATE is a contiguous transfer. Several remote children of one parent reuse these tags, which is safe because
+ !! MPI does not overtake between a fixed (source, tag, comm) triple and both owners walk the sibling loop in the same replicated
+ !! block order. Tag base is disjoint from s_amr_p2p_reflux_faces so an L0/L1 delivery can never be mistaken for a parent
+ !! delivery.
+ impure subroutine s_amr_p2p_freg_to_parent(pblk)
+
+ integer, intent(in) :: pblk
+
+#ifdef MFC_MPI
+ integer :: cowner, powner, cnt, ierr
+
+ cowner = amr_block_owner(amr_cur)
+ powner = amr_block_owner(pblk)
+ if (proc_rank == cowner) then
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ $:GPU_UPDATE(host='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur), freg(' + str(D) &
+ & + ')%hi(:, :, :, amr_reg_cur)]')
+ call s_xa_rec(XA_F5_FREG_SND, 1, cnt, ${40 + 2*D}$)
+ call MPI_SEND(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, powner, ${40 + 2*D}$, MPI_COMM_WORLD, ierr)
+ call s_xa_rec(XA_F5_FREG_SND, 1, cnt, ${41 + 2*D}$)
+ call MPI_SEND(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, powner, ${41 + 2*D}$, MPI_COMM_WORLD, ierr)
+ end if
+ #:endfor
+ else
+ #:for D in [1, 2, 3]
+ if (${D}$ <= num_dims) then
+ cnt = size(freg(${D}$)%lo(:,:,:,amr_reg_cur))
+ call s_xa_rec(XA_F5_FREG_RCV, 2, cnt, ${40 + 2*D}$)
+ call MPI_RECV(freg(${D}$)%lo(:,:,:,amr_reg_cur), cnt, mpi_p, cowner, ${40 + 2*D}$, MPI_COMM_WORLD, &
+ & MPI_STATUS_IGNORE, ierr)
+ call s_xa_rec(XA_F5_FREG_RCV, 2, cnt, ${41 + 2*D}$)
+ call MPI_RECV(freg(${D}$)%hi(:,:,:,amr_reg_cur), cnt, mpi_p, cowner, ${41 + 2*D}$, MPI_COMM_WORLD, &
+ & MPI_STATUS_IGNORE, ierr)
+ $:GPU_UPDATE(device='[freg(' + str(D) + ')%lo(:, :, :, amr_reg_cur), freg(' + str(D) &
+ & + ')%hi(:, :, :, amr_reg_cur)]')
+ end if
+ #:endfor
+ end if
+#endif
+
+ end subroutine s_amr_p2p_freg_to_parent
+
+ !> Sibling-seam face weights for level>=2 block kb under parent pblk: 0 on a face shared with a same-parent sibling tile
+ !! (fine-fine, not c/f - refluxing there double-writes and leaks; the outside parent cell is covered by the sibling's restrict),
+ !! 1 otherwise. REPLICATED metadata only (f_amr_parent_block + f_amr_seam read amr_region_*_all), so every rank derives the same
+ !! weights - the reflux apply AND the freg wave's wire-skip both call this, so what ships and what is consumed cannot drift
+ !! apart.
+ impure subroutine s_amr_sibling_face_weights(kb, pblk, w_lo, w_hi)
+
+ integer, intent(in) :: kb, pblk
+ real(wp), intent(out) :: w_lo(3), w_hi(3)
+ integer :: y, d
+
+ w_lo = 1._wp; w_hi = 1._wp
+ do y = 1, amr_num_blocks ! block outer, dim inner: f_amr_parent_block (a linear scan) is evaluated once per sibling
+ if (y == kb) cycle
+ if (f_amr_parent_block(y) /= pblk) cycle ! same-parent sibling tile only (guarantees same level)
+ do d = 1, num_dims
+ if (f_amr_seam(kb, y, d)) w_hi(d) = 0._wp ! sibling just above -> shared high face
+ if (f_amr_seam(y, kb, d)) w_lo(d) = 0._wp ! sibling just below -> shared low face
+ end do
+ end do
+
+ end subroutine s_amr_sibling_face_weights
+
+ !> Multi-level reflux: apply the Berger-Colella C/F flux correction from the current level>=2 block into its PARENT block's
+ !! cells just OUTSIDE the block footprint, in the parent-fine frame (mirror of the L0 s_amr_apply_reflux targeted at the parent
+ !! - "the coarse" is level l-1). State form: q_parent(outside) += dt*(F_coarse - Fbar_fine)/dxf on the low face and +=
+ !! dt*(Fbar_fine - F_coarse)/dxf on the high face, where Fbar_fine is the child-averaged fine register. creg/freg key off this
+ !! block's slot. Per-face parent-fine dx (stretched-grid safe).
+ !!
+ !! The PARENT's owner applies: it holds the parent field and the parent-side creg (captured over its own advance). Only freg
+ !! crosses the wire, and only when the two owners differ - under tower co-location they never do, so this is byte-identical to
+ !! the previous owner-local form. BOTH participants must reach this routine or the P2P pair deadlocks (cf. the restrict).
+ impure subroutine s_amr_reflux_to_parent(dt_reflux, do_xchg)
+
+ real(wp), intent(in) :: dt_reflux
+ !> exchange the split-ownership freg here (the subcycle per-box path); the lock-step driver runs s_amr_freg_wave first
+ logical, intent(in) :: do_xchg
+ integer :: pblk, d, olo(3), ohi(3), glo(3), ghi(3), woff(3), plo(3), phi(3)
+ real(wp) :: w_lo(3), w_hi(3), mlo(3), mhi(3)
+ logical :: own_child, own_parent
+
+ pblk = f_amr_parent_block(amr_cur)
+ own_child = amr_rank_owns_block
+ own_parent = (amr_block_owner(pblk) == proc_rank)
+ if (.not. (own_child .or. own_parent)) return
+ if (do_xchg .and. (own_child .neqv. own_parent)) call s_amr_p2p_freg_to_parent(pblk)
+ if (.not. own_parent) return
+ ! max_grid_size tiling of a level>=2 feature: a face shared with an ADJACENT sibling tile (same parent) is fine-fine, not a
+ ! c/f boundary - its "outside" parent cell is covered by the sibling's restrict, so refluxing there double-writes and leaks.
+ ! Skip those faces (weight 0); the fine-fine halo already matched the shared seam flux. No siblings -> all weights 1
+ ! (no-op).
+ call s_amr_sibling_face_weights(amr_cur, pblk, w_lo, w_hi)
+ ! parent-fine frame for the shared reflux kernel: outside cell = isect boundary +/-1; creg-local loop range 0:extent;
+ ! transverse write at the isect origin. Per-face parent-fine cell widths - dx at the low/high OUTSIDE cell (olo/ohi),
+ ! mirroring the L0/L1 s_amr_apply_reflux_state so a stretched parent grid corrects each C/F face with its own width (on a
+ ! uniform grid dx is constant, so this is byte-identical to the previous single-dxf form).
+ ! Footprint from REPLICATED metadata (s_amr_parent_foot), not amr_isect_lo/hi: on the parent's owner the child's own isect
+ ! is
+ ! the empty non-owner sentinel whenever the two differ. Identical box while co-located. rr likewise comes from the global
+ ! amr_ref_ratio rather than amr_slots(amr_cur), whose slot need not be allocated on this rank.
+ call s_amr_parent_foot(amr_cur, pblk, plo, phi)
+ olo = 0; ohi = 0; glo = 0; ghi = 0; woff = 0; mlo = 1._wp; mhi = 1._wp
+ do d = 1, num_dims
+ olo(d) = plo(d) - 1; ohi(d) = phi(d) + 1
+ ghi(d) = phi(d) - plo(d)
+ woff(d) = plo(d)
+ end do
+ mlo(1) = amr_slots(pblk)%dx(olo(1)); mhi(1) = amr_slots(pblk)%dx(ohi(1))
+ if (n_glb > 0) then; mlo(2) = amr_slots(pblk)%dy(olo(2)); mhi(2) = amr_slots(pblk)%dy(ohi(2)); end if
+ if (p_glb > 0) then; mlo(3) = amr_slots(pblk)%dz(olo(3)); mhi(3) = amr_slots(pblk)%dz(ohi(3)); end if
+ call s_amr_br_load(amr_loc_of(pblk))
+ call s_amr_reflux_apply_faces(amr_cons_br, amr_reg_cur, amr_ref_ratio, dt_reflux, olo, ohi, glo, ghi, woff, w_lo, w_hi, &
+ & mlo, mhi)
+ call s_amr_br_store(amr_loc_of(pblk))
+
+ end subroutine s_amr_reflux_to_parent
+
+ !> Rank r's coarse INTERIOR box (global) from the computed decomposition (s_amr_rank_decomp, no ghosts). Covered coarse cells
+ !! are in-domain, so restriction targets are identified by interior overlap alone.
+ pure subroutine s_amr_rank_interior(r, ilo, ihi)
+
+ integer, intent(in) :: r
+ integer, intent(out) :: ilo(3), ihi(3)
+ integer :: sidx(3), ext(3)
+
+ call s_amr_rank_decomp(r, sidx, ext)
+ ilo = 0; ihi = 0
+ ilo(1) = sidx(1); ihi(1) = sidx(1) + ext(1)
+ if (n_glb > 0) then; ilo(2) = sidx(2); ihi(2) = sidx(2) + ext(2); end if
+ if (p_glb > 0) then; ilo(3) = sidx(3); ihi(3) = sidx(3) + ext(3); end if
+
+ end subroutine s_amr_rank_interior
+
+ !> Device-native restriction overwrite: restrict the fine block q_fine (DEVICE) to coarse averages over the covered coarse cells
+ !! [bl:bh] GLOBAL and write coarse_tgt (DEVICE) directly - no host round-trip, only the covered cells touched (the old
+ !! whole-coarse device push clobbered non-covered cells). Same child-sum order (ddk, ddj, then fi0 and fi0+1; /nchild; stp cast)
+ !! as the old host restrict path, so bit-identical to it on CPU and matches the coarse restriction. q_fine (== the flat store)
+ !! and coarse_tgt are device-resident. TWIN: s_amr_restrict_pack_device runs this same child-sum into a wire buffer - any change
+ !! to the loop order, arithmetic, or casts here must be mirrored there byte-identically (owner-local and scattered coarse cells
+ !! must match bit-for-bit). TWIN(q<->pb/mv) s_amr_restrict_pbmv_box_device runs this same child-sum on pb/mv - keep the stencil
+ !! lockstep. Two targets, one body: the coarse destination is the level-0 monolithic field (`_sf`) or a parent BLOCK in the flat
+ !! store (`_st`); the fine source is always a block, so it is always the store.
+ #:for SFX, CT in [('sf', ''), ('st', 'amr_cons_st')]
+ #:set CW = (lambda ix: CT + '(ci - o1, cj - o2, ck - o3, ' + ix + ', ctloc)') if CT else (lambda ix: 'coarse_tgt(' + ix &
+ & + ')%sf(ci - o1, cj - o2, ck - o3)')
+ impure subroutine s_amr_restrict_overwrite_device_${SFX}$(${'ctloc' if CT else 'coarse_tgt'}$, loc, bl, bh, o1, o2, o3, &
+ & rlo, rr, dj_hi, dk_hi, nchild)
+
+ #:if CT
+ integer, intent(in) :: ctloc
+ #:else
+ type(scalar_field), dimension(sys_size), intent(inout) :: coarse_tgt
+ #:endif
+ integer, intent(in) :: loc
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3, rlo(3), rr, dj_hi, dk_hi, nchild
+ integer :: i, ci, cj, ck, fi0, fj0, fk0, ddi, ddj, ddk, bl1, bl2, bl3, bh1, bh2, bh3, rl1, rl2, rl3
+ real(wp) :: acc, wacc, w
+
+ bl1 = bl(1); bl2 = bl(2); bl3 = bl(3); bh1 = bh(1); bh2 = bh(2); bh3 = bh(3)
+ rl1 = rlo(1); rl2 = rlo(2); rl3 = rlo(3)
+ if (cyl_coord) then
+ ! axisymmetric volume-weighted fold-back: weight each fine child by its cell-center radius (amr_rvw = fine y_cc, on
+ ! device). Same child order as the Cartesian path and the scatter pack, so CPU==GPU and np=1==np>=2.
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[fi0, fj0, fk0, ddi, ddj, ddk, acc, wacc, w]')
+ do i = 1, sys_size
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ fi0 = (ci - rl1)*rr; fj0 = (cj - rl2)*rr; fk0 = (ck - rl3)*rr
+ acc = 0._wp; wacc = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ w = amr_rvw(fj0 + ddj)
+ do ddi = 0, rr - 1
+ acc = acc + real(amr_cons_st(fi0 + ddi, fj0 + ddj, fk0 + ddk, i, loc), wp)*w
+ wacc = wacc + w
+ end do
+ end do
+ end do
+ ${CW('i')}$ = real(acc/wacc, stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ return
+ end if
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[fi0, fj0, fk0, ddi, ddj, ddk, acc]')
+ do i = 1, sys_size
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ fi0 = (ci - rl1)*rr; fj0 = (cj - rl2)*rr; fk0 = (ck - rl3)*rr
+ acc = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ do ddi = 0, rr - 1
+ acc = acc + real(amr_cons_st(fi0 + ddi, fj0 + ddj, fk0 + ddk, i, loc), wp)
+ end do
+ end do
+ end do
+ ${CW('i')}$ = real(acc/real(nchild, wp), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_restrict_overwrite_device_${SFX}$
+ #:endfor
+
+ !> Device pack of one destination's covered restrict slice (np>=2 scatter): restrict the fine block q_fine (DEVICE) over the
+ !! covered coarse box [bl:bh] GLOBAL straight into the contiguous wire buffer buf (host, via copyout) - only the slice crosses
+ !! PCIe, not the full fine field. Same child-sum order and wp values as s_amr_restrict_overwrite_device (no stp cast: the wire
+ !! carries wp and the receiver casts), packed with ci fastest, then cj, ck, i, matching the receiver's sequential unpack. TWIN:
+ !! s_amr_restrict_overwrite_device runs this same child-sum in place - any change to the loop order, arithmetic, or casts here
+ !! must be mirrored there byte-identically (owner-local and scattered coarse cells must match bit-for-bit). TWIN(q<->pb/mv)
+ !! s_amr_restrict_pbmv_pack_device runs this same child-sum into a wire buffer - keep lockstep.
+ impure subroutine s_amr_restrict_pack_device(loc, bl, bh, rlo, rr, dj_hi, dk_hi, nchild, buf)
+
+ integer, intent(in) :: loc
+ integer, intent(in) :: bl(3), bh(3), rlo(3), rr, dj_hi, dk_hi, nchild
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: i, ci, cj, ck, fi0, fj0, fk0, ddi, ddj, ddk, bl1, bl2, bl3, bh1, bh2, bh3, rl1, rl2, rl3, n1, n2, n3
+ real(wp) :: acc, wacc, w
+
+ bl1 = bl(1); bl2 = bl(2); bl3 = bl(3); bh1 = bh(1); bh2 = bh(2); bh3 = bh(3)
+ rl1 = rlo(1); rl2 = rlo(2); rl3 = rlo(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ if (cyl_coord) then
+ ! axisymmetric volume-weighted pack (amr_rvw = fine y_cc, on device); same child order as the overwrite kernel
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[fi0, fj0, fk0, ddi, ddj, ddk, acc, wacc, w]', copyout='[buf]')
+ do i = 1, sys_size
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ fi0 = (ci - rl1)*rr; fj0 = (cj - rl2)*rr; fk0 = (ck - rl3)*rr
+ acc = 0._wp; wacc = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ w = amr_rvw(fj0 + ddj)
+ do ddi = 0, rr - 1
+ acc = acc + real(amr_cons_st(fi0 + ddi, fj0 + ddj, fk0 + ddk, i, loc), wp)*w
+ wacc = wacc + w
+ end do
+ end do
+ end do
+ buf(1 + (ci - bl1) + n1*((cj - bl2) + n2*((ck - bl3) + n3*(i - 1)))) = acc/wacc
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ return
+ end if
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[fi0, fj0, fk0, ddi, ddj, ddk, acc]', copyout='[buf]')
+ do i = 1, sys_size
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ fi0 = (ci - rl1)*rr; fj0 = (cj - rl2)*rr; fk0 = (ck - rl3)*rr
+ acc = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ do ddi = 0, rr - 1
+ acc = acc + real(amr_cons_st(fi0 + ddi, fj0 + ddj, fk0 + ddk, i, loc), wp)
+ end do
+ end do
+ end do
+ buf(1 + (ci - bl1) + n1*((cj - bl2) + n2*((ck - bl3) + n3*(i - 1)))) = acc/real(nchild, wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_restrict_pack_device
+
+ !> Apply phase-change relaxation (relax) to the current fine block's interior, BEFORE restriction. Relaxation is a cell-local,
+ !! mass/energy-conserving equilibration (no stencil, no ghosts), so it needs no coarse/fine coupling: it just runs over the fine
+ !! interior. Swaps m/n/p to the fine extents so s_infinite_relaxation_k's 0:m,0:n,0:p loop covers this block. Matches the coarse
+ !! timing (once per full step; the coarse relax runs once after s_tvd_rk on q_cons_ts(1)) but on the fine solution so the fine
+ !! dynamics equilibrate at fine resolution, not only the restricted coarse average.
+ impure subroutine s_amr_relax_fine()
+
+ if (.not. amr_rank_owns_block) return
+ call s_amr_swap_to_fine()
+ call s_amr_br_load(amr_loc_of(amr_cur))
+ call s_infinite_relaxation_k(amr_cons_br)
+ call s_amr_br_store(amr_loc_of(amr_cur))
+ call s_amr_restore_coarse()
+
+ end subroutine s_amr_relax_fine
+
+ !> 6-equation model: apply the per-stage pressure relaxation to the fine block's interior (cell-local equilibration, no
+ !! stencil), mirroring the coarse per-stage call. Swaps the grid so the routine's 0:m,0:n,0:p loop covers this block.
+ impure subroutine s_amr_pressure_relax_fine()
+
+ if (.not. amr_rank_owns_block) return
+ call s_amr_swap_to_fine()
+ call s_amr_br_load(amr_loc_of(amr_cur))
+ call s_pressure_relaxation_procedure(amr_cons_br)
+ call s_amr_br_store(amr_loc_of(amr_cur))
+ call s_amr_restore_coarse()
+
+ end subroutine s_amr_pressure_relax_fine
+
+ !> Compute the fine-grid IB state (markers/ghost points/levelset) for every active block from the body geometry (static-body
+ !! AMR). Called once after the coarse IB setup at init (regrid+IB is gated). Per slot with fine cells: swap the grid to the fine
+ !! block, swap the IB globals to the slot store, run the fine IB pipeline (writing into the slot store), restore. No-op unless
+ !! amr .and. ib.
+ impure subroutine s_amr_setup_ib()
+
+ integer :: islot, save_cur
+ integer(kind=8) :: my_ib_gps, nrank_ib
+
+ if (.not. amr .or. .not. ib) return
+ save_cur = amr_cur
+ my_ib_gps = 0_8
+ do islot = 1, amr_num_blocks
+ call s_amr_select_slot(islot)
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_swap_to_fine()
+ call s_ibm_swap_to_fine(islot, gps_on_device=.false.)
+ call s_ibm_setup_fine()
+ my_ib_gps = my_ib_gps + int(num_gps, 8)
+ call s_ibm_restore_from_fine(islot)
+ call s_amr_restore_coarse()
+ end do
+ call s_amr_select_slot(save_cur)
+
+ ! The fine-IB image-point stencil is not decomposition-exact across a rank seam. If the body's fine ghost points appear on
+ ! more than one rank (the body straddles a coarse/fine rank boundary), abort rather than return a wrong body-surface state.
+ ! A
+ ! body wholly within one rank is decomposition-exact.
+ call s_mpi_allreduce_integer_sum(merge(1_8, 0_8, my_ib_gps > 0_8), nrank_ib)
+ if (nrank_ib > 1_8) then
+ call s_mpi_abort('amr with ib: the immersed body straddles a rank boundary, where the ' &
+ & // 'fine-IB image-point stencil is not yet decomposition-exact; keep the ' &
+ & // 'body within a single rank subdomain (use fewer ranks or reposition it).')
+ end if
+
+ end subroutine s_amr_setup_ib
+
+ !> Apply the IB state correction on the current fine block after its RK update (static-body AMR). Mirrors the coarse per-stage
+ !! s_ibm_correct_state: swap the grid + IB globals to the fine block, correct q_cons/q_prim at the fine body/ghost cells,
+ !! restore. amr_cur / amr_rank_owns_block are set by the caller (the per-block advance loop). No-op unless ib.
+ impure subroutine s_amr_ib_correct_fine(q_prim_b)
+
+ !> the q_prim the block's RHS pass filled (pooled scratch for fine blocks; per-slot for L0 tiles, where other tiles' RHS
+ !! work ran in between - ib is in the copy-out gate, so a tile slot always has its own q_prim when this reads it)
+ type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_b
+
+ if (.not. ib) return
+ if (.not. amr_rank_owns_block) return
+ call s_amr_swap_to_fine()
+ call s_ibm_swap_to_fine(amr_cur, gps_on_device=.true.)
+ call s_amr_br_load(amr_loc_of(amr_cur))
+ if (qbmm .and. .not. polytropic) then
+ ! mirror the coarse correct-state: non-polytropic QBMM also corrects the block's own pb/mv side-state at the body ghost
+ ! points (bounds match the swapped fine idwbuff)
+ call s_ibm_correct_state(amr_cons_br, q_prim_b, amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf)
+ else
+ call s_ibm_correct_state(amr_cons_br, q_prim_b)
+ end if
+ call s_amr_br_store(amr_loc_of(amr_cur))
+ call s_ibm_restore_from_fine(amr_cur)
+ call s_amr_restore_coarse()
+
+ end subroutine s_amr_ib_correct_fine
+
+ !> Rebuild the current fine block's IB state (markers/ghost points/image points) from the moving body's position (prescribed
+ !! motion, moving_ibm==1). Reuses the coarse s_update_mib recompute on the swapped-in fine slot (grid + IB globals swapped to
+ !! the fine block, recompute writes into the slot store, restore). For the subcycled advance pass th in [0,1], the fine
+ !! substep's fraction of the coarse step: s_update_mib snapshots the body to the linear time interpolation between the coarse
+ !! t^n and t^{n+1} positions, the same interpolation the subcycle applies to the fluid ghost shell. Pass th < 0 for the
+ !! non-subcycled lockstep stage (uses the body's current position). No-op unless ib. Must precede s_amr_ib_correct_fine.
+ impure subroutine s_amr_update_mib_fine(th)
+
+ real(wp), intent(in) :: th
+ integer :: i, blo(3), bhi(3)
+ logical :: ovl, inside
+
+ if (.not. ib) return
+ if (.not. amr_rank_owns_block) return
+ ! A moving body must stay inside its block (a body overlapping the block edge gets silently clipped forcing - abort
+ ! instead).
+ ! Under dynamic regrid the expansion contained it with margin max(amr_buf,4) and we require body + image-point stencil reach
+ ! (2 coarse cells) to remain contained between regrids; on a STATIC block the user's placement is authoritative (validated
+ ! configs sit tighter than the regrid margin), so only the body bbox itself must stay inside. Consecutive contained
+ ! positions keep every sub-time interpolate contained (axis-aligned boxes are convex in the linearly-moving corners).
+ if (any(patch_ib(1:num_ibs)%moving_ibm /= 0)) then
+ do i = 1, num_ibs
+ if (patch_ib(i)%moving_ibm == 0) cycle
+ call s_amr_body_bbox(i, merge(2, 0, amr_regrid_int > 0), blo, bhi)
+ ovl = blo(1) <= amr_slots(amr_cur)%region%hi(1) .and. bhi(1) >= amr_slots(amr_cur)%region%lo(1)
+ if (n_glb > 0) ovl = ovl .and. blo(2) <= amr_slots(amr_cur)%region%hi(2) .and. bhi(2) &
+ & >= amr_slots(amr_cur)%region%lo(2)
+ if (p_glb > 0) ovl = ovl .and. blo(3) <= amr_slots(amr_cur)%region%hi(3) .and. bhi(3) &
+ & >= amr_slots(amr_cur)%region%lo(3)
+ if (.not. ovl) cycle
+ inside = blo(1) >= amr_slots(amr_cur)%region%lo(1) .and. bhi(1) <= amr_slots(amr_cur)%region%hi(1)
+ if (n_glb > 0) inside = inside .and. blo(2) >= amr_slots(amr_cur)%region%lo(2) .and. bhi(2) &
+ & <= amr_slots(amr_cur)%region%hi(2)
+ if (p_glb > 0) inside = inside .and. blo(3) >= amr_slots(amr_cur)%region%lo(3) .and. bhi(3) &
+ & <= amr_slots(amr_cur)%region%hi(3)
+ if (.not. inside) then
+ call s_mpi_abort('amr with moving ib: the body reached the fine-block boundary; ' &
+ & // 'under dynamic regrid reduce amr_regrid_int or increase amr_buf, ' &
+ & // 'for a static block enlarge it to contain the trajectory')
+ end if
+ end do
+ end if
+ call s_amr_swap_to_fine()
+ call s_ibm_swap_to_fine(amr_cur, gps_on_device=.true.)
+ call s_update_mib(num_ibs, th)
+ call s_ibm_restore_from_fine(amr_cur)
+ call s_amr_restore_coarse()
+
+ end subroutine s_amr_update_mib_fine
+
+ !> Non-polytropic QBMM: piecewise-constant prolongation of the block's pb/mv interior from the gathered coarse side-state
+ !! amr_cg_pb/mv (patch-local frame; the callers run s_amr_gather_coarse_patch_pbmv on ALL ranks first, so np>=2 couples to the
+ !! correct coarse rank). HOST loops + device push; the gather is host-current (.not. pull_host). TWIN
+ !! s_interpolate_coarse_to_fine (pb/mv<->q): pb/mv is piecewise-constant where q_cons is minmod-limited, but the child-offset
+ !! frame and realizability/closure policy track it; keep those lockstep.
+ impure subroutine s_amr_prolong_pbmv()
+
+ integer :: fi, fj, fk, q, ib_, ci, cj, ck, rr, lo1, lo2, lo3, ox, oy, oz
+
+ ! HOST prolongation (both call paths make the coarse pb/mv host mirrors current first: init writes them on the host, regrid
+ ! refreshes them from the device); the device copy of the fine side-state is pushed at the end
+
+ ! coarse pb/mv are read from the gathered block-local patch amr_cg_pb/mv (fine-level distribution): patch-local frame, cell
+ ! 0
+ ! == amr_cpat_off (matching s_prolong_one_var). The gather is a host loop (.not. pull_host) done by the callers.
+
+ ox = amr_cpat_off(1); oy = amr_cpat_off(2); oz = amr_cpat_off(3)
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ lo1 = amr_isect_lo(1); lo2 = amr_isect_lo(2); lo3 = amr_isect_lo(3)
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do fk = 0, amr_slots(amr_cur)%p
+ ck = 0
+ if (p_glb > 0) ck = lo3 + fk/rr - oz
+ do fj = 0, amr_slots(amr_cur)%n
+ cj = 0
+ if (n_glb > 0) cj = lo2 + fj/rr - oy
+ do fi = 0, amr_slots(amr_cur)%m
+ ci = lo1 + fi/rr - ox
+ amr_slots(amr_cur)%pb_f%sf(fi, fj, fk, q, ib_) = amr_cg_pb(ci, cj, ck, q, ib_)
+ amr_slots(amr_cur)%mv_f%sf(fi, fj, fk, q, ib_) = amr_cg_mv(ci, cj, ck, q, ib_)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:GPU_UPDATE(device='[amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf]')
+
+ end subroutine s_amr_prolong_pbmv
+
+ !> Non-polytropic QBMM: piecewise-constant prolongation of the fine pb/mv GHOST shell from the coarse side-state (device kernel;
+ !! interior untouched). The ghosts feed the widened-idwint conversions and the qbmm rhs over the shell, mirroring the q_cons
+ !! ghost fill. All four arrays are assumed-shape dummies with %sf pointer-member actuals (the device-proven pb_ts pattern); only
+ !! raw derived-type 5D members as actuals tripped nvfortran's component-section data clauses on device. TWIN
+ !! s_amr_fill_fine_ghosts (pb/mv<->q): q_cons sibling; keep the ghost-fill mapping lockstep.
+ impure subroutine s_amr_fill_fine_ghosts_pbmv(pb_c, mv_c, pb_t, mv_t)
+
+ !> coarse pb/mv read from the gathered block-local patch amr_cg_pb/mv (0-based patch frame, cell 0 == amr_cpat_off): the
+ !! callers run s_amr_gather_coarse_patch_pbmv on ALL ranks first, so np>=2 reads the correct coarse rank's side-state
+ real(stp), dimension(0:,0:,0:,1:,1:), intent(in) :: pb_c, mv_c
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_t, mv_t
+ integer :: fi, fj, fk, q, ib_, ci, cj, ck, rr, lo1, lo2, lo3, ox, oy, oz
+ integer :: s, ns, l1, u1, l2, u2, l3, u3, ss, g, r, n1, n2, stot
+ integer, dimension(6) :: sb1, se1, sb2, se2, sb3, se3, soff, scnt
+ logical :: d2, d3
+
+ ox = amr_cpat_off(1); oy = amr_cpat_off(2); oz = amr_cpat_off(3)
+ d2 = n_glb > 0; d3 = p_glb > 0
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ lo1 = amr_isect_lo(1); lo2 = amr_isect_lo(2); lo3 = amr_isect_lo(3)
+ call s_amr_build_ghost_slabs(ns, sb1, se1, sb2, se2, sb3, se3)
+ ! flat index over the concatenated DISJOINT slabs - one kernel instead of ns; see s_amr_fill_fine_ghosts
+ soff(1) = 0
+ do s = 1, ns
+ scnt(s) = (se1(s) - sb1(s) + 1)*(se2(s) - sb2(s) + 1)*(se3(s) - sb3(s) + 1)
+ if (s < ns) soff(s + 1) = soff(s) + scnt(s)
+ end do
+ stot = soff(ns) + scnt(ns)
+ $:GPU_PARALLEL_LOOP(collapse=3, copyin='[sb1, se1, sb2, se2, sb3, se3, soff, scnt]', private='[s, ss, r, n1, n2, fi, fj, &
+ & fk, ci, cj, ck]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g = 0, stot - 1
+ s = 1
+ do ss = 2, ns
+ if (g >= soff(ss)) s = ss
+ end do
+ r = g - soff(s)
+ n1 = se1(s) - sb1(s) + 1; n2 = se2(s) - sb2(s) + 1
+ fi = sb1(s) + mod(r, n1)
+ fj = sb2(s) + mod(r/n1, n2)
+ fk = sb3(s) + r/(n1*n2)
+ ck = 0
+ if (d3) ck = lo3 + floor(real(fk, wp)/real(rr, wp)) - oz
+ cj = 0
+ if (d2) cj = lo2 + floor(real(fj, wp)/real(rr, wp)) - oy
+ ci = lo1 + floor(real(fi, wp)/real(rr, wp)) - ox
+ pb_t(fi, fj, fk, q, ib_) = pb_c(ci, cj, ck, q, ib_)
+ mv_t(fi, fj, fk, q, ib_) = mv_c(ci, cj, ck, q, ib_)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_fill_fine_ghosts_pbmv
+
+ !> Non-polytropic QBMM: device copy of the block's pb/mv into the step-entry backup (SSP-RK). TWIN s_amr_copy_fine_fields
+ !! (pb/mv<->q): q_cons sibling of this step-entry backup; keep lockstep.
+ impure subroutine s_amr_backup_pbmv(pb_s, mv_s, pb_d, mv_d)
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pb_s, mv_s
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_d, mv_d
+ integer :: fi, fj, fk, q, ib_, b1, e1, b2, e2, b3, e3
+
+ b1 = amr_slots(amr_cur)%idwbuff(1)%beg; e1 = amr_slots(amr_cur)%idwbuff(1)%end
+ b2 = amr_slots(amr_cur)%idwbuff(2)%beg; e2 = amr_slots(amr_cur)%idwbuff(2)%end
+ b3 = amr_slots(amr_cur)%idwbuff(3)%beg; e3 = amr_slots(amr_cur)%idwbuff(3)%end
+ $:GPU_PARALLEL_LOOP(collapse=5)
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do fk = b3, e3
+ do fj = b2, e2
+ do fi = b1, e1
+ pb_d(fi, fj, fk, q, ib_) = pb_s(fi, fj, fk, q, ib_)
+ mv_d(fi, fj, fk, q, ib_) = mv_s(fi, fj, fk, q, ib_)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_backup_pbmv
+
+ !> Non-polytropic QBMM: SSP-RK stage update of the block's pb/mv (device kernel, interior only; mirror of the coarse pb_ts/mv_ts
+ !! stage combination in m_time_steppers). TWIN s_amr_fine_rk_update + s_tvd_rk (m_time_steppers): same SSP-RK stage combination
+ !! on pb/mv; keep all three lockstep.
+ impure subroutine s_amr_fine_rk_update_pbmv(pb_u, mv_u, pb_s, mv_s, rpb, rmv, c1, c2, c3, c4, dtl)
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_u, mv_u
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pb_s, mv_s
+ real(wp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: rpb, rmv
+ real(wp), intent(in) :: c1, c2, c3, c4, dtl
+ integer :: fi, fj, fk, q, ib_, fm, fn, fp
+
+ fm = amr_slots(amr_cur)%m; fn = amr_slots(amr_cur)%n; fp = amr_slots(amr_cur)%p
+ $:GPU_PARALLEL_LOOP(collapse=5)
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do fk = 0, fp
+ do fj = 0, fn
+ do fi = 0, fm
+ pb_u(fi, fj, fk, q, ib_) = (c1*pb_u(fi, fj, fk, q, ib_) + c2*pb_s(fi, fj, fk, q, &
+ & ib_) + c3*dtl*rpb(fi, fj, fk, q, ib_))/c4
+ mv_u(fi, fj, fk, q, ib_) = (c1*mv_u(fi, fj, fk, q, ib_) + c2*mv_s(fi, fj, fk, q, &
+ & ib_) + c3*dtl*rmv(fi, fj, fk, q, ib_))/c4
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_fine_rk_update_pbmv
+
+ !> Non-polytropic QBMM: volume-weighted restriction of the block's pb/mv onto the coarse side-state under the block (device
+ !! kernel; same equal-weight child average as the q_cons restrict).
+ impure subroutine s_restrict_pbmv(pb_c, mv_c, pb_fin, mv_fin)
+
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_c, mv_c
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pb_fin, mv_fin
+ integer :: ci, cj, ck, q, ib_, fi0, fj0, fk0, ddi, ddj, ddk, nchild, ox, oy, oz, rr
+ integer :: c1lo, c1hi, c2lo, c2hi, c3lo, c3hi, dj_hi, dk_hi
+ real(wp) :: accp, accm
+
+ ox = start_idx(1); oy = 0; oz = 0
+ if (n_glb > 0) oy = start_idx(2)
+ if (p_glb > 0) oz = start_idx(3)
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ nchild = rr
+ if (n_glb > 0) nchild = nchild*rr
+ if (p_glb > 0) nchild = nchild*rr
+ c1lo = amr_isect_lo(1); c1hi = amr_isect_hi(1)
+ c2lo = amr_isect_lo(2); c2hi = merge(amr_isect_hi(2), amr_isect_lo(2), n_glb > 0)
+ c3lo = amr_isect_lo(3); c3hi = merge(amr_isect_hi(3), amr_isect_lo(3), p_glb > 0)
+ dj_hi = merge(rr - 1, 0, n_glb > 0); dk_hi = merge(rr - 1, 0, p_glb > 0)
+ $:GPU_PARALLEL_LOOP(collapse=5, private='[fi0, fj0, fk0, ddi, accp, accm, ddj, ddk]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do ck = c3lo, c3hi
+ do cj = c2lo, c2hi
+ do ci = c1lo, c1hi
+ fi0 = (ci - c1lo)*rr; fj0 = (cj - c2lo)*rr; fk0 = (ck - c3lo)*rr
+ accp = 0._wp; accm = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ do ddi = 0, rr - 1
+ accp = accp + real(pb_fin(fi0 + ddi, fj0 + ddj, fk0 + ddk, q, ib_), wp)
+ accm = accm + real(mv_fin(fi0 + ddi, fj0 + ddj, fk0 + ddk, q, ib_), wp)
+ end do
+ end do
+ end do
+ pb_c(ci - ox, cj - oy, ck - oz, q, ib_) = accp/real(nchild, wp)
+ mv_c(ci - ox, cj - oy, ck - oz, q, ib_) = accm/real(nchild, wp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_restrict_pbmv
+
+ !> Non-polytropic QBMM np>=2: DEVICE restriction of pb/mv over the covered box [bl:bh] GLOBAL into pb_c/mv_c (device), fine
+ !! origin (ci-rlo)*rr, LOCAL coarse index cell - o. Only the covered cells the owner holds are touched (no whole-array push -
+ !! same GPU-only clobber the q_cons device overwrite avoids). Same child-sum as s_restrict_pbmv. TWIN:
+ !! s_amr_restrict_pbmv_pack_device runs this same child-sum into a wire buffer - any change to the loop order, arithmetic, or
+ !! casts here must be mirrored there byte-identically (local and scattered coarse pb/mv must match bit-for-bit). TWIN(pb/mv<->q)
+ !! s_amr_restrict_overwrite_device is the q_cons sibling of this child-sum - keep the stencil lockstep.
+ impure subroutine s_amr_restrict_pbmv_box_device(pb_c, mv_c, pb_fin, mv_fin, bl, bh, o1, o2, o3, rlo, rr, dj_hi, dk_hi, nchild)
+
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_c, mv_c
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pb_fin, mv_fin
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3, rlo(3), rr, dj_hi, dk_hi, nchild
+ integer :: ci, cj, ck, q, ib_, fi0, fj0, fk0, ddi, ddj, ddk, bl1, bl2, bl3, bh1, bh2, bh3, rl1, rl2, rl3
+ real(wp) :: accp, accm
+
+ bl1 = bl(1); bl2 = bl(2); bl3 = bl(3); bh1 = bh(1); bh2 = bh(2); bh3 = bh(3)
+ rl1 = rlo(1); rl2 = rlo(2); rl3 = rlo(3)
+ $:GPU_PARALLEL_LOOP(collapse=5, private='[fi0, fj0, fk0, ddi, accp, accm, ddj, ddk]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ fi0 = (ci - rl1)*rr; fj0 = (cj - rl2)*rr; fk0 = (ck - rl3)*rr
+ accp = 0._wp; accm = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ do ddi = 0, rr - 1
+ accp = accp + real(pb_fin(fi0 + ddi, fj0 + ddj, fk0 + ddk, q, ib_), wp)
+ accm = accm + real(mv_fin(fi0 + ddi, fj0 + ddj, fk0 + ddk, q, ib_), wp)
+ end do
+ end do
+ end do
+ pb_c(ci - o1, cj - o2, ck - o3, q, ib_) = real(accp/real(nchild, wp), stp)
+ mv_c(ci - o1, cj - o2, ck - o3, q, ib_) = real(accm/real(nchild, wp), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_restrict_pbmv_box_device
+
+ !> Non-polytropic QBMM np>=2 scatter pack: DEVICE restriction of pb/mv over the covered box [bl:bh] GLOBAL straight into the
+ !! contiguous wire buffer buf (host, via copyout; pb block then mv block, ci fastest) - only the slice crosses PCIe, not the
+ !! full fine side-state. Same child-sum as s_amr_restrict_pbmv_box_device; the wire carries wp and the receiver casts to stp.
+ !! TWIN: s_amr_restrict_pbmv_box_device runs this same child-sum in place - any change to the loop order, arithmetic, or casts
+ !! here must be mirrored there byte-identically (local and scattered coarse pb/mv must match bit-for-bit). TWIN(pb/mv<->q)
+ !! s_amr_restrict_pack_device is the q_cons sibling of this packed child-sum - keep lockstep.
+ impure subroutine s_amr_restrict_pbmv_pack_device(pb_fin, mv_fin, bl, bh, rlo, rr, dj_hi, dk_hi, nchild, buf)
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pb_fin, mv_fin
+ integer, intent(in) :: bl(3), bh(3), rlo(3), rr, dj_hi, dk_hi, nchild
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: ci, cj, ck, q, ib_, fi0, fj0, fk0, ddi, ddj, ddk, bl1, bl2, bl3, bh1, bh2, bh3, rl1, rl2, rl3
+ integer :: n1, n2, n3, half
+ real(wp) :: accp, accm
+
+ bl1 = bl(1); bl2 = bl(2); bl3 = bl(3); bh1 = bh(1); bh2 = bh(2); bh3 = bh(3)
+ rl1 = rlo(1); rl2 = rlo(2); rl3 = rlo(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ half = n1*n2*n3*nnode*nb
+ $:GPU_PARALLEL_LOOP(collapse=5, private='[fi0, fj0, fk0, ddi, ddj, ddk, accp, accm]', copyout='[buf]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ fi0 = (ci - rl1)*rr; fj0 = (cj - rl2)*rr; fk0 = (ck - rl3)*rr
+ accp = 0._wp; accm = 0._wp
+ do ddk = 0, dk_hi
+ do ddj = 0, dj_hi
+ do ddi = 0, rr - 1
+ accp = accp + real(pb_fin(fi0 + ddi, fj0 + ddj, fk0 + ddk, q, ib_), wp)
+ accm = accm + real(mv_fin(fi0 + ddi, fj0 + ddj, fk0 + ddk, q, ib_), wp)
+ end do
+ end do
+ end do
+ buf(1 + (ci - bl1) + n1*((cj - bl2) + n2*((ck - bl3) + n3*((q - 1) + nnode*(ib_ - 1))))) &
+ & = accp/real(nchild, wp)
+ buf(half + 1 + (ci - bl1) + n1*((cj - bl2) + n2*((ck - bl3) + n3*((q - 1) + nnode*(ib_ - 1))))) &
+ & = accm/real(nchild, wp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_restrict_pbmv_pack_device
+
+ !> Device unpack of a received pb/mv covered slice into the coarse fields - exact inverse of s_amr_restrict_pbmv_pack_device's
+ !! wire layout (ci fastest, then cj, ck, q, ib_, all of pb followed by all of mv). Unpacking on the DEVICE is required, not a
+ !! convenience: a host unpack plus a strided GPU_UPDATE(device=) of the covered box is miscopied as a contiguous run - see the
+ !! note at the q_cons unpack in s_restrict_fine_to_coarse, of which this is the pb/mv twin.
+ impure subroutine s_amr_restrict_pbmv_unpack_device(pb_c, mv_c, bl, bh, o1, o2, o3, buf)
+
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_c, mv_c
+ integer, intent(in) :: bl(3), bh(3), o1, o2, o3
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: ci, cj, ck, q, ib_, bl1, bl2, bl3, bh1, bh2, bh3, n1, n2, n3, half
+
+ bl1 = bl(1); bl2 = bl(2); bl3 = bl(3); bh1 = bh(1); bh2 = bh(2); bh3 = bh(3)
+ n1 = bh1 - bl1 + 1; n2 = bh2 - bl2 + 1; n3 = bh3 - bl3 + 1
+ half = n1*n2*n3*nnode*nb
+ $:GPU_PARALLEL_LOOP(collapse=5, copyin='[buf]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do ck = bl3, bh3
+ do cj = bl2, bh2
+ do ci = bl1, bh1
+ pb_c(ci - o1, cj - o2, ck - o3, q, &
+ & ib_) = real(buf(1 + (ci - bl1) + n1*((cj - bl2) + n2*((ck - bl3) + n3*((q - 1) + nnode*(ib_ &
+ & - 1))))), stp)
+ mv_c(ci - o1, cj - o2, ck - o3, q, &
+ & ib_) = real(buf(half + 1 + (ci - bl1) + n1*((cj - bl2) + n2*((ck - bl3) + n3*((q - 1) &
+ & + nnode*(ib_ - 1))))), stp)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_restrict_pbmv_unpack_device
+
+ !> Non-polytropic QBMM: distributed fine->coarse fold-back of the block's pb/mv onto the coarse side-state pb_ts/mv_ts,
+ !! mirroring the q_cons scatter in s_restrict_fine_to_coarse. The owner restricts the covered cells it holds (device, owned box)
+ !! and SENDS each other coarse-owner its covered pb/mv slice (device-packed averages, pb block then mv block); that owner
+ !! overwrites its local coarse. Called on ALL ranks at np>=2 (owner/non-owner split inside) so the P2P send/recv pair up; np=1
+ !! is handled locally by the direct s_restrict_pbmv call (this routine is reached only when num_procs > 1). TWIN
+ !! s_restrict_fine_to_coarse (scatter half, pb/mv<->q): same scatter skeleton (owner sends covered coarse slices, each
+ !! coarse-owner overwrites its local cells) - keep lockstep.
+ impure subroutine s_amr_scatter_pbmv(pb_fin, mv_fin)
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pb_fin, mv_fin
+ integer :: nchild, rr, dj_hi, dk_hi, o1, o2, o3, owner, r, idx, boxsz, maxsz, nsrc, ierr, cellsz
+ integer :: rlo(3), rhi(3), ilo(3), ihi(3), bl(3), bh(3)
+ real(wp), allocatable :: sbuf(:,:), rbuf(:)
+ integer, allocatable :: reqs(:), drank(:)
+
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ nchild = rr; if (n_glb > 0) nchild = nchild*rr; if (p_glb > 0) nchild = nchild*rr
+ dj_hi = merge(rr - 1, 0, n_glb > 0); dk_hi = merge(rr - 1, 0, p_glb > 0)
+ cellsz = 2*nnode*nb
+ rlo = 0; rhi = 0
+ rlo(1) = amr_region_lo_all(1, amr_cur); rhi(1) = amr_region_hi_all(1, amr_cur)
+ if (n_glb > 0) then; rlo(2) = amr_region_lo_all(2, amr_cur); rhi(2) = amr_region_hi_all(2, amr_cur); end if
+ if (p_glb > 0) then; rlo(3) = amr_region_lo_all(3, amr_cur); rhi(3) = amr_region_hi_all(3, amr_cur); end if
+ owner = amr_block_owner(amr_cur)
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ maxsz = cellsz*(rhi(1) - rlo(1) + 1)*(rhi(2) - rlo(2) + 1)*(rhi(3) - rlo(3) + 1)
+
+ ! block set changed: rebuild the cached overlap-rank lists (same lazy trigger as s_amr_fine_fine_halo; local, replicated)
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+
+ if (proc_rank == owner) then
+ ! overwrite the covered cells this rank owns (device, owned box), then send each other coarse-owner its covered slice
+ call s_amr_rank_interior(proc_rank, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) call s_amr_restrict_pbmv_box_device(pb_ts(1)%sf, &
+ & mv_ts(1)%sf, pb_fin, mv_fin, bl, bh, o1, o2, o3, rlo, rr, dj_hi, dk_hi, nchild)
+ ! cached destination list (every listed rank's interior overlaps the region by construction)
+ nsrc = 0
+ do idx = 1, amr_ovl_scatter_n(amr_cur)
+ if (amr_ovl_scatter(idx, amr_cur) /= owner) nsrc = nsrc + 1
+ end do
+ if (nsrc > 0) then
+ allocate (sbuf(maxsz, nsrc), reqs(nsrc), drank(nsrc))
+ nsrc = 0
+ do idx = 1, amr_ovl_scatter_n(amr_cur)
+ r = amr_ovl_scatter(idx, amr_cur)
+ if (r == owner) cycle
+ call s_amr_rank_interior(r, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ nsrc = nsrc + 1; drank(nsrc) = r
+ boxsz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ ! pack this destination's covered pb/mv slice on the DEVICE (restrict averages straight into the wire
+ ! buffer, same child-sum as the device overwrite above) - no full-field fine host pull
+ call s_amr_restrict_pbmv_pack_device(pb_fin, mv_fin, bl, bh, rlo, rr, dj_hi, dk_hi, nchild, sbuf(1:boxsz,nsrc))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_F7C_SND, 1, boxsz, amr_cur)
+ call MPI_ISEND(sbuf(1, nsrc), boxsz, mpi_p, r, amr_cur, MPI_COMM_WORLD, reqs(nsrc), ierr)
+#endif
+ end do
+#ifdef MFC_MPI
+ call MPI_WAITALL(nsrc, reqs, MPI_STATUSES_IGNORE, ierr)
+#endif
+ deallocate (sbuf, reqs, drank)
+ end if
+ else
+ ! coarse-owner: if I hold covered cells, receive my pb/mv slice from the owner and overwrite my local coarse
+ call s_amr_rank_interior(proc_rank, ilo, ihi)
+ call s_amr_box_isect(rlo, rhi, ilo, ihi, bl, bh)
+ if (bl(1) <= bh(1) .and. bl(2) <= bh(2) .and. bl(3) <= bh(3)) then
+ boxsz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ allocate (rbuf(boxsz))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_F7C_RCV, 2, boxsz, amr_cur)
+ call MPI_RECV(rbuf, boxsz, mpi_p, owner, amr_cur, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ ! DEVICE unpack, writing only the covered cells (a whole-array push would clobber device-advanced non-covered
+ ! coarse cells with this rank's stale host copy)
+ call s_amr_restrict_pbmv_unpack_device(pb_ts(1)%sf, mv_ts(1)%sf, bl, bh, o1, o2, o3, rbuf)
+ deallocate (rbuf)
+ end if
+ end if
+
+ end subroutine s_amr_scatter_pbmv
+
+ !> Swap the global grid state to the fine block. MUST be paired with s_amr_restore_coarse.
+ impure subroutine s_amr_swap_to_fine()
+
+ ! Saving on a NESTED swap would overwrite the sw_* bounce buffers with FINE state, and the eventual restore would install
+ ! fine extents as the coarse grid - silent corruption of everything after. Hence every save below is depth-guarded; the
+ ! installs are not, since re-installing the same slot is idempotent.
+ amr_swap_depth = amr_swap_depth + 1
+ if (amr_swap_depth == 1) then
+ sw_m = m; sw_n = n; sw_p = p
+ sw_idwint = idwint; sw_idwbuff = idwbuff
+ end if
+ ! the acoustic source's precomputed spatials are coarse-grid cell indices: applying them on the fine block would inject at
+ ! wrong cells (or out of bounds). The support is guaranteed not to overlap the block (checked at startup), so the fine RHS
+ ! correctly skips the source.
+ if (amr_swap_depth == 1) sw_acoustic_source = acoustic_source
+ acoustic_source = .false.
+ ! active-box windows are COARSE cell indices: applying them on the swapped fine grid would window the wrong cells. Blocks
+ ! are
+ ! contained in the active window (init check + regrid clamp), so the fine advance legitimately treats its whole block as
+ ! active.
+ if (amr_swap_depth == 1) sw_ab_active = ab_active
+ ab_active = .false.
+ $:GPU_UPDATE(device='[ab_active]')
+ m = amr_slots(amr_cur)%m; n = amr_slots(amr_cur)%n; p = amr_slots(amr_cur)%p
+ idwint(1)%beg = 0; idwint(1)%end = m
+ idwint(2)%beg = 0; idwint(2)%end = n
+ idwint(3)%beg = 0; idwint(3)%end = p
+ idwbuff = amr_slots(amr_cur)%idwbuff
+ ! save coarse coords to bounce buffers, then copy fine coords into global arrays
+ if (amr_swap_depth == 1) then
+ sw_x_cb = x_cb; sw_x_cc = x_cc; sw_dx = dx
+ if (n_glb > 0) then; sw_y_cb = y_cb; sw_y_cc = y_cc; sw_dy = dy; end if
+ if (p_glb > 0) then; sw_z_cb = z_cb; sw_z_cc = z_cc; sw_dz = dz; end if
+ end if
+ x_cb(-1:amr_slots(amr_cur)%m) = amr_slots(amr_cur)%x_cb(-1:amr_slots(amr_cur)%m)
+ x_cc(0:amr_slots(amr_cur)%m) = amr_slots(amr_cur)%x_cc(0:amr_slots(amr_cur)%m)
+ dx(0:amr_slots(amr_cur)%m) = amr_slots(amr_cur)%dx(0:amr_slots(amr_cur)%m)
+ if (n_glb > 0) then
+ y_cb(-1:amr_slots(amr_cur)%n) = amr_slots(amr_cur)%y_cb(-1:amr_slots(amr_cur)%n)
+ y_cc(0:amr_slots(amr_cur)%n) = amr_slots(amr_cur)%y_cc(0:amr_slots(amr_cur)%n)
+ dy(0:amr_slots(amr_cur)%n) = amr_slots(amr_cur)%dy(0:amr_slots(amr_cur)%n)
+ end if
+ if (p_glb > 0) then
+ z_cb(-1:amr_slots(amr_cur)%p) = amr_slots(amr_cur)%z_cb(-1:amr_slots(amr_cur)%p)
+ z_cc(0:amr_slots(amr_cur)%p) = amr_slots(amr_cur)%z_cc(0:amr_slots(amr_cur)%p)
+ dz(0:amr_slots(amr_cur)%p) = amr_slots(amr_cur)%dz(0:amr_slots(amr_cur)%p)
+ end if
+ ! Extend the fine grid into the ghost shell (s_build_level_coords only fills the interior 0:m). Ghost cells use the EXACT
+ ! parent-cell bisection - the same formula as the interior, with floor division for negative indices. Fine-level
+ ! distribution: the owner may not hold the block's coarse coordinate slice locally, so ghost parent boundaries come from the
+ ! GLOBAL boundaries amr_g?cb (cl is a GLOBAL coarse index, region_lo + floor(jg/rr)), matching the interior build. Blocks
+ ! stay buff_size inside the domain, so every ghost parent is an in-domain coarse cell with exact coords.
+ block
+ integer :: jg, cl, pblk2, k, rr, pnf
+ real(wp), allocatable :: cxb(:), cyb(:), czb(:), tcc(:), tdx(:)
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ ! ghost parent boundaries: a level>=2 block's coarse side is its PARENT's fine grid (indexed in the parent-fine
+ ! amr_isect
+ ! frame, matching the interior s_build_level_coords), NOT the L0 global boundaries. amr_isect_lo is a parent-fine index,
+ ! so indexing amr_g?cb (sized for L0) reads OUT OF BOUNDS -> garbage on host, NaN on the device copy. Source the
+ ! parent's
+ ! fine coords for level>=2, the global L0 boundaries for level 1.
+ if (amr_block_level(amr_cur) >= 2) then
+ ! REBUILD the parent's fine boundaries from replicated metadata - do NOT read amr_slots(pblk2)%x_cb. That array is
+ ! allocated only on the PARENT's owner, and under per-level distribution this block's owner need not be it; taking
+ ! lbound/ubound of an unallocated allocatable is undefined. Same ancestor replay as the interior build, so the
+ ! ghost bisection and the interior agree exactly.
+ pblk2 = f_amr_parent_block(amr_cur)
+ pnf = amr_ref_ratio**amr_block_level(pblk2)*(amr_region_hi_all(1, pblk2) - amr_region_lo_all(1, pblk2) + 1) - 1
+ allocate (cxb(-1:pnf), tcc(0:pnf), tdx(0:pnf))
+ call s_amr_build_block_coords(pblk2, amr_gxcb, cxb, tcc, tdx, 1)
+ deallocate (tcc, tdx)
+ if (n_glb > 0) then
+ pnf = amr_ref_ratio**amr_block_level(pblk2)*(amr_region_hi_all(2, pblk2) - amr_region_lo_all(2, pblk2) + 1) - 1
+ allocate (cyb(-1:pnf), tcc(0:pnf), tdx(0:pnf))
+ call s_amr_build_block_coords(pblk2, amr_gycb, cyb, tcc, tdx, 2)
+ deallocate (tcc, tdx)
+ end if
+ if (p_glb > 0) then
+ pnf = amr_ref_ratio**amr_block_level(pblk2)*(amr_region_hi_all(3, pblk2) - amr_region_lo_all(3, pblk2) + 1) - 1
+ allocate (czb(-1:pnf), tcc(0:pnf), tdx(0:pnf))
+ call s_amr_build_block_coords(pblk2, amr_gzcb, czb, tcc, tdx, 3)
+ deallocate (tcc, tdx)
+ end if
+ else
+ allocate (cxb(lbound(amr_gxcb, 1):ubound(amr_gxcb, 1))); cxb = amr_gxcb
+ if (n_glb > 0) then; allocate (cyb(lbound(amr_gycb, 1):ubound(amr_gycb, 1))); cyb = amr_gycb; end if
+ if (p_glb > 0) then; allocate (czb(lbound(amr_gzcb, 1):ubound(amr_gzcb, 1))); czb = amr_gzcb; end if
+ end if
+ do jg = amr_slots(amr_cur)%m + 1, amr_slots(amr_cur)%m + buff_size
+ cl = amr_isect_lo(1) + floor(real(jg, wp)/real(rr, wp))
+ k = modulo(jg, rr)
+ if (k == rr - 1) then
+ x_cb(jg) = cxb(cl)
+ else
+ x_cb(jg) = (real(rr - 1 - k, wp)*cxb(cl - 1) + real(k + 1, wp)*cxb(cl))/real(rr, wp)
+ end if
+ dx(jg) = x_cb(jg) - x_cb(jg - 1); x_cc(jg) = 0.5_wp*(x_cb(jg - 1) + x_cb(jg))
+ end do
+ ! unified boundary formula (matches the interior subdivision): boundary jg belongs to
+ ! parent c = isect_lo + floor(jg/rr); sub-position k=modulo(jg,rr) picks the rr-way split
+ do jg = -1 - buff_size, -1
+ cl = amr_isect_lo(1) + floor(real(jg, wp)/real(rr, wp))
+ k = modulo(jg, rr)
+ if (k == rr - 1) then
+ x_cb(jg) = cxb(cl)
+ else
+ x_cb(jg) = (real(rr - 1 - k, wp)*cxb(cl - 1) + real(k + 1, wp)*cxb(cl))/real(rr, wp)
+ end if
+ end do
+ do jg = -buff_size, -1
+ dx(jg) = x_cb(jg) - x_cb(jg - 1); x_cc(jg) = 0.5_wp*(x_cb(jg - 1) + x_cb(jg))
+ end do
+ if (n_glb > 0) then
+ do jg = amr_slots(amr_cur)%n + 1, amr_slots(amr_cur)%n + buff_size
+ cl = amr_isect_lo(2) + floor(real(jg, wp)/real(rr, wp))
+ k = modulo(jg, rr)
+ if (k == rr - 1) then
+ y_cb(jg) = cyb(cl)
+ else
+ y_cb(jg) = (real(rr - 1 - k, wp)*cyb(cl - 1) + real(k + 1, wp)*cyb(cl))/real(rr, wp)
+ end if
+ dy(jg) = y_cb(jg) - y_cb(jg - 1); y_cc(jg) = 0.5_wp*(y_cb(jg - 1) + y_cb(jg))
+ end do
+ ! unified boundary formula (matches the interior subdivision): boundary jg belongs to
+ ! parent c = isect_lo + floor(jg/rr); sub-position k=modulo(jg,rr) picks the rr-way split
+ do jg = -1 - buff_size, -1
+ cl = amr_isect_lo(2) + floor(real(jg, wp)/real(rr, wp))
+ k = modulo(jg, rr)
+ if (k == rr - 1) then
+ y_cb(jg) = cyb(cl)
+ else
+ y_cb(jg) = (real(rr - 1 - k, wp)*cyb(cl - 1) + real(k + 1, wp)*cyb(cl))/real(rr, wp)
+ end if
+ end do
+ do jg = -buff_size, -1
+ dy(jg) = y_cb(jg) - y_cb(jg - 1); y_cc(jg) = 0.5_wp*(y_cb(jg - 1) + y_cb(jg))
+ end do
+ end if
+ if (p_glb > 0) then
+ do jg = amr_slots(amr_cur)%p + 1, amr_slots(amr_cur)%p + buff_size
+ cl = amr_isect_lo(3) + floor(real(jg, wp)/real(rr, wp))
+ k = modulo(jg, rr)
+ if (k == rr - 1) then
+ z_cb(jg) = czb(cl)
+ else
+ z_cb(jg) = (real(rr - 1 - k, wp)*czb(cl - 1) + real(k + 1, wp)*czb(cl))/real(rr, wp)
+ end if
+ dz(jg) = z_cb(jg) - z_cb(jg - 1); z_cc(jg) = 0.5_wp*(z_cb(jg - 1) + z_cb(jg))
+ end do
+ ! unified boundary formula (matches the interior subdivision): boundary jg belongs to
+ ! parent c = isect_lo + floor(jg/rr); sub-position k=modulo(jg,rr) picks the rr-way split
+ do jg = -1 - buff_size, -1
+ cl = amr_isect_lo(3) + floor(real(jg, wp)/real(rr, wp))
+ k = modulo(jg, rr)
+ if (k == rr - 1) then
+ z_cb(jg) = czb(cl)
+ else
+ z_cb(jg) = (real(rr - 1 - k, wp)*czb(cl - 1) + real(k + 1, wp)*czb(cl))/real(rr, wp)
+ end if
+ end do
+ do jg = -buff_size, -1
+ dz(jg) = z_cb(jg) - z_cb(jg - 1); z_cc(jg) = 0.5_wp*(z_cb(jg - 1) + z_cb(jg))
+ end do
+ end if
+ end block
+ ! sync the swapped extents/bounds/coordinates to the device: RHS kernels read the device copies of these GPU_DECLARE'd
+ ! globals (stale coarse bounds = OOB kernels)
+ call s_amr_sync_grid_state_to_device()
+ ! hypoelastic stress sources use grid-spacing-dependent FD coefficients: recompute them from the (now fine) grid, else every
+ ! fine velocity gradient is halved
+ if (hypoelasticity) call s_hypoelastic_update_fd_coeffs()
+ ! nonuniform coarse grid (stretched, or the axisymmetric axis half-cell): the per-cell WENO coefficients must be rebuilt for
+ ! the block's own grid (no-op flag on uniform grids)
+ if (amr_weno_coef_recompute) call s_amr_recompute_weno_coefs()
+
+ ! IGR: save the coarse sigma state and seed the fine solve. jac holds THIS stage's converged coarse sigma (the coarse RHS
+ ! ran
+ ! first), so its parent values are both the best initial guess and the frozen Dirichlet ghost data for the block-local
+ ! Jacobi
+ ! solve (the per-iteration BC/halo populate is skipped under amr_in_fine_advance). Piecewise-constant parent injection over
+ ! the full buffered fine range.
+ if (igr) call s_amr_igr_swap_sigma()
+
+ end subroutine s_amr_swap_to_fine
+
+ !> Restore the global grid state saved by s_amr_swap_to_fine.
+ impure subroutine s_amr_restore_coarse()
+
+ @:ASSERT(amr_swap_depth > 0, "s_amr_restore_coarse without a matching s_amr_swap_to_fine")
+ amr_swap_depth = amr_swap_depth - 1
+ ! inner restore: the enclosing swap frame still wants its slot installed, and the sw_* buffers still hold the coarse state
+ if (amr_swap_depth > 0) return
+ m = sw_m; n = sw_n; p = sw_p
+ idwint = sw_idwint; idwbuff = sw_idwbuff
+ acoustic_source = sw_acoustic_source
+ ab_active = sw_ab_active
+ $:GPU_UPDATE(device='[ab_active]')
+ ! restore full coarse coords from bounce buffers
+ x_cb = sw_x_cb; x_cc = sw_x_cc; dx = sw_dx
+ if (n_glb > 0) then; y_cb = sw_y_cb; y_cc = sw_y_cc; dy = sw_dy; end if
+ if (p_glb > 0) then; z_cb = sw_z_cb; z_cc = sw_z_cc; dz = sw_dz; end if
+ ! sync the restored coarse extents/bounds/coordinates back to the device
+ call s_amr_sync_grid_state_to_device()
+ if (hypoelasticity) call s_hypoelastic_update_fd_coeffs()
+ if (amr_weno_coef_recompute) call s_amr_recompute_weno_coefs()
+ if (igr) call s_amr_igr_restore_sigma()
+
+ end subroutine s_amr_restore_coarse
+
+ !> Save the coarse jac/jac_old and seed the (already swapped-in) fine block's sigma state by piecewise-constant parent injection
+ !! from the saved coarse sigma: interior = initial guess, ghost shell = frozen Dirichlet coupling data for the block-local
+ !! solve.
+ impure subroutine s_amr_igr_swap_sigma()
+
+ integer :: j, k, l, ci, cj, ck
+ integer :: cb1, ce1, cb2, ce2, cb3, ce3, fb1, fe1, fb2, fe2, fb3, fe3
+ integer :: lo1, lo2, lo3, ox, oy, oz
+
+ ! bounds/offsets hoisted to scalars: sw_idwbuff (and friends) are host-only module state - referencing them inside the
+ ! kernels makes OpenACC's present lookup fail (OpenMP's implicit map(to) tolerates it, which is why only acc lanes crashed)
+
+ cb1 = sw_idwbuff(1)%beg; ce1 = sw_idwbuff(1)%end
+ cb2 = sw_idwbuff(2)%beg; ce2 = sw_idwbuff(2)%end
+ cb3 = sw_idwbuff(3)%beg; ce3 = sw_idwbuff(3)%end
+ fb1 = idwbuff(1)%beg; fe1 = idwbuff(1)%end
+ fb2 = idwbuff(2)%beg; fe2 = idwbuff(2)%end
+ fb3 = idwbuff(3)%beg; fe3 = idwbuff(3)%end
+ lo1 = amr_isect_lo(1); lo2 = amr_isect_lo(2); lo3 = amr_isect_lo(3)
+ ox = start_idx(1); oy = 0; oz = 0
+ if (n_glb > 0) oy = start_idx(2)
+ if (p_glb > 0) oz = start_idx(3)
+ ! SAVE the coarse sigma - outermost swap only. A nested swap must not re-save, or sw_jac would take FINE state and both the
+ ! seed below and s_amr_igr_restore_sigma would work from it. The seed that follows is NOT guarded: it reads sw_jac, which
+ ! still holds the coarse state, so every nested block seeds from the correct parent.
+ if (amr_swap_depth == 1) then
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[j, k, l]')
+ do l = cb3, ce3
+ do k = cb2, ce2
+ do j = cb1, ce1
+ sw_jac(j, k, l) = jac(j, k, l)
+ sw_jac_old(j, k, l) = jac_old(j, k, l)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[j, k, l, ci, cj, ck]')
+ do l = fb3, fe3
+ do k = fb2, fe2
+ do j = fb1, fe1
+ ci = lo1 + floor(real(j, wp)/real(amr_ref_ratio, wp)) - ox
+ cj = 0; ck = 0
+ if (n_glb > 0) cj = lo2 + floor(real(k, wp)/real(amr_ref_ratio, wp)) - oy
+ if (p_glb > 0) ck = lo3 + floor(real(l, wp)/real(amr_ref_ratio, wp)) - oz
+ ci = min(max(ci, cb1), ce1)
+ cj = min(max(cj, cb2), ce2)
+ ck = min(max(ck, cb3), ce3)
+ jac(j, k, l) = sw_jac(ci, cj, ck)
+ jac_old(j, k, l) = sw_jac(ci, cj, ck)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_igr_swap_sigma
+
+ !> Restore the coarse jac/jac_old saved by s_amr_igr_swap_sigma (bounds already restored).
+ impure subroutine s_amr_igr_restore_sigma()
+
+ integer :: j, k, l, b1, e1, b2, e2, b3, e3
+
+ b1 = idwbuff(1)%beg; e1 = idwbuff(1)%end
+ b2 = idwbuff(2)%beg; e2 = idwbuff(2)%end
+ b3 = idwbuff(3)%beg; e3 = idwbuff(3)%end
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[j, k, l]')
+ do l = b3, e3
+ do k = b2, e2
+ do j = b1, e1
+ jac(j, k, l) = sw_jac(j, k, l)
+ jac_old(j, k, l) = sw_jac_old(j, k, l)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_igr_restore_sigma
+
+ !> Recompute the WENO reconstruction coefficient arrays from the CURRENT grid globals (the fine block's after a swap, the coarse
+ !! grid's after a restore). s_compute_weno_coefficients reads the live cell-boundary arrays, refreshes uniform_grid, and pushes
+ !! its own device updates; the coefficient arrays were sized to the coarse local ranges at init, which the fine ranges never
+ !! exceed (the scratch-fit abort guarantees it).
+ impure subroutine s_amr_recompute_weno_coefs()
+
+ type(int_bounds_info) :: is1, is2, is3
+
+ is1%beg = -buff_size; is1%end = m + buff_size
+ call s_compute_weno_coefficients(1, is1)
+ if (n_glb > 0) then
+ is2%beg = -buff_size; is2%end = n + buff_size
+ call s_compute_weno_coefficients(2, is2)
+ end if
+ if (p_glb > 0) then
+ is3%beg = -buff_size; is3%end = p + buff_size
+ call s_compute_weno_coefficients(3, is3)
+ end if
+
+ end subroutine s_amr_recompute_weno_coefs
+
+ !> Push the (host-side) global grid state to its device copies after a swap/restore. m/n/p, idwint/idwbuff, and the coordinate
+ !! arrays are GPU_DECLARE'd; kernels read the device copies. No-op on CPU.
+ impure subroutine s_amr_sync_grid_state_to_device()
+
+ $:GPU_UPDATE(device='[m, n, p, idwint, idwbuff]')
+ $:GPU_UPDATE(device='[x_cb, x_cc, dx]')
+ if (n_glb > 0) then
+ $:GPU_UPDATE(device='[y_cb, y_cc, dy]')
+ end if
+ if (p_glb > 0) then
+ $:GPU_UPDATE(device='[z_cb, z_cc, dz]')
+ end if
+
+ end subroutine s_amr_sync_grid_state_to_device
+
+ !> Decompose the current fine block's ghost shell (buffered extent minus interior) into ns disjoint face slabs whose union is
+ !! exactly the non-interior cells, so the ghost-fill kernels do O(surface) work instead of masking the full buffered volume. x
+ !! slabs span the full transverse extent; y slabs restrict x to the interior; z slabs restrict x and y. Collapsed dims
+ !! (n_glb/p_glb == 0) contribute no slabs.
+ pure subroutine s_amr_build_ghost_slabs(ns, sb1, se1, sb2, se2, sb3, se3)
+
+ integer, intent(out) :: ns
+ integer, dimension(6), intent(out) :: sb1, se1, sb2, se2, sb3, se3
+ integer :: fm, fn, fp, b1, e1, b2, e2, b3, e3
+
+ fm = amr_slots(amr_cur)%m; fn = amr_slots(amr_cur)%n; fp = amr_slots(amr_cur)%p
+ b1 = amr_slots(amr_cur)%idwbuff(1)%beg; e1 = amr_slots(amr_cur)%idwbuff(1)%end
+ b2 = amr_slots(amr_cur)%idwbuff(2)%beg; e2 = amr_slots(amr_cur)%idwbuff(2)%end
+ b3 = amr_slots(amr_cur)%idwbuff(3)%beg; e3 = amr_slots(amr_cur)%idwbuff(3)%end
+ ns = 2
+ sb1(1) = b1; se1(1) = -1; sb1(2) = fm + 1; se1(2) = e1
+ sb2(1:2) = b2; se2(1:2) = e2; sb3(1:2) = b3; se3(1:2) = e3
+ if (n_glb > 0) then
+ ns = 4
+ sb2(3) = b2; se2(3) = -1; sb2(4) = fn + 1; se2(4) = e2
+ sb1(3:4) = 0; se1(3:4) = fm; sb3(3:4) = b3; se3(3:4) = e3
+ end if
+ if (p_glb > 0) then
+ ns = 6
+ sb3(5) = b3; se3(5) = -1; sb3(6) = fp + 1; se3(6) = e3
+ sb1(5:6) = 0; se1(5:6) = fm; sb2(5:6) = 0; se2(5:6) = fn
+ end if
+
+ end subroutine s_amr_build_ghost_slabs
+
+ !> Fill the fine ghost shell of q_fine by conservative-linear prolongation from q_coarse - the gathered block-local coarse patch
+ !! amr_cg (fine-level distribution; the caller gathers the source first). Device kernel: reads the patch and writes the fine
+ !! target in device memory. floor/modulo mapping is valid for negative fine indices (ghosts). Interior untouched. Multi-fluid
+ !! volume fractions get the same sum-preserving closure as the interior prolongation (second kernel). TWIN
+ !! s_amr_fill_fine_ghosts_pbmv (q<->pb/mv): pb/mv sibling; keep the mapping lockstep.
+ !!
+ !! ONE body, several targets. The prolongation is identical whatever it writes into, and the target differs only in the write
+ !! EXPRESSION, so the variants are generated from a single source body with a Fypp accessor lambda (the idiom
+ !! m_riemann_solver_hlld already uses for its per-direction stencil variants). Branching on the target inside one region is NOT
+ !! an option: a dummy referenced in ANY branch of a target region is still mapped, which is the per-region tax this whole
+ !! exercise exists to remove. `_sf` writes a scalar_field vector (q_cons, until it migrates); `_gsta`/`_gstb` write the flat
+ !! per-block store at dense local index `loc`.
+ #:for SFX, TGT in [('cons', 'amr_cons_st'), ('gsta', 'amr_gst_a'), ('gstb', 'amr_gst_b')]
+ #:set QF = lambda ix: TGT + '(fi, fj, fk, ' + ix + ', loc)'
+ impure subroutine s_amr_fill_fine_ghosts_${SFX}$(q_coarse, loc)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: loc
+ integer :: i, fi, fj, fk, ci, cj, ck, ox, oy, oz
+ integer :: rr, lo1, lo2, lo3
+ integer :: advb, adve, bbeg, bend, bstride
+ integer :: s, ns, l1, u1, l2, u2, l3, u3
+ integer :: ss, g, r, n1, n2, stot
+ integer, dimension(6) :: sb1, se1, sb2, se2, sb3, se3, soff, scnt
+ logical :: d2, d3, multi, shx, shy, shz, bubEE
+ real(wp) :: u0, sx, sy, sz, xix, xiy, xiz, av, asum
+
+ ! q_coarse is the gathered block-local patch amr_cg (fine-level distribution); amr_isect_lo (GLOBAL, == region_lo on the
+ ! owner) + f/rr - amr_cpat_off is the patch-local coarse index. Fine indices are LOCAL to this block.
+
+ ox = amr_cpat_off(1); oy = amr_cpat_off(2); oz = amr_cpat_off(3)
+ d2 = n_glb > 0; d3 = p_glb > 0
+ rr = amr_slots(amr_cur)%amr_ref_ratio
+ lo1 = amr_isect_lo(1); lo2 = amr_isect_lo(2); lo3 = amr_isect_lo(3)
+ multi = num_fluids > 1 .and. (.not. bubbles_lagrange) ! EL alphas sum to beta, not 1: no sum-to-one closure
+ advb = eqn_idx%adv%beg; adve = eqn_idx%adv%end
+ bubEE = bubbles_euler; bbeg = eqn_idx%bub%beg; bend = eqn_idx%bub%end
+ bstride = 1; if (bubEE) bstride = (bend - bbeg + 1)/nb
+ call s_amr_build_ghost_slabs(ns, sb1, se1, sb2, se2, sb3, se3)
+ ! ONE kernel over the concatenation of the ns face slabs instead of one kernel each. The slabs are disjoint and their
+ ! union
+ ! is exactly the ghost shell (s_amr_build_ghost_slabs), so every ghost cell is still written exactly once and the result
+ ! is
+ ! byte-identical however the flat index is ordered. NOT the padded-hull form of s_amr_capture_creg_dense_batch: the x
+ ! slabs
+ ! span the full transverse extent, so a hull over all slabs is the whole buffered volume and masking it would throw away
+ ! the
+ ! O(surface) decomposition this routine exists to get.
+ soff(1) = 0
+ do s = 1, ns
+ scnt(s) = (se1(s) - sb1(s) + 1)*(se2(s) - sb2(s) + 1)*(se3(s) - sb3(s) + 1)
+ if (s < ns) soff(s + 1) = soff(s) + scnt(s)
+ end do
+ stot = soff(ns) + scnt(ns)
+ $:GPU_PARALLEL_LOOP(collapse=2, copyin='[sb1, se1, sb2, se2, sb3, se3, soff, scnt]', private='[s, ss, r, n1, n2, fi, &
+ & fj, fk, ci, cj, ck, xix, xiy, xiz, u0, sx, sy, sz]')
+ do i = 1, sys_size
+ do g = 0, stot - 1
+ s = 1 ! decode the flat index: ns <= 6, so a scan beats storing a per-cell slab map
+ do ss = 2, ns
+ if (g >= soff(ss)) s = ss
+ end do
+ r = g - soff(s)
+ n1 = se1(s) - sb1(s) + 1; n2 = se2(s) - sb2(s) + 1
+ fi = sb1(s) + mod(r, n1)
+ fj = sb2(s) + mod(r/n1, n2)
+ fk = sb3(s) + r/(n1*n2)
+ ! the slabs cover exactly the ghost shell; multi-fluid, skip the volume fractions (closure kernel below)
+ if (.not. (multi .and. i >= advb .and. i <= adve)) then
+ ck = 0; xiz = 0._wp
+ if (d3) then
+ ck = lo3 + floor(real(fk, wp)/real(rr, wp)) - oz
+ xiz = (real(modulo(fk, rr), wp) - real(rr - 1, wp)*0.5_wp)/real(rr, wp)
+ end if
+ cj = 0; xiy = 0._wp
+ if (d2) then
+ cj = lo2 + floor(real(fj, wp)/real(rr, wp)) - oy
+ xiy = (real(modulo(fj, rr), wp) - real(rr - 1, wp)*0.5_wp)/real(rr, wp)
+ end if
+ ci = lo1 + floor(real(fi, wp)/real(rr, wp)) - ox
+ xix = (real(modulo(fi, rr), wp) - real(rr - 1, wp)*0.5_wp)/real(rr, wp)
+ u0 = real(q_coarse(i)%sf(ci, cj, ck), wp)
+ sx = minmod(real(q_coarse(i)%sf(ci + 1, cj, ck), wp) - u0, u0 - real(q_coarse(i)%sf(ci - 1, cj, ck), wp))
+ sy = 0._wp
+ if (d2) sy = minmod(real(q_coarse(i)%sf(ci, cj + 1, ck), wp) - u0, u0 - real(q_coarse(i)%sf(ci, cj - 1, &
+ & ck), wp))
+ sz = 0._wp
+ if (d3) sz = minmod(real(q_coarse(i)%sf(ci, cj, ck + 1), wp) - u0, u0 - real(q_coarse(i)%sf(ci, cj, &
+ & ck - 1), wp))
+ ! QBMM: inject the bub block piecewise-constant (child = u0) so the ghost inherits the coarse cell's
+ ! realizable 6-moment set (CHyQMOM needs variance c20 > 0; per-component minmod slopes would break
+ ! that joint constraint). Non-QBMM Euler-Euler bubbles instead floor their positive moments (nR /
+ ! npb / nmv); the signed velocity moment nV (offset 1) is skipped.
+ if (qbmm .and. i >= bbeg .and. i <= bend) then
+ sx = 0._wp; sy = 0._wp; sz = 0._wp
+ end if
+ ${QF('i')}$ = u0 + sx*xix + sy*xiy + sz*xiz
+ if (bubEE .and. .not. qbmm .and. i >= bbeg .and. i <= bend) then
+ if (mod(i - bbeg, bstride) /= 1) ${QF('i')}$ = max(real(${QF('i')}$, wp), bub_pos_frac*u0)
+ end if
+ end if
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ ! multi-fluid volume-fraction ghosts: per-cell closure mirroring s_prolong_alphas_closure (shared limiter switch over
+ ! all
+ ! fluids; interpolate + clamp fluids advb..adve-1; alpha_n = 1 - sum)
+ if (multi) then
+ ! same flat-index fusion as the prolongation loop above, over the same disjoint slabs
+ $:GPU_PARALLEL_LOOP(copyin='[sb1, se1, sb2, se2, sb3, se3, soff, scnt]', private='[s, ss, r, n1, n2, fi, fj, fk, &
+ & i, ci, cj, ck, xix, xiy, xiz, u0, sx, sy, sz, av, asum, shx, shy, shz]')
+ do g = 0, stot - 1
+ s = 1
+ do ss = 2, ns
+ if (g >= soff(ss)) s = ss
+ end do
+ r = g - soff(s)
+ n1 = se1(s) - sb1(s) + 1; n2 = se2(s) - sb2(s) + 1
+ fi = sb1(s) + mod(r, n1)
+ fj = sb2(s) + mod(r/n1, n2)
+ fk = sb3(s) + r/(n1*n2)
+ ck = 0; xiz = 0._wp
+ if (d3) then
+ ck = lo3 + floor(real(fk, wp)/real(rr, wp)) - oz
+ xiz = (real(modulo(fk, rr), wp) - real(rr - 1, wp)*0.5_wp)/real(rr, wp)
+ end if
+ cj = 0; xiy = 0._wp
+ if (d2) then
+ cj = lo2 + floor(real(fj, wp)/real(rr, wp)) - oy
+ xiy = (real(modulo(fj, rr), wp) - real(rr - 1, wp)*0.5_wp)/real(rr, wp)
+ end if
+ ci = lo1 + floor(real(fi, wp)/real(rr, wp)) - ox
+ xix = (real(modulo(fi, rr), wp) - real(rr - 1, wp)*0.5_wp)/real(rr, wp)
+ shx = .true.; shy = d2; shz = d3
+ $:GPU_LOOP(parallelism='[seq]')
+ do i = advb, adve
+ u0 = real(q_coarse(i)%sf(ci, cj, ck), wp)
+ if ((real(q_coarse(i)%sf(ci + 1, cj, ck), wp) - u0)*(u0 - real(q_coarse(i)%sf(ci - 1, cj, ck), &
+ & wp)) <= 0._wp) shx = .false.
+ if (d2) then
+ if ((real(q_coarse(i)%sf(ci, cj + 1, ck), wp) - u0)*(u0 - real(q_coarse(i)%sf(ci, cj - 1, ck), &
+ & wp)) <= 0._wp) shy = .false.
+ end if
+ if (d3) then
+ if ((real(q_coarse(i)%sf(ci, cj, ck + 1), wp) - u0)*(u0 - real(q_coarse(i)%sf(ci, cj, ck - 1), &
+ & wp)) <= 0._wp) shz = .false.
+ end if
+ end do
+ asum = 0._wp
+ $:GPU_LOOP(parallelism='[seq]')
+ do i = advb, adve - 1
+ u0 = real(q_coarse(i)%sf(ci, cj, ck), wp)
+ sx = 0._wp
+ if (shx) sx = minmod(real(q_coarse(i)%sf(ci + 1, cj, ck), wp) - u0, u0 - real(q_coarse(i)%sf(ci - 1, cj, &
+ & ck), wp))
+ sy = 0._wp
+ if (shy) sy = minmod(real(q_coarse(i)%sf(ci, cj + 1, ck), wp) - u0, u0 - real(q_coarse(i)%sf(ci, cj - 1, &
+ & ck), wp))
+ sz = 0._wp
+ if (shz) sz = minmod(real(q_coarse(i)%sf(ci, cj, ck + 1), wp) - u0, u0 - real(q_coarse(i)%sf(ci, cj, &
+ & ck - 1), wp))
+ av = min(max(u0 + sx*xix + sy*xiy + sz*xiz, 0._wp), 1._wp)
+ ${QF('i')}$ = av
+ asum = asum + av
+ end do
+ ${QF('adve')}$ = 1._wp - asum
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ end subroutine s_amr_fill_fine_ghosts_${SFX}$
+ #:endfor
+
+ !> Lerp the fine ghost shell of q_tgt between the coarse t^n and t^{n+1} ghost sources - block loc's slices of the flat store
+ !! amr_gst_a/amr_gst_b - at time fraction th (device kernel). Interior untouched. TWIN s_amr_lerp_fine_ghosts_pbmv (q<->pb/mv):
+ !! pb/mv sibling of this ghost lerp; keep lockstep.
+ impure subroutine s_amr_lerp_fine_ghosts(loc, th)
+
+ integer, intent(in) :: loc
+ real(wp), intent(in) :: th
+ integer :: i, fi, fj, fk, s, ns, l1, u1, l2, u2, l3, u3
+ integer :: ss, g, r, n1, n2, stot
+ integer, dimension(6) :: soff, scnt
+ integer, dimension(6) :: sb1, se1, sb2, se2, sb3, se3
+
+ call s_amr_build_ghost_slabs(ns, sb1, se1, sb2, se2, sb3, se3)
+ ! flat index over the concatenated DISJOINT slabs - one kernel instead of ns; see s_amr_fill_fine_ghosts
+ soff(1) = 0
+ do s = 1, ns
+ scnt(s) = (se1(s) - sb1(s) + 1)*(se2(s) - sb2(s) + 1)*(se3(s) - sb3(s) + 1)
+ if (s < ns) soff(s + 1) = soff(s) + scnt(s)
+ end do
+ stot = soff(ns) + scnt(ns)
+ $:GPU_PARALLEL_LOOP(collapse=2, copyin='[sb1, se1, sb2, se2, sb3, se3, soff, scnt]', &
+ & private='[s, ss, r, n1, n2, fi, fj, fk]')
+ do i = 1, sys_size
+ do g = 0, stot - 1
+ s = 1
+ do ss = 2, ns
+ if (g >= soff(ss)) s = ss
+ end do
+ r = g - soff(s)
+ n1 = se1(s) - sb1(s) + 1; n2 = se2(s) - sb2(s) + 1
+ fi = sb1(s) + mod(r, n1)
+ fj = sb2(s) + mod(r/n1, n2)
+ fk = sb3(s) + r/(n1*n2)
+ amr_cons_st(fi, fj, fk, i, loc) = (1._wp - th)*real(amr_gst_a(fi, fj, fk, i, loc), wp) + th*real(amr_gst_b(fi, &
+ & fj, fk, i, loc), wp)
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_lerp_fine_ghosts
+
+ !> Non-polytropic QBMM twin of s_amr_lerp_fine_ghosts: lerp the block's pb/mv ghost shell between the coarse t^n and t^{n+1}
+ !! sources at the substage time (device kernel; interior untouched). Ghost pb feeds the mixture pressure in the widened
+ !! conversion, so it gets the same time treatment as the conservative ghosts. TWIN s_amr_lerp_fine_ghosts (pb/mv<->q): q_cons
+ !! sibling; keep lockstep.
+ impure subroutine s_amr_lerp_fine_ghosts_pbmv(pb_t, mv_t, pga, mga, pgb, mgb, th)
+
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_t, mv_t
+ real(stp), dimension(amr_slots(amr_cur)%idwbuff(1)%beg:,amr_slots(amr_cur)%idwbuff(2)%beg:, &
+ & amr_slots(amr_cur)%idwbuff(3)%beg:,1:,1:), intent(in) :: pga, mga, pgb, mgb
+ real(wp), intent(in) :: th
+ integer :: fi, fj, fk, q, ib_, s, ns, l1, u1, l2, u2, l3, u3, ss, g, r, n1, n2, stot
+ integer, dimension(6) :: sb1, se1, sb2, se2, sb3, se3, soff, scnt
+
+ call s_amr_build_ghost_slabs(ns, sb1, se1, sb2, se2, sb3, se3)
+ ! flat index over the concatenated DISJOINT slabs - one kernel instead of ns; see s_amr_fill_fine_ghosts
+ soff(1) = 0
+ do s = 1, ns
+ scnt(s) = (se1(s) - sb1(s) + 1)*(se2(s) - sb2(s) + 1)*(se3(s) - sb3(s) + 1)
+ if (s < ns) soff(s + 1) = soff(s) + scnt(s)
+ end do
+ stot = soff(ns) + scnt(ns)
+ $:GPU_PARALLEL_LOOP(collapse=3, copyin='[sb1, se1, sb2, se2, sb3, se3, soff, scnt]', &
+ & private='[s, ss, r, n1, n2, fi, fj, fk]')
+ do ib_ = 1, nb
+ do q = 1, nnode
+ do g = 0, stot - 1
+ s = 1
+ do ss = 2, ns
+ if (g >= soff(ss)) s = ss
+ end do
+ r = g - soff(s)
+ n1 = se1(s) - sb1(s) + 1; n2 = se2(s) - sb2(s) + 1
+ fi = sb1(s) + mod(r, n1)
+ fj = sb2(s) + mod(r/n1, n2)
+ fk = sb3(s) + r/(n1*n2)
+ pb_t(fi, fj, fk, q, ib_) = (1._wp - th)*real(pga(fi, fj, fk, q, ib_), wp) + th*real(pgb(fi, fj, fk, q, ib_), wp)
+ mv_t(fi, fj, fk, q, ib_) = (1._wp - th)*real(mga(fi, fj, fk, q, ib_), wp) + th*real(mgb(fi, fj, fk, q, ib_), wp)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_lerp_fine_ghosts_pbmv
+
+ !> Device copy q_src -> q_dst over [b1:e1, b2:e2, b3:e3] for all sys_size fields (RK step-entry backup). TWIN s_amr_backup_pbmv
+ !! (q<->pb/mv): pb/mv sibling of this step-entry backup; keep lockstep.
+ impure subroutine s_amr_copy_fine_fields(loc, b1, e1, b2, e2, b3, e3)
+
+ integer, intent(in) :: loc !< flat-store slot: source (amr_cons_st) and destination (amr_stor_st) are the same block
+ integer, intent(in) :: b1, e1, b2, e2, b3, e3
+ integer :: i, fi, fj, fk
+
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do fk = b3, e3
+ do fj = b2, e2
+ do fi = b1, e1
+ amr_stor_st(fi, fj, fk, i, loc) = amr_cons_st(fi, fj, fk, i, loc)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_copy_fine_fields
+
+ !> Device RK stage update over the fine interior: q = (c1*q + c2*q_stor + c3*dt_in*rhs)/c4 (compute in wp, store stp). Mirrors
+ !! the coarse non-IGR rk_coef form in s_tvd_rk. TWIN s_amr_fine_rk_update_pbmv + s_tvd_rk (m_time_steppers): same SSP-RK stage
+ !! combination; keep all three lockstep.
+ impure subroutine s_amr_fine_rk_update(loc, q_rhs, c1, c2, c3, c4, dt_in)
+
+ integer, intent(in) :: loc !< flat-store slot of the updated block
+ type(scalar_field), dimension(sys_size), intent(in) :: q_rhs
+ real(wp), intent(in) :: c1, c2, c3, c4, dt_in
+ integer :: i, fi, fj, fk, fm, fn, fp
+
+ fm = amr_slots(amr_cur)%m; fn = amr_slots(amr_cur)%n; fp = amr_slots(amr_cur)%p
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do fk = 0, fp
+ do fj = 0, fn
+ do fi = 0, fm
+ amr_cons_st(fi, fj, fk, i, loc) = (c1*real(amr_cons_st(fi, fj, fk, i, loc), wp) + c2*real(amr_stor_st(fi, &
+ & fj, fk, i, loc), wp) + c3*dt_in*real(q_rhs(i)%sf(fi, fj, fk), wp))/c4
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_fine_rk_update
+
+ !> Exchange the coarse conservative ghost layers at internal rank boundaries (physical-boundary ghosts untouched; per direction
+ !! beg then end, mirroring s_populate_variables_buffers' disblock). The solver never fills CONS ghosts (only prim), so ranks
+ !! whose fine ghost-fill or prolongation stencil leaves their interior need this first. ALL ranks must call together (pairwise
+ !! exchange per internal neighbor).
+ impure subroutine s_amr_exchange_coarse_cons_halo(q_cons)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons
+
+ if (bc_x%beg >= 0) call s_mpi_sendrecv_variables_buffers(q_cons, 1, -1, sys_size)
+ if (bc_x%end >= 0) call s_mpi_sendrecv_variables_buffers(q_cons, 1, 1, sys_size)
+ if (n_glb > 0) then
+ if (bc_y%beg >= 0) call s_mpi_sendrecv_variables_buffers(q_cons, 2, -1, sys_size)
+ if (bc_y%end >= 0) call s_mpi_sendrecv_variables_buffers(q_cons, 2, 1, sys_size)
+ end if
+ if (p_glb > 0) then
+ if (bc_z%beg >= 0) call s_mpi_sendrecv_variables_buffers(q_cons, 3, -1, sys_size)
+ if (bc_z%end >= 0) call s_mpi_sendrecv_variables_buffers(q_cons, 3, 1, sys_size)
+ end if
+
+ end subroutine s_amr_exchange_coarse_cons_halo
+
+ !> True iff dim d is globally periodic. Uses l0_periodic (periodic_bc allreduced to all ranks in s_l0_tiles_init); periodic_bc
+ !! itself is captured from the ORIGINAL bc before MFC folds periodicity into the MPI-cart topology, but only on rank 0, so the
+ !! allreduced copy is the one that is consistent on every rank - required since f_amr_seam builds a replicated seam list.
+ pure logical function f_l0_dim_periodic(d) result(per)
+
+ integer, intent(in) :: d
+
+ per = l0_periodic(d)
+
+ end function f_l0_dim_periodic
+
+ !> True iff sub-block yb sits immediately above sub-block xb on xb's HIGH face in dim d: yb's low coarse face is xb's high face
+ !! + 1, and (tiling produces a regular grid) they share the transverse coarse extents exactly. Each fine-fine seam is exactly
+ !! one such ordered (xb, yb) pair (the lower block is xb). For an L0-tile periodic dim there is ALSO a wrap-seam: xb at the
+ !! domain HIGH face (region_hi == gcell) and yb at the domain LOW face (region_lo == 0) with matching transverse - the fine-fine
+ !! halo then fills xb's high ghost from yb's low interior and vice versa, exactly the periodic connection. Gated on l0_ntile>0
+ !! so the AMR fine-block path (blocks never touch the domain edge) is byte-unchanged.
+ pure logical function f_amr_seam(xb, yb, d) result(seam)
+
+ integer, intent(in) :: xb, yb, d
+ integer :: t, gc
+ logical :: adj
+
+ adj = amr_region_lo_all(d, yb) == amr_region_hi_all(d, xb) + 1
+ if (l0_ntile > 0 .and. f_l0_dim_periodic(d)) then
+ gc = merge(m_glb, merge(n_glb, p_glb, d == 2), d == 1)
+ adj = adj .or. (amr_region_hi_all(d, xb) == gc .and. amr_region_lo_all(d, yb) == 0)
+ end if
+ seam = adj
+ do t = 1, 3
+ if (t /= d) seam = seam .and. amr_region_lo_all(t, xb) == amr_region_lo_all(t, yb) .and. amr_region_hi_all(t, &
+ & xb) == amr_region_hi_all(t, yb)
+ end do
+
+ end function f_amr_seam
+
+ !> Pack (dir=+1) / unpack (dir=-1) the fine cells of slot's q_cons over [dlo:dhi] in dim d, full transverse, all sys_size, in a
+ !! fixed (i, d-index, transverse) order so a packer and unpacker with matching extents align cell-for-cell. GPU: only this
+ !! buff_size-deep near-seam slab is moved device<->host (host<-device before a pack, device<-host after an unpack), interior
+ !! transverse (0:fm) only - exactly the cells touched below, so the round-trip is byte-identical to a full-field update at a
+ !! tiny fraction of the volume (the halo runs per stage, 6x per fine step).
+ impure subroutine s_amr_fine_slice(slot, d, dlo, dhi, buf, dir)
+
+ integer, intent(in) :: slot, d, dlo, dhi, dir
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: i, a, b, c, fm(3), na, nb, nc, loc
+
+ fm(1) = amr_slots(slot)%m; fm(2) = amr_slots(slot)%n; fm(3) = amr_slots(slot)%p
+ loc = amr_loc_of(slot)
+ nc = dhi - dlo + 1
+ ! Pack (dir=1) / unpack (dir=-1) the near-seam slab ON THE DEVICE straight into the contiguous buffer buf, then move ONLY
+ ! buf
+ ! host<->device. flang miscomputes a STRIDED section (seam dim d < num_dims) of a block's conserved field in a
+ ! target-update map clause, corrupting the 2D+ np>1 seam ghosts; the base-grid halo (s_mpi_sendrecv_variables_buffers)
+ ! device-packs into a contiguous buffer for the same reason. buf index runs a fastest, then b, then c, then i, so a pack and
+ ! an unpack with matching extents align cell-for-cell (na/nb are the transverse fine sizes, nc the slab depth).
+ #:for D, TA, TB in [(1, 2, 3), (2, 1, 3), (3, 1, 2)]
+ #:set IDX = {1: 'c, a, b', 2: 'a, c, b', 3: 'a, b, c'}[D]
+ if (d == ${D}$) then
+ na = fm(${TA}$) + 1; nb = fm(${TB}$) + 1 ! scalars; kernel loop bounds MUST use na-1/nb-1, not fm(..), so no host
+ ! array is referenced in the device region (nvfortran/Cray demand it PRESENT)
+ if (dir == 1) then ! host <- device: pack on the device, copyout moves the contiguous buffer to host
+ $:GPU_PARALLEL_LOOP(collapse=4, copyout='[buf]')
+ do i = 1, sys_size
+ do c = dlo, dhi
+ do b = 0, nb - 1
+ do a = 0, na - 1
+ buf(1 + a + na*(b + nb*(c - dlo + nc*(i - 1)))) = real(amr_cons_st(${IDX}$, i, loc), wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ else ! device <- host: copyin moves the contiguous buffer to device, then unpack on the device
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do i = 1, sys_size
+ do c = dlo, dhi
+ do b = 0, nb - 1
+ do a = 0, na - 1
+ amr_cons_st(${IDX}$, i, loc) = real(buf(1 + a + na*(b + nb*(c - dlo + nc*(i - 1)))), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+ #:endfor
+
+ end subroutine s_amr_fine_slice
+
+ !> Same-rank seam exchange for ONE pair, both directions in ONE device kernel: xb's high near-seam interior -> yb's low seam
+ !! ghost, and yb's low interior -> xb's high ghost. Replaces the four s_amr_fine_slice calls the local branch used to make -
+ !! that path routed a purely LOCAL copy through the (since-removed) shared seam buffers, costing four kernels and four blocking
+ !! device<->host round trips per pair per stage. Byte-identical to it: the same cells in the same order, and its wp buffer only
+ !! widened and re-narrowed the stp values. Fusing the two directions is safe because all four slabs are disjoint - a block's
+ !! seam GHOST lies outside its own interior, and the two reads are from different slots than the two writes - so neither
+ !! direction can observe the other's store. Both blocks are now addressed by their flat-store slot, so batching across PAIRS is
+ !! no longer structurally blocked (a runtime slot index into the module store is a plain subscript, not the null deref the
+ !! per-slot scalar_field layout forced). Index order matches s_amr_fine_slice. BATCHED over pairs: one kernel for every
+ !! same-rank seam pair on this rank, instead of one per pair (measured 546 of the 7134 AMR-local launches per run). Both blocks
+ !! of a pair are addressed by their flat-store slot, so a runtime pair index is now a plain subscript - the per-slot
+ !! scalar_field layout is what used to make this a null deref. The per-pair seam dim varies, so the index decode is a runtime
+ !! select rather than the Fypp per-dim unroll the single-pair version used. Threads are launched over the MAX pair extent and
+ !! masked, rather than prefix-summed: pair sizes are equal under uniform tiling, so the waste is ~0 and it avoids an O(npair)
+ !! per-thread offset search.
+ impure subroutine s_amr_fine_seam_exchange(npair, plx, ply, pd, pxhi, pfm, ndep)
+
+ integer, intent(in) :: npair
+ integer, intent(in) :: plx(:), ply(:), pd(:), pxhi(:), pfm(:,:) !< per-pair: slots, seam dim, high extent, fine extents
+ integer, intent(in) :: ndep
+ integer :: i, a, b, t, na, nb, pr, g, gmax, lx, ly, d, xhi, cnt
+ integer :: ix1, ix2, ix3, iy1, iy2, iy3
+
+ ! max thread extent over the pairs on this rank (transverse product x seam depth)
+
+ gmax = 0
+ do pr = 1, npair
+ select case (pd(pr))
+ case (1); na = pfm(2, pr) + 1; nb = pfm(3, pr) + 1
+ case (2); na = pfm(1, pr) + 1; nb = pfm(3, pr) + 1
+ case default; na = pfm(1, pr) + 1; nb = pfm(2, pr) + 1
+ end select
+ gmax = max(gmax, na*nb*ndep)
+ end do
+
+ $:GPU_PARALLEL_LOOP(collapse=3, copyin='[plx, ply, pd, pxhi, pfm]', private='[lx, ly, d, xhi, na, nb, cnt, a, b, t, ix1, &
+ & ix2, ix3, iy1, iy2, iy3]')
+ do pr = 1, npair
+ do i = 1, sys_size
+ do g = 0, gmax - 1
+ d = pd(pr)
+ if (d == 1) then
+ na = pfm(2, pr) + 1; nb = pfm(3, pr) + 1
+ else if (d == 2) then
+ na = pfm(1, pr) + 1; nb = pfm(3, pr) + 1
+ else
+ na = pfm(1, pr) + 1; nb = pfm(2, pr) + 1
+ end if
+ cnt = na*nb*ndep
+ if (g < cnt) then
+ lx = plx(pr); ly = ply(pr); xhi = pxhi(pr)
+ a = mod(g, na); b = mod(g/na, nb); t = g/(na*nb)
+ ! (a, b) are the transverse indices, t the depth into the seam; place them per the pair's seam dim
+ if (d == 1) then
+ ix1 = xhi - ndep + 1 + t; ix2 = a; ix3 = b
+ iy1 = -ndep + t; iy2 = a; iy3 = b
+ else if (d == 2) then
+ ix1 = a; ix2 = xhi - ndep + 1 + t; ix3 = b
+ iy1 = a; iy2 = -ndep + t; iy3 = b
+ else
+ ix1 = a; ix2 = b; ix3 = xhi - ndep + 1 + t
+ iy1 = a; iy2 = b; iy3 = -ndep + t
+ end if
+ ! xb high interior -> yb low ghost, then yb low interior -> xb high ghost. All four slabs are disjoint (a
+ ! block's seam ghost lies outside its own interior, and the reads are from different slots than the
+ ! writes), so fusing the two directions cannot let one observe the other's store.
+ amr_cons_st(iy1, iy2, iy3, i, ly) = amr_cons_st(ix1, ix2, ix3, i, lx)
+ if (d == 1) then
+ ix1 = xhi + 1 + t; iy1 = t
+ else if (d == 2) then
+ ix2 = xhi + 1 + t; iy2 = t
+ else
+ ix3 = xhi + 1 + t; iy3 = t
+ end if
+ amr_cons_st(ix1, ix2, ix3, i, lx) = amr_cons_st(iy1, iy2, iy3, i, ly)
+ end if
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_fine_seam_exchange
+
+ !> Seam dimension of the ordered pair (xb, yb): the dim d in which yb is the immediate high-face neighbour of xb at matched
+ !! resolution (same level), or 0 if not a same-level fine-fine seam. Face adjacency requires transverse overlap, so a pair is
+ !! adjacent in at most one dim; the last-true assignment reproduces the original inline scan in s_amr_fine_fine_halo.
+ pure integer function f_amr_seam_dim(xb, yb) result(d)
+
+ integer, intent(in) :: xb, yb
+
+ d = 0
+ if (xb == yb) return
+ if (amr_block_level(xb) /= amr_block_level(yb)) return
+ if (f_amr_seam(xb, yb, 1)) d = 1
+ if (n_glb > 0) then; if (f_amr_seam(xb, yb, 2)) d = 2; end if
+ if (p_glb > 0) then; if (f_amr_seam(xb, yb, 3)) d = 3; end if
+
+ end function f_amr_seam_dim
+
+ !> Rebuild the cached same-level seam-pair list (amr_seam_pairs): one O(nblocks^2) scan per regrid/restart in place of the same
+ !! scan every RK stage (6x per fine step). Same (xb, yb) nested-loop order on all ranks (replicated region metadata) so the
+ !! paired MPI_SENDRECVs in s_amr_fine_fine_halo stay matched. Count then fill for an exact-size list (no cap, no overflow). Also
+ !! rebuilds the per-block gather/scatter overlap-rank lists (amr_ovl_gather/scatter) by O(overlap) inversion of the computed
+ !! decomposition (s_amr_ranks_overlapping), sized to the max overlap - no O(num_procs) scan or table.
+ !> Binary-search the Morton-sorted block lo corners (ord/mkey) for the block whose region lo equals clo, verify the full
+ !! same-level seam predicate against xb, and record it in (mb, md, nm). Blocks are disjoint, so at most one block carries a
+ !! given lo corner at a level; f_amr_seam_dim takes the LAST true dim, so a block already recorded is raised to the higher d
+ !! rather than duplicated.
+ pure subroutine s_amr_seam_probe(xb, d, clo, mkey, ord, nblk, mb, md, nm)
+
+ integer, intent(in) :: xb, d, clo(3), nblk
+ integer(kind=8), intent(in) :: mkey(:)
+ integer, intent(in) :: ord(:)
+ integer, intent(inout) :: mb(3), md(3), nm
+ integer :: yb, t, i, lo_s, hi_s, mid_s
+ integer(kind=8) :: ck
+ logical :: ok
+
+ ck = f_morton(clo(1), clo(2), clo(3))
+ lo_s = 1; hi_s = nblk
+ do while (lo_s <= hi_s)
+ mid_s = (lo_s + hi_s)/2
+ if (mkey(ord(mid_s)) < ck) then
+ lo_s = mid_s + 1
+ else
+ hi_s = mid_s - 1
+ end if
+ end do
+ ! lo_s is the first index with key >= ck; scan the equal-key run. f_morton keeps 21 bits/dim, so
+ ! above 2**21 cells/dim a run can hold distinct corners - the explicit lo check rejects those.
+ do i = lo_s, nblk
+ if (mkey(ord(i)) /= ck) exit
+ yb = ord(i)
+ if (yb == xb) cycle
+ if (amr_block_level(yb) /= amr_block_level(xb)) cycle
+ ok = .true.
+ do t = 1, 3
+ if (amr_region_lo_all(t, yb) /= clo(t)) ok = .false.
+ if (t /= d) then
+ if (amr_region_hi_all(t, yb) /= amr_region_hi_all(t, xb)) ok = .false.
+ end if
+ end do
+ if (.not. ok) cycle
+ do t = 1, nm
+ if (mb(t) == yb) then
+ md(t) = max(md(t), d)
+ return
+ end if
+ end do
+ nm = nm + 1
+ mb(nm) = yb; md(nm) = d
+ return
+ end do
+
+ end subroutine s_amr_seam_probe
+
+ impure subroutine s_amr_build_seam_pairs()
+
+ integer :: xb, d, np, k, mx, pass, nm, im, jm, tb, td, nb
+ integer :: plo(3), phi(3), rlo(3), rhi(3)
+ integer :: mb(3), md(3), clo(3), gc
+ integer :: width, lo_m, mid_m, hi_m, i_m, j_m, t_m
+ integer(kind=8), allocatable :: mkey(:)
+ integer, allocatable :: ord(:), mrg(:)
+
+ if (allocated(amr_seam_pairs)) deallocate (amr_seam_pairs)
+
+ ! Blocks are disjoint, so (level, region lo) names one uniquely - and the seam predicate FIXES the
+ ! neighbour's lo corner: transverse lo equal to xb's, and lo(d) = hi(d, xb) + 1. The all-pairs
+ ! O(nblocks^2) scan is therefore a lookup. Morton-sort the lo corners once, then binary-search the
+ ! single candidate per (block, dim) and verify the predicate on it. Emission order is unchanged (xb
+ ! ascending, yb ascending within xb), which the paired MPI_SENDRECVs in s_amr_fine_fine_halo depend
+ ! on - a reordered list mismatches sends to receives and deadlocks.
+ nb = max(amr_num_blocks, 1)
+ allocate (mkey(nb), ord(nb), mrg(nb))
+ do k = 1, amr_num_blocks
+ mkey(k) = f_morton(amr_region_lo_all(1, k), amr_region_lo_all(2, k), amr_region_lo_all(3, k))
+ ord(k) = k
+ end do
+
+ ! Bottom-up STABLE merge sort by Morton key (same form as s_amr_sfc_cut): a pure function of the
+ ! replicated region metadata, so every rank builds the identical order.
+ width = 1
+ do while (width < amr_num_blocks)
+ lo_m = 1
+ do while (lo_m <= amr_num_blocks - width)
+ mid_m = lo_m + width - 1
+ hi_m = min(lo_m + 2*width - 1, amr_num_blocks)
+ i_m = lo_m; j_m = mid_m + 1; t_m = lo_m
+ do while (i_m <= mid_m .and. j_m <= hi_m)
+ if (mkey(ord(i_m)) <= mkey(ord(j_m))) then
+ mrg(t_m) = ord(i_m); i_m = i_m + 1
+ else
+ mrg(t_m) = ord(j_m); j_m = j_m + 1
+ end if
+ t_m = t_m + 1
+ end do
+ do while (i_m <= mid_m); mrg(t_m) = ord(i_m); i_m = i_m + 1; t_m = t_m + 1; end do
+ do while (j_m <= hi_m); mrg(t_m) = ord(j_m); j_m = j_m + 1; t_m = t_m + 1; end do
+ ord(lo_m:hi_m) = mrg(lo_m:hi_m)
+ lo_m = lo_m + 2*width
+ end do
+ width = 2*width
+ end do
+
+ ! pass 1 counts, pass 2 fills: keeps amr_seam_pairs exactly sized, as the nested scan did
+ do pass = 1, 2
+ np = 0
+ do xb = 1, amr_num_blocks
+ nm = 0
+ do d = 1, 3
+ if (d == 2 .and. n_glb <= 0) cycle
+ if (d == 3 .and. p_glb <= 0) cycle
+ clo = amr_region_lo_all(:,xb)
+ clo(d) = amr_region_hi_all(d, xb) + 1
+ call s_amr_seam_probe(xb, d, clo, mkey, ord, amr_num_blocks, mb, md, nm)
+ ! periodic wrap (l0 tiling only): xb on the domain high face pairs with lo(d) = 0
+ if (l0_ntile > 0) then
+ if (f_l0_dim_periodic(d)) then
+ gc = merge(m_glb, merge(n_glb, p_glb, d == 2), d == 1)
+ if (amr_region_hi_all(d, xb) == gc) then
+ clo(d) = 0
+ call s_amr_seam_probe(xb, d, clo, mkey, ord, amr_num_blocks, mb, md, nm)
+ end if
+ end if
+ end if
+ end do
+ ! ascending yb within xb, matching the old inner loop's emission order (nm <= 3)
+ do im = 2, nm
+ tb = mb(im); td = md(im); jm = im - 1
+ do while (jm >= 1)
+ if (mb(jm) <= tb) exit
+ mb(jm + 1) = mb(jm); md(jm + 1) = md(jm); jm = jm - 1
+ end do
+ mb(jm + 1) = tb; md(jm + 1) = td
+ end do
+ do im = 1, nm
+ np = np + 1
+ if (pass == 2) then
+ amr_seam_pairs(1, np) = xb; amr_seam_pairs(2, np) = mb(im); amr_seam_pairs(3, np) = md(im)
+ end if
+ end do
+ end do
+ if (pass == 1) then
+ amr_num_seam_pairs = np
+ allocate (amr_seam_pairs(3, max(np, 1)))
+ end if
+ end do
+ deallocate (mkey, ord, mrg)
+ ! per-block P2P overlap-rank lists by O(overlap) inversion (gather: rank coarse range vs the amr_cpat_mar-padded patch box;
+ ! scatter: rank interior vs the region box), rank-ascending so iterating a list preserves the replaced 0..num_procs-1 scans'
+ ! MPI send/recv order. The clamped interior-frame coord range reproduces both frames (see s_amr_coord_range). Bounded first
+ ! dim = max overlap over all blocks (dealloc-realloc each build, like amr_seam_pairs above), NOT num_procs - a block spans
+ ! O(1) ranks, so this collapses the old O(num_procs*amr_max_blocks) table. Every consumer runs behind a build_seam_pairs
+ ! guard, so the arrays are always sized before they are read.
+ mx = 1
+ do k = 1, amr_num_blocks
+ plo = 0; phi = 0; rlo = 0; rhi = 0
+ plo(1) = amr_region_lo_all(1, k) - amr_cpat_mar; phi(1) = amr_region_hi_all(1, k) + amr_cpat_mar
+ rlo(1) = amr_region_lo_all(1, k); rhi(1) = amr_region_hi_all(1, k)
+ if (n_glb > 0) then
+ plo(2) = amr_region_lo_all(2, k) - amr_cpat_mar; phi(2) = amr_region_hi_all(2, k) + amr_cpat_mar
+ rlo(2) = amr_region_lo_all(2, k); rhi(2) = amr_region_hi_all(2, k)
+ end if
+ if (p_glb > 0) then
+ plo(3) = amr_region_lo_all(3, k) - amr_cpat_mar; phi(3) = amr_region_hi_all(3, k) + amr_cpat_mar
+ rlo(3) = amr_region_lo_all(3, k); rhi(3) = amr_region_hi_all(3, k)
+ end if
+ mx = max(mx, f_amr_overlap_count(plo, phi), f_amr_overlap_count(rlo, rhi))
+ end do
+ if (allocated(amr_ovl_gather)) deallocate (amr_ovl_gather)
+ if (allocated(amr_ovl_scatter)) deallocate (amr_ovl_scatter)
+ allocate (amr_ovl_gather(mx, amr_max_blocks), amr_ovl_scatter(mx, amr_max_blocks))
+ do k = 1, amr_num_blocks
+ plo = 0; phi = 0; rlo = 0; rhi = 0
+ plo(1) = amr_region_lo_all(1, k) - amr_cpat_mar; phi(1) = amr_region_hi_all(1, k) + amr_cpat_mar
+ rlo(1) = amr_region_lo_all(1, k); rhi(1) = amr_region_hi_all(1, k)
+ if (n_glb > 0) then
+ plo(2) = amr_region_lo_all(2, k) - amr_cpat_mar; phi(2) = amr_region_hi_all(2, k) + amr_cpat_mar
+ rlo(2) = amr_region_lo_all(2, k); rhi(2) = amr_region_hi_all(2, k)
+ end if
+ if (p_glb > 0) then
+ plo(3) = amr_region_lo_all(3, k) - amr_cpat_mar; phi(3) = amr_region_hi_all(3, k) + amr_cpat_mar
+ rlo(3) = amr_region_lo_all(3, k); rhi(3) = amr_region_hi_all(3, k)
+ end if
+ call s_amr_ranks_overlapping(plo, phi, amr_ovl_gather(:,k), amr_ovl_gather_n(k))
+ call s_amr_ranks_overlapping(rlo, rhi, amr_ovl_scatter(:,k), amr_ovl_scatter_n(k))
+ end do
+ amr_seam_pairs_nblk = amr_num_blocks
+ amr_seam_pairs_dirty = .false.
+
+ end subroutine s_amr_build_seam_pairs
+
+ !> Block-to-block fine-fine halo (max_grid_size tiling): overwrite each sub-block's seam ghost cells (faces shared with an
+ !! ADJACENT sub-block) with the neighbour's stage-entry fine interior, so the shared fine flux matches on both sides
+ !! (coarse-prolonged seam ghosts would be non-conservative). For each seam pair (xb below, yb above, dim d) the two owners
+ !! exchange the buff_size-deep near-seam interior (MPI_Sendrecv, or a local copy when one rank owns both). Buffer is wp, cast to
+ !! stp on unpack (identity for stp fields). No-op with a single block / no adjacent pairs (any untiled case, any np).
+ impure subroutine s_amr_fine_fine_halo(lev_only)
+
+ !> level to exchange, or 0 for ALL levels. The subcycled level-2 child advance needs to reconcile ONLY its own level's
+ !! seams: it runs inside one of the parent's substeps, when the level-1 blocks are mid-substep and must not be touched.
+ integer, intent(in) :: lev_only
+ integer :: xb, yb, d, rX, rY, cnt, xm(3), tsz, ierr, fmul, idx
+ integer :: ip, boff, tq, nreq, qbase, r, sblk, sdlo, sdhi, ublk, udlo, udhi, eblk, edlo, edhi
+ !> same-rank pairs are collected here and exchanged in ONE kernel; cross-rank pairs stay serial (each is an MPI_SENDRECV)
+ integer :: nsame
+ integer, allocatable :: plx(:), ply(:), pd(:), pxhi(:), pfm(:,:)
+
+ if (.not. amr .and. l0_ntile == 0) return
+ if (amr_num_blocks < 2) return
+
+ ! iterate the cached same-level seam list (rebuilt only when the topology changes) instead of the old O(nblocks^2)
+ ! f_amr_seam
+ ! rescan every stage; the list preserves the original (xb, yb) order so paired MPI_SENDRECVs still match.
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+ ! device<->host of the fine state is done per-seam inside s_amr_fine_slice, moving only the buff_size-deep near-seam slab
+ ! each
+ ! pack/unpack touches (not the whole block) - a large PCIe saving since this runs per stage (6x per fine step)
+ allocate (plx(amr_num_seam_pairs), ply(amr_num_seam_pairs), pd(amr_num_seam_pairs), pxhi(amr_num_seam_pairs), pfm(3, &
+ & amr_num_seam_pairs))
+ ! I5-F6 WAVE (plan-based exchange, amr_plan_based_exchange.md): the cross-rank pairs - previously one blocking
+ ! MPI_SENDRECV each, in pair-list order, through the two shared seam buffers - become ONE aggregated message per
+ ! (peer, direction): all recvs posted, all packs into per-transfer pool slices, all sends, one WAITALL, then all
+ ! unpacks. Every pair contributes one send and one recv transfer on each of its two owners; both ranks walk the
+ ! SAME replicated pair list ascending with per-peer running offsets, so the wire layout agrees with no metadata
+ ! exchange (the property the paired SENDRECVs relied on, made explicit). Wire is wp with the same stp cast on
+ ! unpack; under MFC_DEBUG each slab carries the identity header [site, sending slot, (d, dlo, dhi), (cnt, 0, 0)].
+ ! Reuses the fill waves' scratch/pools (the waves never overlap in time). Same-rank pairs keep the batched kernel.
+ if (.not. allocated(amr_fw_map)) then
+ allocate (amr_fw_map(0:num_procs - 1), amr_fw_nx(0:num_procs - 1), amr_fw_pq(0:num_procs - 1), &
+ & amr_fw_pp(0:num_procs - 1))
+ amr_fw_map = 0; amr_fw_nx = 0; amr_fw_pq = 0; amr_fw_pp = 0
+ end if
+ tq = amr_tag_base(6) + int(mod(amr_mesh_epoch, 100_8))
+ nsame = 0
+ amr_fw_snx = 0; amr_fw_snp = 0
+ do idx = 1, amr_num_seam_pairs
+ xb = amr_seam_pairs(1, idx); yb = amr_seam_pairs(2, idx); d = amr_seam_pairs(3, idx)
+ if (lev_only > 0 .and. amr_block_level(xb) /= lev_only) cycle ! pairs are same-level, so xb's level is the pair's
+ rX = amr_block_owner(xb); rY = amr_block_owner(yb)
+ if (proc_rank /= rX .and. proc_rank /= rY) cycle
+ ! fine extents from the REPLICATED region metadata (not amr_slots%m/n/p: at np>1 this rank may own only one of the pair,
+ ! and the transverse size (used for the buffer count) must be valid for both). A level-L block's region is in L0-coarse
+ ! cells but its own grid is 2**L finer (each level halves dx), so fine = 2**L*(coarse extent)-1; xb, yb share the level
+ ! (same-level seam). 2**1 keeps L1 byte-identical; L2 tiles need 2**2 (an L1-frame 2* mislocates the seam slice to half
+ ! the block, filling the seam ghost from the wrong cells - the source of the L2-L2 leak).
+ fmul = amr_ref_ratio**amr_block_level(xb)
+ xm(1) = fmul*(amr_region_hi_all(1, xb) - amr_region_lo_all(1, xb) + 1) - 1
+ xm(2) = merge(fmul*(amr_region_hi_all(2, xb) - amr_region_lo_all(2, xb) + 1) - 1, 0, n_glb > 0)
+ xm(3) = merge(fmul*(amr_region_hi_all(3, xb) - amr_region_lo_all(3, xb) + 1) - 1, 0, p_glb > 0)
+ ! transverse fine size (dims /= d); xb and yb share it (exact-match seam)
+ tsz = 1
+ if (d /= 1) tsz = tsz*(xm(1) + 1)
+ if (d /= 2 .and. n_glb > 0) tsz = tsz*(xm(2) + 1)
+ if (d /= 3 .and. p_glb > 0) tsz = tsz*(xm(3) + 1)
+ cnt = sys_size*buff_size*tsz
+ if (rX == rY) then ! same rank owns both: defer to the ONE batched kernel below (no host buffer, no per-pair launch)
+ nsame = nsame + 1
+ plx(nsame) = amr_loc_of(xb); ply(nsame) = amr_loc_of(yb)
+ pd(nsame) = d; pxhi(nsame) = xm(d); pfm(:,nsame) = xm
+ cycle
+ end if
+ ! cross-rank: append this side's SEND transfer (the matching recv is appended in the second pair walk below)
+ if (proc_rank == rX) then
+ r = rY; sblk = xb; sdlo = xm(d) - buff_size + 1; sdhi = xm(d)
+ else
+ r = rX; sblk = yb; sdlo = 0; sdhi = buff_size - 1
+ end if
+ if (amr_fw_map(r) == 0) then
+ amr_fw_snp = amr_fw_snp + 1
+ call s_amr_fw_szi(amr_fw_sprank, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqsz, amr_fw_snp)
+ call s_amr_fw_szi(amr_fw_snxp, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqbase, amr_fw_snp)
+ amr_fw_map(r) = amr_fw_snp
+ amr_fw_sprank(amr_fw_snp) = r
+ end if
+ amr_fw_snx = amr_fw_snx + 1
+ call s_amr_fw_szi(amr_fw_sblk, amr_fw_snx); call s_amr_fw_szi3(amr_fw_sbl, amr_fw_snx)
+ call s_amr_fw_szi(amr_fw_spi, amr_fw_snx); call s_amr_fw_szi(amr_fw_sqo, amr_fw_snx)
+ call s_amr_fw_szi(amr_fw_spo, amr_fw_snx)
+ amr_fw_sblk(amr_fw_snx) = sblk
+ amr_fw_sbl(1, amr_fw_snx) = d; amr_fw_sbl(2, amr_fw_snx) = sdlo; amr_fw_sbl(3, amr_fw_snx) = sdhi
+ amr_fw_spo(amr_fw_snx) = cnt
+ amr_fw_spi(amr_fw_snx) = amr_fw_map(r)
+ amr_fw_sqo(amr_fw_snx) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_pq(r) = amr_fw_pq(r) + cnt
+ amr_fw_nx(r) = amr_fw_nx(r) + 1
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_snp
+ r = amr_fw_sprank(ip)
+ amr_fw_snxp(ip) = amr_fw_nx(r)
+ amr_fw_sqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_sqbase(ip) = qbase; qbase = qbase + amr_fw_sqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_sq, qbase)
+ ! RECV transfers, second walk over the same pairs: unpack destination is MY block's ghost slab; the expected header
+ ! is the PEER's pack (its block + its interior slab bounds), derived from the same replicated metadata
+ amr_fw_rnx = 0; amr_fw_rnp = 0
+ do idx = 1, amr_num_seam_pairs
+ xb = amr_seam_pairs(1, idx); yb = amr_seam_pairs(2, idx); d = amr_seam_pairs(3, idx)
+ if (lev_only > 0 .and. amr_block_level(xb) /= lev_only) cycle
+ rX = amr_block_owner(xb); rY = amr_block_owner(yb)
+ if (rX == rY) cycle
+ if (proc_rank /= rX .and. proc_rank /= rY) cycle
+ fmul = amr_ref_ratio**amr_block_level(xb)
+ xm(1) = fmul*(amr_region_hi_all(1, xb) - amr_region_lo_all(1, xb) + 1) - 1
+ xm(2) = merge(fmul*(amr_region_hi_all(2, xb) - amr_region_lo_all(2, xb) + 1) - 1, 0, n_glb > 0)
+ xm(3) = merge(fmul*(amr_region_hi_all(3, xb) - amr_region_lo_all(3, xb) + 1) - 1, 0, p_glb > 0)
+ tsz = 1
+ if (d /= 1) tsz = tsz*(xm(1) + 1)
+ if (d /= 2 .and. n_glb > 0) tsz = tsz*(xm(2) + 1)
+ if (d /= 3 .and. p_glb > 0) tsz = tsz*(xm(3) + 1)
+ cnt = sys_size*buff_size*tsz
+ if (proc_rank == rX) then
+ ! yb's low interior arrives -> xb's high ghost
+ r = rY; ublk = xb; udlo = xm(d) + 1; udhi = xm(d) + buff_size
+ eblk = yb; edlo = 0; edhi = buff_size - 1
+ else
+ ! xb's high interior arrives -> yb's low ghost
+ r = rX; ublk = yb; udlo = -buff_size; udhi = -1
+ eblk = xb; edlo = xm(d) - buff_size + 1; edhi = xm(d)
+ end if
+ if (amr_fw_map(r) == 0) then
+ amr_fw_rnp = amr_fw_rnp + 1
+ call s_amr_fw_szi(amr_fw_rprank, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqsz, amr_fw_rnp)
+ call s_amr_fw_szi(amr_fw_rnxp, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqbase, amr_fw_rnp)
+ amr_fw_map(r) = amr_fw_rnp
+ amr_fw_rprank(amr_fw_rnp) = r
+ end if
+ amr_fw_rnx = amr_fw_rnx + 1
+ call s_amr_fw_szi(amr_fw_rblk, amr_fw_rnx); call s_amr_fw_szi3(amr_fw_rbl, amr_fw_rnx)
+ call s_amr_fw_szi3(amr_fw_rbh, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpi, amr_fw_rnx)
+ call s_amr_fw_szi(amr_fw_rqo, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpo, amr_fw_rnx)
+ amr_fw_rblk(amr_fw_rnx) = ublk
+ amr_fw_rbl(1, amr_fw_rnx) = d; amr_fw_rbl(2, amr_fw_rnx) = udlo; amr_fw_rbl(3, amr_fw_rnx) = udhi
+ amr_fw_rbh(1, amr_fw_rnx) = eblk; amr_fw_rbh(2, amr_fw_rnx) = edlo; amr_fw_rbh(3, amr_fw_rnx) = edhi
+ amr_fw_rpo(amr_fw_rnx) = cnt
+ amr_fw_rpi(amr_fw_rnx) = amr_fw_map(r)
+ amr_fw_rqo(amr_fw_rnx) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_pq(r) = amr_fw_pq(r) + cnt
+ amr_fw_nx(r) = amr_fw_nx(r) + 1
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_rnp
+ r = amr_fw_rprank(ip)
+ amr_fw_rnxp(ip) = amr_fw_nx(r)
+ amr_fw_rqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rqbase(ip) = qbase; qbase = qbase + amr_fw_rqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_rq, qbase)
+ nreq = amr_fw_snp + amr_fw_rnp
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+
+ nreq = 0
+#ifdef MFC_MPI
+ do ip = 1, amr_fw_rnp
+ call s_xa_rec(XA_F6W_RCV, 2, amr_fw_rqsz(ip) - amr_fw_rnxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = amr_fw_rqsz(ip)
+ call MPI_IRECV(amr_fw_rq(amr_fw_rqbase(ip) + 1), amr_fw_rqsz(ip), mpi_p, amr_fw_rprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+#endif
+ do idx = 1, amr_fw_snx
+ cnt = amr_fw_spo(idx)
+ boff = amr_fw_sqbase(amr_fw_spi(idx)) + amr_fw_sqo(idx)
+ call s_amr_fine_slice(amr_fw_sblk(idx), amr_fw_sbl(1, idx), amr_fw_sbl(2, idx), amr_fw_sbl(3, idx), &
+ & amr_fw_sq(boff + XA_NH + 1:boff + XA_NH + cnt), 1)
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_fw_sq(boff + 1:boff + XA_NH), XA_F6W_SND, amr_fw_sblk(idx), amr_fw_sbl(:,idx), &
+ & [cnt, 0, 0])
+ end do
+#ifdef MFC_MPI
+ do ip = 1, amr_fw_snp
+ call s_xa_rec(XA_F6W_SND, 1, amr_fw_sqsz(ip) - amr_fw_snxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(amr_fw_sqbase(ip) + 1), amr_fw_sqsz(ip), mpi_p, amr_fw_sprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+ if (nreq > 0) then
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "seam wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+#endif
+ end if
+#endif
+ do idx = 1, amr_fw_rnx
+ cnt = amr_fw_rpo(idx)
+ boff = amr_fw_rqbase(amr_fw_rpi(idx)) + amr_fw_rqo(idx)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_fw_rq(boff + 1:boff + XA_NH), XA_F6W_SND, amr_fw_rbh(1, idx), [amr_fw_rbl(1, &
+ & idx), amr_fw_rbh(2, idx), amr_fw_rbh(3, idx)], [cnt, 0, 0])
+ call s_amr_fine_slice(amr_fw_rblk(idx), amr_fw_rbl(1, idx), amr_fw_rbl(2, idx), amr_fw_rbl(3, idx), &
+ & amr_fw_rq(boff + XA_NH + 1:boff + XA_NH + cnt), -1)
+ end do
+ ! Every same-rank pair in ONE launch. Two things make this safe. Fusing ACROSS pairs: the four slabs of a pair are disjoint
+ ! and no pair writes another's source. DEFERRING past the MPI pairs above (a reordering the per-pair loop did not do):
+ ! every seam operation reads only INTERIOR cells and writes only GHOST cells - the packs read [xhi-buff+1:xhi] / [0:buff-1]
+ ! and the unpacks write [xhi+1:xhi+buff] / [-buff:-1] - so no seam operation can observe another's write, in either path.
+ if (nsame > 0) call s_amr_fine_seam_exchange(nsame, plx(1:nsame), ply(1:nsame), pd(1:nsame), pxhi(1:nsame), pfm(:, &
+ & 1:nsame), buff_size)
+ deallocate (plx, ply, pd, pxhi, pfm)
+ call s_amr_select_slot(1)
+
+ end subroutine s_amr_fine_fine_halo
+
+ !> Ring clip: decompose the hollow shell of patch [plo:phi] minus its OPEN core [clo:chi] (same integer frame; collapsed dims
+ !! pass plo=phi=clo=chi=0 so they never cut the core) into at most 6 DISJOINT slabs in a FIXED order: x-low/x-high spanning the
+ !! full transverse extent, then y-low/high restricted to the core's x-interval, then z-low/high restricted in x and y. Width<=2
+ !! cores are empty (shell = whole patch, legal); the width-1 double-cover is resolved by clamping the high slab past the low
+ !! one. Both sides of every clipped exchange derive the same list from replicated metadata, so the wire layout needs no
+ !! handshake (docs/documentation/amr_stepfill_ring_clip.md).
+ impure subroutine s_amr_shell_slabs(plo, phi, clo, chi, ns, sb1, se1, sb2, se2, sb3, se3, cells)
+
+ integer, intent(in) :: plo(3), phi(3), clo(3), chi(3)
+ integer, intent(out) :: ns, sb1(6), se1(6), sb2(6), se2(6), sb3(6), se3(6), cells
+ integer :: cb(3, 6), ce(3, 6), s, ss
+ integer(8) :: words, patchw, corew
+
+ cb(:,1) = plo; ce(:,1) = [clo(1) - 1, phi(2), phi(3)]
+ cb(:,2) = [max(chi(1) + 1, clo(1)), plo(2), plo(3)]; ce(:,2) = phi
+ cb(:,3) = [clo(1), plo(2), plo(3)]; ce(:,3) = [chi(1), clo(2) - 1, phi(3)]
+ cb(:,4) = [clo(1), max(chi(2) + 1, clo(2)), plo(3)]; ce(:,4) = [chi(1), phi(2), phi(3)]
+ cb(:,5) = [clo(1), clo(2), plo(3)]; ce(:,5) = [chi(1), chi(2), clo(3) - 1]
+ cb(:,6) = [clo(1), clo(2), max(chi(3) + 1, clo(3))]; ce(:,6) = [chi(1), chi(2), phi(3)]
+ ns = 0; words = 0
+ do s = 1, 6
+ if (cb(1, s) > ce(1, s) .or. cb(2, s) > ce(2, s) .or. cb(3, s) > ce(3, s)) cycle
+ ns = ns + 1
+ sb1(ns) = cb(1, s); se1(ns) = ce(1, s)
+ sb2(ns) = cb(2, s); se2(ns) = ce(2, s)
+ sb3(ns) = cb(3, s); se3(ns) = ce(3, s)
+ words = words + int(se1(ns) - sb1(ns) + 1, 8)*int(se2(ns) - sb2(ns) + 1, 8)*int(se3(ns) - sb3(ns) + 1, 8)
+ end do
+ ! the slabs must tile the shell EXACTLY: pairwise disjoint, cells summing to patch - core
+ do s = 1, ns - 1
+ do ss = s + 1, ns
+ @:ASSERT(max(sb1(s), sb1(ss)) > min(se1(s), se1(ss)) .or. max(sb2(s), sb2(ss)) > min(se2(s), &
+ & se2(ss)) .or. max(sb3(s), sb3(ss)) > min(se3(s), se3(ss)), "shell slabs: overlap")
+ end do
+ end do
+ patchw = int(phi(1) - plo(1) + 1, 8)*int(phi(2) - plo(2) + 1, 8)*int(phi(3) - plo(3) + 1, 8)
+ corew = int(max(chi(1) - clo(1) + 1, 0), 8)*int(max(chi(2) - clo(2) + 1, 0), 8)*int(max(chi(3) - clo(3) + 1, 0), 8)
+ @:ASSERT(words == patchw - corew, "shell slabs: coverage mismatch")
+ cells = int(words)
+
+ end subroutine s_amr_shell_slabs
+
+ !> Intersect the shell-slab list with box [bl:bh]: the surviving clipped slabs in the SAME fixed order (each exchange side
+ !! derives an identical list from replicated data, so empties drop symmetrically) plus their total cell count.
+ impure subroutine s_amr_shell_clip(ns, sb1, se1, sb2, se2, sb3, se3, bl, bh, ms, tb1, te1, tb2, te2, tb3, te3, cells)
+
+ integer, intent(in) :: ns, sb1(6), se1(6), sb2(6), se2(6), sb3(6), se3(6), bl(3), bh(3)
+ integer, intent(out) :: ms, tb1(6), te1(6), tb2(6), te2(6), tb3(6), te3(6), cells
+ integer :: s, l1, u1, l2, u2, l3, u3
+
+ ms = 0; cells = 0
+ do s = 1, ns
+ l1 = max(sb1(s), bl(1)); u1 = min(se1(s), bh(1))
+ l2 = max(sb2(s), bl(2)); u2 = min(se2(s), bh(2))
+ l3 = max(sb3(s), bl(3)); u3 = min(se3(s), bh(3))
+ if (l1 > u1 .or. l2 > u2 .or. l3 > u3) cycle
+ ms = ms + 1
+ tb1(ms) = l1; te1(ms) = u1; tb2(ms) = l2; te2(ms) = u2; tb3(ms) = l3; te3(ms) = u3
+ cells = cells + (u1 - l1 + 1)*(u2 - l2 + 1)*(u3 - l3 + 1)
+ end do
+
+ end subroutine s_amr_shell_clip
+
+ !> Validation arm (debug builds only): flood the current patch extent of amr_cg with quiet NaN BEFORE a clipped gather writes
+ !! its shell, so a consumer read of any unshipped cell - core OR a missed shell slab - NaNs the ghost fill within a step
+ !! (mandated by docs/documentation/amr_stepfill_ring_clip.md).
+ impure subroutine s_amr_poison_patch_device(w1, w2, w3)
+
+ use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
+ integer, intent(in) :: w1, w2, w3
+ integer :: i, g1, g2, g3
+ real(stp) :: nanv
+
+ nanv = real(ieee_value(0._wp, ieee_quiet_nan), stp)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do g3 = 0, w3
+ do g2 = 0, w2
+ do g1 = 0, w1
+ amr_cg(i)%sf(g1, g2, g3) = nanv
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_poison_patch_device
+
+ !> Ring-clipped runtime own-box copy (device): the owner's shell-slab / own-box intersections [tb:te] GLOBAL from q_coarse into
+ !! amr_cg in the patch-local frame - no host round-trip, ONE fused kernel over the slab concatenation (the ghost-fill kernel's
+ !! flat-index idiom). Same index map and direct stp assignment as the host path in s_amr_gather_coarse_patch.
+ impure subroutine s_amr_gather_own_shell_device(q_coarse, ms, tb1, te1, tb2, te2, tb3, te3, o1, o2, o3)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_coarse
+ integer, intent(in) :: ms, tb1(6), te1(6), tb2(6), te2(6), tb3(6), te3(6), o1, o2, o3
+ integer :: lb1(6), le1(6), lb2(6), le2(6), lb3(6), le3(6), soff(6), scnt(6)
+ integer :: i, s, ss, g, r, n1, n2, g1, g2, g3, stot, coff1, coff2, coff3
+
+ ! scalar/local copies: no host array may be referenced inside the device region (nvfortran/Cray demand it PRESENT)
+
+ coff1 = amr_cpat_off(1); coff2 = amr_cpat_off(2); coff3 = amr_cpat_off(3)
+ soff(1) = 0
+ do s = 1, ms
+ lb1(s) = tb1(s); le1(s) = te1(s); lb2(s) = tb2(s); le2(s) = te2(s); lb3(s) = tb3(s); le3(s) = te3(s)
+ scnt(s) = (te1(s) - tb1(s) + 1)*(te2(s) - tb2(s) + 1)*(te3(s) - tb3(s) + 1)
+ if (s < ms) soff(s + 1) = soff(s) + scnt(s)
+ end do
+ stot = soff(ms) + scnt(ms)
+ $:GPU_PARALLEL_LOOP(collapse=2, copyin='[lb1, le1, lb2, le2, lb3, le3, soff, scnt]', &
+ & private='[s, ss, r, n1, n2, g1, g2, g3]')
+ do i = 1, sys_size
+ do g = 0, stot - 1
+ s = 1 ! decode the flat index: ms <= 6, so a scan beats storing a per-cell slab map
+ do ss = 2, ms
+ if (g >= soff(ss)) s = ss
+ end do
+ r = g - soff(s)
+ n1 = le1(s) - lb1(s) + 1; n2 = le2(s) - lb2(s) + 1
+ g1 = lb1(s) + mod(r, n1)
+ g2 = lb2(s) + mod(r/n1, n2)
+ g3 = lb3(s) + r/(n1*n2)
+ amr_cg(i)%sf(g1 - coff1, g2 - coff2, g3 - coff3) = q_coarse(i)%sf(g1 - o1, g2 - o2, g3 - o3)
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_gather_own_shell_device
+
+ !> Non-subcycle per-stage LEVEL-1 fill as one exchange WAVE (I2a, amr_plan_based_exchange.md): derive this stage's full (box,
+ !! contributor) transfer set from the replicated caches, exchange one aggregated message per (peer, family) - F1 q_cons and,
+ !! under non-polytropic QBMM, the F3 pb/mv twin - with all recvs posted first, then packs, then sends, then ONE waitall, and
+ !! finally consume owned boxes in ascending slot order through the single amr_cg patch (own-box device copy + per-slab device
+ !! unpack + ghost fill). The per-box path's operations, re-ordered: no per-box owner WAITALL, no per-box contributor flush, no
+ !! F3 blocking sends. Level>=2 blocks keep the per-box F2 path (increment I3); the subcycle sites keep theirs (I8). Under
+ !! MFC_DEBUG every slab carries the I1b identity header, verified at consume, and each received message length is checked
+ !! against the plan.
+ impure subroutine s_amr_stage_fill_wave(q_cons_coarse, pb_in, mv_in)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_coarse
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ logical :: do_pbmv
+ integer :: k, r, idx, ix, ip, owner, o1, o2, o3, qsz, psz, cellsz, tq, tp, nreq, qbase, pbase, ierr, kk
+ integer :: v1hi, v2hi, v3hi, plo(3), phi(3), crlo(3), crhi(3), bl(3), bh(3), boff
+ integer :: clo(3), chi(3), nsh, msl, isl, scells
+ integer :: shb1(6), she1(6), shb2(6), she2(6), shb3(6), she3(6), tb1(6), te1(6), tb2(6), te2(6), tb3(6), te3(6)
+
+ if (amr_num_blocks <= 0) return
+ @:ASSERT(.not. amr_subcycle, "stage-fill wave: the subcycle path keeps its per-box sites")
+ @:ASSERT(amr_gsnd_n == 0, "stage-fill wave: the deferred gather-send pool must be drained")
+
+ do_pbmv = qbmm .and. .not. polytropic
+ cellsz = 0
+ if (do_pbmv) cellsz = 2*nnode*nb
+ o1 = start_idx(1); o2 = 0; o3 = 0
+ if (n_glb > 0) o2 = start_idx(2)
+ if (p_glb > 0) o3 = start_idx(3)
+ tq = amr_tag_base(1) + int(mod(amr_mesh_epoch, 100_8))
+ tp = amr_tag_base(3) + int(mod(amr_mesh_epoch, 100_8))
+
+ call s_phase_tic(PH_GATHER)
+ call s_phase_tic(PH_GWPLAN)
+ ! block set changed: rebuild the cached overlap-rank lists BEFORE reading them (same lazy trigger as the per-box path)
+ if (amr_seam_pairs_dirty .or. amr_seam_pairs_nblk /= amr_num_blocks) call s_amr_build_seam_pairs()
+ if (.not. allocated(amr_fw_map)) then
+ allocate (amr_fw_map(0:num_procs - 1), amr_fw_nx(0:num_procs - 1), amr_fw_pq(0:num_procs - 1), &
+ & amr_fw_pp(0:num_procs - 1))
+ amr_fw_map = 0; amr_fw_nx = 0; amr_fw_pq = 0; amr_fw_pp = 0
+ end if
+
+ ! SEND side: for every level-1 box someone else owns, my coarse-range slice of its padded patch box. The per-box lag
+ ! guard and slot selection run here so every rank still visits every level-1 slot once per stage, as before.
+ amr_fw_snx = 0; amr_fw_snp = 0
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ call s_amr_check_lag_clear()
+ owner = amr_block_owner(k)
+ if (owner == proc_rank) cycle
+ plo(1) = amr_region_lo_all(1, k) - amr_cpat_mar; plo(2) = 0; plo(3) = 0
+ if (n_glb > 0) plo(2) = amr_region_lo_all(2, k) - amr_cpat_mar
+ if (p_glb > 0) plo(3) = amr_region_lo_all(3, k) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, k) - amr_region_lo_all(1, k)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, k) - amr_region_lo_all(2, k)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, k) - amr_region_lo_all(3, k)) + 2*amr_cpat_mar
+ phi(1) = plo(1) + v1hi; phi(2) = plo(2) + v2hi; phi(3) = plo(3) + v3hi
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (bl(1) > bh(1) .or. bl(2) > bh(2) .or. bl(3) > bh(3)) cycle
+ ! ring clip (runtime q-only path): consumers of amr_cg read only the patch's hollow shell
+ ! (docs/documentation/amr_stepfill_ring_clip.md), so ship only the shell's intersection with this rank's
+ ! slice - as up to 6 sub-slab transfers, derived identically on both sides from replicated metadata. The
+ ! pbmv gather keeps its full-box wire contract, so qbmm+non-polytropic runs stay unclipped (full slab).
+ if (do_pbmv) then
+ msl = 1
+ tb1(1) = bl(1); te1(1) = bh(1); tb2(1) = bl(2); te2(1) = bh(2); tb3(1) = bl(3); te3(1) = bh(3)
+ else
+ clo = 0; chi = 0
+ clo(1) = amr_region_lo_all(1, k) + 1; chi(1) = amr_region_hi_all(1, k) - 1
+ if (n_glb > 0) then; clo(2) = amr_region_lo_all(2, k) + 1; chi(2) = amr_region_hi_all(2, k) - 1; end if
+ if (p_glb > 0) then; clo(3) = amr_region_lo_all(3, k) + 1; chi(3) = amr_region_hi_all(3, k) - 1; end if
+ call s_amr_shell_slabs(plo, phi, clo, chi, nsh, shb1, she1, shb2, she2, shb3, she3, scells)
+ call s_amr_shell_clip(nsh, shb1, she1, shb2, she2, shb3, she3, bl, bh, msl, tb1, te1, tb2, te2, tb3, te3, scells)
+ if (msl == 0) cycle
+ end if
+ do isl = 1, msl
+ bl = [tb1(isl), tb2(isl), tb3(isl)]; bh = [te1(isl), te2(isl), te3(isl)]
+ qsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ psz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ if (amr_fw_map(owner) == 0) then
+ amr_fw_snp = amr_fw_snp + 1
+ call s_amr_fw_szi(amr_fw_sprank, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqsz, amr_fw_snp)
+ call s_amr_fw_szi(amr_fw_spsz, amr_fw_snp); call s_amr_fw_szi(amr_fw_snxp, amr_fw_snp)
+ call s_amr_fw_szi(amr_fw_sqbase, amr_fw_snp); call s_amr_fw_szi(amr_fw_spbase, amr_fw_snp)
+ amr_fw_map(owner) = amr_fw_snp
+ amr_fw_sprank(amr_fw_snp) = owner
+ end if
+ amr_fw_snx = amr_fw_snx + 1
+ call s_amr_fw_szi(amr_fw_sblk, amr_fw_snx); call s_amr_fw_szi3(amr_fw_sbl, amr_fw_snx)
+ call s_amr_fw_szi3(amr_fw_sbh, amr_fw_snx); call s_amr_fw_szi(amr_fw_spi, amr_fw_snx)
+ call s_amr_fw_szi(amr_fw_sqo, amr_fw_snx); call s_amr_fw_szi(amr_fw_spo, amr_fw_snx)
+ amr_fw_sblk(amr_fw_snx) = k; amr_fw_sbl(:,amr_fw_snx) = bl; amr_fw_sbh(:,amr_fw_snx) = bh
+ amr_fw_spi(amr_fw_snx) = amr_fw_map(owner)
+ amr_fw_sqo(amr_fw_snx) = amr_fw_pq(owner) + amr_fw_nx(owner)*XA_NH
+ amr_fw_spo(amr_fw_snx) = amr_fw_pp(owner) + amr_fw_nx(owner)*XA_NH
+ amr_fw_pq(owner) = amr_fw_pq(owner) + qsz
+ amr_fw_pp(owner) = amr_fw_pp(owner) + psz
+ amr_fw_nx(owner) = amr_fw_nx(owner) + 1
+ end do
+ end do
+ qbase = 0; pbase = 0
+ do ip = 1, amr_fw_snp
+ r = amr_fw_sprank(ip)
+ amr_fw_snxp(ip) = amr_fw_nx(r)
+ amr_fw_sqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_spsz(ip) = amr_fw_pp(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_sqbase(ip) = qbase; qbase = qbase + amr_fw_sqsz(ip)
+ amr_fw_spbase(ip) = pbase; pbase = pbase + amr_fw_spsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0; amr_fw_pp(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_sq, qbase)
+ if (do_pbmv) call s_amr_fw_szr(amr_fw_sp, pbase)
+
+ ! RECV side: for every level-1 box I own, each listed contributor's slice (owner excluded - the own box is a device
+ ! copy at consume). Both sides enumerate boxes ascending with per-rank running offsets, so the offsets agree.
+ amr_fw_rnx = 0; amr_fw_rnp = 0
+ call s_amr_refresh_my_blocks()
+ do kk = 1, amr_n_my
+ k = amr_my_blk(kk)
+ if (amr_block_level(k) /= 1) cycle
+ plo(1) = amr_region_lo_all(1, k) - amr_cpat_mar; plo(2) = 0; plo(3) = 0
+ if (n_glb > 0) plo(2) = amr_region_lo_all(2, k) - amr_cpat_mar
+ if (p_glb > 0) plo(3) = amr_region_lo_all(3, k) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, k) - amr_region_lo_all(1, k)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, k) - amr_region_lo_all(2, k)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, k) - amr_region_lo_all(3, k)) + 2*amr_cpat_mar
+ phi(1) = plo(1) + v1hi; phi(2) = plo(2) + v2hi; phi(3) = plo(3) + v3hi
+ ! ring clip: the shell is a per-box property; clip each contributor's slice against it (mirror of the
+ ! send walk, so both sides derive the identical sub-slab list)
+ if (.not. do_pbmv) then
+ clo = 0; chi = 0
+ clo(1) = amr_region_lo_all(1, k) + 1; chi(1) = amr_region_hi_all(1, k) - 1
+ if (n_glb > 0) then; clo(2) = amr_region_lo_all(2, k) + 1; chi(2) = amr_region_hi_all(2, k) - 1; end if
+ if (p_glb > 0) then; clo(3) = amr_region_lo_all(3, k) + 1; chi(3) = amr_region_hi_all(3, k) - 1; end if
+ call s_amr_shell_slabs(plo, phi, clo, chi, nsh, shb1, she1, shb2, she2, shb3, she3, scells)
+ end if
+ do idx = 1, amr_ovl_gather_n(k)
+ r = amr_ovl_gather(idx, k)
+ if (r == proc_rank) cycle
+ call s_amr_rank_coarse_range(r, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (do_pbmv) then
+ msl = 1
+ tb1(1) = bl(1); te1(1) = bh(1); tb2(1) = bl(2); te2(1) = bh(2); tb3(1) = bl(3); te3(1) = bh(3)
+ else
+ call s_amr_shell_clip(nsh, shb1, she1, shb2, she2, shb3, she3, bl, bh, msl, tb1, te1, tb2, te2, tb3, te3, &
+ & scells)
+ if (msl == 0) cycle
+ end if
+ do isl = 1, msl
+ bl = [tb1(isl), tb2(isl), tb3(isl)]; bh = [te1(isl), te2(isl), te3(isl)]
+ qsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ psz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ if (amr_fw_map(r) == 0) then
+ amr_fw_rnp = amr_fw_rnp + 1
+ call s_amr_fw_szi(amr_fw_rprank, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqsz, amr_fw_rnp)
+ call s_amr_fw_szi(amr_fw_rpsz, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rnxp, amr_fw_rnp)
+ call s_amr_fw_szi(amr_fw_rqbase, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rpbase, amr_fw_rnp)
+ amr_fw_map(r) = amr_fw_rnp
+ amr_fw_rprank(amr_fw_rnp) = r
+ end if
+ amr_fw_rnx = amr_fw_rnx + 1
+ call s_amr_fw_szi(amr_fw_rblk, amr_fw_rnx); call s_amr_fw_szi3(amr_fw_rbl, amr_fw_rnx)
+ call s_amr_fw_szi3(amr_fw_rbh, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpi, amr_fw_rnx)
+ call s_amr_fw_szi(amr_fw_rqo, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpo, amr_fw_rnx)
+ amr_fw_rblk(amr_fw_rnx) = k; amr_fw_rbl(:,amr_fw_rnx) = bl; amr_fw_rbh(:,amr_fw_rnx) = bh
+ amr_fw_rpi(amr_fw_rnx) = amr_fw_map(r)
+ amr_fw_rqo(amr_fw_rnx) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rpo(amr_fw_rnx) = amr_fw_pp(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_pq(r) = amr_fw_pq(r) + qsz
+ amr_fw_pp(r) = amr_fw_pp(r) + psz
+ amr_fw_nx(r) = amr_fw_nx(r) + 1
+ end do
+ end do
+ end do
+ qbase = 0; pbase = 0
+ do ip = 1, amr_fw_rnp
+ r = amr_fw_rprank(ip)
+ amr_fw_rnxp(ip) = amr_fw_nx(r)
+ amr_fw_rqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rpsz(ip) = amr_fw_pp(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rqbase(ip) = qbase; qbase = qbase + amr_fw_rqsz(ip)
+ amr_fw_rpbase(ip) = pbase; pbase = pbase + amr_fw_rpsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0; amr_fw_pp(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_rq, qbase)
+ if (do_pbmv) call s_amr_fw_szr(amr_fw_rp, pbase)
+ nreq = (amr_fw_snp + amr_fw_rnp)*(1 + merge(1, 0, do_pbmv))
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+ call s_phase_toc(PH_GWPLAN)
+
+ ! post ALL recvs, then pack ALL sends (device kernels into contiguous host pool slices), then post ALL sends, then one
+ ! waitall (amr_plan_based_exchange.md order-of-operations rule). [amr-xa] records payload words only, so the family
+ ! totals stay comparable to the per-box baseline; the message counts drop to the peer-pair count by design.
+ nreq = 0
+#ifdef MFC_MPI
+ do ip = 1, amr_fw_rnp
+ call s_xa_rec(XA_F1W_RCV, 2, amr_fw_rqsz(ip) - amr_fw_rnxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = amr_fw_rqsz(ip)
+ call MPI_IRECV(amr_fw_rq(amr_fw_rqbase(ip) + 1), amr_fw_rqsz(ip), mpi_p, amr_fw_rprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ if (do_pbmv) then
+ call s_xa_rec(XA_F3W_RCV, 2, amr_fw_rpsz(ip) - amr_fw_rnxp(ip)*XA_NH, tp)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = amr_fw_rpsz(ip)
+ call MPI_IRECV(amr_fw_rp(amr_fw_rpbase(ip) + 1), amr_fw_rpsz(ip), mpi_p, amr_fw_rprank(ip), tp, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ end do
+#endif
+ call s_phase_tic(PH_GWPACK)
+ do ix = 1, amr_fw_snx
+ bl = amr_fw_sbl(:,ix); bh = amr_fw_sbh(:,ix)
+ qsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ boff = amr_fw_sqbase(amr_fw_spi(ix)) + amr_fw_sqo(ix)
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_fw_sq(boff + 1:boff + XA_NH), XA_F1W_SND, amr_fw_sblk(ix), bl, bh)
+ call s_amr_pack_box_device(q_cons_coarse, bl, bh, o1, o2, o3, amr_fw_sq(boff + XA_NH + 1:boff + XA_NH + qsz))
+ if (do_pbmv) then
+ psz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ boff = amr_fw_spbase(amr_fw_spi(ix)) + amr_fw_spo(ix)
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_fw_sp(boff + 1:boff + XA_NH), XA_F3W_SND, amr_fw_sblk(ix), bl, bh)
+ call s_amr_pack_box_pbmv_device(pb_in, mv_in, bl, bh, o1, o2, o3, amr_fw_sp(boff + XA_NH + 1:boff + XA_NH + psz))
+ end if
+ end do
+ call s_phase_toc(PH_GWPACK)
+#ifdef MFC_MPI
+ do ip = 1, amr_fw_snp
+ call s_xa_rec(XA_F1W_SND, 1, amr_fw_sqsz(ip) - amr_fw_snxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(amr_fw_sqbase(ip) + 1), amr_fw_sqsz(ip), mpi_p, amr_fw_sprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ if (do_pbmv) then
+ call s_xa_rec(XA_F3W_SND, 1, amr_fw_spsz(ip) - amr_fw_snxp(ip)*XA_NH, tp)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sp(amr_fw_spbase(ip) + 1), amr_fw_spsz(ip), mpi_p, amr_fw_sprank(ip), tp, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end if
+ end do
+ call s_phase_tic(PH_GWWAIT)
+ if (nreq > 0) then
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "stage-fill wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+#endif
+ end if
+ call s_phase_toc(PH_GWWAIT)
+#endif
+ call s_phase_toc(PH_GATHER)
+
+ ! CONSUME, ascending slot order: per owned box, patch frame + own-box device copy + per-slab device unpack (recv
+ ! transfers were appended box-major, so each box's slabs are the next contiguous run), then the ghost fills - the
+ ! same operations the per-box path ran, minus its rendezvous.
+ ix = 1
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ if (.not. amr_rank_owns_block) cycle
+ call s_phase_tic(PH_GATHER)
+ amr_cpat_off = 0
+ amr_cpat_off(1) = amr_region_lo_all(1, k) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = amr_region_lo_all(2, k) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = amr_region_lo_all(3, k) - amr_cpat_mar
+ v1hi = (amr_region_hi_all(1, k) - amr_region_lo_all(1, k)) + 2*amr_cpat_mar
+ v2hi = 0; v3hi = 0
+ if (n_glb > 0) v2hi = (amr_region_hi_all(2, k) - amr_region_lo_all(2, k)) + 2*amr_cpat_mar
+ if (p_glb > 0) v3hi = (amr_region_hi_all(3, k) - amr_region_lo_all(3, k)) + 2*amr_cpat_mar
+ plo = amr_cpat_off
+ phi(1) = plo(1) + v1hi; phi(2) = plo(2) + v2hi; phi(3) = plo(3) + v3hi
+ call s_amr_rank_coarse_range(proc_rank, crlo, crhi)
+ call s_amr_box_isect(plo, phi, crlo, crhi, bl, bh)
+ if (do_pbmv) then
+ call s_amr_gather_own_box_device(q_cons_coarse, bl, bh, o1, o2, o3)
+ call s_amr_gather_own_box_pbmv_device(pb_in, mv_in, bl, bh, o1, o2, o3)
+ else
+#ifdef MFC_DEBUG
+ ! validation arm: flood the patch with NaN BEFORE the clipped writes, so a consumer read of any
+ ! unshipped cell - core OR a missed shell slab - NaNs the ghost fill within a step
+ call s_amr_poison_patch_device(v1hi, v2hi, v3hi)
+#endif
+ clo = 0; chi = 0
+ clo(1) = amr_region_lo_all(1, k) + 1; chi(1) = amr_region_hi_all(1, k) - 1
+ if (n_glb > 0) then; clo(2) = amr_region_lo_all(2, k) + 1; chi(2) = amr_region_hi_all(2, k) - 1; end if
+ if (p_glb > 0) then; clo(3) = amr_region_lo_all(3, k) + 1; chi(3) = amr_region_hi_all(3, k) - 1; end if
+ call s_amr_shell_slabs(plo, phi, clo, chi, nsh, shb1, she1, shb2, she2, shb3, she3, scells)
+ call s_amr_shell_clip(nsh, shb1, she1, shb2, she2, shb3, she3, bl, bh, msl, tb1, te1, tb2, te2, tb3, te3, scells)
+ if (msl > 0) call s_amr_gather_own_shell_device(q_cons_coarse, msl, tb1, te1, tb2, te2, tb3, te3, o1, o2, o3)
+ end if
+ do while (ix <= amr_fw_rnx)
+ if (amr_fw_rblk(ix) /= k) exit
+ bl = amr_fw_rbl(:,ix); bh = amr_fw_rbh(:,ix)
+ qsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ boff = amr_fw_rqbase(amr_fw_rpi(ix)) + amr_fw_rqo(ix)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_fw_rq(boff + 1:boff + XA_NH), XA_F1W_SND, k, bl, bh)
+ call s_amr_unpack_box_device(bl, bh, amr_fw_rq(boff + XA_NH + 1:boff + XA_NH + qsz))
+ if (do_pbmv) then
+ psz = cellsz*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ boff = amr_fw_rpbase(amr_fw_rpi(ix)) + amr_fw_rpo(ix)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_fw_rp(boff + 1:boff + XA_NH), XA_F3W_SND, k, bl, bh)
+ call s_amr_unpack_box_pbmv_device(bl, bh, amr_fw_rp(boff + XA_NH + 1:boff + XA_NH + psz))
+ end if
+ ix = ix + 1
+ end do
+ call s_phase_toc(PH_GATHER)
+ if (rank_time_wrt) call s_rank_time_tic()
+ call s_amr_cov_note_fill()
+ call s_phase_tic(PH_GFILL)
+ call s_amr_fill_fine_ghosts_cons(amr_cg, amr_loc_of(amr_cur))
+ call s_phase_toc(PH_GFILL)
+ if (do_pbmv) call s_amr_fill_fine_ghosts_pbmv(amr_cg_pb, amr_cg_mv, amr_slots(amr_cur)%pb_f%sf, &
+ & amr_slots(amr_cur)%mv_f%sf)
+ if (rank_time_wrt) call s_rank_time_toc()
+ end do
+ @:ASSERT(ix == amr_fw_rnx + 1, "stage-fill wave: unconsumed recv transfers")
+
+ end subroutine s_amr_stage_fill_wave
+
+ !> The parent-fill wave's per-box transfer list in the PATCH-LOCAL frame: the padded patch's hollow-shell slabs (the same
+ !! dead-byte proof as the stepfill clip - the runtime consumer is the same amr_cg ghost fill, so the open interior of the parent
+ !! footprint [mar+1, w-mar-1] never ships), or the single full patch when non-polytropic QBMM keeps the full-box contract. Send
+ !! walk, recv walk, and consume all derive the list HERE, so the wire layout cannot drift between sides.
+ impure subroutine s_amr_parent_shell(w1, w2, w3, full, msl, tb1, te1, tb2, te2, tb3, te3)
+
+ integer, intent(in) :: w1, w2, w3
+ logical, intent(in) :: full
+ integer, intent(out) :: msl, tb1(6), te1(6), tb2(6), te2(6), tb3(6), te3(6)
+ integer :: clo(3), chi(3), scells
+
+ if (full) then
+ msl = 1
+ tb1(1) = 0; te1(1) = w1; tb2(1) = 0; te2(1) = w2; tb3(1) = 0; te3(1) = w3
+ else
+ clo = 0; chi = 0
+ clo(1) = amr_cpat_mar + 1; chi(1) = w1 - amr_cpat_mar - 1
+ if (n_glb > 0) then; clo(2) = amr_cpat_mar + 1; chi(2) = w2 - amr_cpat_mar - 1; end if
+ if (p_glb > 0) then; clo(3) = amr_cpat_mar + 1; chi(3) = w3 - amr_cpat_mar - 1; end if
+ call s_amr_shell_slabs([0, 0, 0], [w1, w2, w3], clo, chi, msl, tb1, te1, tb2, te2, tb3, te3, scells)
+ end if
+
+ end subroutine s_amr_parent_shell
+
+ !> Per-step LEVEL-lev fill as one exchange WAVE (I3, amr_plan_based_exchange.md): the F2 parent gather for every level-lev block
+ !! in one aggregated exchange - each split child is its s_amr_parent_shell transfer list (ring-clipped shell slabs, or one full
+ !! patch under the pbmv contract) from its parent's owner to its own owner, so the plan is a pair list, not an overlap map. Same
+ !! skeleton as s_amr_stage_fill_wave (whose scratch arrays it reuses - the two never overlap in time): plans from replicated
+ !! metadata (f_amr_parent_block + s_amr_parent_foot + amr_block_owner ONLY - the per-owner mirrors lag and are empty on
+ !! non-owners), recvs-packs-sends-one-WAITALL, box-major consume through the single amr_cg. Called per level ASCENDING, so a
+ !! level-(lev-1) parent's own ghost fill is complete before this wave reads its interior (the same parent-before-child guarantee
+ !! slot order gave the per-box loop). Co-located parent-child stays a consume-phase device copy with no wire transfer. The
+ !! regrid keeps the chunked F2 path; the subcycle keeps its per-box sites (I8); init/static keep the per-box
+ !! s_amr_gather_from_parent.
+ impure subroutine s_amr_parent_fill_wave(lev)
+
+ integer, intent(in) :: lev
+ integer :: k, r, ix, ip, pblk, powner, cowner, boxsz, tq, nreq, qbase, ierr, kk
+ integer :: w1, w2, w3, plo(3), phi(3), boff, bl(3), bh(3)
+ integer :: msl, isl
+ integer :: tb1(6), te1(6), tb2(6), te2(6), tb3(6), te3(6)
+ logical :: do_pbmv
+
+ if (amr_num_blocks <= 0) return
+ @:ASSERT(.not. amr_subcycle, "parent-fill wave: the subcycle path keeps its per-box sites")
+ @:ASSERT(amr_gsnd_n == 0, "parent-fill wave: the deferred gather-send pool must be drained")
+ do_pbmv = qbmm .and. .not. polytropic
+
+ tq = amr_tag_base(2) + int(mod(amr_mesh_epoch, 100_8))
+
+ call s_phase_tic(PH_GATHER)
+ ! SEND side: every level-lev block whose parent I own but whose child-owner is another rank. The per-box lag guard and
+ ! slot selection run here so every rank still visits every level-lev slot once per stage, as before.
+ amr_fw_snx = 0; amr_fw_snp = 0
+ if (.not. allocated(amr_fw_map)) then
+ allocate (amr_fw_map(0:num_procs - 1), amr_fw_nx(0:num_procs - 1), amr_fw_pq(0:num_procs - 1), &
+ & amr_fw_pp(0:num_procs - 1))
+ amr_fw_map = 0; amr_fw_nx = 0; amr_fw_pq = 0; amr_fw_pp = 0
+ end if
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= lev) cycle
+ call s_amr_select_slot(k)
+ call s_amr_check_lag_clear()
+ pblk = f_amr_parent_block(k)
+ powner = amr_block_owner(pblk); cowner = amr_block_owner(k)
+ if (powner == cowner .or. powner /= proc_rank) cycle
+ call s_amr_parent_foot(k, pblk, plo, phi)
+ w1 = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ w2 = 0; w3 = 0
+ if (n_glb > 0) w2 = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w3 = (phi(3) - plo(3)) + 2*amr_cpat_mar
+ call s_amr_parent_shell(w1, w2, w3, do_pbmv, msl, tb1, te1, tb2, te2, tb3, te3)
+ do isl = 1, msl
+ bl = [tb1(isl), tb2(isl), tb3(isl)]; bh = [te1(isl), te2(isl), te3(isl)]
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ if (amr_fw_map(cowner) == 0) then
+ amr_fw_snp = amr_fw_snp + 1
+ call s_amr_fw_szi(amr_fw_sprank, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqsz, amr_fw_snp)
+ call s_amr_fw_szi(amr_fw_snxp, amr_fw_snp); call s_amr_fw_szi(amr_fw_sqbase, amr_fw_snp)
+ amr_fw_map(cowner) = amr_fw_snp
+ amr_fw_sprank(amr_fw_snp) = cowner
+ end if
+ amr_fw_snx = amr_fw_snx + 1
+ call s_amr_fw_szi(amr_fw_sblk, amr_fw_snx); call s_amr_fw_szi3(amr_fw_sbl, amr_fw_snx)
+ call s_amr_fw_szi3(amr_fw_sbh, amr_fw_snx); call s_amr_fw_szi(amr_fw_spi, amr_fw_snx)
+ call s_amr_fw_szi(amr_fw_sqo, amr_fw_snx)
+ amr_fw_sblk(amr_fw_snx) = k; amr_fw_sbl(:,amr_fw_snx) = bl; amr_fw_sbh(:,amr_fw_snx) = bh
+ amr_fw_spi(amr_fw_snx) = amr_fw_map(cowner)
+ amr_fw_sqo(amr_fw_snx) = amr_fw_pq(cowner) + amr_fw_nx(cowner)*XA_NH
+ amr_fw_pq(cowner) = amr_fw_pq(cowner) + boxsz
+ amr_fw_nx(cowner) = amr_fw_nx(cowner) + 1
+ end do
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_snp
+ r = amr_fw_sprank(ip)
+ amr_fw_snxp(ip) = amr_fw_nx(r)
+ amr_fw_sqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_sqbase(ip) = qbase; qbase = qbase + amr_fw_sqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_sq, qbase)
+
+ ! RECV side: every level-lev block I own whose parent lives on another rank - the box's shell-slab transfers (or its
+ ! one full-patch transfer under the pbmv contract). Both sides enumerate boxes ascending, slabs in the fixed
+ ! s_amr_parent_shell order, with per-rank running offsets, so the wire layout agrees with no metadata exchange.
+ amr_fw_rnx = 0; amr_fw_rnp = 0
+ call s_amr_refresh_my_blocks()
+ do kk = 1, amr_n_my
+ k = amr_my_blk(kk)
+ if (amr_block_level(k) /= lev) cycle
+ pblk = f_amr_parent_block(k)
+ powner = amr_block_owner(pblk)
+ if (powner == proc_rank) cycle
+ call s_amr_parent_foot(k, pblk, plo, phi)
+ w1 = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ w2 = 0; w3 = 0
+ if (n_glb > 0) w2 = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w3 = (phi(3) - plo(3)) + 2*amr_cpat_mar
+ call s_amr_parent_shell(w1, w2, w3, do_pbmv, msl, tb1, te1, tb2, te2, tb3, te3)
+ do isl = 1, msl
+ bl = [tb1(isl), tb2(isl), tb3(isl)]; bh = [te1(isl), te2(isl), te3(isl)]
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ if (amr_fw_map(powner) == 0) then
+ amr_fw_rnp = amr_fw_rnp + 1
+ call s_amr_fw_szi(amr_fw_rprank, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqsz, amr_fw_rnp)
+ call s_amr_fw_szi(amr_fw_rnxp, amr_fw_rnp); call s_amr_fw_szi(amr_fw_rqbase, amr_fw_rnp)
+ amr_fw_map(powner) = amr_fw_rnp
+ amr_fw_rprank(amr_fw_rnp) = powner
+ end if
+ amr_fw_rnx = amr_fw_rnx + 1
+ call s_amr_fw_szi(amr_fw_rblk, amr_fw_rnx); call s_amr_fw_szi3(amr_fw_rbl, amr_fw_rnx)
+ call s_amr_fw_szi3(amr_fw_rbh, amr_fw_rnx); call s_amr_fw_szi(amr_fw_rpi, amr_fw_rnx)
+ call s_amr_fw_szi(amr_fw_rqo, amr_fw_rnx)
+ amr_fw_rblk(amr_fw_rnx) = k; amr_fw_rbl(:,amr_fw_rnx) = bl; amr_fw_rbh(:,amr_fw_rnx) = bh
+ amr_fw_rpi(amr_fw_rnx) = amr_fw_map(powner)
+ amr_fw_rqo(amr_fw_rnx) = amr_fw_pq(powner) + amr_fw_nx(powner)*XA_NH
+ amr_fw_pq(powner) = amr_fw_pq(powner) + boxsz
+ amr_fw_nx(powner) = amr_fw_nx(powner) + 1
+ end do
+ end do
+ qbase = 0
+ do ip = 1, amr_fw_rnp
+ r = amr_fw_rprank(ip)
+ amr_fw_rnxp(ip) = amr_fw_nx(r)
+ amr_fw_rqsz(ip) = amr_fw_pq(r) + amr_fw_nx(r)*XA_NH
+ amr_fw_rqbase(ip) = qbase; qbase = qbase + amr_fw_rqsz(ip)
+ amr_fw_map(r) = 0; amr_fw_nx(r) = 0; amr_fw_pq(r) = 0
+ end do
+ call s_amr_fw_szr(amr_fw_rq, qbase)
+ nreq = amr_fw_snp + amr_fw_rnp
+ call s_amr_fw_szi(amr_fw_req, nreq); call s_amr_fw_szi(amr_fw_reqw, nreq)
+
+ nreq = 0
+#ifdef MFC_MPI
+ do ip = 1, amr_fw_rnp
+ call s_xa_rec(XA_F2W_RCV, 2, amr_fw_rqsz(ip) - amr_fw_rnxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = amr_fw_rqsz(ip)
+ call MPI_IRECV(amr_fw_rq(amr_fw_rqbase(ip) + 1), amr_fw_rqsz(ip), mpi_p, amr_fw_rprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+#endif
+ ! pack: the parent-patch pack kernel reads amr_cpat_off from module scope, so set the CHILD's frame per transfer
+ ! (the consume loop recomputes it per box; phases are sequential, so the global is single-writer at any time).
+ ! sbl/sbh hold the transfer's PATCH-LOCAL slab bounds; the frame comes from the box's parent foot.
+ do ix = 1, amr_fw_snx
+ k = amr_fw_sblk(ix)
+ call s_amr_parent_foot(k, f_amr_parent_block(k), plo, phi)
+ amr_cpat_off = 0
+ amr_cpat_off(1) = plo(1) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = plo(2) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = plo(3) - amr_cpat_mar
+ bl = amr_fw_sbl(:,ix); bh = amr_fw_sbh(:,ix)
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ boff = amr_fw_sqbase(amr_fw_spi(ix)) + amr_fw_sqo(ix)
+ call s_amr_pack_parent_box_device_cons(amr_loc_of(f_amr_parent_block(k)), bl, bh, &
+ & amr_fw_sq(boff + XA_NH + 1:boff + XA_NH + boxsz))
+ if (XA_NH > 0) call s_xa_hdr_pack(amr_fw_sq(boff + 1:boff + XA_NH), XA_F2W_SND, k, bl, bh)
+ end do
+#ifdef MFC_MPI
+ do ip = 1, amr_fw_snp
+ call s_xa_rec(XA_F2W_SND, 1, amr_fw_sqsz(ip) - amr_fw_snxp(ip)*XA_NH, tq)
+ nreq = nreq + 1; amr_fw_reqw(nreq) = -1
+ call MPI_ISEND(amr_fw_sq(amr_fw_sqbase(ip) + 1), amr_fw_sqsz(ip), mpi_p, amr_fw_sprank(ip), tq, MPI_COMM_WORLD, &
+ & amr_fw_req(nreq), ierr)
+ end do
+ if (nreq > 0) then
+#ifdef MFC_DEBUG
+ block
+ integer :: st(MPI_STATUS_SIZE, nreq), gotw, q
+ call MPI_WAITALL(nreq, amr_fw_req, st, ierr)
+ do q = 1, nreq
+ if (amr_fw_reqw(q) < 0) cycle
+ call MPI_GET_COUNT(st(:,q), mpi_p, gotw, ierr)
+ @:ASSERT(gotw == amr_fw_reqw(q), "parent-fill wave: received message length differs from the plan")
+ end do
+ end block
+#else
+ call MPI_WAITALL(nreq, amr_fw_req, MPI_STATUSES_IGNORE, ierr)
+#endif
+ end if
+#endif
+ call s_phase_toc(PH_GATHER)
+
+ ! CONSUME, ascending slot order: per owned level-lev box, patch frame + the shell-slab parent copies (co-located) or
+ ! the box's received transfers, then the ghost fills - the per-box path's operations, minus its rendezvous.
+ ix = 1
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= lev) cycle
+ call s_amr_select_slot(k)
+ if (.not. amr_rank_owns_block) cycle
+ call s_phase_tic(PH_GATHER)
+ pblk = f_amr_parent_block(k)
+ call s_amr_parent_foot(k, pblk, plo, phi)
+ amr_cpat_off = 0
+ amr_cpat_off(1) = plo(1) - amr_cpat_mar
+ if (n_glb > 0) amr_cpat_off(2) = plo(2) - amr_cpat_mar
+ if (p_glb > 0) amr_cpat_off(3) = plo(3) - amr_cpat_mar
+ w1 = (phi(1) - plo(1)) + 2*amr_cpat_mar
+ w2 = 0; w3 = 0
+ if (n_glb > 0) w2 = (phi(2) - plo(2)) + 2*amr_cpat_mar
+ if (p_glb > 0) w3 = (phi(3) - plo(3)) + 2*amr_cpat_mar
+#ifdef MFC_DEBUG
+ ! validation arm (mirror of the stepfill clip): NaN-flood the patch before the shell writes land, so a consumer
+ ! read of any unshipped cell - the clipped core or a missed slab - NaNs the ghost fill within a step
+ if (.not. do_pbmv) call s_amr_poison_patch_device(w1, w2, w3)
+#endif
+ if (amr_block_owner(pblk) == proc_rank) then
+ call s_amr_parent_shell(w1, w2, w3, do_pbmv, msl, tb1, te1, tb2, te2, tb3, te3)
+ do isl = 1, msl
+ call s_amr_copy_parent_box_cons(amr_loc_of(pblk), [tb1(isl), tb2(isl), tb3(isl)], [te1(isl), te2(isl), &
+ & te3(isl)])
+ end do
+ else
+ @:ASSERT(ix <= amr_fw_rnx .and. amr_fw_rblk(ix) == k, "parent-fill wave: missing recv transfer")
+ do while (ix <= amr_fw_rnx)
+ if (amr_fw_rblk(ix) /= k) exit
+ bl = amr_fw_rbl(:,ix); bh = amr_fw_rbh(:,ix)
+ boxsz = sys_size*(bh(1) - bl(1) + 1)*(bh(2) - bl(2) + 1)*(bh(3) - bl(3) + 1)
+ boff = amr_fw_rqbase(amr_fw_rpi(ix)) + amr_fw_rqo(ix)
+ if (XA_NH > 0) call s_xa_hdr_check(amr_fw_rq(boff + 1:boff + XA_NH), XA_F2W_SND, k, bl, bh)
+ call s_amr_unpack_parent_box_device(bl, bh, amr_fw_rq(boff + XA_NH + 1:boff + XA_NH + boxsz))
+ ix = ix + 1
+ end do
+ end if
+ call s_phase_toc(PH_GATHER)
+ if (rank_time_wrt) call s_rank_time_tic()
+ call s_amr_cov_note_fill()
+ call s_phase_tic(PH_GFILL)
+ call s_amr_fill_fine_ghosts_cons(amr_cg, amr_loc_of(amr_cur))
+ call s_phase_toc(PH_GFILL)
+ if (qbmm .and. .not. polytropic) call s_amr_fill_fine_ghosts_pbmv(amr_cg_pb, amr_cg_mv, amr_slots(amr_cur)%pb_f%sf, &
+ & amr_slots(amr_cur)%mv_f%sf)
+ if (rank_time_wrt) call s_rank_time_toc()
+ end do
+ @:ASSERT(ix == amr_fw_rnx + 1, "parent-fill wave: unconsumed recv transfers")
+
+ end subroutine s_amr_parent_fill_wave
+
+ !> High-water sizing for the wave's plan scratch. Callers size-then-write at APPEND time, so a grow must preserve the entries
+ !! already appended this wave.
+ impure subroutine s_amr_fw_szi(a, n)
+
+ integer, allocatable, intent(inout) :: a(:)
+ integer, intent(in) :: n
+ integer, allocatable :: tmp(:)
+
+ if (.not. allocated(a)) then
+ allocate (a(max(n, 64)))
+ return
+ end if
+ if (size(a) >= n) return
+ call move_alloc(a, tmp)
+ allocate (a(max(n, 2*size(tmp))))
+ a(1:size(tmp)) = tmp
+
+ end subroutine s_amr_fw_szi
+
+ impure subroutine s_amr_fw_szi3(a, n)
+
+ integer, allocatable, intent(inout) :: a(:,:)
+ integer, intent(in) :: n
+ integer, allocatable :: tmp(:,:)
+
+ if (.not. allocated(a)) then
+ allocate (a(3, max(n, 64)))
+ return
+ end if
+ if (size(a, 2) >= n) return
+ call move_alloc(a, tmp)
+ allocate (a(3, max(n, 2*size(tmp, 2))))
+ a(:,1:size(tmp, 2)) = tmp
+
+ end subroutine s_amr_fw_szi3
+
+ !> Wire pools: preserving on grow (the F5 waves append debug header slots incrementally; the other waves size once).
+ impure subroutine s_amr_fw_szr(a, n)
+
+ real(wp), allocatable, intent(inout) :: a(:)
+ integer, intent(in) :: n
+ real(wp), allocatable :: tmp(:)
+
+ if (.not. allocated(a)) then
+ allocate (a(max(n, 64)))
+ return
+ end if
+ if (size(a) >= n) return
+ call move_alloc(a, tmp)
+ allocate (a(max(n, 2*size(tmp))))
+ a(1:size(tmp)) = tmp
+
+ end subroutine s_amr_fw_szr
+
+ !> ADVANCE phase of a fine RK stage: fine RHS + RK update (+ QBMM/6eq/IB) for the current block. Owner-only. Reads the block's
+ !! ghost shell (coarse prolong + fine-fine halo already applied by the fill + halo phases).
+ !> One fine-block RK stage = RHS pass then RK pass. Fused wrapper: the AMR fine blocks (m_time_steppers) call this so their
+ !! rhs+rk stay back-to-back (byte-identical). The coexist tile path (s_l0_advance_stage) instead calls the two passes directly
+ !! with the reflux-delta copy-back interposed between them, so the corrected coarse rhs reaches the tile before its RK update.
+ impure subroutine s_amr_fine_stage_advance(s, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+
+ integer, intent(in) :: s, t_step
+ real(wp), intent(in) :: coefs(4)
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+
+ call s_amr_fine_stage_rhs(s, bc_type, q_T_sf, amr_scr_prim, amr_scr_rhs, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+ call s_amr_fine_stage_rk(s, coefs, amr_scr_prim, amr_scr_rhs)
+
+ end subroutine s_amr_fine_stage_advance
+
+ !> RHS pass of a fine-block RK stage: step-entry backup, swap grid globals to the block, s_compute_rhs (fills amr_slots%rhs +
+ !! captures the block's freg / its children's creg), restore coarse globals. Leaves the per-slot rhs ready for the RK pass (or,
+ !! under coexist, for the reflux-delta copy-back before the RK pass).
+ impure subroutine s_amr_fine_stage_rhs(s, bc_type, q_T_sf, q_prim_b, rhs_b, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+
+ integer, intent(in) :: s, t_step
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ !> the block's q_prim/rhs target: the pooled scratch for fine blocks, the slot's own arrays for L0 tiles (whose rhs must
+ !! survive the whole-set RHS pass; the caller chooses - see s_l0_advance_stage_rhs)
+ type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_b, rhs_b
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+
+ if (.not. amr .and. l0_ntile == 0) return
+ if (.not. amr_rank_owns_block) return
+ if (rank_time_wrt) call s_rank_time_tic()
+
+ ! step-entry backup for the SSP-RK combination (device copy over the current buffered extents)
+ if (s == 1) then
+ call s_amr_copy_fine_fields(amr_loc_of(amr_cur), amr_slots(amr_cur)%idwbuff(1)%beg, &
+ & amr_slots(amr_cur)%idwbuff(1)%end, amr_slots(amr_cur)%idwbuff(2)%beg, &
+ & amr_slots(amr_cur)%idwbuff(2)%end, amr_slots(amr_cur)%idwbuff(3)%beg, &
+ & amr_slots(amr_cur)%idwbuff(3)%end)
+ if (qbmm .and. .not. polytropic) call s_amr_backup_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf, &
+ & amr_slots(amr_cur)%pb_stor%sf, amr_slots(amr_cur)%mv_stor%sf)
+ end if
+
+ amr_in_fine_advance = .true.
+ call s_phase_tic(PH_SWAP)
+ call s_amr_swap_to_fine()
+ idwint = amr_slots(amr_cur)%idwbuff ! widen the conversion range to the ghost shell (restored by s_amr_restore_coarse)
+ $:GPU_UPDATE(device='[idwint]')
+ call s_phase_toc(PH_SWAP)
+ call s_phase_tic(PH_RHS)
+ call s_amr_br_load(amr_loc_of(amr_cur))
+ ! 2a: this block's computed prim vars (mom, E) were already produced by the stage-top batched conversion;
+ ! land them and let s_compute_rhs skip its per-block conversion. L0 tile slots (level 0) are not in the
+ ! batch and keep the per-block conversion.
+ if (amr_prim_batch .and. amr_block_level(amr_cur) >= 1) then
+ call s_amr_prim_load(q_prim_qp%vf, amr_loc_of(amr_cur))
+ amr_prim_preloaded = .true.
+ end if
+ if (qbmm .and. .not. polytropic) then
+ ! the block's OWN side-state and rhs scratch: the coarse pb_in/rhs_pb must not be touched at fine indices (the coarse
+ ! stage consumes them after this fine stage)
+ call s_compute_rhs(amr_cons_br, q_T_sf, q_prim_b, bc_type, rhs_b, amr_slots(amr_cur)%pb_f%sf, amr_rhs_pb_f, &
+ & amr_slots(amr_cur)%mv_f%sf, amr_rhs_mv_f, t_step, s)
+ else
+ call s_compute_rhs(amr_cons_br, q_T_sf, q_prim_b, bc_type, rhs_b, pb_in, rhs_pb, mv_in, rhs_mv, t_step, s)
+ end if
+ amr_prim_preloaded = .false.
+ call s_amr_br_store(amr_loc_of(amr_cur))
+ call s_phase_toc(PH_RHS)
+ call s_phase_tic(PH_SWAP) ! the other half of the swap pair - keep the bracket symmetric
+ call s_amr_restore_coarse()
+ call s_phase_toc(PH_SWAP)
+ amr_in_fine_advance = .false.
+
+ end subroutine s_amr_fine_stage_rhs
+
+ !> RK pass of a fine-block RK stage: SSP-RK combination consuming the per-slot rhs (already reflux-corrected under coexist),
+ !! then per-stage pressure relaxation / moving-IB / IB-state correction. Uses slot bounds (no grid swap needed).
+ impure subroutine s_amr_fine_stage_rk(s, coefs, q_prim_b, rhs_b)
+
+ integer, intent(in) :: s
+ real(wp), intent(in) :: coefs(4)
+ !> the same q_prim/rhs pair the RHS pass of this stage filled (pooled scratch for fine blocks, per-slot for L0 tiles)
+ type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_b, rhs_b
+
+ if (.not. amr .and. l0_ntile == 0) return
+ if (.not. amr_rank_owns_block) return
+
+ call s_phase_tic(PH_RK)
+ ! RK stage update (device kernel; mirror of the coarse form - under IGR the rhs already embeds dt, matching the coarse igr
+ ! update, so the dt factor is 1)
+ call s_amr_fine_rk_update(amr_loc_of(amr_cur), rhs_b, coefs(1), coefs(2), coefs(3), coefs(4), merge(1._wp, dt, igr))
+ if (qbmm .and. .not. polytropic) call s_amr_fine_rk_update_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf, &
+ & amr_slots(amr_cur)%pb_stor%sf, amr_slots(amr_cur)%mv_stor%sf, amr_rhs_pb_f, amr_rhs_mv_f, coefs(1), coefs(2), &
+ & coefs(3), coefs(4), dt)
+ ! 6-equation model: per-stage pressure relaxation on the block (before IB correct, coarse order)
+ if (model_eqns == model_eqns_6eq .and. (.not. relax)) call s_amr_pressure_relax_fine()
+ ! moving body: rebuild the fine-block IB state at the current (lockstep-stage) body position before the correct-state
+ if (moving_immersed_boundary_flag) call s_amr_update_mib_fine(-1._wp)
+ ! IB state correction on the fine block (mirrors the coarse per-stage correct-state; no-op unless ib)
+ call s_amr_ib_correct_fine(q_prim_b)
+ call s_phase_toc(PH_RK)
+ if (rank_time_wrt) call s_rank_time_toc()
+
+ end subroutine s_amr_fine_stage_rk
+
+ !> Per-block SETUP for the transposed subcycle advance (amr_subcycle): exchange valid coarse ghosts, gather+prolong the selected
+ !! block's two time-lerp ghost sources (parent t^n in q_ghost_a, t^{n+1} in q_ghost_b), and zero its flux registers. The
+ !! collective exchanges/gathers run on ALL ranks; the owner-only fills and register-zero are guarded. Called once per level-1
+ !! block before the transposed stage loop (which reuses the prepared ghost sources every substep).
+ impure subroutine s_amr_subcycle_setup_block(q_old, q_new, pb_old, mv_old, pb_in, mv_in)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_old, q_new
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_old, mv_old
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+
+ ! valid coarse CONS ghosts on both lerp sources (ALL ranks call: pairwise halo); the exchanged t^n / t^{n+1} ghost layers
+ ! make the prolonged block-boundary ghosts correct even at rank boundaries
+
+ ! the two lerp sources' coarse halos are LOOP-INVARIANT over the setup loop (both read, neither written), so the
+ ! exchanges are hoisted to s_amr_advance_fine_subcycle_all - same defect as the lock-step path, doubled for two fields
+
+ call s_amr_check_lag_clear() ! EVERY rank: non-owner bubbles can reach the block across a seam
+
+ ! fine-level distribution: gather each lerp source's coarse patch (collective - ALL ranks) then prolong its ghost shell on
+ ! the owner. Interleaved so the single amr_cg buffer is consumed by the fill before the next gather overwrites it.
+ ! non-polytropic QBMM: the pb/mv ghost shell gets the same two-source time-lerp treatment, gathered + filled INTERLEAVED
+ ! with
+ ! q_cons so the single amr_cg_pb/mv buffer is consumed by each fill before the next gather overwrites it. Gathers collective
+ ! (ALL ranks - P2P); fills owner-only.
+ call s_amr_gather_coarse_patch(q_old, .true.)
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics
+ if (qbmm .and. .not. polytropic) call s_amr_gather_coarse_patch_pbmv(pb_old, mv_old, .true.)
+ if (amr_rank_owns_block) call s_amr_fill_fine_ghosts_gsta(amr_cg, amr_loc_of(amr_cur))
+ if (amr_rank_owns_block .and. qbmm .and. .not. polytropic) call s_amr_fill_fine_ghosts_pbmv(amr_cg_pb, amr_cg_mv, &
+ & amr_slots(amr_cur)%pb_ghost_a%sf, amr_slots(amr_cur)%mv_ghost_a%sf)
+ call s_amr_gather_coarse_patch(q_new, .true.)
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics
+ if (qbmm .and. .not. polytropic) call s_amr_gather_coarse_patch_pbmv(pb_in, mv_in, .true.)
+ if (amr_rank_owns_block) call s_amr_fill_fine_ghosts_gstb(amr_cg, amr_loc_of(amr_cur))
+ if (amr_rank_owns_block .and. qbmm .and. .not. polytropic) call s_amr_fill_fine_ghosts_pbmv(amr_cg_pb, amr_cg_mv, &
+ & amr_slots(amr_cur)%pb_ghost_b%sf, amr_slots(amr_cur)%mv_ghost_b%sf)
+ if (.not. amr_rank_owns_block) return
+
+ ! registers accumulate over all six stages of the transposed loop, so zero them once at setup (the stage-1 overwrite trick
+ ! cannot span two substeps)
+ call s_amr_zero_fine_registers()
+
+ end subroutine s_amr_subcycle_setup_block
+
+ !> Subcycled fine advance (amr_subcycle) over ALL level-1 blocks, TRANSPOSED: instead of each block running its full 2x3-stage
+ !! subcycle in turn, every same-level block advances stage-by-stage in LOCKSTEP with the block-to-block fine-fine seam halo
+ !! (s_amr_fine_fine_halo) interposed between the ghost lerp and the RHS at each stage. That makes max_grid_size-tiled ADJACENT
+ !! sub-blocks (which appear at np>1 when a feature exceeds a rank's slot) compute a MATCHING shared-face flux, so the subcycle
+ !! conserves at the seam - the per-block order did not run the halo and leaked there. Two dt/2 SSP-RK3 substeps AFTER the coarse
+ !! step: q_old/q_new are the coarse t^n / t^{n+1} states; each stage's ghosts are the linear time interpolation at stage time
+ !! theta = (substep-1 + c_s)/2 with SSP-RK3 abscissae c = [0, 1, 1/2]. Level-1 blocks drive their level-2 children per substep
+ !! (s_amr_advance_children), which applies this same transposed shape at every deeper level, so L2-L2 seams are reconciled by
+ !! the level-filtered halo too. A single owned level-1 block is byte-identical to the old per-block subcycle (the halo is a
+ !! no-op with < 2 adjacent same-level blocks).
+ impure subroutine s_amr_advance_fine_subcycle_all(q_old, q_new, coefs, bc_type, q_T_sf, pb_old, mv_old, pb_in, rhs_pb, mv_in, &
+ & rhs_mv, t_step)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_old, q_new
+ real(wp), dimension(:,:), intent(in) :: coefs !< rk_coef(1:3, 1:4)
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(in) :: pb_old, mv_old
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+ integer, intent(in) :: t_step
+ real(wp), parameter :: c_abs(3) = [0._wp, 1._wp, 0.5_wp]
+ integer :: islot, sub, s
+ real(wp) :: th
+
+ if (.not. amr) return
+
+ ! valid coarse CONS ghosts on BOTH lerp sources, ONCE for the whole setup loop (ALL ranks call: pairwise halo). Neither
+ ! source is written below, so this is the loop-invariant hoist described in s_amr_subcycle_setup_block.
+ if (amr_xchg_coarse_ghosts) then
+ call s_amr_exchange_coarse_cons_halo(q_old)
+ call s_amr_exchange_coarse_cons_halo(q_new)
+ end if
+
+ ! SETUP: each level-1 block prepares its two time-lerp ghost sources and zeros its registers (collective; ALL ranks call)
+ do islot = 1, amr_num_blocks
+ if (amr_block_level(islot) /= 1) cycle
+ call s_amr_select_slot(islot)
+ call s_amr_subcycle_setup_block(q_old, q_new, pb_old, mv_old, pb_in, mv_in)
+ end do
+
+ do sub = 1, 2
+ do s = 1, 3
+ th = (real(sub - 1, wp) + c_abs(s))*0.5_wp
+ ! lerp every block's ghost shell to the stage time (+ substep-entry backup) BEFORE the seam halo reads interiors
+ do islot = 1, amr_num_blocks
+ if (amr_block_level(islot) /= 1) cycle
+ call s_amr_select_slot(islot)
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_subtree_stage_lerp(s, th)
+ end do
+ ! reconcile shared seam ghosts among ADJACENT same-level blocks so both sides compute a matching flux. Tiling can
+ ! split a wide feature into adjacent sub-blocks at ANY rank count (amr_maxc_fit caps a box at half the global extent
+ ! even at np=1), so the halo runs unconditionally - it self-no-ops when there are no seam pairs, keeping every
+ ! untiled
+ ! case byte-identical.
+ call s_amr_fine_fine_halo(0)
+ ! RHS + RK update every block from the reconciled ghost shell
+ do islot = 1, amr_num_blocks
+ if (amr_block_level(islot) /= 1) cycle
+ call s_amr_select_slot(islot)
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_subtree_stage_advance(amr_dt_fine, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step, &
+ & s, th)
+ end do
+ end do
+ ! after this substep EVERY level-1 block is at t_b (q_cons) with t_a in q_cons_stor: level 2 subcycles within [t_a, t_b]
+ ! then folds back (restrict + Berger-Colella reflux). ONE level-wide call, not one per parent - the level-2 seam halo
+ ! inside it spans all parents, so every owner must arrive at it together. No-op for single-level.
+ if (amr_max_level >= 2) call s_amr_advance_children(1, amr_dt_fine, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, &
+ & rhs_mv, t_step)
+ end do
+ call s_amr_select_slot(1)
+
+ end subroutine s_amr_advance_fine_subcycle_all
+
+ !> Ghost-lerp half of one subcycled fine substage for the selected block (amr_cur): time-interpolate the ghost shell to stage
+ !! time th and, on substep stage 1, back up the substep-entry state. Split from the RHS half so same-level blocks can run this
+ !! together and the block-to-block fine-fine seam halo can be interposed before any block reads a neighbour's interior.
+ !! Owner-only (the caller guards); no numerical coupling between blocks here.
+ impure subroutine s_amr_subtree_stage_lerp(s, th)
+
+ integer, intent(in) :: s
+ real(wp), intent(in) :: th
+
+ if (rank_time_wrt) call s_rank_time_tic()
+ ! lerp the ghost shell into q_cons at the stage time (device kernel; interior untouched)
+ call s_amr_lerp_fine_ghosts(amr_loc_of(amr_cur), th)
+ if (qbmm .and. .not. polytropic) call s_amr_lerp_fine_ghosts_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf, &
+ & amr_slots(amr_cur)%pb_ghost_a%sf, amr_slots(amr_cur)%mv_ghost_a%sf, amr_slots(amr_cur)%pb_ghost_b%sf, &
+ & amr_slots(amr_cur)%mv_ghost_b%sf, th)
+
+ ! substep-entry backup for the SSP-RK combination (device copy, interior only)
+ if (s == 1) then
+ call s_amr_copy_fine_fields(amr_loc_of(amr_cur), 0, amr_slots(amr_cur)%m, 0, amr_slots(amr_cur)%n, 0, &
+ & amr_slots(amr_cur)%p)
+ if (qbmm .and. .not. polytropic) call s_amr_backup_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf, &
+ & amr_slots(amr_cur)%pb_stor%sf, amr_slots(amr_cur)%mv_stor%sf)
+ end if
+ if (rank_time_wrt) call s_rank_time_toc()
+
+ end subroutine s_amr_subtree_stage_lerp
+
+ !> RHS + RK-update half of one subcycled fine substage for the selected block (amr_cur): compute the fine RHS from the (already
+ !! halo-reconciled) ghost shell and apply the SSP-RK stage update at the fine substep dt_sub, plus per-stage pressure relaxation
+ !! and IB correction. Split from the lerp half so the fine-fine seam halo runs between them. Owner-only (caller guards).
+ impure subroutine s_amr_subtree_stage_advance(dt_sub, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step, s, th)
+
+ real(wp), intent(in) :: dt_sub !< this block's substep dt (parent step / amr_ref_ratio)
+ real(wp), dimension(:,:), intent(in) :: coefs !< rk_coef(1:3, 1:4)
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+ integer, intent(in) :: t_step, s
+ real(wp), intent(in) :: th
+
+ if (rank_time_wrt) call s_rank_time_tic()
+ amr_in_fine_advance = .true.
+ call s_amr_swap_to_fine()
+ ! widen the conversion range to the ghost shell (restored by s_amr_restore_coarse)
+ idwint = amr_slots(amr_cur)%idwbuff
+ $:GPU_UPDATE(device='[idwint]')
+ call s_amr_br_load(amr_loc_of(amr_cur))
+ if (qbmm .and. .not. polytropic) then
+ ! the block's OWN side-state and rhs scratch (the coarse arrays stay untouched)
+ call s_compute_rhs(amr_cons_br, q_T_sf, amr_scr_prim, bc_type, amr_scr_rhs, amr_slots(amr_cur)%pb_f%sf, amr_rhs_pb_f, &
+ & amr_slots(amr_cur)%mv_f%sf, amr_rhs_mv_f, t_step, s)
+ else
+ call s_compute_rhs(amr_cons_br, q_T_sf, amr_scr_prim, bc_type, amr_scr_rhs, pb_in, rhs_pb, mv_in, rhs_mv, t_step, s)
+ end if
+ call s_amr_br_store(amr_loc_of(amr_cur))
+ call s_amr_restore_coarse()
+ amr_in_fine_advance = .false.
+
+ ! RK stage update at the FINE time step (device kernel)
+ call s_amr_fine_rk_update(amr_loc_of(amr_cur), amr_scr_rhs, coefs(s, 1), coefs(s, 2), coefs(s, 3), coefs(s, 4), dt_sub)
+ if (qbmm .and. .not. polytropic) then
+ call s_amr_fine_rk_update_pbmv(amr_slots(amr_cur)%pb_f%sf, amr_slots(amr_cur)%mv_f%sf, amr_slots(amr_cur)%pb_stor%sf, &
+ & amr_slots(amr_cur)%mv_stor%sf, amr_rhs_pb_f, amr_rhs_mv_f, coefs(s, 1), coefs(s, 2), &
+ & coefs(s, 3), coefs(s, 4), dt_sub)
+ end if
+ ! 6-equation model: per-substage pressure relaxation (instantaneous equilibration - per stage at fine dt is the same
+ ! infinite-rate limit the coarse applies per stage)
+ if (model_eqns == model_eqns_6eq .and. (.not. relax)) call s_amr_pressure_relax_fine()
+ ! moving body: rebuild the fine-block IB state at the body's fine sub-time position (th matches the fluid-ghost lerp)
+ if (moving_immersed_boundary_flag) call s_amr_update_mib_fine(th)
+ ! IB state correction on the fine block after each substep RK update (no-op unless ib)
+ call s_amr_ib_correct_fine(amr_scr_prim)
+ if (rank_time_wrt) call s_rank_time_toc()
+
+ end subroutine s_amr_subtree_stage_advance
+
+ !> Recursively subcycle EVERY block at level plev+1 - across ALL parents at once - within one of the parents' substeps [t_a,
+ !! t_b] (duration dt_sub). Every level-plev block has just finished that substep: q_cons = parent @ t_b, q_cons_stor = parent @
+ !! t_a. Per child: gather its two ghost-lerp sources from its OWN parent's two snapshots (parent-fine frame), recurse into level
+ !! plev+2 at dt_sub/2 (a child takes amr_ref_ratio substeps covering [t_a, t_b]), then fold back into its parent - restrict the
+ !! covered cells and apply the Berger-Colella C/F flux correction (s_amr_reflux_to_parent over dt_sub, consuming the child's
+ !! freg + the parent-side creg captured during THIS substep). The registers already carry the matching per-substep time weights
+ !! (freg 1/r*rk3_w, creg rk3_w), so conservation closes with no register changes.
+ !!
+ !! LEVEL-WIDE, NOT PER-PARENT. Driving one parent's whole subtree to completion before the next parent's put the interposed
+ !! s_amr_fine_fine_halo(clev) out of lockstep: the halo exchanges EVERY level-clev seam pair, so a pair whose two blocks sit
+ !! under different parents had only one side present. Co-location hid that (both ends of such a pair landed on one rank, making
+ !! the exchange a local device copy), which is why multi-level subcycling was fail-closed at np>1. Walking the whole level
+ !! together puts every owner at the same halo. At np=1 this only re-orders independent per-parent work - each child reads solely
+ !! its own parent's finished snapshots and its same-level neighbours - so results are unchanged.
+ recursive subroutine s_amr_advance_children(plev, dt_sub, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+
+ integer, intent(in) :: plev
+ real(wp), intent(in) :: dt_sub
+ real(wp), dimension(:,:), intent(in) :: coefs
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+ integer, intent(in) :: t_step
+ real(wp), parameter :: c_abs(3) = [0._wp, 1._wp, 0.5_wp]
+ integer :: kc, pblk, clev, sub, s
+ real(wp) :: th
+
+ clev = plev + 1
+ ! SETUP each child: its two ghost-lerp sources from ITS OWN parent's substep endpoints (parent-fine frame) + zeroed
+ ! registers
+ do kc = 1, amr_num_blocks
+ if (amr_block_level(kc) /= clev) cycle
+ call s_amr_select_slot(kc) ! amr_cur = kc; mirrors (isect already parent-fine)
+ pblk = f_amr_parent_block(kc)
+ if (.not. (amr_rank_owns_block .or. amr_block_owner(pblk) == proc_rank)) cycle
+ ! Two P2P pairs (parent @ t_a, then @ t_b), so BOTH owners must arrive or the receiver never posts. The parent owner
+ ! packs and sends from its own slot; the child owner receives WITHOUT naming the parent field - amr_slots(pblk) is
+ ! unallocated there. Co-located (np=1, or parent and child on one rank) takes the local device-copy path unchanged.
+ ! Both sends carry tag amr_cur; MPI non-overtaking on a fixed (source, tag, comm) keeps t_a ahead of t_b.
+ if (amr_block_owner(pblk) == proc_rank) then
+ call s_amr_gather_from_parent_field_stor(amr_cur, pblk, amr_loc_of(pblk), .false.) ! parent @ t_a (device C/F fill)
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics - NO drain follows this loop
+ else
+ call s_amr_recv_parent_patch(pblk, .false.)
+ end if
+ if (amr_rank_owns_block) call s_amr_fill_fine_ghosts_gsta(amr_cg, amr_loc_of(kc))
+ if (amr_block_owner(pblk) == proc_rank) then
+ call s_amr_gather_from_parent_field_cons(amr_cur, pblk, amr_loc_of(pblk), .false.) ! parent @ t_b (device C/F fill)
+ call s_amr_gather_send_flush() ! keep this site's original blocking semantics - NO drain follows this loop
+ else
+ call s_amr_recv_parent_patch(pblk, .false.)
+ end if
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_fill_fine_ghosts_gstb(amr_cg, amr_loc_of(kc))
+ call s_amr_zero_fine_registers()
+ end do
+ ! ADVANCE the level TRANSPOSED - every level-clev block through each substep together, with the level-clev seam halo
+ ! interposed - exactly as s_amr_advance_fine_subcycle_all does at level 1. Advancing each child's whole subtree in turn (the
+ ! previous shape) left adjacent blocks unable to see each other, so their shared face carried mismatched fluxes; that is why
+ ! the regrid clamped subcycle to ONE capped child per box. The halo is level-filtered because this runs INSIDE one of the
+ ! parents' substeps, when level plev is mid-substep and must not be touched.
+ do sub = 1, 2
+ do s = 1, 3
+ th = (real(sub - 1, wp) + c_abs(s))*0.5_wp
+ do kc = 1, amr_num_blocks
+ if (amr_block_level(kc) /= clev) cycle
+ call s_amr_select_slot(kc)
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_subtree_stage_lerp(s, th)
+ end do
+ call s_amr_fine_fine_halo(clev)
+ do kc = 1, amr_num_blocks
+ if (amr_block_level(kc) /= clev) cycle
+ call s_amr_select_slot(kc)
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_subtree_stage_advance(dt_sub*0.5_wp, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step, &
+ & s, th)
+ end do
+ end do
+ ! every level-clev block is now at its own t_b with t_a in q_cons_stor: recurse into level clev+1 within this substep
+ if (amr_max_level >= clev + 1) call s_amr_advance_children(clev, dt_sub*0.5_wp, coefs, bc_type, q_T_sf, pb_in, &
+ & rhs_pb, mv_in, rhs_mv, t_step)
+ end do
+ ! FOLD each child back into its parent (relax the fine phase first, matching the driver's relax -> restrict order)
+ do kc = 1, amr_num_blocks
+ if (amr_block_level(kc) /= clev) cycle
+ call s_amr_select_slot(kc)
+ ! The restrict and the reflux are each a P2P pair when child and parent are on different ranks, so BOTH participants
+ ! must reach them or the receiver never posts and the pair deadlocks. Owner-only work (relax) stays behind the guard.
+ if (amr_rank_owns_block) then
+ if (relax) call s_amr_relax_fine()
+ end if
+ if (amr_rank_owns_block .or. amr_block_owner(f_amr_parent_block(kc)) == proc_rank) then
+ call s_amr_restrict_to_parent()
+ call s_amr_reflux_to_parent(dt_sub, .true.)
+ end if
+ end do
+
+ end subroutine s_amr_advance_children
+
+ !> Convert a physical-space bbox to a global coarse-index bbox padded by pad_cells.
+ pure subroutine s_lag_phys_to_cells(pmin, pmax, pad_cells, blo, bhi)
+
+ real(wp), dimension(3), intent(in) :: pmin, pmax
+ integer, intent(in) :: pad_cells
+ integer, intent(out) :: blo(3), bhi(3)
+
+ blo(1) = int((pmin(1) - glb_bounds(1)%beg)/dx(0)) - pad_cells
+ bhi(1) = int((pmax(1) - glb_bounds(1)%beg)/dx(0)) + pad_cells
+ blo(2) = 0; bhi(2) = 0; blo(3) = 0; bhi(3) = 0
+ if (n_glb > 0) then
+ blo(2) = int((pmin(2) - glb_bounds(2)%beg)/dy(min(1, n))) - pad_cells
+ bhi(2) = int((pmax(2) - glb_bounds(2)%beg)/dy(min(1, n))) + pad_cells
+ end if
+ if (p_glb > 0) then
+ blo(3) = int((pmin(3) - glb_bounds(3)%beg)/dz(0)) - pad_cells
+ bhi(3) = int((pmax(3) - glb_bounds(3)%beg)/dz(0)) + pad_cells
+ end if
+
+ end subroutine s_lag_phys_to_cells
+
+ !> Rank-local per-stage guard: the local bubbles' padded bbox must stay clear of the current block. Catches an overlapping
+ !! initial placement on the first stage and drift that outran the regrid margin afterwards.
+ impure subroutine s_amr_check_lag_clear()
+
+ real(wp), dimension(3) :: pmin_loc, pmax_loc
+ integer :: blo(3), bhi(3)
+ logical :: ovl
+
+ if (.not. bubbles_lagrange) return
+ call s_lag_cloud_bbox_local(pmin_loc, pmax_loc)
+ if (pmin_loc(1) > pmax_loc(1)) return ! no bubbles on this rank
+ call s_lag_phys_to_cells(pmin_loc, pmax_loc, mapCells + 2, blo, bhi)
+ ovl = blo(1) <= amr_slots(amr_cur)%region%hi(1) .and. bhi(1) >= amr_slots(amr_cur)%region%lo(1)
+ if (n_glb > 0) ovl = ovl .and. blo(2) <= amr_slots(amr_cur)%region%hi(2) .and. bhi(2) >= amr_slots(amr_cur)%region%lo(2)
+ if (p_glb > 0) ovl = ovl .and. blo(3) <= amr_slots(amr_cur)%region%hi(3) .and. bhi(3) >= amr_slots(amr_cur)%region%lo(3)
+ if (ovl) then
+ call s_mpi_abort('amr with Lagrangian bubbles: the bubble cloud (positions + smearing support) ' &
+ & // 'overlaps an active fine block, where two-way coupling would be lost. Keep the initial ' &
+ & // 'block clear of the cloud; under dynamic regrid, reduce amr_regrid_int or increase ' &
+ & // 'amr_buf so the exclusion margin covers the cloud drift between regrids')
+ end if
+
+ end subroutine s_amr_check_lag_clear
+
+ !> Expand a candidate regrid box (global indices) to fully contain every immersed body it overlaps, with a buff_size margin (the
+ !! IB image-point stencils need resolved surroundings). Expansion is re-clamped to the domain interior by the caller's own
+ !! guards; a body too large for the per-rank block cap aborts with a named message. The bbox reads the live centroid, so a
+ !! moving body's box tracks its current position; between regrids s_amr_update_mib_fine guards containment.
+
+ !> Margin-padded global coarse-index bounding box of immersed body i (supported analytic geometries only; aborts on others).
+ !! Reads the body's LIVE centroid, so a moving body's box tracks its current position.
+ impure subroutine s_amr_body_bbox(i, mrg, blo, bhi)
+
+ integer, intent(in) :: i, mrg
+ integer, intent(out) :: blo(3), bhi(3)
+ real(wp) :: c(3), half(3)
+
+ c = [patch_ib(i)%x_centroid, patch_ib(i)%y_centroid, patch_ib(i)%z_centroid]
+ select case (patch_ib(i)%geometry)
+ case (2, 8, 10) ! circle, sphere, cylinder: radius-bounded (cylinder length adds below)
+ half = patch_ib(i)%radius
+ if (patch_ib(i)%geometry == 10) then
+ half(1) = max(half(1), 0.5_wp*patch_ib(i)%length_x)
+ half(2) = max(half(2), 0.5_wp*patch_ib(i)%length_y)
+ half(3) = max(half(3), 0.5_wp*patch_ib(i)%length_z)
+ end if
+ case (3, 9) ! rectangle, box
+ half = 0.5_wp*[patch_ib(i)%length_x, patch_ib(i)%length_y, patch_ib(i)%length_z]
+ case default
+ call s_mpi_abort('amr dynamic regrid with ib: unsupported body geometry for the ' &
+ & // 'containment bounding box (supported: circle/rectangle/sphere/box/cylinder)')
+ end select
+ ! physical bbox -> global coarse indices: uniform spacing only (stretched grids with ib-dynamic-regrid/Lagrangian are
+ ! aborted
+ ! at init; the axisymmetric half axis cell only shrinks dy(0), so the floor is still conservative)
+ blo(1) = int((c(1) - half(1) - glb_bounds(1)%beg)/dx(0)) - mrg
+ bhi(1) = int((c(1) + half(1) - glb_bounds(1)%beg)/dx(0)) + mrg
+ blo(2) = 0; bhi(2) = 0; blo(3) = 0; bhi(3) = 0
+ if (n_glb > 0) then
+ blo(2) = int((c(2) - half(2) - glb_bounds(2)%beg)/dy(min(1, n))) - mrg
+ bhi(2) = int((c(2) + half(2) - glb_bounds(2)%beg)/dy(min(1, n))) + mrg
+ end if
+ if (p_glb > 0) then
+ blo(3) = int((c(3) - half(3) - glb_bounds(3)%beg)/dz(0)) - mrg
+ bhi(3) = int((c(3) + half(3) - glb_bounds(3)%beg)/dz(0)) + mrg
+ end if
+
+ end subroutine s_amr_body_bbox
+
+ impure subroutine s_amr_expand_box_over_bodies(lo, hi)
+
+ integer, intent(inout) :: lo(3), hi(3)
+ integer :: i, d, blo(3), bhi(3), mrg
+ logical :: ovl
+
+ ! containment margin: the IB image-point stencil reaches a few cells beyond the surface (the validated static-block goldens
+ ! keep ~5); buff_size (floored to 10 by ib) would exceed the per-rank block cap for ordinary bodies. For amr_max_level > 1
+ ! the
+ ! body must survive every child nesting inset (amr_cpat_mar per level down to amr_max_level), so the parent block clears the
+ ! body by that many extra cells - keeping the finest C/F boundary a full image-point stencil off the surface (refining the
+ ! surface, not the interior).
+
+ mrg = max(amr_buf, 4) + max(0, amr_max_level - 1)*amr_cpat_mar
+
+ do i = 1, num_ibs
+ call s_amr_body_bbox(i, mrg, blo, bhi)
+ ! blocks must stay buff_size inside the domain: a body whose margin-padded bbox does not fit cannot be contained - fail
+ ! with a named message instead of a clipped body
+ if (blo(1) < buff_size .or. bhi(1) > m_glb - buff_size .or. (n_glb > 0 .and. (blo(2) < buff_size .or. bhi(2) > n_glb &
+ & - buff_size)) .or. (p_glb > 0 .and. (blo(3) < buff_size .or. bhi(3) > p_glb - buff_size))) then
+ call s_mpi_abort('amr dynamic regrid with ib: the immersed body plus its containment ' &
+ & // 'margin does not fit inside the refinable domain interior (blocks stay buff_size off the edges)')
+ end if
+ ovl = lo(1) <= bhi(1) .and. hi(1) >= blo(1)
+ if (n_glb > 0) ovl = ovl .and. lo(2) <= bhi(2) .and. hi(2) >= blo(2)
+ if (p_glb > 0) ovl = ovl .and. lo(3) <= bhi(3) .and. hi(3) >= blo(3)
+ if (.not. ovl) cycle
+ do d = 1, num_dims
+ lo(d) = min(lo(d), blo(d))
+ hi(d) = max(hi(d), bhi(d))
+ end do
+ if (hi(1) - lo(1) + 1 > amr_maxc_fit(1) .or. (n_glb > 0 .and. hi(2) - lo(2) + 1 > amr_maxc_fit(2)) .or. (p_glb > 0 &
+ & .and. hi(3) - lo(3) + 1 > amr_maxc_fit(3))) then
+ call s_mpi_abort('amr dynamic regrid with ib: containing the immersed body plus margin ' &
+ & // 'exceeds the per-rank block size cap; use fewer ranks or a larger amr_maxc_fit')
+ end if
+ end do
+
+ end subroutine s_amr_expand_box_over_bodies
+
+ !> max_grid_size tiling: split box [lo:hi] into a grid of contiguous sub-boxes each <= amr_maxc_fit per dim (the max a rank can
+ !! whole-own), appending them to out(nt+1:). Tiles are ADJACENT (share fine seams) - the block-to-block fine-fine halo makes
+ !! those seams conservative. Even split: ntl = ceil(ext/amr_maxc_fit) tiles, each of size ceil(ext/ntl) <= amr_maxc_fit. Sets
+ !! capped=1 and stops if the amr_max_blocks cap is hit. Collapsed dims stay [0:0].
+ pure subroutine s_amr_tile_box(lo, hi, out, nt, cap, capped, tsz)
+
+ integer, intent(in) :: lo(3), hi(3), cap
+ type(t_box), intent(inout) :: out(:)
+ integer, intent(inout) :: nt, capped
+ !> per-dim tile size (default amr_maxc_fit; a level-lev caller passes amr_maxc_fit/amr_ref_ratio**(lev-1) - the slot holds
+ !! amr_ref_ratio*amr_maxc_fit fine cells and a level-lev block spans amr_ref_ratio**lev per coarse cell)
+ integer, intent(in), optional :: tsz(3)
+ integer :: ntl(3), s(3), t1, t2, t3, qlo(3), qhi(3), tc(3)
+
+ tc = amr_maxc_fit; if (present(tsz)) tc = tsz
+ tc = max(tc, 1) ! a level>=2 caller passes amr_maxc_fit/2, which is 0 when a rank's fine half-extent is 1 (small subdomain
+ ! at high np) - a 0 tile size would divide-by-zero below; a 1-cell tile is the valid floor
+ ntl = 1; s = 1
+ ntl(1) = (hi(1) - lo(1) + tc(1))/tc(1); s(1) = (hi(1) - lo(1) + ntl(1))/ntl(1)
+ if (n_glb > 0) then
+ ntl(2) = (hi(2) - lo(2) + tc(2))/tc(2); s(2) = (hi(2) - lo(2) + ntl(2))/ntl(2)
+ end if
+ if (p_glb > 0) then
+ ntl(3) = (hi(3) - lo(3) + tc(3))/tc(3); s(3) = (hi(3) - lo(3) + ntl(3))/ntl(3)
+ end if
+ do t3 = 0, ntl(3) - 1
+ qlo(3) = 0; qhi(3) = 0
+ if (p_glb > 0) then; qlo(3) = lo(3) + t3*s(3); qhi(3) = min(lo(3) + (t3 + 1)*s(3) - 1, hi(3)); end if
+ do t2 = 0, ntl(2) - 1
+ qlo(2) = 0; qhi(2) = 0
+ if (n_glb > 0) then; qlo(2) = lo(2) + t2*s(2); qhi(2) = min(lo(2) + (t2 + 1)*s(2) - 1, hi(2)); end if
+ do t1 = 0, ntl(1) - 1
+ if (nt >= cap) then; capped = 1; return; end if
+ qlo(1) = lo(1) + t1*s(1); qhi(1) = min(lo(1) + (t1 + 1)*s(1) - 1, hi(1))
+ nt = nt + 1; out(nt)%lo = qlo; out(nt)%hi = qhi
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_tile_box
+
+ !> minmod slope limiter: 0 if a,b differ in sign, else the smaller-magnitude argument.
+ pure elemental function minmod(a, b) result(m)
+
+ $:GPU_ROUTINE(parallelism='[seq]')
+ real(wp), intent(in) :: a, b
+ real(wp) :: m
+
+ if (a*b <= 0._wp) then
+ m = 0._wp
+ else if (abs(a) < abs(b)) then
+ m = a
+ else
+ m = b
+ end if
+
+ end function minmod
+
+ !> Allocate slot islot's per-block field arrays (coords + the 6 device-resident field vectors + non-poly QBMM side-state), sized
+ !! to the max buffered block. Idempotent (no-op if already live). The single QBMM RHS scratch amr_rhs_pb_f/mv_f and the global
+ !! amr_cg are NOT per-slot and stay in init/finalize.
+ !> Allocate/reset the dense local-index maps. Called from BOTH pool-allocation sites - s_initialize_amr_module and
+ !! s_l0_tiles_init - because pure-L0 mode (amr = F) returns early from the former yet still calls s_amr_alloc_slot. Idempotent
+ !! so either order is safe.
+ impure subroutine s_amr_loc_index_init()
+
+ if (.not. allocated(amr_loc_of)) allocate (amr_loc_of(1:amr_max_blocks))
+ if (.not. allocated(amr_loc_free)) allocate (amr_loc_free(1:amr_max_blocks))
+ amr_loc_of = 0; amr_loc_free = 0; amr_loc_n = 0; amr_loc_nfree = 0
+
+ end subroutine s_amr_loc_index_init
+
+ !> Move one local slot's store data src -> dst on the DEVICE, in place within each live store array (no staging copy: holding a
+ !! second store-sized array on device is exactly the transient that OOMs at the S0 operating point). s_amr_compact_store's
+ !! ascending-source ordering guarantees dst's previous contents are already consumed. The HOST copy goes stale, which is the
+ !! store's normal state between rebuilds (device-authoritative; host readers pull per slot).
+ impure subroutine s_amr_st_move_slot(src, dst)
+
+ integer, intent(in) :: src, dst
+ integer :: i, j, k, l
+ logical :: want(4)
+
+ want = [.true., .true., amr_subcycle, amr_subcycle]
+ #:for ST, IDX in [('amr_cons_st', 1), ('amr_stor_st', 2), ('amr_gst_a', 3), ('amr_gst_b', 4)]
+ if (want(${IDX}$)) then
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = mbuf3_lo, mbuf3_hi
+ do k = mbuf2_lo, mbuf2_hi
+ do j = mbuf1_lo, mbuf1_hi
+ ${ST}$(j, k, l, i, dst) = ${ST}$(j, k, l, i, src)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ #:endfor
+
+ end subroutine s_amr_st_move_slot
+
+ !> Re-densify the flat store's local INDEX SPACE after every reconcile: the W8 weak-scaling fix. Slot indices are GLOBAL, so at
+ !! np>=2 a rank's owned set is a shifting SFC window plus received migration slots; without re-densification `amr_loc_n`
+ !! ratchets run-long (~210 MiB/slot of capacity) until the device OOMs at FIXED per-rank work (measured: S0 np=4). Renumbering
+ !! every reconcile pins loc_n to the live count, so the capacity high-water plateaus at the rebuild transient (old + new block
+ !! generations coexist mid-rebuild, ~2x live) instead of growing without bound. The allocation itself is NOT shrunk - the moves
+ !! are device-side and in place, processed in ascending old-index order, which makes in-place safe: each destination (the rank
+ !! of its source among the live indices) is <= its source, and every pending source lies above the current destination.
+ !!
+ !! Called at the END of s_amr_reconcile_slots, where every reader is finished: the rebuild's overlap carry-forward
+ !! (which reads amr_stor_st at the OLD blocks' local indices) has completed, and the next rebuild has not started.
+ impure subroutine s_amr_compact_store()
+
+ integer :: k, v, newloc
+ integer, allocatable :: inv(:)
+
+ if (amr_st_cap <= 0) return
+ ! invert the map: inv(local index) = global slot, 0 if free. The walk covers the L0 tile prefix too - those slots
+ ! hold store data even though the reconcile walk skips them.
+ allocate (inv(amr_st_cap)); inv = 0
+ do k = 1, amr_max_blocks
+ if (amr_loc_of(k) > 0) inv(amr_loc_of(k)) = k
+ end do
+ newloc = 0
+ do v = 1, amr_st_cap
+ if (inv(v) == 0) cycle
+ newloc = newloc + 1
+ amr_loc_of(inv(v)) = newloc
+ if (newloc /= v) call s_amr_st_move_slot(v, newloc)
+ end do
+ deallocate (inv)
+#ifdef MFC_DEBUG
+ if (newloc < amr_loc_n) write (0, '(A,I0,A,I0,A,I0,A,I0)') '[amr-compact] rank ', proc_rank, ' loc_n ', amr_loc_n, &
+ & ' -> ', newloc, ' cap ', amr_st_cap
+#endif
+ amr_loc_n = newloc
+ amr_loc_nfree = 0 ! every recycled index is invalid after renumbering
+ amr_st_hw = newloc ! let the trip-wire report the post-compaction trajectory
+
+ end subroutine s_amr_compact_store
+
+ !> Size the flat store for at least nloc local slots, growing 1.25x and never shrinking, so a run pays few reallocations no
+ !! matter how the block count churns (with the index space re-densified every reconcile, growth fires only on a new
+ !! rebuild-transient high-water). Growth must PRESERVE the live blocks' fields, and those live on the device, so each array
+ !! stages through a DEVICE-side temporary (two on-device copies, no PCIe round trip) - the device-native remake the
+ !! store-vs-AMReX analysis called for. The old device->host->device trip existed only to carry the migration stash's host writes
+ !! across a growth; the stash chain is device-side now, so no reader depends on the host mirror through a grow.
+ impure subroutine s_amr_st_reserve(nloc)
+
+ integer, intent(in) :: nloc
+ integer :: oldcap, newcap, i
+ integer :: c5, i4, k3, j2, i1
+ !> device-native staging doubles the array's device footprint transiently; above this many old columns, fall back to the
+ !! host round trip (device peak max(old, new)). 32 covers the startup/early-regrid growth events whose round trips dominated
+ !! short runs, while near-limit late growth keeps the OOM-safe path.
+ integer, parameter :: amr_grow_dev_cap = 32
+ logical :: want(4)
+ real(stp), allocatable :: tmp(:,:,:,:,:), hstage(:,:,:,:,:)
+ type(scalar_field), allocatable :: tmp_br(:) !< CCE descriptor workaround, see below
+
+ ! CONTRACT: the store is DEVICE-authoritative at every call; growth preserves the DEVICE contents only, and the host
+ ! mirror comes out of a growth UNDEFINED (host readers pull per slot before reading - the store's normal state between
+ ! rebuilds anyway, cf. s_amr_compact_store). A caller that has just written the store on the HOST (restart read) must
+ ! still push its slot to the device before the next s_amr_alloc_slot, or that host data is lost.
+
+ ! TRIP-WIRE on the store trajectory (kept from the W8 ratchet investigation). STDERR because stdout is buffered and
+ ! lost on abort - the OOM run's stdout showed nothing at all.
+
+ if (nloc > amr_st_hw) then
+ amr_st_hw = nloc
+#ifdef MFC_DEBUG
+ write (0, '(A,I0,A,I0,A,I0,A,I0)') '[amr-store] rank ', proc_rank, ' NEW high-water nloc ', nloc, ' cap ', &
+ & amr_st_cap, ' recycle-depth ', amr_loc_nfree
+#endif
+ end if
+ if (nloc <= amr_st_cap) return
+ oldcap = amr_st_cap
+ ! grow 1.25x with the increment CAPPED at 16 slots: a proportional increment is itself store-scaled, and at a large cap
+ ! the +25% transient is what tips a near-limit device over (measured: S0 np=4 plateaued flat at 57.3 GiB, then one
+ ! late-run growth event's +67-slot overshoot OOMed it). The +8 floor keeps early growth cheap when oldcap is tiny.
+ newcap = max(oldcap + max(min(oldcap/4, 16), 8), nloc)
+ want = [.true., .true., amr_subcycle, amr_subcycle]
+
+ #:for ST, IDX in [('amr_cons_st', 1), ('amr_stor_st', 2), ('amr_gst_a', 3), ('amr_gst_b', 4)]
+ if (want(${IDX}$)) then
+ if (oldcap > amr_grow_dev_cap) then
+ ! near-limit fallback: the device-native staging below transiently holds old + tmp = 2*oldcap columns
+ ! on the device, and growth fires exactly at the memory high-water mark - a measured OOM class (a
+ ! +25%-increment transient alone tipped a 57.3 GiB np=4 run; see the cap-sweep history). Above the
+ ! threshold, keep the host round trip: slow (full PCIe both ways) but its device peak is max(old, new).
+ $:GPU_UPDATE(host='[' + ST + ']')
+ allocate (hstage(mbuf1_lo:mbuf1_hi,mbuf2_lo:mbuf2_hi,mbuf3_lo:mbuf3_hi,1:sys_size,1:oldcap))
+ hstage = ${ST}$(:,:,:,:,1:oldcap)
+ @:DEALLOCATE(${ST}$)
+ @:ALLOCATE(${ST}$(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:sys_size, 1:newcap))
+ ${ST}$(:,:,:,:,1:oldcap) = hstage
+ ${ST}$(:,:,:,:,oldcap + 1:newcap) = 0._stp
+ deallocate (hstage)
+ $:GPU_UPDATE(device='[' + ST + ']')
+ else
+ if (oldcap > 0) then
+ ! stage the live columns on the DEVICE (tmp is device-mapped by @:ALLOCATE); no PCIe traffic
+ @:ALLOCATE(tmp(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:sys_size, 1:oldcap))
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do c5 = 1, oldcap
+ do i4 = 1, sys_size
+ do k3 = mbuf3_lo, mbuf3_hi
+ do j2 = mbuf2_lo, mbuf2_hi
+ do i1 = mbuf1_lo, mbuf1_hi
+ tmp(i1, j2, k3, i4, c5) = ${ST}$(i1, j2, k3, i4, c5)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ @:DEALLOCATE(${ST}$)
+ end if
+ @:ALLOCATE(${ST}$(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:sys_size, 1:newcap))
+ ! restore the preserved columns and zero the rest, both on the device; the host mirror stays undefined
+ ! (see the contract above - every host reader pulls its slot first). Two kernels so the zero-only path
+ ! (oldcap == 0) never references the unallocated tmp.
+ if (oldcap > 0) then
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do c5 = 1, oldcap
+ do i4 = 1, sys_size
+ do k3 = mbuf3_lo, mbuf3_hi
+ do j2 = mbuf2_lo, mbuf2_hi
+ do i1 = mbuf1_lo, mbuf1_hi
+ ${ST}$(i1, j2, k3, i4, c5) = tmp(i1, j2, k3, i4, c5)
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ @:DEALLOCATE(tmp)
+ end if
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do c5 = oldcap + 1, newcap
+ do i4 = 1, sys_size
+ do k3 = mbuf3_lo, mbuf3_hi
+ do j2 = mbuf2_lo, mbuf2_hi
+ do i1 = mbuf1_lo, mbuf1_hi
+ ${ST}$(i1, j2, k3, i4, c5) = 0._stp
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+ #:endfor
+
+ amr_st_cap = newcap
+
+ ! the bridge spans a BOUNDED batch of blocks along k (see amr_br_batch), so one s_compute_rhs call can advance a
+ ! whole batch instead of one block; it rides the same pool lifetime and is rebuilt only if the window changes
+ amr_br_w = mbuf3_hi - mbuf3_lo + 1
+ if (.not. allocated(amr_cons_br)) then
+ ! Same CCE descriptor defect as amr_cg / amr_scr_prim: a bare module-scope derived-type allocatable must be given a
+ ! valid descriptor by allocating a LOCAL and handing it over with move_alloc, then mapped.
+ allocate (tmp_br(1:sys_size)); call move_alloc(tmp_br, amr_cons_br)
+ $:GPU_ENTER_DATA(create='[amr_cons_br]')
+ do i = 1, sys_size
+ @:ALLOCATE(amr_cons_br(i)%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_lo + amr_br_batch*amr_br_w - 1))
+ @:ACC_SETUP_SFs(amr_cons_br(i))
+ end do
+ amr_br_nblk = amr_br_batch
+ end if
+
+ ! 2a prim landing zone + batch metadata: per-STAGE scratch (rewritten by every s_amr_convert_prim_batch
+ ! call), so growth discards contents - no device staging round trip, unlike the stores above.
+ if (amr_prim_batch) then
+ if (allocated(amr_prim_st)) then
+ @:DEALLOCATE(amr_prim_st)
+ @:DEALLOCATE(amr_bt_lo)
+ @:DEALLOCATE(amr_bt_hi)
+ @:DEALLOCATE(amr_bt_on)
+ end if
+ allocate (amr_prim_st(mbuf1_lo:mbuf1_hi,mbuf2_lo:mbuf2_hi,mbuf3_lo:mbuf3_hi,1:num_vels + 1,1:newcap))
+ allocate (amr_bt_lo(3, newcap), amr_bt_hi(3, newcap), amr_bt_on(newcap))
+ end if
+
+ end subroutine s_amr_st_reserve
+
+ !> 2a: ONE batched cons->prim conversion over every owned fine block (all levels), straight from the flat cons store into the
+ !! flat prim landing zone. Runs once per RK stage after the fill + seam phases; each block's store bytes there are identical to
+ !! what its per-block conversion point would read (advances write only their own slots), and the kernel is per-cell with no
+ !! reductions, so the result is bit-identical to the per-block path it replaces. The cell body below is PINNED to
+ !! s_convert_conservative_to_primitive_variables (m_variables_conversion.fpp) restricted to the amr_prim_batch gate's configs:
+ !! species fractions (s_compute_species_fraction inlined against the store; igr/bubbles_euler excluded by the gate), mixture
+ !! properties, velocity + dynamic pressure, and pressure. Change the conversion and this must follow.
+ impure subroutine s_amr_convert_prim_batch()
+
+ integer :: g, loc, i, j, k, l, gg
+ integer :: nl, nv, b1l, b1h, b2l, b2h, b3l, b3h
+
+ #:if USING_AMD and not MFC_CASE_OPTIMIZATION
+ real(wp), dimension(3) :: alpha_K, alpha_rho_K
+ real(wp) :: rhoYks_b(1:10)
+ #:else
+ real(wp), dimension(num_fluids) :: alpha_K, alpha_rho_K
+ real(wp) :: rhoYks_b(1:num_species)
+ #:endif
+ real(wp) :: Re_K(2)
+ real(wp) :: rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, alpha_K_sum, pres, T, pmag
+
+ if (amr_loc_n == 0) return
+ call s_phase_tic(PH_CVTB)
+ amr_bt_on(1:amr_loc_n) = .false.
+ call s_amr_refresh_my_blocks()
+ do gg = 1, amr_n_my
+ g = amr_my_blk(gg)
+ if (amr_block_level(g) < 1) cycle
+ loc = amr_loc_of(g)
+ if (loc <= 0) cycle
+ amr_bt_on(loc) = .true.
+ do i = 1, 3
+ amr_bt_lo(i, loc) = amr_slots(g)%idwbuff(i)%beg
+ amr_bt_hi(i, loc) = amr_slots(g)%idwbuff(i)%end
+ end do
+ end do
+ $:GPU_UPDATE(device='[amr_bt_on, amr_bt_lo, amr_bt_hi]')
+ ! bounds through local scalars, never GPU_DECLARE'd module state (the CCE-acc stale-device-bounds class)
+ nl = amr_loc_n; nv = num_vels
+ b1l = mbuf1_lo; b1h = mbuf1_hi; b2l = mbuf2_lo; b2h = mbuf2_hi; b3l = mbuf3_lo; b3h = mbuf3_hi
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[alpha_K, alpha_rho_K, Re_K, rhoYks_b, rho_K, gamma_K, pi_inf_K, qv_K, &
+ & dyn_pres_K, alpha_K_sum, pres, T, pmag]', copyin='[nl, nv, b1l, b1h, b2l, b2h, b3l, b3h]')
+ do loc = 1, nl
+ do l = b3l, b3h
+ do k = b2l, b2h
+ do j = b1l, b1h
+ if (.not. amr_bt_on(loc)) cycle
+ if (j < amr_bt_lo(1, loc) .or. j > amr_bt_hi(1, loc) .or. k < amr_bt_lo(2, loc) .or. k > amr_bt_hi(2, &
+ & loc) .or. l < amr_bt_lo(3, loc) .or. l > amr_bt_hi(3, loc)) cycle
+ if (num_fluids == 1) then
+ alpha_rho_K(1) = amr_cons_st(j, k, l, eqn_idx%cont%beg, loc)
+ alpha_K(1) = amr_cons_st(j, k, l, eqn_idx%adv%beg, loc)
+ else
+ $:GPU_LOOP(parallelism='[seq]')
+ do i = 1, num_fluids
+ alpha_rho_K(i) = amr_cons_st(j, k, l, i, loc)
+ alpha_K(i) = amr_cons_st(j, k, l, eqn_idx%adv%beg + i - 1, loc)
+ end do
+ end if
+ if (mpp_lim) then
+ alpha_K_sum = 0._wp
+ $:GPU_LOOP(parallelism='[seq]')
+ do i = 1, num_fluids
+ alpha_rho_K(i) = max(0._wp, alpha_rho_K(i))
+ alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp)
+ alpha_K_sum = alpha_K_sum + alpha_K(i)
+ end do
+ ! explicit loop, not array syntax: an inline whole-array expression in a target
+ ! region is a per-thread temporary on amdflang
+ $:GPU_LOOP(parallelism='[seq]')
+ do i = 1, num_fluids
+ alpha_K(i) = alpha_K(i)/max(alpha_K_sum, 1.e-16_wp)
+ end do
+ end if
+ call s_convert_species_to_mixture_variables_kernel(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, alpha_rho_K, &
+ & Re_K)
+ if (enforce_density_floor_vc) rho_K = max(rho_K, sgm_eps)
+ dyn_pres_K = 0._wp
+ $:GPU_LOOP(parallelism='[seq]')
+ do i = 1, nv
+ amr_prim_st(j, k, l, i, loc) = amr_cons_st(j, k, l, eqn_idx%mom%beg + i - 1, loc)/rho_K
+ dyn_pres_K = dyn_pres_K + 5.e-1_wp*amr_cons_st(j, k, l, eqn_idx%mom%beg + i - 1, loc)*amr_prim_st(j, &
+ & k, l, i, loc)
+ end do
+ pmag = 0._wp
+ call s_compute_pressure(amr_cons_st(j, k, l, eqn_idx%E, loc), amr_cons_st(j, k, l, eqn_idx%alf, loc), &
+ & dyn_pres_K, pi_inf_K, gamma_K, rho_K, qv_K, rhoYks_b, pres, T, pres_mag=pmag)
+ amr_prim_st(j, k, l, nv + 1, loc) = pres
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ call s_phase_toc(PH_CVTB)
+
+ end subroutine s_amr_convert_prim_batch
+
+ !> 2a: land the current block's batch-computed prim vars (the contiguous mom%beg..E range) from the prim store into the m_rhs
+ !! conversion scratch, replacing that block's per-block conversion.
+ impure subroutine s_amr_prim_load(q_prim_b, loc)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_b
+ integer, intent(in) :: loc
+ integer :: i, lb(3)
+
+ ! One launch per var through a PLAIN contiguous array dummy: a scalar_field-array dummy makes the
+ ! target region map the derived-type descriptors per launch (the measured per-region attach cost this
+ ! per-block path must not pay). The dummy rebases to 1, so offset from the actual's own lower bounds.
+
+ do i = eqn_idx%mom%beg, eqn_idx%E
+ lb = lbound(q_prim_b(i)%sf)
+ call s_amr_prim_load_one(q_prim_b(i)%sf, i - eqn_idx%mom%beg + 1, loc, amr_slots(amr_cur)%idwbuff(1)%beg, &
+ & amr_slots(amr_cur)%idwbuff(1)%end, amr_slots(amr_cur)%idwbuff(2)%beg, &
+ & amr_slots(amr_cur)%idwbuff(2)%end, amr_slots(amr_cur)%idwbuff(3)%beg, &
+ & amr_slots(amr_cur)%idwbuff(3)%end, 1 - lb(1), 1 - lb(2), 1 - lb(3))
+ end do
+
+ end subroutine s_amr_prim_load
+
+ impure subroutine s_amr_prim_load_one(dst, pv, loc, j1l, j1h, j2l, j2h, j3l, j3h, o1, o2, o3)
+
+ real(stp), dimension(:,:,:), contiguous, intent(inout) :: dst
+ integer, intent(in) :: pv, loc, j1l, j1h, j2l, j2h, j3l, j3h, o1, o2, o3
+ integer :: j, k, l
+
+ $:GPU_PARALLEL_LOOP(collapse=3, copyin='[pv, loc, j1l, j1h, j2l, j2h, j3l, j3h, o1, o2, o3]')
+ do l = j3l, j3h
+ do k = j2l, j2h
+ do j = j1l, j1h
+ dst(j + o1, k + o2, l + o3) = amr_prim_st(j, k, l, pv, loc)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_prim_load_one
+
+ !> Allocate the pooled q_prim/rhs advance scratch (idempotent). The lockstep driver argument-associates the scratch for every
+ !! block, owned or not, so it must exist on EVERY rank - including one that never allocates a slot. Called from the ONE point
+ !! per mode where mbuf* are final: end of s_initialize_amr_module when l0_ntile == 0 (pure AMR), and after s_l0_tiles_init's
+ !! mbuf UNION when tiles exist (pure-L0 AND coexist - the union can enlarge mbuf* past the fine-only values, so an earlier
+ !! allocation would undersize the scratch). rhs mirrors the per-slot igr widening.
+ impure subroutine s_amr_scr_init()
+
+ integer :: i
+ type(scalar_field), allocatable :: tmp_p(:), tmp_r(:)
+
+ if (allocated(amr_scr_prim)) return
+ ! CCE OpenMP-offload leaves a bare module-scope derived-type allocatable's descriptor uninitialized, so a direct
+ ! allocate here aborts with `lib-4425 INTERNAL ERROR-Unitialized descriptor for ALLOCATE statement argument`. Same
+ ! defect, same workaround as amr_cg above: allocate a LOCAL, which gets a valid descriptor, then hand it over with
+ ! move_alloc and map afterwards. Verified on Frontier 2026-08-28 -- the abort was here, with sys_size and the mbuf
+ ! bounds all sane, on the HOST allocate rather than the device map. GPU_DECLARE alone does NOT avoid it.
+ allocate (tmp_p(1:sys_size)); call move_alloc(tmp_p, amr_scr_prim)
+ allocate (tmp_r(1:sys_size)); call move_alloc(tmp_r, amr_scr_rhs)
+ $:GPU_ENTER_DATA(create='[amr_scr_prim, amr_scr_rhs]')
+ do i = 1, sys_size
+ @:ALLOCATE(amr_scr_prim(i)%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi))
+ if (igr) then
+ @:ALLOCATE(amr_scr_rhs(i)%sf(mbuf1_lo:mbuf1_hi, min(mbuf2_lo, -1):max(mbuf2_hi, 1), min(mbuf3_lo, &
+ & -1):max(mbuf3_hi, 1)))
+ else
+ @:ALLOCATE(amr_scr_rhs(i)%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi))
+ end if
+ @:ACC_SETUP_SFs(amr_scr_prim(i))
+ @:ACC_SETUP_SFs(amr_scr_rhs(i))
+ end do
+
+ end subroutine s_amr_scr_init
+
+ !> Move block loc's conserved state between the flat store and the bridge. One kernel each way over the whole buffered box:
+ !! every slot's arrays carry the same mbuf extents, so this is exactly the box the per-slot q_cons used to own.
+ #:set BR = 'amr_cons_br(i)%sf(j, k, l)'
+ #:set ST = 'amr_cons_st(j, k, l, i, loc)'
+ #:for DIR in ['load', 'store']
+ #:set LHS = BR if DIR == 'load' else ST
+ #:set RHS = ST if DIR == 'load' else BR
+ impure subroutine s_amr_br_${DIR}$(loc)
+
+ integer, intent(in) :: loc
+ integer :: i, j, k, l
+
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = mbuf3_lo, mbuf3_hi
+ do k = mbuf2_lo, mbuf2_hi
+ do j = mbuf1_lo, mbuf1_hi
+ ${LHS}$ = ${RHS}$
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_br_${DIR}$
+ #:endfor
+
+ !> BATCHED bridge move: a whole batch of blocks in ONE kernel instead of one kernel per block. This is what the flat store was
+ !! built for - its own comment calls a single contiguous array "the prerequisite for running ONE kernel over every live block
+ !! instead of one kernel per block". Block `loc` of the batch lands at k-offset (loc-1)*amr_br_w with its ghost shell intact, so
+ !! the bridge holds a concatenation of independent blocks two ghost shells apart. The per-block s_amr_br_load/store above are
+ !! KEPT unchanged: reflux and the relaxation paths still work one block at a time and read the bridge at offset 0.
+ #:set BRA = 'amr_cons_br(i)%sf(j, k, l + (loc - 1)*amr_br_w)'
+ #:set STA = 'amr_cons_st(j, k, l, i, base + loc)'
+ #:for DIR in ['load', 'store']
+ #:set LHS = BRA if DIR == 'load' else STA
+ #:set RHS = STA if DIR == 'load' else BRA
+ impure subroutine s_amr_br_${DIR}$_all(base, nblk)
+
+ integer, intent(in) :: base !< dense local slot preceding this batch
+ integer, intent(in) :: nblk !< blocks in this batch, <= amr_br_batch
+ integer :: i, j, k, l, loc
+
+ $:GPU_PARALLEL_LOOP(collapse=5)
+ do loc = 1, nblk
+ do i = 1, sys_size
+ do l = mbuf3_lo, mbuf3_hi
+ do k = mbuf2_lo, mbuf2_hi
+ do j = mbuf1_lo, mbuf1_hi
+ ${LHS}$ = ${RHS}$
+ end do
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_br_${DIR}$_all
+ #:endfor
+
+ !> Free the flat store and the dense-index maps. Mirrors s_amr_loc_index_init: called from BOTH finalize paths, because either
+ !! pool-allocation site can have created them. Idempotent.
+ impure subroutine s_amr_st_finalize()
+
+ integer :: i
+
+ if (allocated(amr_loc_of)) deallocate (amr_loc_of, amr_loc_free)
+ #:for ST in ['amr_cons_st', 'amr_stor_st', 'amr_gst_a', 'amr_gst_b']
+ if (allocated(${ST}$)) then
+ @:DEALLOCATE(${ST}$)
+ end if
+ #:endfor
+ if (allocated(amr_prim_st)) then
+ @:DEALLOCATE(amr_prim_st)
+ @:DEALLOCATE(amr_bt_lo)
+ @:DEALLOCATE(amr_bt_hi)
+ @:DEALLOCATE(amr_bt_on)
+ end if
+ if (allocated(amr_cons_br)) then
+ do i = 1, sys_size
+ @:ACC_TEARDOWN_SFs(amr_cons_br(i))
+ @:DEALLOCATE(amr_cons_br(i)%sf)
+ end do
+ @:DEALLOCATE(amr_cons_br)
+ end if
+ if (allocated(amr_scr_prim)) then
+ do i = 1, sys_size
+ @:ACC_TEARDOWN_SFs(amr_scr_prim(i))
+ @:DEALLOCATE(amr_scr_prim(i)%sf)
+ @:ACC_TEARDOWN_SFs(amr_scr_rhs(i))
+ @:DEALLOCATE(amr_scr_rhs(i)%sf)
+ end do
+ @:DEALLOCATE(amr_scr_prim)
+ @:DEALLOCATE(amr_scr_rhs)
+ end if
+ amr_st_cap = 0
+
+ end subroutine s_amr_st_finalize
+
+ !> One-shot pre-reserve before a batch of s_amr_alloc_slot_stash calls: grows the store AT MOST ONCE, to the batch's exact final
+ !! size, instead of once per 8-16 incrementally allocated slots. Every growth restages the WHOLE store (both arrays) through the
+ !! host (s_amr_st_reserve), so a migration wave allocating tens of replica slots pays that restage repeatedly without this.
+ !! getk(k) marks dense fine-block index k (slot f_l0_slot(k)) for a coming stash alloc.
+ impure subroutine s_amr_prereserve_stash(getk, nblk)
+
+ integer, intent(in) :: nblk
+ logical, intent(in) :: getk(nblk)
+ integer :: i, nneed
+
+ nneed = 0
+ do i = 1, nblk
+ if (getk(i) .and. .not. amr_slot_live(f_l0_slot(i))) nneed = nneed + 1
+ end do
+ ! mirrors the alloc loop exactly: the first amr_loc_nfree allocs pop the recycle stack and do
+ ! not raise amr_loc_n; only the remainder grow
+ call s_amr_st_reserve(amr_loc_n + max(nneed - amr_loc_nfree, 0))
+
+ end subroutine s_amr_prereserve_stash
+
+ !> Assign slot islot a dense store index WITHOUT the per-block field arrays: a migration REPLICA only ever has its amr_stor_st
+ !! slot written (receive-unpack) and read (the rebuild's overlap carry-forward), so q_prim/rhs would roughly double its device
+ !! cost across the np-scaled replica set of a migration-heavy regrid (the W8 gate's np=4 arm OOMed on exactly that storm).
+ !! s_amr_alloc_slot upgrades a stash-only slot in place when the same global slot becomes an owned block; s_amr_free_slot
+ !! handles both flavors.
+ impure subroutine s_amr_alloc_slot_stash(islot)
+
+ integer, intent(in) :: islot
+
+ if (amr_slot_live(islot)) return
+ if (amr_loc_nfree > 0) then
+ amr_loc_of(islot) = amr_loc_free(amr_loc_nfree)
+ amr_loc_nfree = amr_loc_nfree - 1
+ else
+ amr_loc_n = amr_loc_n + 1
+ amr_loc_of(islot) = amr_loc_n
+ end if
+ amr_slot_live(islot) = .true.
+ call s_amr_st_reserve(amr_loc_n)
+
+ end subroutine s_amr_alloc_slot_stash
+
+ impure subroutine s_amr_alloc_slot(islot)
+
+ integer, intent(in) :: islot
+ integer :: i
+
+ ! full-vs-stash discriminator is the grid arrays: every full slot (tile or fine) has x_cb; a stash-only slot has none
+ ! (fine slots no longer carry q_prim - see the pooled scratch amr_scr_prim/amr_scr_rhs)
+
+ if (amr_slot_live(islot) .and. allocated(amr_slots(islot)%x_cb)) return
+ ! recycle a freed local index if one is available, else extend the dense range; a live STASH-ONLY slot upgrading to a
+ ! full one keeps the index (and so the stor data) it already holds
+ if (.not. amr_slot_live(islot)) then
+ if (amr_loc_nfree > 0) then
+ amr_loc_of(islot) = amr_loc_free(amr_loc_nfree)
+ amr_loc_nfree = amr_loc_nfree - 1
+ else
+ amr_loc_n = amr_loc_n + 1
+ amr_loc_of(islot) = amr_loc_n
+ end if
+ end if
+ amr_slots(islot)%amr_ref_ratio = amr_ref_ratio
+ amr_slots(islot)%buff_size = buff_size
+ allocate (amr_slots(islot)%x_cb(-1:max_f1), amr_slots(islot)%x_cc(0:max_f1), amr_slots(islot)%dx(0:max_f1))
+ if (n_glb > 0) allocate (amr_slots(islot)%y_cb(-1:max_f2), amr_slots(islot)%y_cc(0:max_f2), amr_slots(islot)%dy(0:max_f2))
+ if (p_glb > 0) allocate (amr_slots(islot)%z_cb(-1:max_f3), amr_slots(islot)%z_cc(0:max_f3), amr_slots(islot)%dz(0:max_f3))
+ ! P1 pooling: fine blocks advance through the shared scratch (amr_scr_prim/amr_scr_rhs) - the fused per-block advance
+ ! leaves no cross-block q_prim/rhs lifetime. L0 tile slots are the exception: all owned tiles' rhs coexist across the
+ ! MPI-synchronized reflux point (s_l0_add_reflux_to_tiles between the whole-set RHS and RK passes), and a tile's q_prim
+ ! written by the RHS pass is read in the later RK pass (IB correction), so tiles keep per-slot rhs always and per-slot
+ ! q_prim exactly when s_compute_rhs's copy-out gate writes it (m_rhs.fpp end-of-rhs gate).
+ if (islot <= l0_slot_off) then
+ @:ALLOCATE(amr_slots(islot)%rhs(1:sys_size))
+ if (run_time_info .or. probe_wrt .or. ib .or. bubbles_lagrange) then
+ @:ALLOCATE(amr_slots(islot)%q_prim(1:sys_size))
+ end if
+ do i = 1, sys_size
+ ! rhs is ghost-inclusive (mbuf); igr widens to -1:+1 per dim including collapsed ones (coarse rhs_vf is -1:m+1 etc.)
+ if (igr) then
+ @:ALLOCATE(amr_slots(islot)%rhs(i)%sf(mbuf1_lo:mbuf1_hi, min(mbuf2_lo, -1):max(mbuf2_hi, 1), min(mbuf3_lo, &
+ & -1):max(mbuf3_hi, 1)))
+ else
+ @:ALLOCATE(amr_slots(islot)%rhs(i)%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi))
+ end if
+ @:ACC_SETUP_SFs(amr_slots(islot)%rhs(i))
+ if (allocated(amr_slots(islot)%q_prim)) then
+ @:ALLOCATE(amr_slots(islot)%q_prim(i)%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi))
+ @:ACC_SETUP_SFs(amr_slots(islot)%q_prim(i))
+ end if
+ end do
+ end if
+ if (qbmm .and. .not. polytropic) then
+ #:for PF in ['pb_f', 'mv_f', 'pb_stor', 'mv_stor']
+ @:ALLOCATE(amr_slots(islot)%${PF}$%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:nnode, 1:nb))
+ @:ACC_SETUP_SFs(amr_slots(islot)%${PF}$)
+ #:endfor
+ if (amr_subcycle) then
+ #:for PF in ['pb_ghost_a', 'mv_ghost_a', 'pb_ghost_b', 'mv_ghost_b']
+ @:ALLOCATE(amr_slots(islot)%${PF}$%sf(mbuf1_lo:mbuf1_hi, mbuf2_lo:mbuf2_hi, mbuf3_lo:mbuf3_hi, 1:nnode, 1:nb))
+ @:ACC_SETUP_SFs(amr_slots(islot)%${PF}$)
+ #:endfor
+ end if
+ end if
+ amr_slot_live(islot) = .true.
+ call s_amr_st_reserve(amr_loc_n)
+
+ end subroutine s_amr_alloc_slot
+
+ !> Free slot islot's per-block field arrays (inverse of s_amr_alloc_slot). Idempotent (no-op if not live).
+ impure subroutine s_amr_free_slot(islot)
+
+ integer, intent(in) :: islot
+ integer :: i
+
+ if (.not. amr_slot_live(islot)) return
+ if (amr_loc_of(islot) > 0) then
+ amr_loc_nfree = amr_loc_nfree + 1
+ amr_loc_free(amr_loc_nfree) = amr_loc_of(islot)
+ amr_loc_of(islot) = 0
+ end if
+ ! Undo each field's ACC_SETUP_SFs (Cray descriptor + %sf copyin) BEFORE the @:DEALLOCATE - Cray 'exit data delete'
+ ! decrements
+ ! the ref count, so the lone @:DEALLOCATE would leave the descriptor and the ACC_SETUP %sf ref dangling; the leaked host
+ ! address is later reused (e.g. by Gs_rs at restart), tripping a Cray "Error placing / already present" present-table crash
+ ! (gpu-acc). A STASH-ONLY slot (s_amr_alloc_slot_stash) has none of these arrays - only the index bookkeeping above.
+ if (allocated(amr_slots(islot)%q_prim)) then
+ do i = 1, sys_size
+ @:ACC_TEARDOWN_SFs(amr_slots(islot)%q_prim(i))
+ @:DEALLOCATE(amr_slots(islot)%q_prim(i)%sf)
+ end do
+ @:DEALLOCATE(amr_slots(islot)%q_prim)
+ end if
+ if (allocated(amr_slots(islot)%rhs)) then
+ do i = 1, sys_size
+ @:ACC_TEARDOWN_SFs(amr_slots(islot)%rhs(i))
+ @:DEALLOCATE(amr_slots(islot)%rhs(i)%sf)
+ end do
+ @:DEALLOCATE(amr_slots(islot)%rhs)
+ end if
+ if (qbmm .and. .not. polytropic .and. associated(amr_slots(islot)%pb_f%sf)) then
+ #:for PF in ['pb_f', 'mv_f', 'pb_stor', 'mv_stor']
+ @:ACC_TEARDOWN_SFs(amr_slots(islot)%${PF}$)
+ @:DEALLOCATE(amr_slots(islot)%${PF}$%sf)
+ #:endfor
+ if (amr_subcycle) then
+ #:for PF in ['pb_ghost_a', 'mv_ghost_a', 'pb_ghost_b', 'mv_ghost_b']
+ @:ACC_TEARDOWN_SFs(amr_slots(islot)%${PF}$)
+ @:DEALLOCATE(amr_slots(islot)%${PF}$%sf)
+ #:endfor
+ end if
+ end if
+ if (allocated(amr_slots(islot)%x_cb)) deallocate (amr_slots(islot)%x_cb, amr_slots(islot)%x_cc, amr_slots(islot)%dx)
+ if (allocated(amr_slots(islot)%y_cb)) deallocate (amr_slots(islot)%y_cb, amr_slots(islot)%y_cc, amr_slots(islot)%dy)
+ if (allocated(amr_slots(islot)%z_cb)) deallocate (amr_slots(islot)%z_cb, amr_slots(islot)%z_cc, amr_slots(islot)%dz)
+ amr_slot_live(islot) = .false.
+
+ end subroutine s_amr_free_slot
+
+ !> Reconcile the allocated per-slot field arrays to the CURRENT ownership: allocate every active block this rank owns, free
+ !! everything else. Call after ownership is set (init/regrid/restart). A rank ends holding only its owned blocks' fine arrays
+ !! (~amr_num_blocks/num_procs of the pool), not all amr_max_blocks. Regrid must alloc its transient (received/old) slots BEFORE
+ !! this call, since it frees anything not currently owned.
+ impure subroutine s_amr_reconcile_slots()
+
+ integer :: k, nliv, nfr, nal, nfree_in
+ logical :: needed
+
+ nliv = 0; nfr = 0; nal = 0; nfree_in = amr_loc_nfree
+ do k = 1, amr_max_blocks
+ ! Skip the L0 tile prefix [1..l0_slot_off]: those slots are owned + sized by s_l0_tiles_init (rr=1 tile geometry), not
+ ! by the AMR fine-block reconcile. Without this, at coexist init the tile-prefix owner defaults to 0, so RANK 0 would
+ ! alloc these slots here with the FINE mbuf* sizing; s_amr_alloc_slot is idempotent, so s_l0_build_tile_slot could not
+ ! then resize them - a latent tile-undersizing landmine (benign only while fine mbuf* >= tile). l0_slot_off = 0 with no
+ ! tiles, so this is a no-op for pure AMR. (Audit IMP-3.)
+ if (k <= l0_slot_off) cycle
+ needed = k <= amr_num_blocks
+ if (needed) needed = amr_block_owner(k) == proc_rank
+ if (needed) then
+ if (.not. amr_slot_live(k)) nal = nal + 1
+ call s_amr_alloc_slot(k)
+ nliv = nliv + 1
+ else
+ if (amr_slot_live(k)) nfr = nfr + 1
+ call s_amr_free_slot(k)
+ end if
+ end do
+ ! stderr (survives an abort). live = what the run actually needs; loc_n = indices ever handed out;
+ ! the gap between them IS the leak. stack_in/out shows whether frees accumulate for the next
+ ! rebuild to recycle, and 'new' counts allocs that had to EXTEND rather than recycle.
+#ifdef MFC_DEBUG
+ write (0, '(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)') '[amr-recon] rank ', proc_rank, ' live ', nliv, ' loc_n ', amr_loc_n, &
+ & ' freed ', nfr, ' newalloc ', nal, ' stack_in ', nfree_in, ' stack_out ', amr_loc_nfree
+#endif
+ ! I1a invariant: no stash-only slot survives a reconcile - every migration replica was freed (early-free or the walk
+ ! above) or upgraded to a full slot by the owned-path alloc. A survivor would reach the solver with no geometry arrays.
+ do k = 1, amr_max_blocks
+ if (amr_slot_live(k)) then
+ @:ASSERT(allocated(amr_slots(k)%x_cb), "a stash-only replica slot survived reconcile")
+ end if
+ end do
+ ! every reader of a stale slot has finished by here (the rebuild's overlap carry-forward is done and the next rebuild
+ ! has not started), which is what makes the renumbering safe - see s_amr_compact_store.
+ call s_amr_compact_store()
+ ! TRACK S: per-rank store capacity is the W8 invariant (device memory = f(live local boxes)); wall time cannot see it,
+ ! so report it like [amr-scale]. live == loc_n after the compaction above; cap - live is the rebuild-transient envelope.
+ if (rank_time_wrt) write (0, '(A,I0,A,I0,A,I0)') '[amr-cap] rank ', proc_rank, ' live ', amr_loc_n, ' cap ', amr_st_cap
+ amr_mesh_epoch = amr_mesh_epoch + 1 ! local slot indices may have been renumbered: plans that baked them are stale
+
+ end subroutine s_amr_reconcile_slots
+
+ ! L0-AS-BLOCKS SPIKE (l0_ntile > 0):
+ ! Base grid tiled into l0_ntiles_tot refinement-ratio-1 blocks advanced through the shared swap-based per-block solver; the
+ ! bit-identity oracle is l0_ntile=0 (monolithic). See the l0_ntiles_tot declaration above for the design.
+
+ !> Low global-cell index of tile `it` (0-based) when `ncell` cells split into `nt` balanced tiles: the first mod(ncell,nt) tiles
+ !! get one extra cell. Tile `it` spans [f_l0_lo(it) : f_l0_lo(it+1)-1]; the widest tile is ceil(ncell/nt) cells.
+ pure integer function f_l0_lo(ncell, nt, it)
+
+ integer, intent(in) :: ncell, nt, it
+
+ f_l0_lo = it*(ncell/nt) + min(it, mod(ncell, nt))
+
+ end function f_l0_lo
+
+ !> True if a domain-face BC code is a PHYSICAL boundary the spike does not support. Supported: extrapolation (BC_GHOST_EXTRAP),
+ !! reflective (BC_REFLECTIVE), and periodic (BC_PERIODIC) - each has a cons-space tile fill matching the monolithic prim-space
+ !! BC. The characteristic / slip-wall / dirichlet family (bc < BC_GHOST_EXTRAP) has no tile fill yet and is rejected. MPI
+ !! processor boundaries (bc >= 0, incl. a periodic wrap-neighbour rank at np>1) are interior seams handled by the fine-fine
+ !! halo, never a physical face here.
+ pure logical function f_l0_bc_unsupported(bc)
+
+ integer, intent(in) :: bc
+
+ f_l0_bc_unsupported = (bc < BC_GHOST_EXTRAP)
+
+ end function f_l0_bc_unsupported
+
+ !> Slot index of regrid-managed fine block k in the shared pool: tiles occupy [1..l0_slot_off], fine blocks [l0_slot_off+1..].
+ !! Identity (l0_slot_off=0) until L0 tiles + AMR coexist.
+ pure integer function f_l0_slot(k) result(s)
+
+ integer, intent(in) :: k
+
+ s = l0_slot_off + k
+
+ end function f_l0_slot
+
+ !> Build the base-grid tiling: allocate the slot/region/seam machinery for l0_ntiles_tot rr=1 tiles covering L0, set each tile's
+ !! geometry (extent, L0-slice coords, whole-tile footprint, owner) and copy the current L0 state in. Standalone (does not call
+ !! s_initialize_amr_module) so the spike lifts out cleanly. np=1 spike: rank 0 owns every tile.
+ impure subroutine s_l0_tiles_init()
+
+ integer :: nt(3), ix, iy, iz, k, j, r, e
+ integer :: tlo(3), thi(3)
+ integer :: rsidx(3), rext(3)
+ integer :: ierr
+
+ if (l0_ntile <= 0) return
+
+ ! periodic_bc is set on rank 0 only (s_read_input_file is rank-0-guarded), so make it globally consistent: every rank must
+ ! build
+ ! the SAME wrap-seam list in f_amr_seam / apply the same periodic edge fill, else an unmatched MPI_SENDRECV deadlocks.
+ ! MPI_LOR:
+ ! rank 0's .true. wins on all ranks (others hold the .false. default). No-op at np=1.
+ l0_periodic = periodic_bc
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(MPI_IN_PLACE, l0_periodic, 3, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr)
+#endif
+
+ ! Supported physical faces (any np): extrapolation (BC_GHOST_EXTRAP), reflective (BC_REFLECTIVE), periodic (BC_PERIODIC) -
+ ! each
+ ! has a cons-space tile fill that commutes with the cons->prim convert so a tile matches the monolithic prim-space BC
+ ! bit-for-
+ ! bit. The characteristic/slip/dirichlet family (bc < BC_GHOST_EXTRAP) is not yet handled. Validate once here (host), not
+ ! per
+ ! stage.
+ if (f_l0_bc_unsupported(bc_x%beg) .or. f_l0_bc_unsupported(bc_x%end) .or. (n_glb > 0 .and. (f_l0_bc_unsupported(bc_y%beg) &
+ & .or. f_l0_bc_unsupported(bc_y%end))) .or. (p_glb > 0 .and. (f_l0_bc_unsupported(bc_z%beg) &
+ & .or. f_l0_bc_unsupported(bc_z%end)))) then
+ call s_mpi_abort('l0_ntile spike: unsupported physical BC (only extrapolation, reflective, periodic are handled)')
+ end if
+ ! the monolithic L0 RHS is skipped for l0_ntile>0, so the global q_prim_vf it populated is stale: run-time-info and probes
+ ! (which read it at stage 1) are not supported in the spike.
+ if (run_time_info .or. probe_wrt) then
+ call s_mpi_abort('l0_ntile spike does not support run_time_info or probe_wrt (monolithic q_prim_vf is not maintained)')
+ end if
+
+ ! rr=1 makes the swap ghost-coord bisection and the fine-fine-halo fmul (=amr_ref_ratio**level) both identity; slots inherit
+ ! it via s_amr_alloc_slot. Only clobber the GLOBAL in pure-L0 (amr off): under coexist the global must stay the real 2/4 so
+ ! fine blocks size correctly (s_set_amr_fine_geometry etc.), and tiles get rr=1 via the per-slot override in
+ ! s_l0_build_tile_slot (Option 2: level-0 tiles are rr=1 regardless of the global).
+ if (.not. amr) amr_ref_ratio = 1
+
+ ! Tiles are PER-RANK: each rank's local chunk is split into nt(:) pieces; the global tile table (region + owner) is the
+ ! union
+ ! over ranks, REPLICATED on every rank. Total = num_procs * nt(1)*nt(2)*nt(3). At np=1 this is identical to the old global
+ ! tiling. Each rank allocates slot DATA (fields + coords) only for its OWN tiles; the seam-pair scan and fine-fine halo see
+ ! the
+ ! full table and exchange cross-rank seams over MPI.
+ ! l0_nt/l0_ntiles_tot/l0_slot_off are computed once by s_initialize_amr_module (which always runs first, per
+ ! m_start_up.fpp) so both inits agree on the shared-pool layout; just read them here.
+ nt = l0_nt
+
+ amr_num_levels = 1
+ amr_cur = 1
+
+ if (.not. amr) then
+ ! l0-only mode: this routine owns the pool exactly as before (fine budget = 0)
+ amr_max_fine = 0; l0_slot_off = l0_ntiles_tot
+ amr_max_blocks = l0_ntiles_tot
+ amr_num_blocks = l0_ntiles_tot
+
+ ! block-metadata pool (mirror of s_initialize_amr_module's allocation)
+ allocate (amr_slots(1:amr_max_blocks))
+ call s_amr_loc_index_init()
+ allocate (amr_region_lo_all(3, amr_max_blocks), amr_region_hi_all(3, amr_max_blocks))
+ allocate (amr_isect_lo_all(3, amr_max_blocks), amr_isect_hi_all(3, amr_max_blocks))
+ allocate (amr_owns_all(amr_max_blocks))
+ allocate (amr_block_owner(amr_max_blocks)); amr_block_owner = 0
+ allocate (amr_owner_cut(0:num_procs - 1)); amr_owner_cut = -1_8
+ allocate (amr_fine_cut(0:num_procs - 1,1:max(amr_max_level, 1))); amr_fine_cut = -1_8
+ allocate (amr_tile_l0_owner(amr_max_blocks)); amr_tile_l0_owner = 0
+ allocate (amr_tile_cost(amr_max_blocks)); amr_tile_cost = 0._wp
+ allocate (amr_tile_cost_ema(amr_max_blocks)); amr_tile_cost_ema = 0._wp
+ ! L0 tiles are the BASE level (Option 2: fine blocks become level>=1 on a tile)
+ allocate (amr_block_level(amr_max_blocks)); amr_block_level = 0
+ ! 2D rank lists sized to the computed max overlap in s_amr_build_seam_pairs; only the per-block counts are sized here.
+ allocate (amr_ovl_gather_n(amr_max_blocks), amr_ovl_scatter_n(amr_max_blocks))
+ allocate (amr_slot_live(amr_max_blocks)); amr_slot_live = .false.
+ amr_region_lo_all = 0; amr_region_hi_all = 0; amr_isect_lo_all = 0; amr_isect_hi_all = 0; amr_owns_all = .false.
+ else
+ ! coexist mode: s_initialize_amr_module already allocated the shared pool sized l0_slot_off+amr_max_fine.
+ ! Only allocate the TILE-specific side tables here, and do NOT touch amr_slots / amr_region_* / amr_owns_all /
+ ! amr_block_owner / amr_ovl_* - those are shared with AMR and already sized/allocated.
+ allocate (amr_tile_l0_owner(amr_max_blocks)); amr_tile_l0_owner = 0
+ allocate (amr_tile_cost(amr_max_blocks)); amr_tile_cost = 0._wp
+ allocate (amr_tile_cost_ema(amr_max_blocks)); amr_tile_cost_ema = 0._wp
+ ! tiles are level 0 in slots [1..l0_ntiles_tot]; set that band without disturbing the fine slots
+ amr_block_level(1:l0_ntiles_tot) = 0
+ end if
+
+ ! the per-rank coarse decomposition (global origin + local extent) that the tile geometry and max-tile-extent sizing below
+ ! read for every rank is computed O(1) by s_amr_rank_decomp - no table, no allgather. In l0-only mode
+ ! s_initialize_amr_module
+ ! did not run, so validate the formula against this rank's actual decomposition here (coexist validates it in that routine).
+ if (.not. amr) call s_amr_validate_decomp()
+
+ ! max tile extent per dim over ALL ranks (= widest per-rank chunk split by nt); slots + seam buffers are sized to this
+ ! global
+ ! max so every rank's buffers match. Chunk r has s_amr_rank_decomp ext(d)+1 cells in dim d.
+ ! Coexist: the FINE sizing s_initialize_amr_module just computed must SURVIVE - these are module-level and are what
+ ! s_amr_alloc_slot reads, so zeroing them here leaves the shared pool sized to the tile extent. The static block's slot
+ ! is allocated before this routine and so escapes, but every slot a REGRID allocates afterwards is a fine block cut to
+ ! tile size, which then writes past its own bounds (an out-of-range device write, not a host abort). Accumulate the max
+ ! of both instead. l0-only (.not. amr): s_initialize_amr_module returned early, so no fine sizing exists - start at 0.
+ if (.not. amr) then
+ max_f1 = 0; max_f2 = 0; max_f3 = 0
+ end if
+ do r = 0, num_procs - 1
+ call s_amr_rank_decomp(r, rsidx, rext)
+ e = (rext(1) + 1 + nt(1) - 1)/nt(1) - 1; max_f1 = max(max_f1, e)
+ if (n_glb > 0) then; e = (rext(2) + 1 + nt(2) - 1)/nt(2) - 1; max_f2 = max(max_f2, e); end if
+ if (p_glb > 0) then; e = (rext(3) + 1 + nt(3) - 1)/nt(3) - 1; max_f3 = max(max_f3, e); end if
+ end do
+ mbuf1_lo = -buff_size; mbuf1_hi = max_f1 + buff_size
+ mbuf2_lo = 0; mbuf2_hi = 0; mbuf3_lo = 0; mbuf3_hi = 0
+ if (n_glb > 0) then; mbuf2_lo = -buff_size; mbuf2_hi = max_f2 + buff_size; end if
+ if (p_glb > 0) then; mbuf3_lo = -buff_size; mbuf3_hi = max_f3 + buff_size; end if
+ call s_amr_scr_init() ! mbuf* now FINAL (fine/tile union under coexist); scratch must exist on every rank
+
+ amr_seam_pairs_dirty = .true.; amr_seam_pairs_nblk = -1
+ amr_mesh_epoch = amr_mesh_epoch + 1
+
+ ! swap bounce buffers (same bounds as the L0 global coord arrays). SHARED with s_initialize_amr_module (identical m/n/p
+ ! sizing), so only allocate in l0-only mode to avoid a coexist double-allocate; under coexist the AMR init's buffers already
+ ! serve both the fine-block and the tile swaps.
+ if (.not. amr) then
+ allocate (sw_x_cb(-1 - buff_size:m_alloc + buff_size), sw_x_cc(-buff_size:m_alloc + buff_size), &
+ & sw_dx(-buff_size:m_alloc + buff_size))
+ if (n_glb > 0) allocate (sw_y_cb(-1 - buff_size:n_alloc + buff_size), sw_y_cc(-buff_size:n_alloc + buff_size), &
+ & sw_dy(-buff_size:n_alloc + buff_size))
+ if (p_glb > 0) allocate (sw_z_cb(-1 - buff_size:p_alloc + buff_size), sw_z_cc(-buff_size:p_alloc + buff_size), &
+ & sw_dz(-buff_size:p_alloc + buff_size))
+ end if
+ call s_l0_build_extended_global_cb() ! global L0 boundaries EXTENDED into the domain ghost shell (edge tiles need it)
+ amr_cpat_mar = (buff_size + amr_ref_ratio - 1)/amr_ref_ratio + 1
+ amr_xchg_coarse_ghosts = .false. ! tiles never prolong from a coarser level
+
+ ! per-tile geometry: level-1 rr=1 blocks. Loop is rank-major then z,y,x (x fastest) so intra-rank neighbours are contiguous;
+ ! the global region scan finds cross-rank seams. A rank writes region+owner for EVERY tile but allocates slot data only for
+ ! its
+ ! own (r == proc_rank). Domain-edge detection uses the global region indices (region_lo == 0 / region_hi == m_glb).
+ k = 0
+ do r = 0, num_procs - 1
+ call s_amr_rank_decomp(r, rsidx, rext)
+ do iz = 0, nt(3) - 1
+ do iy = 0, nt(2) - 1
+ do ix = 0, nt(1) - 1
+ k = k + 1
+ ! global cell range of tile (r, ix, iy, iz) = rank r's chunk split by f_l0_lo (identical split on every rank
+ ! so seam transverse extents match across ranks for an even decomposition)
+ tlo(1) = rsidx(1) + f_l0_lo(rext(1) + 1, nt(1), ix)
+ thi(1) = rsidx(1) + f_l0_lo(rext(1) + 1, nt(1), ix + 1) - 1
+ tlo(2) = 0; thi(2) = 0
+ if (n_glb > 0) then
+ tlo(2) = rsidx(2) + f_l0_lo(rext(2) + 1, nt(2), iy)
+ thi(2) = rsidx(2) + f_l0_lo(rext(2) + 1, nt(2), iy + 1) - 1
+ end if
+ tlo(3) = 0; thi(3) = 0
+ if (p_glb > 0) then
+ tlo(3) = rsidx(3) + f_l0_lo(rext(3) + 1, nt(3), iz)
+ thi(3) = rsidx(3) + f_l0_lo(rext(3) + 1, nt(3), iz + 1) - 1
+ end if
+ amr_block_owner(k) = r; amr_myblk_dirty = .true.
+ amr_tile_l0_owner(k) = r ! L0 storage owner = init owner; stays fixed under migration
+ amr_owns_all(k) = (r == proc_rank)
+ amr_region_lo_all(:,k) = tlo; amr_region_hi_all(:,k) = thi
+ amr_isect_lo_all(:,k) = tlo; amr_isect_hi_all(:,k) = thi ! footprint = whole tile on the owner (rr=1)
+ ! slot data is NOT allocated here: it must follow the SFC COMPUTE owner assigned below, which need not be
+ ! this cartesian owner r. Every rank writes region+owner metadata for every tile.
+ end do
+ end do
+ end do
+ end do
+
+ ! COMPUTE owner = SFC cost-split over the tiles (fills the O(num_procs) amr_owner_cut), superseding the cartesian owner set
+ ! in
+ ! the loop above; amr_tile_l0_owner keeps the cartesian STORAGE assignment (where the L0 field data physically lives). Init
+ ! cost is geometric (whole-tile cell count), uniform on a uniform grid. The SFC compute owner may differ from the cartesian
+ ! storage owner - whether it does depends on how the cartesian split direction lines up with Morton order, so it is a
+ ! property of the grid SHAPE (a 2:1 grid at np=2 splits in y and agrees; a square grid tie-breaks to x and diverges).
+ ! s_l0_copy_coarse_to_tiles routes the initial fill storage-owner -> compute-owner when they differ, so no precondition is
+ ! asserted here; the rebalancer's routed migration already handles post-init divergence.
+ block
+ integer :: sfco(l0_ntiles_tot), kk
+ integer(kind=8) :: tkey(l0_ntiles_tot)
+ real(wp) :: twt(l0_ntiles_tot)
+ do kk = 1, l0_ntiles_tot
+ tkey(kk) = f_morton(amr_region_lo_all(1, kk), amr_region_lo_all(2, kk), amr_region_lo_all(3, kk))
+ twt(kk) = real(amr_region_hi_all(1, kk) - amr_region_lo_all(1, kk) + 1, wp)*real(amr_region_hi_all(2, &
+ & kk) - amr_region_lo_all(2, kk) + 1, wp)*real(amr_region_hi_all(3, kk) - amr_region_lo_all(3, kk) + 1, wp)
+ end do
+ call s_amr_sfc_cut(tkey, twt, l0_ntiles_tot, amr_owner_cut, sfco)
+ do kk = 1, l0_ntiles_tot
+ amr_block_owner(kk) = sfco(kk); amr_myblk_dirty = .true.
+ amr_owns_all(kk) = (sfco(kk) == proc_rank)
+ end do
+ ! allocate slot data for the tiles this rank COMPUTES (deferred from the cartesian loop above). s_l0_build_tile_slot
+ ! reads only replicated region metadata and the global amr_g?cb, so it is valid for any tile on any rank. When the SFC
+ ! cut agrees with the cartesian order this allocates exactly the same set as before, just later.
+ do kk = 1, l0_ntiles_tot
+ if (amr_block_owner(kk) == proc_rank) call s_l0_build_tile_slot(kk)
+ end do
+ end block
+ ! validate the full picture now that tiles exist: tiles vs amr_owner_cut (tile cut, just built), fine blocks vs amr_fine_cut
+ ! (the level-1 cut the assigner saved at init). Runs in coexist too (amr_fine_cut is populated by the earlier assigner
+ ! call).
+ call s_amr_validate_owner()
+
+ call s_amr_select_slot(1)
+ ! tiles are PERSISTENT: L0 seeds them once at the first timestep (s_l0_copy_coarse_to_tiles self-gates on this flag), then
+ ! they carry their own state across stages/timesteps. No init-time device copy (q_cons device state is not live at module
+ ! init).
+ l0_tiles_need_fill = .true.
+
+ end subroutine s_l0_tiles_init
+
+ !> Global L0 cell boundaries EXTENDED into the domain ghost shell (-1-buff_size : G+buff_size), unlike s_amr_build_global_cb
+ !! (-1:G). The swap rebuilds a block's ghost-shell coordinates from these, and a tile that touches the domain boundary reaches
+ !! indices beyond G (AMR fine blocks never do, being buff_size inside). Sourced from the monolithic x_cb, whose ghost cells
+ !! already hold the domain's ghost coordinates - so a tile's ghost coords match the monolithic grid's bit-for-bit.
+ impure subroutine s_l0_build_extended_global_cb()
+
+ integer :: j
+ real(wp), parameter :: sentinel = -huge(1._wp)
+
+ ! Under coexist, s_amr_build_global_cb (called by s_initialize_amr_module) already allocated amr_g?cb at the NON-extended
+ ! bounds (-1:G) for the fine-block geometry. The tiles need the EXTENDED bounds (-1-buff:G+buff) since an edge tile reaches
+ ! into the domain ghost shell; the extended array is a value-consistent superset (same x_cb source over the overlap, and the
+ ! fine geometry already copied its coords into the slots), so replace it. Without this the second allocate is a fatal error
+ ! on gfortran and a silent double-allocate (leaked non-extended buffer) on flang.
+
+ if (allocated(amr_gxcb)) deallocate (amr_gxcb)
+ allocate (amr_gxcb(-1 - buff_size:m_glb + buff_size)); amr_gxcb = sentinel
+ do j = -1 - buff_size, m + buff_size
+ amr_gxcb(start_idx(1) + j) = x_cb(j)
+ end do
+ call s_mpi_allreduce_array_max(amr_gxcb, m_glb + 2 + 2*buff_size)
+ if (n_glb > 0) then
+ if (allocated(amr_gycb)) deallocate (amr_gycb)
+ allocate (amr_gycb(-1 - buff_size:n_glb + buff_size)); amr_gycb = sentinel
+ do j = -1 - buff_size, n + buff_size
+ amr_gycb(start_idx(2) + j) = y_cb(j)
+ end do
+ call s_mpi_allreduce_array_max(amr_gycb, n_glb + 2 + 2*buff_size)
+ end if
+ if (p_glb > 0) then
+ if (allocated(amr_gzcb)) deallocate (amr_gzcb)
+ allocate (amr_gzcb(-1 - buff_size:p_glb + buff_size)); amr_gzcb = sentinel
+ do j = -1 - buff_size, p + buff_size
+ amr_gzcb(start_idx(3) + j) = z_cb(j)
+ end do
+ call s_mpi_allreduce_array_max(amr_gzcb, p_glb + 2 + 2*buff_size)
+ end if
+
+ end subroutine s_l0_build_extended_global_cb
+
+ !> Build tile k's slot on THIS rank from its (already-set, replicated) region metadata: allocate the field/coord arrays and set
+ !! the local extents, idwbuff, and rr=1 cell coordinates sliced from the global amr_g?cb. Shared by s_l0_tiles_init (initial
+ !! owned tiles) and s_l0_migrate_tile (a tile arriving on its new owner). Requires amr_gxcb/gycb/gzcb + mbuf*/max_f* already
+ !! set.
+ impure subroutine s_l0_build_tile_slot(k)
+
+ integer, intent(in) :: k
+ integer :: j, tlo(3), thi(3)
+
+ tlo = amr_region_lo_all(:,k); thi = amr_region_hi_all(:,k)
+ call s_amr_alloc_slot(k) ! sizes to mbuf*, sets slot%amr_ref_ratio = amr_ref_ratio
+ ! a base-level tile is rr=1 regardless of the global refinement ratio (Option 2: global may be 2/4 for fine blocks)
+ amr_slots(k)%amr_ref_ratio = 1
+ amr_slots(k)%m = thi(1) - tlo(1); amr_slots(k)%n = 0; amr_slots(k)%p = 0
+ if (n_glb > 0) amr_slots(k)%n = thi(2) - tlo(2)
+ if (p_glb > 0) amr_slots(k)%p = thi(3) - tlo(3)
+ amr_slots(k)%idwbuff(1)%beg = -buff_size; amr_slots(k)%idwbuff(1)%end = amr_slots(k)%m + buff_size
+ amr_slots(k)%idwbuff(2)%beg = 0; amr_slots(k)%idwbuff(2)%end = 0
+ amr_slots(k)%idwbuff(3)%beg = 0; amr_slots(k)%idwbuff(3)%end = 0
+ if (n_glb > 0) then
+ amr_slots(k)%idwbuff(2)%beg = -buff_size; amr_slots(k)%idwbuff(2)%end = amr_slots(k)%n + buff_size
+ end if
+ if (p_glb > 0) then
+ amr_slots(k)%idwbuff(3)%beg = -buff_size; amr_slots(k)%idwbuff(3)%end = amr_slots(k)%p + buff_size
+ end if
+ ! rr=1: tile cell j (right boundary) IS the global L0 boundary amr_g?cb(tlo + j); interior coords only (the swap extends the
+ ! ghost shell from amr_g?cb identically).
+ do j = -1, amr_slots(k)%m
+ amr_slots(k)%x_cb(j) = amr_gxcb(tlo(1) + j)
+ end do
+ do j = 0, amr_slots(k)%m
+ amr_slots(k)%dx(j) = amr_slots(k)%x_cb(j) - amr_slots(k)%x_cb(j - 1)
+ amr_slots(k)%x_cc(j) = 0.5_wp*(amr_slots(k)%x_cb(j - 1) + amr_slots(k)%x_cb(j))
+ end do
+ if (n_glb > 0) then
+ do j = -1, amr_slots(k)%n
+ amr_slots(k)%y_cb(j) = amr_gycb(tlo(2) + j)
+ end do
+ do j = 0, amr_slots(k)%n
+ amr_slots(k)%dy(j) = amr_slots(k)%y_cb(j) - amr_slots(k)%y_cb(j - 1)
+ amr_slots(k)%y_cc(j) = 0.5_wp*(amr_slots(k)%y_cb(j - 1) + amr_slots(k)%y_cb(j))
+ end do
+ end if
+ if (p_glb > 0) then
+ do j = -1, amr_slots(k)%p
+ amr_slots(k)%z_cb(j) = amr_gzcb(tlo(3) + j)
+ end do
+ do j = 0, amr_slots(k)%p
+ amr_slots(k)%dz(j) = amr_slots(k)%z_cb(j) - amr_slots(k)%z_cb(j - 1)
+ amr_slots(k)%z_cc(j) = 0.5_wp*(amr_slots(k)%z_cb(j - 1) + amr_slots(k)%z_cb(j))
+ end do
+ end if
+
+ end subroutine s_l0_build_tile_slot
+
+ !> Copy the current L0 interior state into every owned tile's interior (global cell tlo+j -> tile-local cell j). A tile whose
+ !! compute owner is also its L0-storage owner is seeded by a local device copy (the common case, and the ENTIRE path when the
+ !! SFC cut agrees with the cartesian order, so byte-identical to before). When the SFC compute owner differs from the cartesian
+ !! storage owner the seed is ROUTED: the L0-storage owner device-packs its chunk and sends it to the compute owner, which
+ !! unpacks into its tile slot. Exact reverse of s_l0_scatter_tiles_to_coarse, and sound because a tile is built by subdividing
+ !! ONE rank's cartesian chunk (s_l0_tiles_init), so it never spans two L0-storage ranks.
+ impure subroutine s_l0_copy_coarse_to_tiles(q_cons_vf)
+
+ ! inout (not in): passed as the bidirectional s_l0_copy_block q_l0 dummy (intent(inout)); read-only here (L0 -> tile)
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
+
+ ! Persistent tiles: seed from L0 exactly once. After the first fill the tiles are authoritative; re-copying would be an
+ ! identity round-trip (each stage scatters tile->L0, so L0 already mirrors the tile interior at the next timestep's stage
+ ! 1).
+
+ if (.not. l0_tiles_need_fill) return
+
+ call s_l0_fill_tiles_from_coarse(q_cons_vf)
+ l0_tiles_need_fill = .false.
+
+ end subroutine s_l0_copy_coarse_to_tiles
+
+ !> The fill itself, without the seed gate: overwrite every owned tile interior from the L0 field. Separate from
+ !! s_l0_copy_coarse_to_tiles because the coexist SUBCYCLE path round-trips through L0 every step (tiles -> L0, fine fold writes
+ !! L0, L0 -> tiles), so it needs this unconditionally, while the seed must still happen exactly once.
+ impure subroutine s_l0_fill_tiles_from_coarse(q_cons_vf)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
+ integer :: k, o1, o2, o3, fm1, fm2, fm3, bown, lown, cnt, ierr
+ real(wp), allocatable :: buf(:)
+
+ do k = 1, l0_ntiles_tot
+ bown = amr_block_owner(k); lown = amr_tile_l0_owner(k)
+ if (bown == lown) then ! compute owner holds the L0 cells: local device copy (unchanged path)
+ if (bown /= proc_rank) cycle
+ call s_l0_tile_l0_offsets(k, o1, o2, o3)
+ fm1 = amr_slots(k)%m; fm2 = amr_slots(k)%n; fm3 = amr_slots(k)%p
+ call s_l0_copy_block(amr_loc_of(k), q_cons_vf, o1, o2, o3, fm1, fm2, fm3, .true.)
+ cycle
+ end if
+ ! routed seed: extents come from the REPLICATED region (the L0 owner has no slot for this tile)
+ fm1 = amr_region_hi_all(1, k) - amr_region_lo_all(1, k)
+ fm2 = 0; if (n_glb > 0) fm2 = amr_region_hi_all(2, k) - amr_region_lo_all(2, k)
+ fm3 = 0; if (p_glb > 0) fm3 = amr_region_hi_all(3, k) - amr_region_lo_all(3, k)
+ cnt = sys_size*(fm1 + 1)*(fm2 + 1)*(fm3 + 1)
+ if (proc_rank == lown) then ! L0-storage owner: device-pack the tile's L0 chunk, send to the compute owner
+ call s_l0_tile_l0_offsets(k, o1, o2, o3)
+ allocate (buf(cnt))
+ call s_l0_pack_unpack_block_sf(q_cons_vf, o1, o2, o3, fm1, fm2, fm3, buf, .true.)
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_FILL_SND, 1, cnt, k)
+ call MPI_SEND(buf, cnt, mpi_p, bown, k, MPI_COMM_WORLD, ierr)
+#endif
+ deallocate (buf)
+ else if (proc_rank == bown) then ! compute owner: recv, device-unpack into the tile interior
+ allocate (buf(cnt))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_FILL_RCV, 2, cnt, k)
+ call MPI_RECV(buf, cnt, mpi_p, lown, k, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ call s_l0_pack_unpack_block_st(amr_loc_of(k), 0, 0, 0, fm1, fm2, fm3, buf, .false.)
+ deallocate (buf)
+ end if
+ end do
+
+ end subroutine s_l0_fill_tiles_from_coarse
+
+ !> Local-index offset of tile k's global origin in the L0 field: o(d) = region_lo(d) - start_idx(d) for active dims, 0 for a
+ !! collapsed dim (start_idx is sized num_dims, so start_idx(3) must not be touched in 2D).
+ subroutine s_l0_tile_l0_offsets(k, o1, o2, o3)
+
+ integer, intent(in) :: k
+ integer, intent(out) :: o1, o2, o3
+
+ o1 = amr_region_lo_all(1, k) - start_idx(1)
+ o2 = 0; if (n_glb > 0) o2 = amr_region_lo_all(2, k) - start_idx(2)
+ o3 = 0; if (p_glb > 0) o3 = amr_region_lo_all(3, k) - start_idx(3)
+
+ end subroutine s_l0_tile_l0_offsets
+
+ !> Scatter every tile's interior back into the L0 field (tile-local cell j -> global cell tlo+j). A tile whose compute owner is
+ !! also its L0-storage owner writes locally (device kernel - the common case, and the ENTIRE no-migration path, so
+ !! byte-identical to before). A MIGRATED tile (owner != l0_owner) has its interior sent by the compute owner to the L0-storage
+ !! owner over MPI, which writes it into L0 - keeping the fixed L0 decomposition (hence output/restart) correct after migration.
+ !! Ghosts are not scattered (the tile path never reads L0 ghosts). GPU-correct: the MPI branch device-packs/unpacks via
+ !! s_l0_pack_unpack_block, so the receiver writes L0 ON THE DEVICE - it survives the GPU_UPDATE(host) that s_save_data does
+ !! before writing.
+ impure subroutine s_l0_scatter_tiles_to_coarse(q_cons_vf)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
+ integer :: k, o1, o2, o3, fm1, fm2, fm3, bown, lown, cnt, ierr
+ real(wp), allocatable :: buf(:)
+
+ ! Precondition: tiles are the authoritative store. Before the first seed (s_l0_copy_coarse_to_tiles) the tile slots hold
+ ! uninitialized (zero) state and L0 still holds the initial condition, so there is nothing to refresh - scattering here
+ ! would overwrite the IC with zeros (zero density -> NaN once the coexist L0 coarse RHS consumes it). Skip until seeded.
+
+ if (l0_tiles_need_fill) return
+
+ do k = 1, l0_ntiles_tot
+ bown = amr_block_owner(k); lown = amr_tile_l0_owner(k)
+ fm1 = amr_region_hi_all(1, k) - amr_region_lo_all(1, k)
+ fm2 = 0; if (n_glb > 0) fm2 = amr_region_hi_all(2, k) - amr_region_lo_all(2, k)
+ fm3 = 0; if (p_glb > 0) fm3 = amr_region_hi_all(3, k) - amr_region_lo_all(3, k)
+ if (bown == lown) then ! not migrated: local device copy (unchanged path)
+ if (bown /= proc_rank) cycle
+ call s_l0_tile_l0_offsets(k, o1, o2, o3)
+ call s_l0_copy_block(amr_loc_of(k), q_cons_vf, o1, o2, o3, fm1, fm2, fm3, .false.)
+ cycle
+ end if
+ cnt = sys_size*(fm1 + 1)*(fm2 + 1)*(fm3 + 1)
+ if (proc_rank == bown) then ! compute owner: device-pack owned tile interior, send to the L0 owner
+ allocate (buf(cnt))
+ call s_l0_pack_unpack_block_st(amr_loc_of(k), 0, 0, 0, fm1, fm2, fm3, buf, .true.)
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_SCAT_SND, 1, cnt, k)
+ call MPI_SEND(buf, cnt, mpi_p, lown, k, MPI_COMM_WORLD, ierr)
+#endif
+ deallocate (buf)
+ else if (proc_rank == lown) then ! L0 owner: recv, device-unpack into the local L0 chunk (device write -> survives the
+ call s_l0_tile_l0_offsets(k, o1, o2, o3) ! GPU_UPDATE(host) s_save_data does before writing)
+ allocate (buf(cnt))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_SCAT_RCV, 2, cnt, k)
+ call MPI_RECV(buf, cnt, mpi_p, bown, k, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ call s_l0_pack_unpack_block_sf(q_cons_vf, o1, o2, o3, fm1, fm2, fm3, buf, .false.)
+ deallocate (buf)
+ end if
+ end do
+
+ end subroutine s_l0_scatter_tiles_to_coarse
+
+ !> Device ADD of an L0 block [o+0:o+fm] into a tile rhs interior [0:fm] (q_rhs += q_l0). Additive twin of s_l0_copy_block's
+ !! to_tile branch, in wp (the rhs is computed in wp, stored stp). Slot rhs is a dummy so the kernel reads a valid mapped
+ !! descriptor (indexing module amr_slots%rhs in a kernel is a null deref - see s_l0_copy_block / s_amr_fine_slice).
+ impure subroutine s_l0_add_block(q_rhs, q_l0, o1, o2, o3, fm1, fm2, fm3)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_rhs
+ type(scalar_field), dimension(sys_size), intent(in) :: q_l0
+ integer, intent(in) :: o1, o2, o3, fm1, fm2, fm3
+ integer :: i, j, k, l
+
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = 0, fm3
+ do k = 0, fm2
+ do j = 0, fm1
+ q_rhs(i)%sf(j, k, l) = real(real(q_rhs(i)%sf(j, k, l), wp) + real(q_l0(i)%sf(o1 + j, o2 + k, o3 + l), &
+ & wp), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_l0_add_block
+
+ !> Device ADD of the contiguous MPI buffer buf into a tile rhs interior [0:fm] (q_rhs += buf). Additive twin of
+ !! s_l0_pack_unpack_block's unpack branch (same j-fastest buf layout), in wp. Slot rhs passed as a dummy (GPU-safe).
+ impure subroutine s_l0_unpack_add_block(q_rhs, fm1, fm2, fm3, buf)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_rhs
+ integer, intent(in) :: fm1, fm2, fm3
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: i, j, k, l
+
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do i = 1, sys_size
+ do l = 0, fm3
+ do k = 0, fm2
+ do j = 0, fm1
+ q_rhs(i)%sf(j, k, l) = real(real(q_rhs(i)%sf(j, k, l), &
+ & wp) + buf(1 + j + (fm1 + 1)*(k + (fm2 + 1)*(l + (fm3 + 1)*(i - 1)))), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_l0_unpack_add_block
+
+ !> Coexist reflux copy-back: ADD the fixed-L0-frame Berger-Colella reflux delta into each tile's per-slot rhs on its (possibly
+ !! migrated) compute owner, so the tile RK update sees the same c/f-face correction the monolithic coarse update would. The
+ !! delta lives in rhs_delta (the L0 rhs, which s_tvd_rk zeroed before the fine loop so s_amr_apply_reflux filled it with the
+ !! PURE delta). Reverse of s_l0_scatter_tiles_to_coarse: source is the fixed L0-storage owner (amr_tile_l0_owner), dest is the
+ !! compute owner (amr_block_owner); local when they coincide, else P2P (L0-owner packs the tile's L0 region, compute-owner adds
+ !! it). Whole tile interior is routed - the delta is zero outside the c/f reflux shell, so the add is identity elsewhere.
+ impure subroutine s_l0_add_reflux_to_tiles(rhs_delta)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: rhs_delta
+ integer :: k, o1, o2, o3, fm1, fm2, fm3, bown, lown, cnt, ierr
+ real(wp), allocatable :: buf(:)
+
+ do k = 1, l0_ntiles_tot
+ bown = amr_block_owner(k); lown = amr_tile_l0_owner(k)
+ fm1 = amr_region_hi_all(1, k) - amr_region_lo_all(1, k)
+ fm2 = 0; if (n_glb > 0) fm2 = amr_region_hi_all(2, k) - amr_region_lo_all(2, k)
+ fm3 = 0; if (p_glb > 0) fm3 = amr_region_hi_all(3, k) - amr_region_lo_all(3, k)
+ if (bown == lown) then ! not migrated: local device add
+ if (bown /= proc_rank) cycle
+ call s_l0_tile_l0_offsets(k, o1, o2, o3)
+ call s_l0_add_block(amr_slots(k)%rhs, rhs_delta, o1, o2, o3, fm1, fm2, fm3)
+ cycle
+ end if
+ cnt = sys_size*(fm1 + 1)*(fm2 + 1)*(fm3 + 1)
+ if (proc_rank == lown) then ! L0 owner: device-pack the delta over this tile's L0 region, send to the compute owner
+ call s_l0_tile_l0_offsets(k, o1, o2, o3)
+ allocate (buf(cnt))
+ call s_l0_pack_unpack_block_sf(rhs_delta, o1, o2, o3, fm1, fm2, fm3, buf, .true.)
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_RFLX_SND, 1, cnt, k)
+ call MPI_SEND(buf, cnt, mpi_p, bown, k, MPI_COMM_WORLD, ierr)
+#endif
+ deallocate (buf)
+ else if (proc_rank == bown) then ! compute owner: recv, device-ADD the delta into the tile rhs
+ allocate (buf(cnt))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_RFLX_RCV, 2, cnt, k)
+ call MPI_RECV(buf, cnt, mpi_p, lown, k, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ call s_l0_unpack_add_block(amr_slots(k)%rhs, fm1, fm2, fm3, buf)
+ deallocate (buf)
+ end if
+ end do
+
+ end subroutine s_l0_add_reflux_to_tiles
+
+ !> Coexist restrict copy-back: after the fine blocks restrict their solution into the L0 covered cells (fixed-L0-frame q_cons),
+ !! OVERWRITE each covering tile's matching cells with those restricted values on the tile's (possibly migrated) compute owner -
+ !! the coexist twin of the monolithic level-0 covered-cell overwrite. Only the covered footprint moves (non-covered tile cells
+ !! keep their advanced state; disjoint from the reflux shell). Per (tile, level-1 block) footprint intersection in the L0 frame:
+ !! local when L0-owner == compute-owner (buffer roundtrip), else P2P (L0-owner packs the intersection, compute-owner unpacks).
+ !! Reuses s_l0_pack_unpack_block with per-side offsets (its offset arg is per-call, so src L0 and dst tile offsets differ).
+ impure subroutine s_l0_restrict_to_tiles(q_cons_vf)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
+ integer :: k, b, d, bown, lown, cnt, ierr
+ integer :: ilo(3), ihi(3), e1, e2, e3, lo1, lo2, lo3, to1, to2, to3
+ real(wp), allocatable :: buf(:)
+ logical :: nonempty
+
+ do k = 1, l0_ntiles_tot ! tiles are the level-0 prefix
+ bown = amr_block_owner(k); lown = amr_tile_l0_owner(k)
+ do b = 1, amr_num_blocks
+ ! only level-1 fine blocks restrict into L0 covered cells (level>=2 fold to parent)
+ if (amr_block_level(b) /= 1) cycle
+ nonempty = .true. ! L0-frame intersection of tile k's region and fine block b's footprint
+ do d = 1, 3
+ ilo(d) = max(amr_region_lo_all(d, k), amr_region_lo_all(d, b))
+ ihi(d) = min(amr_region_hi_all(d, k), amr_region_hi_all(d, b))
+ if (ilo(d) > ihi(d)) nonempty = .false.
+ end do
+ if (.not. nonempty) cycle
+ e1 = ihi(1) - ilo(1)
+ e2 = 0; if (n_glb > 0) e2 = ihi(2) - ilo(2)
+ e3 = 0; if (p_glb > 0) e3 = ihi(3) - ilo(3)
+ lo1 = ilo(1) - start_idx(1); to1 = ilo(1) - amr_region_lo_all(1, k) ! L0-local (src) vs tile-local (dst) offsets
+ lo2 = 0; to2 = 0
+ if (n_glb > 0) then; lo2 = ilo(2) - start_idx(2); to2 = ilo(2) - amr_region_lo_all(2, k); end if
+ lo3 = 0; to3 = 0
+ if (p_glb > 0) then; lo3 = ilo(3) - start_idx(3); to3 = ilo(3) - amr_region_lo_all(3, k); end if
+ cnt = sys_size*(e1 + 1)*(e2 + 1)*(e3 + 1)
+ if (bown == lown) then ! not migrated: local device pack (L0 region) -> unpack (tile region), same rank
+ if (bown /= proc_rank) cycle
+ allocate (buf(cnt))
+ call s_l0_pack_unpack_block_sf(q_cons_vf, lo1, lo2, lo3, e1, e2, e3, buf, .true.)
+ call s_l0_pack_unpack_block_st(amr_loc_of(k), to1, to2, to3, e1, e2, e3, buf, .false.)
+ deallocate (buf)
+ else if (proc_rank == lown) then ! L0 owner: device-pack the intersection, send to the compute owner
+ allocate (buf(cnt))
+ call s_l0_pack_unpack_block_sf(q_cons_vf, lo1, lo2, lo3, e1, e2, e3, buf, .true.)
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_REST_SND, 1, cnt, 4400 + k)
+ call MPI_SEND(buf, cnt, mpi_p, bown, 4400 + k, MPI_COMM_WORLD, ierr)
+#endif
+ deallocate (buf)
+ else if (proc_rank == bown) then ! compute owner: recv, device-unpack (overwrite) into the tile covered cells
+ allocate (buf(cnt))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_REST_RCV, 2, cnt, 4400 + k)
+ call MPI_RECV(buf, cnt, mpi_p, lown, 4400 + k, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ call s_l0_pack_unpack_block_st(amr_loc_of(k), to1, to2, to3, e1, e2, e3, buf, .false.)
+ deallocate (buf)
+ end if
+ end do
+ end do
+
+ end subroutine s_l0_restrict_to_tiles
+
+ !> Migrate tile k from its current compute owner to new_owner: P2P-move the persistent interior state, (re)build the slot on the
+ !! receiver, free it on the sender, and update the replicated owner map + seam topology. ALL ranks call with the same (k,
+ !! new_owner). This is the load-balance MIGRATION primitive; the DECISION of which tile moves where is made by the caller (a
+ !! forced remap in the spike; a cost-driven trigger later). Ghosts are not moved (refilled by edge-BC + fine-fine halo before
+ !! the next stage). GPU-correct: interior is device-packed/unpacked via s_l0_pack_unpack_block (wp buffer, cast to/from stp).
+ impure subroutine s_l0_migrate_tile(k, new_owner)
+
+ integer, intent(in) :: k, new_owner
+ integer :: old_owner, ni, nj, nl, cnt, ierr
+ real(wp), allocatable :: buf(:)
+
+ old_owner = amr_block_owner(k)
+ if (old_owner == new_owner) return
+
+ ni = amr_region_hi_all(1, k) - amr_region_lo_all(1, k)
+ nj = 0; if (n_glb > 0) nj = amr_region_hi_all(2, k) - amr_region_lo_all(2, k)
+ nl = 0; if (p_glb > 0) nl = amr_region_hi_all(3, k) - amr_region_lo_all(3, k)
+ cnt = sys_size*(ni + 1)*(nj + 1)*(nl + 1)
+
+ if (proc_rank == old_owner) then ! device-pack + send the interior, then release the slot
+ allocate (buf(cnt))
+ call s_l0_pack_unpack_block_st(amr_loc_of(k), 0, 0, 0, ni, nj, nl, buf, .true.)
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_MIGR_SND, 1, cnt, 4300)
+ call MPI_SEND(buf, cnt, mpi_p, new_owner, 4300, MPI_COMM_WORLD, ierr)
+#endif
+ deallocate (buf)
+ call s_amr_free_slot(k)
+ else if (proc_rank == new_owner) then ! build the slot, recv + device-unpack the interior into it
+ call s_l0_build_tile_slot(k)
+ allocate (buf(cnt))
+#ifdef MFC_MPI
+ call s_xa_rec(XA_L0_MIGR_RCV, 2, cnt, 4300)
+ call MPI_RECV(buf, cnt, mpi_p, old_owner, 4300, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
+#endif
+ call s_l0_pack_unpack_block_st(amr_loc_of(k), 0, 0, 0, ni, nj, nl, buf, .false.)
+ deallocate (buf)
+ end if
+
+ ! replicated ownership update on EVERY rank; mark the seam topology dirty so the next halo rebuilds pair/overlap lists.
+ ! The epoch bump matters most HERE: ownership changed with NO regrid, which the consumed boolean cannot express to a
+ ! cached exchange plan.
+ amr_block_owner(k) = new_owner
+ amr_owns_all(k) = (new_owner == proc_rank)
+ amr_seam_pairs_dirty = .true.
+ amr_mesh_epoch = amr_mesh_epoch + 1
+
+ end subroutine s_l0_migrate_tile
+
+ !> Spike test hook: at t_step == l0_migrate_step, force-migrate the LAST tile (initially owned by rank num_procs-1) to rank 0,
+ !! exercising the migration primitive + seam-topology rebuild. Output must stay byte-identical to the no-migration run. No-op at
+ !! np=1 (the last tile already lives on rank 0). ALL ranks call with identical arguments.
+ impure subroutine s_l0_forced_remap()
+
+ integer :: k
+
+ k = l0_ntiles_tot
+ if (amr_block_owner(k) /= 0) call s_l0_migrate_tile(k, 0)
+
+ end subroutine s_l0_forced_remap
+
+ !> Closed-loop rebalancer driven by MEASURED per-tile compute time. Each rank accumulated amr_tile_cost for its OWN tiles since
+ !! the last rebalance; an allreduce(SUM) makes the full cost vector REPLICATED and bit-identical on every rank (each tile has
+ !! exactly one nonzero contributor, so the sum is exact) -> every rank runs the identical greedy and issues MATCHING P2P
+ !! migrations. Greedy: move the tile on the heaviest rank that most reduces the max-min load gap onto the lightest, bounded,
+ !! with a small relative deadband so timing noise does not cause churn. Because migration is bit-preserving and the decision
+ !! touches no field data, OUTPUT is byte-identical regardless of the (run-to-run nondeterministic) measured schedule - the
+ !! decomposition-invariance proven for the tile path is exactly what keeps a nondeterministic cost signal golden-safe. Costs
+ !! reset after each rebalance. No-op at np=1.
+ impure subroutine s_l0_rebalance(t_step)
+
+ integer, intent(in) :: t_step
+ integer :: k, nmig, ierr
+ integer :: newo(l0_ntiles_tot)
+ real(wp) :: cost(l0_ntiles_tot), load(0:num_procs - 1), gap0, gap1, mean, tol
+ real(wp), parameter :: ema_hist = 0.5_wp ! weight on the running estimate vs this window's measurement
+
+ if (num_procs < 2) then
+ amr_tile_cost = 0._wp ! nothing to balance; still clear the window
+ return
+ end if
+
+ cost = amr_tile_cost ! local: nonzero only for this rank's owned tiles
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(MPI_IN_PLACE, cost, l0_ntiles_tot, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr) ! -> replicated, bit-identical
+#endif
+ ! smooth the (replicated) window cost with a per-tile EMA so GPU per-tile launch-latency noise does not drive spurious
+ ! migrations; seed on the first window (ema still all-zero) with the raw measurement to avoid a cold-start bias toward 0.
+ ! amr_tile_cost_ema is derived only from the replicated cost, so it stays bit-identical on every rank -> consistent
+ ! decision.
+ if (all(amr_tile_cost_ema(1:l0_ntiles_tot) == 0._wp)) then
+ amr_tile_cost_ema(1:l0_ntiles_tot) = cost
+ else
+ amr_tile_cost_ema(1:l0_ntiles_tot) = ema_hist*amr_tile_cost_ema(1:l0_ntiles_tot) + (1._wp - ema_hist)*cost
+ end if
+ cost = amr_tile_cost_ema(1:l0_ntiles_tot) ! decide on the smoothed cost
+ newo = amr_block_owner
+ load = 0._wp
+ do k = 1, l0_ntiles_tot
+ load(newo(k)) = load(newo(k)) + cost(k)
+ end do
+ mean = sum(load)/real(num_procs, wp)
+ tol = 0.05_wp*mean ! deadband: ignore imbalance below 5% of the mean load so measurement noise does not churn migrations
+ gap0 = maxval(load) - minval(load)
+
+ ! SFC weighted re-cut (replaces the greedy min-max mover): Morton-sort the tiles, then cumulative-split the smoothed cost
+ ! into num_procs contiguous SFC ranges - identical partition logic to s_amr_assign_block_owners' cut. Ownership stays
+ ! SFC-contiguous and O(num_procs) cut-derivable (the precondition for retiring the amr_block_owner table), and locality is
+ ! preserved. Deadband kept: skip the re-cut while the load gap is already within tol (no churn on sub-5% imbalance).
+ if (gap0 > tol) then
+ block
+ integer(kind=8) :: tkey(l0_ntiles_tot), cut_try(0:num_procs - 1)
+ integer :: newo_try(l0_ntiles_tot)
+ real(wp) :: load_try(0:num_procs - 1)
+ do k = 1, l0_ntiles_tot
+ tkey(k) = f_morton(amr_region_lo_all(1, k), amr_region_lo_all(2, k), amr_region_lo_all(3, k))
+ end do
+ ! shared SFC cut: cumulative-split the smoothed cost into num_procs contiguous Morton ranges. Because the cut is
+ ! restricted to CONTIGUOUS ranges, the finest correction it can make is one whole tile; when tiles-per-rank is small
+ ! that quantum exceeds the gap the deadband admits, and the re-cut can return a partition WORSE than the current one
+ ! (measured 5.738E-02 -> 3.898E-01 at 8 tiles / 2 ranks, and it never recovered). Evaluate into a temporary and
+ ! reject only a STRICT WORSENING. Not "accept only a strict improvement": with near-uniform tile costs the Morton
+ ! partition and the cartesian one have EQUAL gaps, and rejecting those would silently kill the migration that
+ ! golden "L0 tiles -> 2D -> SFC re-cut rebalance np=2" exists to cover (it would still PASS, because migration is
+ ! bit-neutral - the coverage would just be gone). amr_owner_cut must move WITH newo: f_amr_owner resolves tile
+ ! ownership against it, so refreshing it without migrating would leave it disagreeing with amr_block_owner.
+ call s_amr_sfc_cut(tkey, cost, l0_ntiles_tot, cut_try, newo_try)
+ load_try = 0._wp
+ do k = 1, l0_ntiles_tot
+ load_try(newo_try(k)) = load_try(newo_try(k)) + cost(k)
+ end do
+ if (maxval(load_try) - minval(load_try) <= gap0) then
+ amr_owner_cut = cut_try
+ newo = newo_try
+ end if
+ end block
+ end if
+ load = 0._wp
+ do k = 1, l0_ntiles_tot
+ load(newo(k)) = load(newo(k)) + cost(k)
+ end do
+ gap1 = maxval(load) - minval(load)
+
+ nmig = 0
+ do k = 1, l0_ntiles_tot
+ if (newo(k) /= amr_block_owner(k)) then
+ call s_l0_migrate_tile(k, newo(k))
+ nmig = nmig + 1
+ end if
+ end do
+ ! tol is printed because without it "deadband skipped the re-cut" (gap0 <= tol) and "the re-cut ran and was REJECTED for not
+ ! improving the gap" (gap0 > tol, guard above) emit byte-identical output - gap0 -> gap0, 0 migrations. Those are different
+ ! behaviours and one of them is the guard doing its job; a verification run cannot tell them apart otherwise.
+ if (proc_rank == 0) print '(A,I0,A,ES10.3,A,ES10.3,A,ES10.3,A,I0,A)', ' [l0 rebalance] t_step=', t_step, ' load-gap ', &
+ & gap0, ' -> ', gap1, ' (deadband ', tol, ', ', nmig, ' migrations)'
+
+ amr_tile_cost = 0._wp ! reset the measurement window
+
+ end subroutine s_l0_rebalance
+
+ !> Device copy between a tile interior [0:fm] and the L0 field [o+0:o+fm]. to_tile=T copies L0->tile, F copies tile->L0. The
+ !! slot is addressed through the flat store, which is a plain GPU_DECLARE'd module array (the old per-slot layout made a null
+ !! deref - see s_amr_fine_slice).
+ impure subroutine s_l0_copy_block(loc, q_l0, o1, o2, o3, fm1, fm2, fm3, to_tile)
+
+ integer, intent(in) :: loc
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_l0
+ integer, intent(in) :: o1, o2, o3, fm1, fm2, fm3
+ logical, intent(in) :: to_tile
+ integer :: i, j, k, l
+
+ if (to_tile) then
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = 0, fm3
+ do k = 0, fm2
+ do j = 0, fm1
+ amr_cons_st(j, k, l, i, loc) = q_l0(i)%sf(o1 + j, o2 + k, o3 + l)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ else
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = 0, fm3
+ do k = 0, fm2
+ do j = 0, fm1
+ q_l0(i)%sf(o1 + j, o2 + k, o3 + l) = amr_cons_st(j, k, l, i, loc)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ end subroutine s_l0_copy_block
+
+ !> Device pack (to_buf=T) / unpack (F) of a field's interior block [o+0:o+fm] <-> the contiguous MPI buffer buf, for the P2P
+ !! migration + migrated-tile scatter. Follows s_amr_fine_slice: the pack/unpack runs ON THE DEVICE with copyout/copyin moving
+ !! only buf host<->device (no strided %sf section in a map clause - flang miscomputes those). buf index runs j fastest then
+ !! k,l,i so a matching pack/unpack aligns cell-for-cell. wp buffer, cast to/from stp (identity at double) - matches the
+ !! fine-fine halo. Two targets, one body: `_st` packs a block out of the flat store (the migration/scatter paths), `_sf` packs
+ !! the level-0 monolithic q_cons_vf, which is a real scalar_field array and not in the store.
+ #:for SFX, TGT in [('st', 'amr_cons_st'), ('sf', '')]
+ #:set QB = (lambda ix: TGT + '(o1 + j, o2 + k, o3 + l, ' + ix + ', loc)') if TGT else (lambda ix: 'q(' + ix &
+ & + ')%sf(o1 + j, o2 + k, o3 + l)')
+ impure subroutine s_l0_pack_unpack_block_${SFX}$(${'loc' if TGT else 'q'}$, o1, o2, o3, fm1, fm2, fm3, buf, to_buf)
+
+ #:if TGT
+ integer, intent(in) :: loc
+ #:else
+ type(scalar_field), dimension(sys_size), intent(inout) :: q
+ #:endif
+ integer, intent(in) :: o1, o2, o3, fm1, fm2, fm3
+ real(wp), intent(inout), contiguous :: buf(:)
+ logical, intent(in) :: to_buf
+ integer :: i, j, k, l
+
+ if (to_buf) then
+ $:GPU_PARALLEL_LOOP(collapse=4, copyout='[buf]')
+ do i = 1, sys_size
+ do l = 0, fm3
+ do k = 0, fm2
+ do j = 0, fm1
+ buf(1 + j + (fm1 + 1)*(k + (fm2 + 1)*(l + (fm3 + 1)*(i - 1)))) = real(${QB('i')}$, wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ else
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do i = 1, sys_size
+ do l = 0, fm3
+ do k = 0, fm2
+ do j = 0, fm1
+ ${QB('i')}$ = real(buf(1 + j + (fm1 + 1)*(k + (fm2 + 1)*(l + (fm3 + 1)*(i - 1)))), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ end subroutine s_l0_pack_unpack_block_${SFX}$
+ #:endfor
+
+ !> Fill each tile's DOMAIN-EDGE face ghosts with the physical BC (interior-seam faces are overwritten by s_amr_fine_fine_halo
+ !! afterward). Milestone 1 supports extrapolation (bc <= BC_GHOST_EXTRAP); other codes abort. A face (d,side) is a domain edge
+ !! iff the tile touches the global boundary there.
+ impure subroutine s_l0_fill_edge_bc()
+
+ integer :: k, fm(3), gcell(3)
+
+ gcell(1) = m_glb; gcell(2) = n_glb; gcell(3) = p_glb
+ do k = 1, l0_ntiles_tot
+ if (amr_block_owner(k) /= proc_rank) cycle
+ fm(1) = amr_slots(k)%m; fm(2) = amr_slots(k)%n; fm(3) = amr_slots(k)%p
+ call s_l0_edge_bc_tile(amr_loc_of(k), amr_region_lo_all(1, k), amr_region_hi_all(1, k), gcell(1), fm, 1, bc_x%beg, &
+ & bc_x%end)
+ if (n_glb > 0) call s_l0_edge_bc_tile(amr_loc_of(k), amr_region_lo_all(2, k), amr_region_hi_all(2, k), gcell(2), fm, &
+ & 2, bc_y%beg, bc_y%end)
+ if (p_glb > 0) call s_l0_edge_bc_tile(amr_loc_of(k), amr_region_lo_all(3, k), amr_region_hi_all(3, k), gcell(3), fm, &
+ & 3, bc_z%beg, bc_z%end)
+ end do
+
+ end subroutine s_l0_fill_edge_bc
+
+ !> One tile, one dimension d: extrapolate the low/high face ghost from the edge interior cell, but only where the tile touches
+ !! the domain boundary (rlo==0 low / rhi==gcell high). Applied to q_cons; convert (identity-commuting for extrapolation) makes
+ !! the prim ghost the monolithic path produces. The transverse loop spans the FACE interior only (dimension-split scheme reads
+ !! no corner ghost).
+ impure subroutine s_l0_edge_bc_tile(loc, rlo, rhi, gcell, fm, d, bcbeg, bcend)
+
+ integer, intent(in) :: loc
+ integer, intent(in) :: rlo, rhi, gcell, fm(3), d, bcbeg, bcend
+
+ ! BC support is validated once at init (s_l0_tiles_init); here we only apply it at domain-edge faces. Periodicity is read
+ ! from
+ ! the global periodic_bc(d) (not bcbeg, which becomes a wrap-neighbour RANK at a decomposed periodic boundary): a periodic
+ ! dim
+ ! wraps - a tile that SPANS it (rlo==0 .and. rhi==gcell) self-wraps here, a partial tile's periodic faces are cross-tile
+ ! wrap-seams filled by s_amr_fine_fine_halo (skipped here). A non-periodic domain-edge face gets reflective (mirror + normal
+ ! momentum flip) or 0th-order extrapolation per its physical bc code.
+
+ if (l0_periodic(d)) then
+ if (rlo == 0 .and. rhi == gcell) call s_l0_wrap_one(loc, d, fm)
+ return
+ end if
+ if (rlo == 0) then
+ if (bcbeg == BC_REFLECTIVE) then; call s_l0_reflect_one(loc, d, -1, fm); else; call s_l0_extrap_one(loc, d, -1, &
+ & fm); end if
+ end if
+ if (rhi == gcell) then
+ if (bcend == BC_REFLECTIVE) then; call s_l0_reflect_one(loc, d, 1, fm); else; call s_l0_extrap_one(loc, d, 1, &
+ & fm); end if
+ end if
+
+ end subroutine s_l0_edge_bc_tile
+
+ !> Extrapolate tile face ghosts in dim d, side (-1 low / +1 high): ghost cells 1..buff_size = the edge interior cell (0 or md).
+ !! Transverse extents (na, nb) and md are read into scalars before the device region (no host array element in the kernel).
+ impure subroutine s_l0_extrap_one(loc, d, side, fm)
+
+ integer, intent(in) :: loc
+ integer, intent(in) :: d, side, fm(3)
+ integer :: i, jg, a, b, e, gc, na, nb, md
+
+ #:for D, TA, TB in [(1, 2, 3), (2, 1, 3), (3, 1, 2)]
+ #:set SIDX = {1: 'e, a, b', 2: 'a, e, b', 3: 'a, b, e'}[D]
+ #:set GIDX = {1: 'gc, a, b', 2: 'a, gc, b', 3: 'a, b, gc'}[D]
+ if (d == ${D}$) then
+ na = fm(${TA}$); nb = fm(${TB}$); md = fm(${D}$)
+ e = merge(0, md, side == -1)
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[gc]')
+ do i = 1, sys_size
+ do b = 0, nb
+ do a = 0, na
+ do jg = 1, buff_size
+ gc = merge(-jg, md + jg, side == -1)
+ amr_cons_st(${GIDX}$, i, loc) = amr_cons_st(${SIDX}$, i, loc)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ #:endfor
+
+ end subroutine s_l0_extrap_one
+
+ !> Reflective (symmetry) tile face ghosts in dim d, side (-1 low / +1 high): ghost cell 1..buff_size MIRRORS the near-edge
+ !! interior (ghost -jg <- interior jg-1 low; md+jg <- md-(jg-1) high) with the NORMAL-direction momentum (eqn_idx%mom%beg + d -
+ !! 1) negated, all other conserved variables copied. Done on q_cons; negating conserved normal momentum commutes with the
+ !! cons->prim convert (velocity flips, rho and mom**2 - hence pressure - are unchanged), so this reproduces the monolithic
+ !! prim-space s_symmetry bit-for-bit. Transverse extent is the face interior only (dimension-split reads no corner ghost),
+ !! matching s_l0_extrap_one.
+ impure subroutine s_l0_reflect_one(loc, d, side, fm)
+
+ integer, intent(in) :: loc
+ integer, intent(in) :: d, side, fm(3)
+ integer :: i, jg, a, b, gc, sc, na, nb, md, nrm
+
+ #:for D, TA, TB in [(1, 2, 3), (2, 1, 3), (3, 1, 2)]
+ #:set SIDX = {1: 'sc, a, b', 2: 'a, sc, b', 3: 'a, b, sc'}[D]
+ #:set GIDX = {1: 'gc, a, b', 2: 'a, gc, b', 3: 'a, b, gc'}[D]
+ if (d == ${D}$) then
+ na = fm(${TA}$); nb = fm(${TB}$); md = fm(${D}$)
+ nrm = eqn_idx%mom%beg + ${D}$ - 1
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[gc, sc]')
+ do i = 1, sys_size
+ do b = 0, nb
+ do a = 0, na
+ do jg = 1, buff_size
+ gc = merge(-jg, md + jg, side == -1)
+ sc = merge(jg - 1, md - (jg - 1), side == -1)
+ amr_cons_st(${GIDX}$, i, loc) = merge(-amr_cons_st(${SIDX}$, i, loc), amr_cons_st(${SIDX}$, i, &
+ & loc), i == nrm)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ #:endfor
+
+ end subroutine s_l0_reflect_one
+
+ !> Periodic self-wrap for a tile that SPANS dim d (its low AND high faces are both the domain boundary, i.e. l0_ntile==1 in d):
+ !! fill both ghost shells from the opposite-end interior of the SAME tile - low ghost -jg <- interior md-(jg-1), high ghost
+ !! md+jg <- interior jg-1 (a pure copy, matching the monolithic prim-space s_periodic; copy commutes with cons->prim convert).
+ !! Partial tiles never reach here (their periodic faces are cross-tile wrap-seams handled by s_amr_fine_fine_halo). Face
+ !! interior only.
+ impure subroutine s_l0_wrap_one(loc, d, fm)
+
+ integer, intent(in) :: loc
+ integer, intent(in) :: d, fm(3)
+ integer :: i, jg, a, b, glo, shi, ghi, slo, na, nb, md
+
+ #:for D, TA, TB in [(1, 2, 3), (2, 1, 3), (3, 1, 2)]
+ #:set GLO = {1: 'glo, a, b', 2: 'a, glo, b', 3: 'a, b, glo'}[D]
+ #:set SHI = {1: 'shi, a, b', 2: 'a, shi, b', 3: 'a, b, shi'}[D]
+ #:set GHI = {1: 'ghi, a, b', 2: 'a, ghi, b', 3: 'a, b, ghi'}[D]
+ #:set SLO = {1: 'slo, a, b', 2: 'a, slo, b', 3: 'a, b, slo'}[D]
+ if (d == ${D}$) then
+ na = fm(${TA}$); nb = fm(${TB}$); md = fm(${D}$)
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[glo, shi, ghi, slo]')
+ do i = 1, sys_size
+ do b = 0, nb
+ do a = 0, na
+ do jg = 1, buff_size
+ glo = -jg; shi = md - (jg - 1)
+ ghi = md + jg; slo = jg - 1
+ amr_cons_st(${GLO}$, i, loc) = amr_cons_st(${SHI}$, i, loc)
+ amr_cons_st(${GHI}$, i, loc) = amr_cons_st(${SLO}$, i, loc)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ #:endfor
+
+ end subroutine s_l0_wrap_one
+
+ !> Fill a tile's MULTI-DIM ghost cells (>= 2 dims in the ghost region: 2D diagonal corners, 3D ghost edges + corners) from the
+ !! nearest INTERIOR cell (each index clamped to [0:m]/[0:n]/[0:p]). The dimension-split face fills only set single-ghost face
+ !! slabs (they are all the RHS stencil reads), leaving these unset; the cons->prim convert still visits them and an unset ghost
+ !! (void fractions 0 -> gamma 0) is a 0/0 (traps under -ffpe-trap, a stray NaN otherwise). The clamp source is always an
+ !! interior cell (valid, real data) and never a face ghost, so the RHS-relevant ghosts are untouched and output is
+ !! bit-unchanged.
+ impure subroutine s_l0_fill_ghost_corners(loc, mx, ny, pz)
+
+ integer, intent(in) :: loc
+ integer, intent(in) :: mx, ny, pz
+ integer :: i, jb, kb, lb, jc, kc, lc, ng, lo2, hi2, lo3, hi3
+
+ lo2 = 0; hi2 = 0; if (n_glb > 0) then; lo2 = -buff_size; hi2 = ny + buff_size; end if
+ lo3 = 0; hi3 = 0; if (p_glb > 0) then; lo3 = -buff_size; hi3 = pz + buff_size; end if
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[jc, kc, lc, ng]')
+ do i = 1, sys_size
+ do lb = lo3, hi3
+ do kb = lo2, hi2
+ do jb = -buff_size, mx + buff_size
+ ng = 0
+ if (jb < 0 .or. jb > mx) ng = ng + 1
+ if (n_glb > 0) then; if (kb < 0 .or. kb > ny) ng = ng + 1; end if
+ if (p_glb > 0) then; if (lb < 0 .or. lb > pz) ng = ng + 1; end if
+ if (ng >= 2) then
+ jc = min(max(jb, 0), mx); kc = min(max(kb, 0), ny); lc = min(max(lb, 0), pz)
+ amr_cons_st(jb, kb, lb, i, loc) = amr_cons_st(jc, kc, lc, i, loc)
+ end if
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_l0_fill_ghost_corners
+
+ !> Advance every tile one RK stage: fill domain-edge BC ghosts (phase 1), overwrite interior-seam ghosts with neighbour interior
+ !! (phase 2, fmul=1), then advance + RK-update each tile through the shared swap-based solver (phase 3). Mirrors the AMR
+ !! fine-block phase structure (m_time_steppers) with prolong/reflux dropped - a base-res tile has no coarser level.
+ !> Advance every owned tile one RK stage. Fused wrapper (pure-L0): RHS pass then RK pass back-to-back = byte-identical to the
+ !! single-pass form. Under coexist (amr) s_tvd_rk instead calls the two passes directly with s_l0_add_reflux_to_tiles between
+ !! them, so each tile's coarse rhs is Berger-Colella corrected (from the fixed-L0-frame reflux) before its RK update.
+ impure subroutine s_l0_advance_stage(s, coefs, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+
+ integer, intent(in) :: s, t_step
+ real(wp), intent(in) :: coefs(4)
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+
+ call s_l0_advance_stage_rhs(s, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+ call s_l0_advance_stage_rk(s, coefs)
+
+ end subroutine s_l0_advance_stage
+
+ !> RHS pass for all owned tiles: fill domain-edge BC + interior-seam (fine-fine) halo, then s_compute_rhs each owned tile into
+ !! its per-slot rhs. Leaves amr_slots(k)%rhs ready for the RK pass (or, under coexist, for the reflux-delta copy-back first).
+ impure subroutine s_l0_advance_stage_rhs(s, bc_type, q_T_sf, pb_in, rhs_pb, mv_in, rhs_mv, t_step)
+
+ integer, intent(in) :: s, t_step
+ type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type
+ type(scalar_field), intent(inout) :: q_T_sf
+ real(stp), dimension(:,:,:,:,:), intent(inout) :: pb_in, mv_in
+ real(wp), dimension(:,:,:,:,:), intent(inout) :: rhs_pb, rhs_mv
+ integer :: islot
+ integer(8) :: tc0, tc1, crate
+ logical :: measure
+
+ ! measure per-tile compute time only when rebalancing is active (the GPU_WAIT bracketing serialises the GPU, so it is off by
+ ! default). GPU-synced wall time (cpu_time would capture only host launch overhead under offload); accumulated across
+ ! stages, reset at each rebalance. Timing is a pure side-channel - it never touches field data, so output stays
+ ! bit-identical.
+
+ measure = (l0_rebalance_interval > 0)
+
+ call s_l0_fill_edge_bc()
+ call s_amr_fine_fine_halo(0)
+ ! Fill the multi-dim ghost cells (2D diagonal corners; 3D also the ghost edges) that the dimension-split face fills
+ ! (s_l0_fill_edge_bc + s_amr_fine_fine_halo) deliberately leave unset. The RHS never reads them, but the cons->prim
+ ! convert processes the whole buffered range, and an unset ghost (all void fractions 0 -> gamma 0) is a 0/0 that traps
+ ! under -ffpe-trap and is a stray NaN otherwise. Each is copied from the nearest INTERIOR cell (valid state; the face
+ ! ghosts the RHS reads are single-ghost and untouched, so output is unchanged).
+ do islot = 1, l0_ntiles_tot
+ if (amr_block_owner(islot) /= proc_rank) cycle
+ call s_l0_fill_ghost_corners(amr_loc_of(islot), amr_slots(islot)%m, amr_slots(islot)%n, amr_slots(islot)%p)
+ end do
+ do islot = 1, l0_ntiles_tot
+ if (amr_block_owner(islot) /= proc_rank) cycle ! advance only owned tiles; remote tiles live on their owner rank
+ call s_amr_select_slot(islot)
+ if (measure) then
+ $:GPU_WAIT()
+ call system_clock(tc0)
+ end if
+ ! tiles fill their OWN rhs (it must survive the whole-set RHS pass through the reflux point to the RK pass); the
+ ! per-slot q_prim exists exactly when the copy-out gate writes it - otherwise the pooled scratch takes the (unread,
+ ! unwritten) dummy
+ if (allocated(amr_slots(islot)%q_prim)) then
+ call s_amr_fine_stage_rhs(s, bc_type, q_T_sf, amr_slots(islot)%q_prim, amr_slots(islot)%rhs, pb_in, rhs_pb, &
+ & mv_in, rhs_mv, t_step)
+ else
+ call s_amr_fine_stage_rhs(s, bc_type, q_T_sf, amr_scr_prim, amr_slots(islot)%rhs, pb_in, rhs_pb, mv_in, rhs_mv, &
+ & t_step)
+ end if
+ if (measure) then
+ $:GPU_WAIT()
+ call system_clock(tc1, crate)
+ amr_tile_cost(islot) = amr_tile_cost(islot) + real(tc1 - tc0, wp)/real(crate, wp)
+ end if
+ end do
+ call s_amr_select_slot(1)
+
+ end subroutine s_l0_advance_stage_rhs
+
+ !> RK pass for all owned tiles: SSP-RK update consuming each tile's per-slot rhs (already reflux-corrected under coexist).
+ impure subroutine s_l0_advance_stage_rk(s, coefs)
+
+ integer, intent(in) :: s
+ real(wp), intent(in) :: coefs(4)
+ integer :: islot
+
+ do islot = 1, l0_ntiles_tot
+ if (amr_block_owner(islot) /= proc_rank) cycle
+ call s_amr_select_slot(islot)
+ if (allocated(amr_slots(islot)%q_prim)) then
+ call s_amr_fine_stage_rk(s, coefs, amr_slots(islot)%q_prim, amr_slots(islot)%rhs)
+ else
+ call s_amr_fine_stage_rk(s, coefs, amr_scr_prim, amr_slots(islot)%rhs)
+ end if
+ end do
+ call s_amr_select_slot(1)
+
+ end subroutine s_l0_advance_stage_rk
+
+ !> Free the base-grid tiling allocations (mirror of s_l0_tiles_init).
+ impure subroutine s_l0_tiles_finalize()
+
+ integer :: islot
+
+ if (l0_ntile <= 0) return
+ ! Only free the shared slot pool in pure-L0 mode: under coexist (amr) s_finalize_amr_module runs FIRST (m_start_up call
+ ! order) and already freed every slot 1..amr_max_blocks AND deallocated amr_slot_live, so re-running s_amr_free_slot here
+ ! would read the deallocated amr_slot_live (use-after-free).
+ if (.not. amr) then
+ do islot = 1, amr_max_blocks
+ call s_amr_free_slot(islot)
+ end do
+ end if
+ if (allocated(amr_seam_pairs)) deallocate (amr_seam_pairs)
+ ! amr_slots, amr_region_*, amr_isect_*, amr_owns_all, amr_block_owner, amr_block_level, amr_ovl_*, and
+ ! amr_slot_live are SHARED with s_initialize_amr_module/s_finalize_amr_module: when amr, that pair owns them, so only
+ ! free them here in l0-only mode to avoid a coexist double-free. amr_tile_l0_owner/amr_tile_cost/amr_tile_cost_ema are
+ ! TILE-ONLY and always freed here.
+ if (.not. amr) then
+ deallocate (amr_slot_live)
+ call s_amr_st_finalize()
+ if (allocated(amr_ovl_gather)) deallocate (amr_ovl_gather)
+ if (allocated(amr_ovl_scatter)) deallocate (amr_ovl_scatter)
+ deallocate (amr_ovl_gather_n, amr_ovl_scatter_n)
+ if (allocated(amr_gpl_nsrc)) deallocate (amr_gpl_nsrc, amr_gpl_src, amr_gpl_sz, amr_gpl_psrc, amr_gpl_psz)
+ if (allocated(amr_gcr_pool)) deallocate (amr_gcr_pool)
+ if (allocated(amr_gcr_req)) deallocate (amr_gcr_req, amr_gcr_off)
+ deallocate (amr_slots)
+ deallocate (amr_region_lo_all, amr_region_hi_all, amr_isect_lo_all, amr_isect_hi_all, amr_owns_all)
+ deallocate (amr_block_owner, amr_block_level)
+ if (allocated(amr_owner_cut)) deallocate (amr_owner_cut)
+ if (allocated(amr_fine_cut)) deallocate (amr_fine_cut)
+ end if
+ deallocate (amr_tile_l0_owner, amr_tile_cost, amr_tile_cost_ema)
+ if (allocated(sw_x_cb)) deallocate (sw_x_cb, sw_x_cc, sw_dx)
+ if (allocated(sw_y_cb)) deallocate (sw_y_cb, sw_y_cc, sw_dy)
+ if (allocated(sw_z_cb)) deallocate (sw_z_cb, sw_z_cc, sw_dz)
+ if (allocated(amr_gxcb)) deallocate (amr_gxcb)
+ if (allocated(amr_gycb)) deallocate (amr_gycb)
+ if (allocated(amr_gzcb)) deallocate (amr_gzcb)
+
+ end subroutine s_l0_tiles_finalize
+
+ impure subroutine s_finalize_amr_module()
+
+ integer :: i, islot
+
+ ! BEFORE the amr early-return: the report's conservation allreduce is collective, and the L0 tile
+ ! families can fire with amr = F. All ranks take the same path either way.
+
+ call s_xa_report()
+ call s_amr_cov_report()
+ if (.not. amr) return
+ do islot = 1, amr_max_blocks
+ call s_amr_free_slot(islot)
+ end do
+ if (qbmm .and. .not. polytropic) then
+ @:DEALLOCATE(amr_rhs_pb_f)
+ @:DEALLOCATE(amr_rhs_mv_f)
+ @:DEALLOCATE(amr_cg_pb)
+ @:DEALLOCATE(amr_cg_mv)
+ end if
+ deallocate (amr_slot_live)
+ call s_amr_st_finalize()
+ if (allocated(amr_seam_pairs)) deallocate (amr_seam_pairs)
+ if (allocated(amr_ovl_gather)) deallocate (amr_ovl_gather)
+ if (allocated(amr_ovl_scatter)) deallocate (amr_ovl_scatter)
+ deallocate (amr_ovl_gather_n, amr_ovl_scatter_n)
+ if (allocated(amr_gpl_nsrc)) deallocate (amr_gpl_nsrc, amr_gpl_src, amr_gpl_sz, amr_gpl_psrc, amr_gpl_psz)
+ if (allocated(amr_gcr_pool)) deallocate (amr_gcr_pool)
+ if (allocated(amr_gcr_req)) deallocate (amr_gcr_req, amr_gcr_off)
+ ! per-array guards, NOT grouped on a lead member: the wave-scratch arrays of one group allocate
+ ! independently (spsz/rpsz are sized only by the qbmm pb/mv wave branch), so a non-qbmm np>1 run
+ ! reaches here with a group partially allocated. gfortran/ifx abort on deallocating an unallocated
+ ! array (amdflang silently tolerates it) - the CI probe's "Restart roundtrip run failed" crash class.
+ #:for A in ['amr_fw_sblk', 'amr_fw_sbl', 'amr_fw_sbh', 'amr_fw_spi', 'amr_fw_sqo', 'amr_fw_spo', &
+ 'amr_fw_rblk', 'amr_fw_rbl', 'amr_fw_rbh', 'amr_fw_rpi', 'amr_fw_rqo', 'amr_fw_rpo', &
+ 'amr_fw_sprank', 'amr_fw_sqsz', 'amr_fw_spsz', 'amr_fw_snxp', 'amr_fw_sqbase', 'amr_fw_spbase', &
+ 'amr_fw_rprank', 'amr_fw_rqsz', 'amr_fw_rpsz', 'amr_fw_rnxp', 'amr_fw_rqbase', 'amr_fw_rpbase', &
+ 'amr_fw_map', 'amr_fw_nx', 'amr_fw_pq', 'amr_fw_pp']
+ if (allocated(${A}$)) deallocate (${A}$)
+ #:endfor
+ if (allocated(amr_fw_sq)) deallocate (amr_fw_sq)
+ if (allocated(amr_fw_sp)) deallocate (amr_fw_sp)
+ if (allocated(amr_fw_rq)) deallocate (amr_fw_rq)
+ if (allocated(amr_fw_rp)) deallocate (amr_fw_rp)
+ if (allocated(amr_fw_req)) deallocate (amr_fw_req, amr_fw_reqw)
+ do i = 1, sys_size
+ @:DEALLOCATE(amr_cg(i)%sf)
+ end do
+ @:DEALLOCATE(amr_cg)
+ deallocate (amr_slots)
+ deallocate (amr_region_lo_all, amr_region_hi_all, amr_isect_lo_all, amr_isect_hi_all, amr_owns_all)
+ if (allocated(sw_x_cb)) deallocate (sw_x_cb, sw_x_cc, sw_dx)
+ if (allocated(sw_y_cb)) deallocate (sw_y_cb, sw_y_cc, sw_dy)
+ if (allocated(sw_z_cb)) deallocate (sw_z_cb, sw_z_cc, sw_dz)
+ if (allocated(amr_block_owner)) deallocate (amr_block_owner)
+ if (allocated(amr_owner_cut)) deallocate (amr_owner_cut)
+ if (allocated(amr_fine_cut)) deallocate (amr_fine_cut)
+ if (allocated(amr_block_level)) deallocate (amr_block_level)
+ if (allocated(amr_gxcb)) deallocate (amr_gxcb)
+ if (allocated(amr_gycb)) deallocate (amr_gycb)
+ if (allocated(amr_gzcb)) deallocate (amr_gzcb)
+ if (igr) then
+ @:DEALLOCATE(sw_jac)
+ @:DEALLOCATE(sw_jac_old)
+ end if
+ if (cyl_coord .and. n_glb > 0) then
+ @:DEALLOCATE(amr_rvw)
+ end if
+
+ end subroutine s_finalize_amr_module
+
+end module m_amr
diff --git a/src/simulation/m_amr_registers.fpp b/src/simulation/m_amr_registers.fpp
new file mode 100644
index 0000000000..8ff3dab821
--- /dev/null
+++ b/src/simulation/m_amr_registers.fpp
@@ -0,0 +1,1339 @@
+!>
+!!@file
+!!@brief Contains module m_amr_registers
+
+#:include 'macros.fpp'
+
+!> @brief AMR flux registers: per-RK-stage refluxing at the coarse/fine block boundary (SP4). Depends only on m_derived_types +
+!! m_global_parameters so both m_rhs (capture) and m_time_steppers (apply) can use it without cycles. "use m_amr" would cycle (m_amr
+!! -> m_rhs -> m_amr_registers), so region info is read from amr_region_lo/hi and amr_isect_lo/hi (m_global_parameters), mirrored
+!! across regrids by s_set_amr_fine_geometry. creg uses 0-based transverse indexing relative to the rank's block INTERSECTION (= the
+!! block at np=1); freg uses 0-based LOCAL fine (fine children of isect cell t are 2*t and 2*t+1). All arrays are preallocated at
+!! max size, so regrid needs no reallocation.
+!!
+!! Multi-fluid (5-eq HLLC, amr-gated path): the volume-fraction ADVECTIVE flux alpha_i*u_star travels through flux_rsx_vf (the
+!! "VOLUME FRACTION FLUX" block of m_riemann_solver_hllc, same form as the mass flux), so the uniform 1:sys_size capture below
+!! refluxes per-fluid masses, momentum, energy, AND alpha's advective part with no extra registers. The non-conservative remainder
+!! (the +alpha*d(u_star)/dx compression term m_rhs assembles from flux_src_n = u_star) is deliberately NOT captured: alpha is
+!! genuinely non-conservative, so flux-matching u_star would be wrong; coarse/fine volume-fraction consistency is instead held by
+!! mpp_lim's clamp+renormalize (required by the checker for amr with num_fluids > 1).
+!!
+!! Viscous (SP11): the viscous stress/work face fluxes travel through flux_src_n for mom and energy (m_rhs
+!! s_compute_additional_physics_rhs: rhs += (flux_src_n(j-1) - flux_src_n(j))/dx, identical face indexing and sign to advective
+!! flux_rsx_vf). Captured into the SAME registers (added on top of advective flux for mom..E) so the c/f reflux matches the TOTAL
+!! advective+viscous flux; energy conservation thus includes viscous work. Fine-ghost velocity gradients at the c/f boundary come
+!! from the conservative-linear cons prolongation (no special gradient reconstruction) - like the alpha K-term, that inconsistency
+!! is bounded, and conservation is enforced by the flux-register matching.
+!!
+!! Chemistry species diffusion (SP17): the mixture-averaged species mass fluxes travel through flux_src_n for the species
+!! equations, and the thermal-conduction + enthalpy energy flux through the energy equation - same face-difference assembly as
+!! viscous. Captured into the SAME registers (species always; energy only when NOT viscous, since a viscous run already captures
+!! the combined flux_src_n(E)) so the c/f reflux matches the total advective+diffusive flux and species/element/energy conservation
+!! holds across the block boundary. Fine-ghost species gradients come from the species-closure cons prolongation - bounded like
+!! viscous.
+module m_amr_registers
+
+ use m_derived_types
+ use m_global_parameters
+ use m_riemann_state, only: flux_rsx_vf, flux_src_rsx_vf
+
+ implicit none
+
+ private; public :: s_initialize_amr_registers, s_amr_capture_boundary_flux, s_amr_apply_reflux, s_amr_zero_fine_registers, &
+ & s_amr_apply_reflux_state, s_finalize_amr_registers, s_amr_reflux_face_flags, s_amr_reflux_apply_faces, &
+ & s_amr_parent_foot, s_amr_reg_prepare, freg, creg, f_amr_face_is_seam
+
+ !> SSP-RK3 effective flux weights: q^{n+1} = q^n + dt*(L(q^n)/6 + L(q^(1))/6 + 2*L(q^(2))/3).
+ real(wp), parameter :: rk3_w(3) = [1._wp/6._wp, 1._wp/6._wp, 2._wp/3._wp]
+
+ !> Registers for the two block faces normal to one direction: (1:sys_size, transverse-1, transverse-2, 1:amr_max_blocks). The
+ !! trailing dimension is the block slot (indexed by amr_cur); each slot is captured/applied independently.
+ type t_face_reg
+ real(wp), allocatable :: lo(:,:,:,:)
+ real(wp), allocatable :: hi(:,:,:,:)
+ end type t_face_reg
+
+ type(t_face_reg) :: creg(3) !< coarse flux at block boundary faces (relative 0-based transverse)
+ type(t_face_reg) :: freg(3) !< fine flux at covering fine faces (0-based fine transverse)
+ $:GPU_DECLARE(create='[creg, freg]')
+
+ !> Slot capacity the registers are currently sized for, and the transverse extents they were built with.
+ !!
+ !! These used to be dimensioned 1:amr_max_blocks outright, which is a pure memory tax: amr_max_blocks is a SAFETY CAP, not a
+ !! block count. At 400^3 with ~243 live blocks against the shipped cap of 8192 that is a 34x over-provision costing a MEASURED
+ !! 1.41 MB of device memory per unused slot, i.e. 10.8 GiB per GCD. They now grow geometrically like the flat store
+ !! (s_amr_st_reserve), so the cap bounds correctness only and memory follows the actual block count.
+ integer, parameter :: amr_reg_floor = 64 !< initial slot capacity; growth doubles from here
+ integer :: amr_reg_cap = 0
+ integer :: rc1, rc2, rc3 !< coarse transverse extents (creg is 0:rc*-1)
+ integer :: rf1, rf2, rf3 !< fine transverse extents (freg is 0:rf*)
+ !> Mesh-epoch/tripwire keys of the last participation-map build (s_amr_reg_prepare; mirror of the seam-pair cache keys).
+ integer(8) :: amr_reg_epoch_built = -1_8
+ integer :: amr_reg_nblk_built = -1
+
+ !> Per-slot geometry scratch for the batched creg capture kernels (1:amr_max_blocks): host-filled from per-slot flags/overlap,
+ !! then GPU_UPDATE'd so ONE kernel iterates the slot dimension instead of O(blocks) tiny launches. bactive gates the slot;
+ !! bt1lo/bt1hi/bt2lo/bt2hi are the per-slot transverse window (a slot outside the rectangular max caps is cycled); bjlo/bjhi are
+ !! the normal-face flux indices; bo1/bo2 the transverse origins; bclo/bchi the per-face capture gates.
+ integer, allocatable :: bjlo(:), bjhi(:), bo1(:), bo2(:), bt1lo(:), bt1hi(:), bt2lo(:), bt2hi(:)
+ logical, allocatable :: bclo(:), bchi(:), bactive(:)
+ $:GPU_DECLARE(create='[bjlo, bjhi, bo1, bo2, bt1lo, bt1hi, bt2lo, bt2hi, bclo, bchi, bactive]')
+
+ !> Per-slot geometry scratch for the batched reflux APPLY kernels (mirror of the capture batching above): a_act gates the slot,
+ !! a_lo/a_hi the per-face applies, a_ol/a_oh the outside coarse cell's local index in the face dim, a_t1/t2/t3 the local
+ !! transverse origins, a_b1l..a_b2h the transverse windows (block-relative, freg/creg-aligned), a_mlo/a_mhi the outside-cell
+ !! widths with the cyl area factors folded in. Filled per direction on the host, GPU_UPDATE'd, consumed by ONE kernel per face
+ !! direction instead of O(blocks) tiny launches.
+ integer, allocatable :: a_ol(:), a_oh(:), a_t1(:), a_t2(:), a_t3(:), a_b1l(:), a_b1h(:), a_b2l(:), a_b2h(:)
+ logical, allocatable :: a_lo(:), a_hi(:), a_act(:)
+ real(wp), allocatable :: a_mlo(:), a_mhi(:)
+ $:GPU_DECLARE(create='[a_ol, a_oh, a_t1, a_t2, a_t3, a_b1l, a_b1h, a_b2l, a_b2h, a_lo, a_hi, a_act, a_mlo, a_mhi]')
+
+contains
+
+ #:def REG_GROW(A, L2, U2, L3, U3)
+ if (allocated(${A}$)) then
+ if (oldcap > amr_reg_grow_dev_cap) then
+ ! near-limit fallback (mirror of s_amr_st_reserve): the device staging below transiently holds
+ ! old + tmp = 2*oldcap slots on the device and growth fires at the memory high-water mark, so above
+ ! the threshold keep the host round trip - slow, but its device peak is max(old, new).
+ $:GPU_UPDATE(host='[' + A + ']')
+ allocate (rtmp(1:sys_size,${L2}$:${U2}$,${L3}$:${U3}$,1:oldcap))
+ rtmp = ${A}$(:,:,:,1:oldcap)
+ @:DEALLOCATE(${A}$)
+ @:ALLOCATE(${A}$(1:sys_size, ${L2}$:${U2}$, ${L3}$:${U3}$, 1:newcap))
+ ${A}$ = 0._wp
+ ${A}$(:,:,:,1:oldcap) = rtmp
+ deallocate (rtmp)
+ $:GPU_UPDATE(device='[' + A + ']')
+ else
+ ! stage the live slots on the DEVICE (rtmp_d is device-mapped by @:ALLOCATE); no PCIe traffic
+ @:ALLOCATE(rtmp_d(1:sys_size, ${L2}$:${U2}$, ${L3}$:${U3}$, 1:oldcap))
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do c4 = 1, oldcap
+ do t2 = ${L3}$, ${U3}$
+ do t1 = ${L2}$, ${U2}$
+ do eq = 1, sys_size
+ rtmp_d(eq, t1, t2, c4) = ${A}$(eq, t1, t2, c4)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ @:DEALLOCATE(${A}$)
+ @:ALLOCATE(${A}$(1:sys_size, ${L2}$:${U2}$, ${L3}$:${U3}$, 1:newcap))
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do c4 = 1, oldcap
+ do t2 = ${L3}$, ${U3}$
+ do t1 = ${L2}$, ${U2}$
+ do eq = 1, sys_size
+ ${A}$(eq, t1, t2, c4) = rtmp_d(eq, t1, t2, c4)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ @:DEALLOCATE(rtmp_d)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do c4 = oldcap + 1, newcap
+ do t2 = ${L3}$, ${U3}$
+ do t1 = ${L2}$, ${U2}$
+ do eq = 1, sys_size
+ ${A}$(eq, t1, t2, c4) = 0._wp
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+ #:enddef
+
+ !> Grow the reflux registers to cover at least nslot slots, doubling and never shrinking.
+ !!
+ !! Keyed on amr_reg_n, the DENSE participation-local count (s_amr_reg_prepare): register slots are dense indices from
+ !! amr_reg_of, so capacity follows what this rank owns or participates in, not the global block count. The capture and
+ !! apply kernels sweep slot = 1..amr_reg_n with bactive/a_act gating the filled subset.
+ !!
+ !! Contents are PRESERVED across growth, mirroring s_amr_st_reserve. Every caller of s_amr_alloc_slot today is a between-step
+ !! operation (regrid, restart, slot reconcile, L0 tile build) and stage 1 overwrites the registers anyway, so discarding would
+ !! probably be safe - but freg accumulates across RK stages and across subcycle substeps, so "probably" is not the right
+ !! standard for a silent conservation error. Growth stages through a DEVICE temporary like the store (the registers are
+ !! device-authoritative; every host consumer pulls its slot to the host immediately before reading, so the host
+ !! mirror coming out of a device-path growth UNDEFINED is the store's contract, not a new one). Above the transient threshold
+ !! the old host round trip remains as the OOM-safe path.
+ impure subroutine s_amr_reg_reserve(nslot)
+
+ integer, intent(in) :: nslot
+ integer :: oldcap, newcap
+ integer :: eq, t1, t2, c4
+ !> device staging transiently doubles one register array's footprint; register slots are faces (~1.4 MB across all 12 arrays
+ !! vs tens of MB for a store column), so the byte transient of 512 register slots matches the store's 32-column threshold.
+ !! Above it, fall back to the host round trip (device peak max(old, new)).
+ integer, parameter :: amr_reg_grow_dev_cap = 512
+ real(wp), allocatable :: rtmp(:,:,:,:), rtmp_d(:,:,:,:)
+
+ if (nslot <= amr_reg_cap) return
+ oldcap = amr_reg_cap
+ newcap = min(amr_max_blocks, max(2*oldcap, nslot))
+
+ @:REG_GROW(creg(1)%lo, 0, rc2 - 1, 0, rc3 - 1)
+ @:REG_GROW(creg(1)%hi, 0, rc2 - 1, 0, rc3 - 1)
+ @:REG_GROW(freg(1)%lo, 0, rf2, 0, rf3)
+ @:REG_GROW(freg(1)%hi, 0, rf2, 0, rf3)
+ @:REG_GROW(creg(2)%lo, 0, rc1 - 1, 0, rc3 - 1)
+ @:REG_GROW(creg(2)%hi, 0, rc1 - 1, 0, rc3 - 1)
+ @:REG_GROW(freg(2)%lo, 0, rf1, 0, rf3)
+ @:REG_GROW(freg(2)%hi, 0, rf1, 0, rf3)
+ @:REG_GROW(creg(3)%lo, 0, rc1 - 1, 0, rc2 - 1)
+ @:REG_GROW(creg(3)%hi, 0, rc1 - 1, 0, rc2 - 1)
+ @:REG_GROW(freg(3)%lo, 0, rf1, 0, rf2)
+ @:REG_GROW(freg(3)%hi, 0, rf1, 0, rf2)
+
+ amr_reg_cap = newcap
+
+ end subroutine s_amr_reg_reserve
+
+ !> Build/refresh the participation-local register index (amr_reg_of/amr_reg_n, m_global_parameters) and size the registers to
+ !! the DENSE count. Lazily keyed on the mesh epoch (every regrid, migration, restart, and slot renumbering bumps it; a
+ !! block-count change is the tripwire). A global slot g maps iff this rank (a) owns g, (b) owns g's parent (the parent-side
+ !! child-creg capture, the freg receives, and the reflux-to-parent apply all index the CHILD's slot on the parent's owner), or
+ !! (c) reflux-face-participates in g per s_amr_reflux_face_flags - the coarse capture, the L0/L1 apply, and the reflux face-wave
+ !! receives are gated by exactly these flags, so the map cannot under-cover them. The register footprint was the O(GLOBAL boxes)
+ !! device term that broke np32 weak scaling (~1.4 MB/slot across the 12 arrays, reserved toward amr_num_blocks); it is now
+ !! O(owned + participation halo). The mapped range is ZEROED after a rebuild: dense slots alias across rebuilds (block g's new
+ !! slot may hold another block's stale flux), and zeroing keeps the standing garbage-until-captured contract deterministic.
+ !! Contents at a rebuild are dead by construction - the epoch only moves between steps, and every consumer overwrites (stage-1)
+ !! or zeroes (s_amr_zero_fine_registers) before its first read of a step.
+ impure subroutine s_amr_reg_prepare()
+
+ integer :: g, kc, dch, save_cur, d, t, eq, t1, t2, t1_hi, t2_hi, islot
+ integer :: sidx(3), ext(3)
+ logical :: tv(3), tvd, need, is_child
+
+ if (.not. amr) return
+ if (amr_reg_epoch_built == amr_mesh_epoch .and. amr_reg_nblk_built == amr_num_blocks) return
+ save_cur = amr_cur
+ amr_reg_of = 0
+ amr_reg_n = 0
+ do g = 1, amr_num_blocks
+ need = amr_owns_all(g)
+ if (.not. need .and. amr_block_level(g) <= 1) then
+ ! (c) reflux-face participation WITHOUT the fine-fine seam clip - the formula of
+ ! f_amr_reflux_participates (m_amr) evaluated for THIS rank, keep lockstep. The subcycle p2p exchange
+ ! gates its whole-slot receives on that UNCLIPPED predicate, so a rank whose only participating faces
+ ! are tiling seams still posts into the block's register slot and must be mapped. The seam-clipped
+ ! s_amr_reflux_face_flags fills (coarse capture, L0/L1 apply, face-wave) are a strict subset.
+ call s_amr_select_slot(g)
+ sidx = 0; ext = 0
+ sidx(1) = start_idx(1); ext(1) = m
+ if (n_glb > 0) then; sidx(2) = start_idx(2); ext(2) = n; end if
+ if (p_glb > 0) then; sidx(3) = start_idx(3); ext(3) = p; end if
+ tv(1) = amr_region_lo(1) <= sidx(1) + ext(1) .and. amr_region_hi(1) >= sidx(1)
+ tv(2) = (n_glb == 0) .or. (amr_region_lo(2) <= sidx(2) + ext(2) .and. amr_region_hi(2) >= sidx(2))
+ tv(3) = (p_glb == 0) .or. (amr_region_lo(3) <= sidx(3) + ext(3) .and. amr_region_hi(3) >= sidx(3))
+ do d = 1, num_dims
+ tvd = .true.
+ do t = 1, num_dims
+ if (t /= d) tvd = tvd .and. tv(t)
+ end do
+ if (tvd .and. amr_region_lo(d) - 1 >= sidx(d) .and. amr_region_lo(d) - 1 <= sidx(d) + ext(d)) need = .true.
+ if (tvd .and. amr_region_hi(d) + 1 >= sidx(d) .and. amr_region_hi(d) + 1 <= sidx(d) + ext(d)) need = .true.
+ end do
+ end if
+ if (need) then
+ amr_reg_n = amr_reg_n + 1
+ amr_reg_of(g) = amr_reg_n
+ end if
+ end do
+ ! (b) children of owned blocks - the inline child test of the fine-branch capture below; keep lockstep
+ do g = 1, amr_num_blocks
+ if (.not. amr_owns_all(g)) cycle
+ do kc = 1, amr_num_blocks
+ if (amr_reg_of(kc) /= 0) cycle
+ if (amr_block_level(kc) /= amr_block_level(g) + 1) cycle
+ is_child = .true.
+ do dch = 1, 3
+ is_child = is_child .and. amr_region_lo_all(dch, kc) <= amr_region_hi_all(dch, &
+ & g) .and. amr_region_hi_all(dch, kc) >= amr_region_lo_all(dch, g)
+ end do
+ if (.not. is_child) cycle
+ amr_reg_n = amr_reg_n + 1
+ amr_reg_of(kc) = amr_reg_n
+ end do
+ end do
+ call s_amr_select_slot(save_cur) ! also refreshes amr_reg_cur under the new map
+ amr_reg_epoch_built = amr_mesh_epoch
+ amr_reg_nblk_built = amr_num_blocks
+ call s_amr_reg_reserve(amr_reg_n)
+ do d = 1, 3
+ if (allocated(freg(d)%lo) .and. amr_reg_n > 0) then
+ t1_hi = ubound(freg(d)%lo, 2); t2_hi = ubound(freg(d)%lo, 3)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do islot = 1, amr_reg_n
+ do t2 = 0, t2_hi
+ do t1 = 0, t1_hi
+ do eq = 1, sys_size
+ freg(d)%lo(eq, t1, t2, islot) = 0._wp
+ freg(d)%hi(eq, t1, t2, islot) = 0._wp
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ if (allocated(creg(d)%lo) .and. amr_reg_n > 0) then
+ t1_hi = ubound(creg(d)%lo, 2); t2_hi = ubound(creg(d)%lo, 3)
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do islot = 1, amr_reg_n
+ do t2 = 0, t2_hi
+ do t1 = 0, t1_hi
+ do eq = 1, sys_size
+ creg(d)%lo(eq, t1, t2, islot) = 0._wp
+ creg(d)%hi(eq, t1, t2, islot) = 0._wp
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end do
+
+ end subroutine s_amr_reg_prepare
+
+ !> Reflux-face participation for THIS rank: own_lo(d)/own_hi(d) = it owns the coarse cell layer just OUTSIDE the block's
+ !! low/high face in dim d (where the coarse capture and both reflux applies run; at an interior face the same rank also holds
+ !! the inside cells) - i.e. the outside layer lies in its subdomain in dim d and the block's transverse range overlaps it.
+ !! Fine-level distribution: participation derives from the REPLICATED block range vs this rank's coarse subdomain (NOT
+ !! amr_isect, which is owner-only under whole-block ownership); tlo/thi return the GLOBAL transverse overlap [max(region_lo,
+ !! sidx) : min(region_hi, sidx+ext)] per dim, so capture and apply share a block-relative frame aligned with the owner's freg.
+ !! All true / full-block at np=1. Also returns sidx/ext (collapsed dims pinned to 0). Reads the COARSE grid m/n/p.
+ impure subroutine s_amr_reflux_face_flags(sidx, ext, own_lo, own_hi, tlo, thi)
+
+ integer, intent(out) :: sidx(3), ext(3)
+ logical, intent(out) :: own_lo(3), own_hi(3)
+ integer, intent(out) :: tlo(3), thi(3)
+ logical :: tv(3), tvd
+ integer :: d, t
+
+ sidx = 0; ext = 0
+ sidx(1) = start_idx(1); ext(1) = m
+ if (n_glb > 0) then; sidx(2) = start_idx(2); ext(2) = n; end if
+ if (p_glb > 0) then; sidx(3) = start_idx(3); ext(3) = p; end if
+ ! global transverse overlap of block with this rank's coarse subdomain (collapsed dims pin to 0)
+ do d = 1, 3
+ tlo(d) = max(amr_region_lo(d), sidx(d))
+ thi(d) = min(amr_region_hi(d), sidx(d) + ext(d))
+ end do
+ tv(1) = tlo(1) <= thi(1)
+ tv(2) = (n_glb == 0) .or. tlo(2) <= thi(2)
+ tv(3) = (p_glb == 0) .or. tlo(3) <= thi(3)
+ own_lo = .false.; own_hi = .false.
+ do d = 1, num_dims
+ tvd = .true.
+ do t = 1, num_dims
+ if (t /= d) tvd = tvd .and. tv(t)
+ end do
+ own_lo(d) = tvd .and. amr_region_lo(d) - 1 >= sidx(d) .and. amr_region_lo(d) - 1 <= sidx(d) + ext(d)
+ own_hi(d) = tvd .and. amr_region_hi(d) + 1 >= sidx(d) .and. amr_region_hi(d) + 1 <= sidx(d) + ext(d)
+ ! max_grid_size tiling: a face shared with an adjacent sub-block is fine-fine, NOT a c/f boundary - exclude it from
+ ! reflux (its outside cell is inside the neighbour block; refluxing there would corrupt that cell mid-step). The
+ ! block-to-block fine-fine halo already matches the shared flux. (No seams without tiling, so np=1/untiled: no-op.)
+ if (own_lo(d) .and. f_amr_face_is_seam(d, -1)) own_lo(d) = .false.
+ if (own_hi(d) .and. f_amr_face_is_seam(d, 1)) own_hi(d) = .false.
+ end do
+
+ end subroutine s_amr_reflux_face_flags
+
+ !> True iff the current block's face on `side` (+1 high / -1 low) in dim d is shared with an ADJACENT sub-block (max_grid_size
+ !! tiling) - i.e. another block's opposite face is exactly one cell away with matching transverse extents. Such a seam is
+ !! fine-fine, not a c/f boundary. Reads the replicated block list (amr_region_*_all) - no tiling means no match.
+ pure logical function f_amr_face_is_seam(d, side) result(seam)
+
+ integer, intent(in) :: d, side
+ integer :: y, t
+ logical :: match
+
+ seam = .false.
+ do y = 1, amr_num_blocks
+ if (y == amr_cur) cycle
+ if (side == 1) then
+ if (amr_region_lo_all(d, y) /= amr_region_hi(d) + 1) cycle
+ else
+ if (amr_region_hi_all(d, y) /= amr_region_lo(d) - 1) cycle
+ end if
+ match = .true.
+ do t = 1, num_dims
+ if (t /= d) match = match .and. amr_region_lo_all(t, y) == amr_region_lo(t) .and. amr_region_hi_all(t, &
+ & y) == amr_region_hi(t)
+ end do
+ if (match) then; seam = .true.; return; end if
+ end do
+
+ end function f_amr_face_is_seam
+
+ impure subroutine s_initialize_amr_registers(maxc_fit)
+
+ integer, intent(in) :: maxc_fit(3) !< amr_maxc_fit from m_amr (min-over-ranks local half-extent = max block a rank owns)
+ integer :: maxc1, maxc2, maxc3, max_f1, max_f2, max_f3
+
+ if (.not. amr) return
+ ! Registers on ALL ranks: regrid moves block faces, so any rank can participate (fine cells for freg; outside-face layer
+ ! for creg capture/apply and for receiving freg from the block owner). Fine-level distribution: freg is captured for the
+ ! WHOLE block and indexed block-relative by every applier, so registers must span a whole block. The largest block a rank
+ ! can own is amr_maxc_fit (the scratch-constraint cap), so size to it - matches m_amr's fine arrays and right-sizes the face
+ ! registers to ~1/num_procs^(d-1) the global-half memory at scale.
+ maxc1 = maxc_fit(1)
+ maxc2 = 1; maxc3 = 1
+ if (n_glb > 0) maxc2 = maxc_fit(2)
+ if (p_glb > 0) maxc3 = maxc_fit(3)
+ max_f1 = amr_ref_ratio*maxc1 - 1
+ max_f2 = 0; max_f3 = 0
+ if (n_glb > 0) max_f2 = amr_ref_ratio*maxc2 - 1
+ if (p_glb > 0) max_f3 = amr_ref_ratio*maxc3 - 1
+ ! creg: relative 0-based transverse (0:maxc_t-1); freg: 0-based fine (0:max_f_t).
+ ! Device-resident (@:ALLOCATE): capture and both applies run as kernels; no host copies read.
+ ! Stash the transverse extents so s_amr_reg_reserve can rebuild the same shapes when the slot dimension grows.
+ rc1 = maxc1; rc2 = maxc2; rc3 = maxc3
+ rf1 = max_f1; rf2 = max_f2; rf3 = max_f3
+ ! Start at a small slot capacity and grow on demand; do NOT size to amr_max_blocks (see amr_reg_cap above).
+ amr_reg_cap = min(amr_max_blocks, amr_reg_floor)
+ @:ALLOCATE(creg(1)%lo(1:sys_size,0:rc2 - 1,0:rc3 - 1,1:amr_reg_cap), creg(1)%hi(1:sys_size,0:rc2 - 1, 0:rc3 - 1, &
+ & 1:amr_reg_cap))
+ @:ALLOCATE(freg(1)%lo(1:sys_size,0:rf2,0:rf3,1:amr_reg_cap), freg(1)%hi(1:sys_size,0:rf2,0:rf3, 1:amr_reg_cap))
+ if (n_glb > 0) then
+ @:ALLOCATE(creg(2)%lo(1:sys_size,0:rc1 - 1,0:rc3 - 1,1:amr_reg_cap), creg(2)%hi(1:sys_size,0:rc1 - 1, 0:rc3 - 1, &
+ & 1:amr_reg_cap))
+ @:ALLOCATE(freg(2)%lo(1:sys_size,0:rf1,0:rf3,1:amr_reg_cap), freg(2)%hi(1:sys_size,0:rf1,0:rf3, 1:amr_reg_cap))
+ end if
+ if (p_glb > 0) then
+ @:ALLOCATE(creg(3)%lo(1:sys_size,0:rc1 - 1,0:rc2 - 1,1:amr_reg_cap), creg(3)%hi(1:sys_size,0:rc1 - 1, 0:rc2 - 1, &
+ & 1:amr_reg_cap))
+ @:ALLOCATE(freg(3)%lo(1:sys_size,0:rf1,0:rf2,1:amr_reg_cap), freg(3)%hi(1:sys_size,0:rf1,0:rf2, 1:amr_reg_cap))
+ end if
+ ! per-slot geometry scratch for the batched capture kernels (device-resident: host-filled, GPU_UPDATE'd before each call)
+ @:ALLOCATE(bjlo(1:amr_max_blocks), bjhi(1:amr_max_blocks), bo1(1:amr_max_blocks), bo2(1:amr_max_blocks))
+ @:ALLOCATE(bt1lo(1:amr_max_blocks), bt1hi(1:amr_max_blocks), bt2lo(1:amr_max_blocks), bt2hi(1:amr_max_blocks))
+ @:ALLOCATE(bclo(1:amr_max_blocks), bchi(1:amr_max_blocks), bactive(1:amr_max_blocks))
+ @:ALLOCATE(a_ol(1:amr_max_blocks), a_oh(1:amr_max_blocks), a_t1(1:amr_max_blocks), a_t2(1:amr_max_blocks))
+ @:ALLOCATE(a_t3(1:amr_max_blocks), a_b1l(1:amr_max_blocks), a_b1h(1:amr_max_blocks), a_b2l(1:amr_max_blocks))
+ @:ALLOCATE(a_b2h(1:amr_max_blocks), a_lo(1:amr_max_blocks), a_hi(1:amr_max_blocks), a_act(1:amr_max_blocks))
+ @:ALLOCATE(a_mlo(1:amr_max_blocks), a_mhi(1:amr_max_blocks))
+ ! participation-local register index (host-only ints; the register REALS are what the dense map shrinks)
+ allocate (amr_reg_of(1:amr_max_blocks))
+ amr_reg_of = 0; amr_reg_n = 0; amr_reg_cur = 0
+ amr_reg_epoch_built = -1_8; amr_reg_nblk_built = -1
+
+ end subroutine s_initialize_amr_registers
+
+ !> Parent-fine footprint of block k inside its parent pblk, from REPLICATED metadata only, so every rank computes the same box
+ !! (a rank needs it for a block it does NOT own, whose own amr_isect_lo/hi is the empty non-owner footprint). Mirrors the
+ !! level>=2 branch of s_set_amr_fine_geometry exactly; rr is the global amr_ref_ratio because a level>=2 block's parent is never
+ !! an L0 tile (the only slot with a per-slot ratio of 1). Lives here rather than in m_amr so the child-creg capture below and
+ !! m_amr's P2P gather/restrict/reflux share one copy of the formula ("use m_amr" would cycle).
+ pure subroutine s_amr_parent_foot(k, pblk, plo, phi)
+
+ integer, intent(in) :: k, pblk
+ integer, intent(out) :: plo(3), phi(3)
+ integer :: d, rr
+
+ rr = amr_ref_ratio
+ do d = 1, 3
+ plo(d) = rr*(amr_region_lo_all(d, k) - amr_region_lo_all(d, pblk))
+ phi(d) = rr*(amr_region_hi_all(d, k) - amr_region_lo_all(d, pblk)) + (rr - 1)
+ end do
+ if (n_glb == 0) then; plo(2) = 0; phi(2) = 0; end if
+ if (p_glb == 0) then; plo(3) = 0; phi(3) = 0; end if
+
+ end subroutine s_amr_parent_foot
+
+ !> Shared creg boundary-flux capture (dense eq range), BATCHED over the slot dimension: for each active slot in [1:nb],
+ !! creg(id)%lo/hi(eq, t1, t2, slot) [+=/=] cf * flux(face, bo1(slot)+t1, bo2(slot)+t2) for eq in [eqb:eqe], over the per-slot
+ !! transverse window [bt1lo:bt1hi] x [bt2lo:bt2hi]. acc=.true. accumulates, .false. overwrites (the merge picks the old value or
+ !! 0 with no arithmetic, so a stage-1 overwrite reads no uninitialized creg). bclo/bchi gate the low/high face (unowned coarse
+ !! faces off; child faces always on). The device kernel collapses (slot, t2, t1, eq) over the rectangular caps
+ !! [0:maxt2]x[0:maxt1] (max over slots) and cycles inactive slots / out-of-window cells - one launch replaces O(blocks) per-slot
+ !! launches. Per-slot geometry (bjlo etc.) is host-filled and GPU_UPDATE'd by the caller. Used for the advective (flat=T,
+ !! eqb=1..sys_size) and viscous (flux_src, eqb=mom..E) captures on BOTH the coarse-self and child sides.
+ impure subroutine s_amr_capture_creg_dense_batch(nb, id, advective, cf, acc, maxt1, maxt2, eqb, eqe)
+
+ integer, intent(in) :: nb, id, maxt1, maxt2, eqb, eqe
+ !> Which flat Riemann buffer to read: T = flux_rsx_vf (advective), F = flux_src_rsx_vf (viscous). Both are plain module
+ !! arrays now, so this routine takes NO field dummies at all - the whole point of the flattening.
+ logical, intent(in) :: advective
+ real(wp), intent(in) :: cf
+ logical, intent(in) :: acc
+ integer :: eq, t1, t2, slot, i1, i2, i3, j1, j2, j3
+ real(wp) :: v_lo, v_hi
+
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[i1, i2, i3, j1, j2, j3, v_lo, v_hi]')
+ do slot = 1, nb
+ do t2 = 0, maxt2
+ do t1 = 0, maxt1
+ do eq = eqb, eqe
+ if (.not. bactive(slot)) cycle
+ if (t1 < bt1lo(slot) .or. t1 > bt1hi(slot) .or. t2 < bt2lo(slot) .or. t2 > bt2hi(slot)) cycle
+ select case (id)
+ case (1)
+ i1 = bjlo(slot); i2 = bo1(slot) + t1; i3 = bo2(slot) + t2
+ j1 = bjhi(slot); j2 = i2; j3 = i3
+ case (2)
+ i1 = bo1(slot) + t1; i2 = bjlo(slot); i3 = bo2(slot) + t2
+ j1 = i1; j2 = bjhi(slot); j3 = i3
+ case (3)
+ i1 = bo1(slot) + t1; i2 = bo2(slot) + t2; i3 = bjlo(slot)
+ j1 = i1; j2 = i2; j3 = bjhi(slot)
+ end select
+ ! The flux reads MUST stay inside the bclo/bchi guards. A slot goes active when EITHER face is owned
+ ! (s_amr_capture_boundary_flux: cap_lo .or. cap_hi), and the UNOWNED face's index is still computed - it
+ ! then points a whole block width outside this rank's subdomain (jlo down to -amr_max_grid_size). Reading
+ ! it unguarded is an out-of-bounds device access against flux_rsx_vf's tight (-1:m_alloc) bounds. It hides
+ ! at np=1, where the intersection IS the block and both flags hold, so goldens do not catch it.
+ if (bclo(slot)) then
+ if (advective) then
+ v_lo = flux_rsx_vf(i1, i2, i3, eq)
+ else
+ v_lo = flux_src_rsx_vf(i1, i2, i3, eq)
+ end if
+ select case (id)
+ case (1); creg(1)%lo(eq, t1, t2, slot) = merge(creg(1)%lo(eq, t1, t2, slot), 0._wp, acc) + cf*v_lo
+ case (2); creg(2)%lo(eq, t1, t2, slot) = merge(creg(2)%lo(eq, t1, t2, slot), 0._wp, acc) + cf*v_lo
+ case (3); creg(3)%lo(eq, t1, t2, slot) = merge(creg(3)%lo(eq, t1, t2, slot), 0._wp, acc) + cf*v_lo
+ end select
+ end if
+ if (bchi(slot)) then
+ if (advective) then
+ v_hi = flux_rsx_vf(j1, j2, j3, eq)
+ else
+ v_hi = flux_src_rsx_vf(j1, j2, j3, eq)
+ end if
+ select case (id)
+ case (1); creg(1)%hi(eq, t1, t2, slot) = merge(creg(1)%hi(eq, t1, t2, slot), 0._wp, acc) + cf*v_hi
+ case (2); creg(2)%hi(eq, t1, t2, slot) = merge(creg(2)%hi(eq, t1, t2, slot), 0._wp, acc) + cf*v_hi
+ case (3); creg(3)%hi(eq, t1, t2, slot) = merge(creg(3)%hi(eq, t1, t2, slot), 0._wp, acc) + cf*v_hi
+ end select
+ end if
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_capture_creg_dense_batch
+
+ !> Shared creg boundary-flux capture (chemistry species diffusion), BATCHED over the slot dimension: always-accumulate the
+ !! species mass fluxes, plus the energy flux only when NOT viscous (the viscous pass already captured flux_src(E)). Species use
+ !! a seq inner loop (runtime range). The device kernel collapses (slot, t2, t1) over the rectangular caps [0:maxt2]x[0:maxt1]
+ !! (max over slots) and cycles inactive slots / out-of-window cells. Per-slot geometry is host-filled + GPU_UPDATE'd by the
+ !! caller. Used for the chem capture on BOTH the coarse-self and child sides. TWIN of the chemistry freg capture in
+ !! s_amr_capture_boundary_flux (fine branch): same species-always + energy-only-when-not-viscous policy - keep lockstep.
+ impure subroutine s_amr_capture_creg_chem_batch(nb, id, cf, maxt1, maxt2)
+
+ integer, intent(in) :: nb, id, maxt1, maxt2
+ real(wp), intent(in) :: cf
+ integer :: eq, t1, t2, slot
+
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do slot = 1, nb
+ do t2 = 0, maxt2
+ do t1 = 0, maxt1
+ if (.not. bactive(slot)) cycle
+ if (t1 < bt1lo(slot) .or. t1 > bt1hi(slot) .or. t2 < bt2lo(slot) .or. t2 > bt2hi(slot)) cycle
+ $:GPU_LOOP(parallelism='[seq]')
+ do eq = eqn_idx%species%beg, eqn_idx%species%end
+ select case (id)
+ case (1)
+ if (bclo(slot)) creg(1)%lo(eq, t1, t2, slot) = creg(1)%lo(eq, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bjlo(slot), bo1(slot) + t1, bo2(slot) + t2, eq)
+ if (bchi(slot)) creg(1)%hi(eq, t1, t2, slot) = creg(1)%hi(eq, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bjhi(slot), bo1(slot) + t1, bo2(slot) + t2, eq)
+ case (2)
+ if (bclo(slot)) creg(2)%lo(eq, t1, t2, slot) = creg(2)%lo(eq, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bjlo(slot), bo2(slot) + t2, eq)
+ if (bchi(slot)) creg(2)%hi(eq, t1, t2, slot) = creg(2)%hi(eq, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bjhi(slot), bo2(slot) + t2, eq)
+ case (3)
+ if (bclo(slot)) creg(3)%lo(eq, t1, t2, slot) = creg(3)%lo(eq, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bo2(slot) + t2, bjlo(slot), eq)
+ if (bchi(slot)) creg(3)%hi(eq, t1, t2, slot) = creg(3)%hi(eq, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bo2(slot) + t2, bjhi(slot), eq)
+ end select
+ end do
+ if (.not. viscous) then
+ select case (id)
+ case (1)
+ if (bclo(slot)) creg(1)%lo(eqn_idx%E, t1, t2, slot) = creg(1)%lo(eqn_idx%E, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bjlo(slot), bo1(slot) + t1, bo2(slot) + t2, eqn_idx%E)
+ if (bchi(slot)) creg(1)%hi(eqn_idx%E, t1, t2, slot) = creg(1)%hi(eqn_idx%E, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bjhi(slot), bo1(slot) + t1, bo2(slot) + t2, eqn_idx%E)
+ case (2)
+ if (bclo(slot)) creg(2)%lo(eqn_idx%E, t1, t2, slot) = creg(2)%lo(eqn_idx%E, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bjlo(slot), bo2(slot) + t2, eqn_idx%E)
+ if (bchi(slot)) creg(2)%hi(eqn_idx%E, t1, t2, slot) = creg(2)%hi(eqn_idx%E, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bjhi(slot), bo2(slot) + t2, eqn_idx%E)
+ case (3)
+ if (bclo(slot)) creg(3)%lo(eqn_idx%E, t1, t2, slot) = creg(3)%lo(eqn_idx%E, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bo2(slot) + t2, bjlo(slot), eqn_idx%E)
+ if (bchi(slot)) creg(3)%hi(eqn_idx%E, t1, t2, slot) = creg(3)%hi(eqn_idx%E, t1, t2, &
+ & slot) + cf*flux_src_rsx_vf(bo1(slot) + t1, bo2(slot) + t2, bjhi(slot), eqn_idx%E)
+ end select
+ end if
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_capture_creg_chem_batch
+
+ !> Capture the c/f boundary-face fluxes for direction id from the just-finalized flux array. Runs INSIDE s_compute_rhs: coarse
+ !! call (amr_in_fine_advance false, coarse globals) fills creg at block boundary faces; fine call (flag true, globals swapped to
+ !! the fine block) fills freg at fine faces -1 and m/n/p. creg uses relative 0-based transverse; freg uses 0-based fine.
+ impure subroutine s_amr_capture_boundary_flux(id, stage)
+
+ integer, intent(in) :: id
+ integer, intent(in) :: stage
+ integer :: eq, t1, t2, jlo, jhi, t1_lo, t1_hi, t2_lo, t2_hi, o1, o2, islot, save_cur, sreg
+ integer :: sidx(3), ext(3), tlo(3), thi(3), cflo(3), cfhi(3), kc, dch, maxt1, maxt2
+ logical :: own_lo(3), own_hi(3), cap_lo, cap_hi
+ real(wp) :: coef, ccoef
+ logical :: accum, cacc, is_child
+
+ if (.not. amr) return
+ ! Refresh the participation map + register capacity on a topology change; no-op (two integer compares) otherwise.
+ call s_amr_reg_prepare()
+ if (igr) return ! stage-1 IGR coupling is restriction-only: the fused IGR flux kernels do not expose face fluxes to capture
+ if (amr_in_fine_advance .and. .not. amr_rank_owns_block) return
+ ! a level-0 L0 tile advancing through the fine path is COARSE, not a fine block: skip the freg self-capture and the
+ ! parent-of-level-1 child-creg loop (which would overwrite the real fine block's creg in the tile-swapped frame). Its creg
+ ! comes from the dedicated L0 coarse RHS (amr_in_fine_advance=F). Pure-AMR has no level-0 slots so this never fires.
+ if (amr_in_fine_advance .and. amr_block_level(amr_cur) == 0) return
+ islot = amr_reg_cur ! working block's DENSE register slot (local => captured by value in the device kernels below)
+ ! flux data was just written by device kernels; the face reads below run as device kernels too
+ if (amr_subcycle) then
+ if (amr_in_fine_advance) then
+ coef = 0.5_wp*rk3_w(stage); accum = .true. ! zeroed by s_amr_zero_fine_registers before substep 1
+ else
+ coef = rk3_w(stage); accum = (stage > 1) ! stage 1 overwrites = implicit zero per coarse step
+ end if
+ else if (amr_in_fine_advance .and. amr_block_level(amr_cur) >= 2) then
+ ! lock-step L2->L1 reflux: parent is already RK-updated by reflux time, so freg must hold the rk3_w-weighted
+ ! step-integral flux for the once-per-step STATE correction (stage 1 overwrites = implicit zero, cf. coarse creg).
+ coef = rk3_w(stage); accum = (stage > 1)
+ else
+ coef = 1._wp; accum = .false. ! overwrite each stage - default, byte-identical
+ end if
+ if (amr_in_fine_advance) then
+ ! fine branch: globals swapped; jlo=-1, jhi=current fine extent in direction id.
+ ! TWIN of the creg capture: the advective / viscous (flux_src mom..E) / chemistry (flux_src species always, energy only
+ ! when NOT viscous) captures below stay lockstep with s_amr_capture_creg_dense_batch + s_amr_capture_creg_chem_batch,
+ ! which encode the identical policy on the coarse side. The "energy only when not viscous" rule lives in FOUR places -
+ ! here (freg viscous + chemistry blocks) and both creg batch helpers - change one, change all, or the c/f reflux
+ ! subtracts mismatched coarse/fine fluxes (a conservation leak no single-level test catches).
+ select case (id)
+ case (1); jlo = -1; jhi = m; t1_hi = n; t2_hi = p
+ case (2); jlo = -1; jhi = n; t1_hi = m; t2_hi = p
+ case (3); jlo = -1; jhi = p; t1_hi = m; t2_hi = n
+ end select
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do t2 = 0, t2_hi
+ do t1 = 0, t1_hi
+ do eq = 1, sys_size
+ select case (id)
+ case (1)
+ if (accum) then
+ freg(1)%lo(eq, t1, t2, islot) = freg(1)%lo(eq, t1, t2, islot) + coef*flux_rsx_vf(jlo, t1, t2, eq)
+ freg(1)%hi(eq, t1, t2, islot) = freg(1)%hi(eq, t1, t2, islot) + coef*flux_rsx_vf(jhi, t1, t2, eq)
+ else
+ freg(1)%lo(eq, t1, t2, islot) = coef*flux_rsx_vf(jlo, t1, t2, eq)
+ freg(1)%hi(eq, t1, t2, islot) = coef*flux_rsx_vf(jhi, t1, t2, eq)
+ end if
+ case (2)
+ if (accum) then
+ freg(2)%lo(eq, t1, t2, islot) = freg(2)%lo(eq, t1, t2, islot) + coef*flux_rsx_vf(t1, jlo, t2, eq)
+ freg(2)%hi(eq, t1, t2, islot) = freg(2)%hi(eq, t1, t2, islot) + coef*flux_rsx_vf(t1, jhi, t2, eq)
+ else
+ freg(2)%lo(eq, t1, t2, islot) = coef*flux_rsx_vf(t1, jlo, t2, eq)
+ freg(2)%hi(eq, t1, t2, islot) = coef*flux_rsx_vf(t1, jhi, t2, eq)
+ end if
+ case (3)
+ if (accum) then
+ freg(3)%lo(eq, t1, t2, islot) = freg(3)%lo(eq, t1, t2, islot) + coef*flux_rsx_vf(t1, t2, jlo, eq)
+ freg(3)%hi(eq, t1, t2, islot) = freg(3)%hi(eq, t1, t2, islot) + coef*flux_rsx_vf(t1, t2, jhi, eq)
+ else
+ freg(3)%lo(eq, t1, t2, islot) = coef*flux_rsx_vf(t1, t2, jlo, eq)
+ freg(3)%hi(eq, t1, t2, islot) = coef*flux_rsx_vf(t1, t2, jhi, eq)
+ end if
+ end select
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ ! total-flux matching: add the viscous mom/energy face fluxes (flux_src) into the same fine registers so the c/f reflux
+ ! sees advective+viscous. Base coef applied above; always accumulate here. Inviscid path skips this (registers stay
+ ! byte-identical).
+ if (viscous) then
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do t2 = 0, t2_hi
+ do t1 = 0, t1_hi
+ do eq = eqn_idx%mom%beg, eqn_idx%E
+ select case (id)
+ case (1)
+ freg(1)%lo(eq, t1, t2, islot) = freg(1)%lo(eq, t1, t2, islot) + coef*flux_src_rsx_vf(jlo, t1, t2, &
+ & eq)
+ freg(1)%hi(eq, t1, t2, islot) = freg(1)%hi(eq, t1, t2, islot) + coef*flux_src_rsx_vf(jhi, t1, t2, &
+ & eq)
+ case (2)
+ freg(2)%lo(eq, t1, t2, islot) = freg(2)%lo(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, jlo, t2, &
+ & eq)
+ freg(2)%hi(eq, t1, t2, islot) = freg(2)%hi(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, jhi, t2, &
+ & eq)
+ case (3)
+ freg(3)%lo(eq, t1, t2, islot) = freg(3)%lo(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, t2, jlo, &
+ & eq)
+ freg(3)%hi(eq, t1, t2, islot) = freg(3)%hi(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, t2, jhi, &
+ & eq)
+ end select
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ ! total-flux matching (chemistry species diffusion): the mixture-averaged species mass fluxes travel through
+ ! flux_src_rsx_vf
+ ! for the species equations; the thermal-conduction + enthalpy energy flux travels through the energy equation, captured
+ ! here only when NOT viscous (the viscous block above already captured flux_src_rsx_vf(E), which holds
+ ! viscous+diffusion).
+ if (chemistry .and. chem_params%diffusion) then
+ $:GPU_PARALLEL_LOOP(collapse=2)
+ do t2 = 0, t2_hi
+ do t1 = 0, t1_hi
+ $:GPU_LOOP(parallelism='[seq]')
+ do eq = eqn_idx%species%beg, eqn_idx%species%end
+ select case (id)
+ case (1)
+ freg(1)%lo(eq, t1, t2, islot) = freg(1)%lo(eq, t1, t2, islot) + coef*flux_src_rsx_vf(jlo, t1, t2, &
+ & eq)
+ freg(1)%hi(eq, t1, t2, islot) = freg(1)%hi(eq, t1, t2, islot) + coef*flux_src_rsx_vf(jhi, t1, t2, &
+ & eq)
+ case (2)
+ freg(2)%lo(eq, t1, t2, islot) = freg(2)%lo(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, jlo, t2, &
+ & eq)
+ freg(2)%hi(eq, t1, t2, islot) = freg(2)%hi(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, jhi, t2, &
+ & eq)
+ case (3)
+ freg(3)%lo(eq, t1, t2, islot) = freg(3)%lo(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, t2, jlo, &
+ & eq)
+ freg(3)%hi(eq, t1, t2, islot) = freg(3)%hi(eq, t1, t2, islot) + coef*flux_src_rsx_vf(t1, t2, jhi, &
+ & eq)
+ end select
+ end do
+ if (.not. viscous) then
+ select case (id)
+ case (1)
+ freg(1)%lo(eqn_idx%E, t1, t2, islot) = freg(1)%lo(eqn_idx%E, t1, t2, &
+ & islot) + coef*flux_src_rsx_vf(jlo, t1, t2, eqn_idx%E)
+ freg(1)%hi(eqn_idx%E, t1, t2, islot) = freg(1)%hi(eqn_idx%E, t1, t2, &
+ & islot) + coef*flux_src_rsx_vf(jhi, t1, t2, eqn_idx%E)
+ case (2)
+ freg(2)%lo(eqn_idx%E, t1, t2, islot) = freg(2)%lo(eqn_idx%E, t1, t2, &
+ & islot) + coef*flux_src_rsx_vf(t1, jlo, t2, eqn_idx%E)
+ freg(2)%hi(eqn_idx%E, t1, t2, islot) = freg(2)%hi(eqn_idx%E, t1, t2, &
+ & islot) + coef*flux_src_rsx_vf(t1, jhi, t2, eqn_idx%E)
+ case (3)
+ freg(3)%lo(eqn_idx%E, t1, t2, islot) = freg(3)%lo(eqn_idx%E, t1, t2, &
+ & islot) + coef*flux_src_rsx_vf(t1, t2, jlo, eqn_idx%E)
+ freg(3)%hi(eqn_idx%E, t1, t2, islot) = freg(3)%hi(eqn_idx%E, t1, t2, &
+ & islot) + coef*flux_src_rsx_vf(t1, t2, jhi, eqn_idx%E)
+ end select
+ end if
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ ! multi-level lock-step: this fine block (amr_cur) is the COARSE side (parent) of its level+1 children. Capture creg for
+ ! each child from THIS block's fine flux at the child's footprint faces - the child's amr_isect_lo/hi is already in this
+ ! parent's fine frame, so it indexes flux_rsx_vf directly (face jlo=isect_lo-1, jhi=isect_hi; transverse origin o1/o2).
+ ! creg holds the rk3_w-weighted step-integral flux for the once-per-step STATE reflux into this parent
+ ! (s_amr_reflux_to_parent). Captures the TOTAL flux - advective (flux_rsx_vf), then viscous (flux_src, mom..E), then
+ ! chemistry species+energy - mirroring the coarse-self branch below, so viscous/chemistry multi-level conserves (no
+ ! checker gate). creg is the PARENT's OWN flux, so the parent owner captures it for EVERY child of this block -
+ ! including children owned by another rank, which supply only the matching freg (s_amr_p2p_freg_to_parent). Framing
+ ! therefore comes from s_amr_parent_foot (replicated metadata), NOT amr_isect_*_all(:,kc), which is the empty sentinel
+ ! for a child this rank does not own. Under tower co-location every child IS owned, so this captures the identical set.
+ ! Fill per-slot (per-child) geometry, then one batched kernel per capture category. Each child's creg lives at its
+ ! DENSE register slot (sreg = amr_reg_of(kc); a child of an owned block is always mapped - s_amr_reg_prepare clause
+ ! (b) is this loop's twin); both faces always owned (the parent spans the whole child footprint), t1lo=t2lo=0.
+ ccoef = rk3_w(stage); cacc = (stage > 1)
+ bactive = .false.
+ maxt1 = 0; maxt2 = 0
+ do kc = 1, amr_num_blocks
+ if (amr_block_level(kc) /= amr_block_level(amr_cur) + 1) cycle
+ is_child = .true.
+ do dch = 1, 3
+ is_child = is_child .and. amr_region_lo_all(dch, kc) <= amr_region_hi_all(dch, &
+ & amr_cur) .and. amr_region_hi_all(dch, kc) >= amr_region_lo_all(dch, amr_cur)
+ end do
+ if (.not. is_child) cycle
+ call s_amr_parent_foot(kc, amr_cur, cflo, cfhi)
+ select case (id)
+ case (1); jlo = cflo(1) - 1; jhi = cfhi(1)
+ o1 = cflo(2); t1_hi = cfhi(2) - cflo(2)
+ o2 = cflo(3); t2_hi = cfhi(3) - cflo(3)
+ case (2); jlo = cflo(2) - 1; jhi = cfhi(2)
+ o1 = cflo(1); t1_hi = cfhi(1) - cflo(1)
+ o2 = cflo(3); t2_hi = cfhi(3) - cflo(3)
+ case (3); jlo = cflo(3) - 1; jhi = cfhi(3)
+ o1 = cflo(1); t1_hi = cfhi(1) - cflo(1)
+ o2 = cflo(2); t2_hi = cfhi(2) - cflo(2)
+ end select
+ sreg = amr_reg_of(kc)
+ bactive(sreg) = .true.; bclo(sreg) = .true.; bchi(sreg) = .true.
+ bjlo(sreg) = jlo; bjhi(sreg) = jhi; bo1(sreg) = o1; bo2(sreg) = o2
+ bt1lo(sreg) = 0; bt1hi(sreg) = t1_hi; bt2lo(sreg) = 0; bt2hi(sreg) = t2_hi
+ maxt1 = max(maxt1, t1_hi); maxt2 = max(maxt2, t2_hi)
+ end do
+ if (any(bactive(1:amr_reg_n))) then
+ $:GPU_UPDATE(device='[bjlo, bjhi, bo1, bo2, bt1lo, bt1hi, bt2lo, bt2hi, bclo, bchi, bactive]')
+ ! shared capture into each CHILD's creg (parent-fine frame): advective, then total-flux viscous, then chemistry
+ call s_amr_capture_creg_dense_batch(amr_reg_n, id, .true., ccoef, cacc, maxt1, maxt2, 1, sys_size)
+ if (viscous) call s_amr_capture_creg_dense_batch(amr_reg_n, id, .false., ccoef, .true., maxt1, maxt2, &
+ & eqn_idx%mom%beg, eqn_idx%E)
+ if (chemistry .and. chem_params%diffusion) call s_amr_capture_creg_chem_batch(amr_reg_n, id, ccoef, maxt1, maxt2)
+ end if
+ else
+ ! coarse branch: a face's capture runs on the rank owning the coarse cells just OUTSIDE it (its flux_rsx_vf covers that
+ ! face;
+ ! at a rank-interior face the same rank also holds the inside cells). jlo/jhi = LOCAL flux indices of the block's
+ ! low/high faces; t1/t2 = 0-based transverse indices relative to this rank's block INTERSECTION (o1/o2 = local
+ ! transverse origins), aligned with the fine registers: fine children of isect-relative cell t are faces 2*t and 2*t+1.
+ ! At np=1 the intersection is the block and both flags hold, recovering single-rank behavior exactly.
+ ! ONE coarse s_compute_rhs pass fills EVERY active block's registers: revisit each slot's region+intersection in turn.
+ save_cur = amr_cur
+ bactive = .false.
+ maxt1 = 0; maxt2 = 0
+ do islot = 1, amr_num_blocks
+ ! a level>=2 block's coarse side is its PARENT (creg captured in the fine branch), not L0
+ if (amr_block_level(islot) >= 2) cycle
+ call s_amr_select_slot(islot)
+ call s_amr_reflux_face_flags(sidx, ext, own_lo, own_hi, tlo, thi)
+ cap_lo = own_lo(id); cap_hi = own_hi(id)
+ if (cap_lo .or. cap_hi) then
+ ! block-relative transverse frame (0-based from region_lo, aligned with the owner's freg): this rank fills creg
+ ! over its owned overlap [tlo-region_lo : thi-region_lo]; o1/o2 map that back to LOCAL flux indices.
+ select case (id)
+ case (1); jlo = amr_region_lo(1) - 1 - sidx(1); jhi = amr_region_hi(1) - sidx(1)
+ t1_lo = tlo(2) - amr_region_lo(2); t1_hi = thi(2) - amr_region_lo(2); o1 = amr_region_lo(2) - sidx(2)
+ t2_lo = tlo(3) - amr_region_lo(3); t2_hi = thi(3) - amr_region_lo(3); o2 = amr_region_lo(3) - sidx(3)
+ case (2); jlo = amr_region_lo(2) - 1 - sidx(2); jhi = amr_region_hi(2) - sidx(2)
+ t1_lo = tlo(1) - amr_region_lo(1); t1_hi = thi(1) - amr_region_lo(1); o1 = amr_region_lo(1) - sidx(1)
+ t2_lo = tlo(3) - amr_region_lo(3); t2_hi = thi(3) - amr_region_lo(3); o2 = amr_region_lo(3) - sidx(3)
+ case (3); jlo = amr_region_lo(3) - 1 - sidx(3); jhi = amr_region_hi(3) - sidx(3)
+ t1_lo = tlo(1) - amr_region_lo(1); t1_hi = thi(1) - amr_region_lo(1); o1 = amr_region_lo(1) - sidx(1)
+ t2_lo = tlo(2) - amr_region_lo(2); t2_hi = thi(2) - amr_region_lo(2); o2 = amr_region_lo(2) - sidx(2)
+ end select
+ ! cap_lo/cap_hi is s_amr_reg_prepare's clause (c) verbatim, so amr_reg_of(islot) is always mapped here
+ sreg = amr_reg_of(islot)
+ bactive(sreg) = .true.; bclo(sreg) = cap_lo; bchi(sreg) = cap_hi
+ bjlo(sreg) = jlo; bjhi(sreg) = jhi; bo1(sreg) = o1; bo2(sreg) = o2
+ bt1lo(sreg) = t1_lo; bt1hi(sreg) = t1_hi; bt2lo(sreg) = t2_lo; bt2hi(sreg) = t2_hi
+ maxt1 = max(maxt1, t1_hi); maxt2 = max(maxt2, t2_hi)
+ end if ! cap_lo .or. cap_hi
+ end do
+ call s_amr_select_slot(save_cur)
+ if (any(bactive(1:amr_reg_n))) then
+ $:GPU_UPDATE(device='[bjlo, bjhi, bo1, bo2, bt1lo, bt1hi, bt2lo, bt2hi, bclo, bchi, bactive]')
+ ! shared capture into each coarse block's creg (region/sidx frame, per-face ownership gating): advective, then
+ ! total-flux viscous, then chemistry species+energy
+ call s_amr_capture_creg_dense_batch(amr_reg_n, id, .true., coef, accum, maxt1, maxt2, 1, sys_size)
+ if (viscous) call s_amr_capture_creg_dense_batch(amr_reg_n, id, .false., coef, .true., maxt1, maxt2, &
+ & eqn_idx%mom%beg, eqn_idx%E)
+ if (chemistry .and. chem_params%diffusion) call s_amr_capture_creg_chem_batch(amr_reg_n, id, coef, maxt1, maxt2)
+ end if
+ end if
+
+ end subroutine s_amr_capture_boundary_flux
+
+ !> Correct the coarse rhs in the first cell OUTSIDE each block face so the coarse update sees the (child-averaged) fine flux at
+ !! every c/f face. Signs follow rhs = (flux_left - flux_right)/dx: low face is the outside cell's RIGHT face => rhs += (F_coarse
+ !! - Fbar_fine)/dx; high face is the outside cell's LEFT face => rhs += (Fbar_fine - F_coarse)/dx. Cells INSIDE the block need
+ !! no correction (end-of-step restriction overwrites them). c1/c2 are relative 0-based coarse transverse indices.
+ impure subroutine s_amr_apply_reflux(rhs_vf)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
+ integer :: eq, c1, c2, c1w, c2w, k, save_cur, nact, gmax1, gmax2
+ integer :: f10, f20, dd1, dd2, nch, rr, dd1_hi, dd2_hi, sreg
+ integer :: bl1, bh1, bl2, bh2, bl3, bh3
+ integer :: i2, i3, sidx(3), ext(3), tlo(3), thi(3)
+ logical :: d2, d3, own_lo(3), own_hi(3)
+ real(wp) :: fblo, fbhi, wsum, rf
+
+ if (.not. amr) return
+ ! Refresh the participation map + register capacity on a topology change; no-op (two integer compares) otherwise.
+ call s_amr_reg_prepare()
+ if (igr) return ! stage-1 IGR: restriction-only coupling (no captured fluxes)
+ rr = amr_ref_ratio
+ d2 = n_glb > 0; d3 = p_glb > 0
+ save_cur = amr_cur
+
+ ! BATCHED over the level-1 blocks, one kernel per face direction (mirror of the capture-side batching,
+ ! s_amr_capture_creg_dense_batch): the per-box form launched up to 3 tiny face kernels per block per step, and the
+ ! per-launch overhead - not the arithmetic - dominated the reflux-apply phase. The per-(face, eq, cell) arithmetic
+ ! and child-sum order below are IDENTICAL to the per-box form, and block corrections are disjoint (the merge
+ ! invariant keeps blocks >= buff_size apart), so the outputs are bit-identical. Host precompute walks the slots
+ ! with the SAME select_slot + s_amr_reflux_face_flags the per-box form used; the a_* descriptors are pushed once
+ ! per direction.
+
+ ! x-faces: transverse dims (y, z); children in each active transverse dim
+ nch = 1
+ if (n_glb > 0) nch = nch*rr
+ if (p_glb > 0) nch = nch*rr
+ dd1_hi = merge(rr - 1, 0, n_glb > 0); dd2_hi = merge(rr - 1, 0, p_glb > 0)
+ nact = 0; gmax1 = 0; gmax2 = 0
+ a_act = .false.
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ call s_amr_reflux_face_flags(sidx, ext, own_lo, own_hi, tlo, thi)
+ if (.not. (own_lo(1) .or. own_hi(1))) cycle
+ bl2 = tlo(2) - amr_region_lo(2); bh2 = thi(2) - amr_region_lo(2)
+ bl3 = tlo(3) - amr_region_lo(3); bh3 = thi(3) - amr_region_lo(3)
+ ! own_lo/own_hi is s_amr_reg_prepare's clause (c) verbatim, so amr_reg_of(k) is always mapped here
+ sreg = amr_reg_of(k)
+ a_act(sreg) = .true.; a_lo(sreg) = own_lo(1); a_hi(sreg) = own_hi(1)
+ a_ol(sreg) = amr_region_lo(1) - 1 - sidx(1); a_oh(sreg) = amr_region_hi(1) + 1 - sidx(1)
+ a_t2(sreg) = amr_region_lo(2) - sidx(2); a_t3(sreg) = amr_region_lo(3) - sidx(3)
+ a_b1l(sreg) = bl2; a_b1h(sreg) = bh2; a_b2l(sreg) = bl3; a_b2h(sreg) = bh3
+ a_mlo(sreg) = 1._wp; a_mhi(sreg) = 1._wp
+ if (own_lo(1)) a_mlo(sreg) = dx(a_ol(sreg))
+ if (own_hi(1)) a_mhi(sreg) = dx(a_oh(sreg))
+ nact = nact + 1
+ gmax1 = max(gmax1, bh2 - bl2); gmax2 = max(gmax2, bh3 - bl3)
+ end do
+ call s_amr_select_slot(save_cur)
+ if (nact > 0) then
+ $:GPU_UPDATE(device='[a_ol, a_oh, a_t2, a_t3, a_b1l, a_b1h, a_b2l, a_b2h, a_lo, a_hi, a_act, a_mlo, a_mhi]')
+ if (cyl_coord) then
+ ! axisymmetric x-face (axial): the rr covering fine faces stack in the RADIAL (transverse) direction at
+ ! DIFFERENT radii, so Fbar_fine must be area-weighted by fine-face radius (fine y_cc rebuilt from the coarse
+ ! y_cb of transverse cell tl2+c1). Outside-cell axial divergence has no radial factor (axial face area ~
+ ! cell volume ~ y_cc, cancels), so the width stays dx.
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[c1, c2, f10, f20, dd1, fblo, fbhi, wsum, rf, i2, i3]')
+ do k = 1, amr_reg_n
+ do c2w = 0, gmax2
+ do c1w = 0, gmax1
+ do eq = 1, sys_size
+ if (.not. a_act(k)) cycle
+ c1 = a_b1l(k) + c1w; c2 = a_b2l(k) + c2w
+ if (c1 > a_b1h(k) .or. c2 > a_b2h(k)) cycle
+ f20 = 0
+ f10 = rr*c1
+ fblo = 0._wp; fbhi = 0._wp; wsum = 0._wp
+ do dd1 = 0, dd1_hi
+ rf = y_cb(a_t2(k) + c1 - 1) + (real(dd1, &
+ & wp) + 0.5_wp)*(y_cb(a_t2(k) + c1) - y_cb(a_t2(k) + c1 - 1))/real(rr, wp)
+ fblo = fblo + freg(1)%lo(eq, f10 + dd1, f20, k)*rf
+ fbhi = fbhi + freg(1)%hi(eq, f10 + dd1, f20, k)*rf
+ wsum = wsum + rf
+ end do
+ fblo = fblo/wsum; fbhi = fbhi/wsum
+ i2 = a_t2(k) + c1; i3 = a_t3(k) + c2
+ if (a_lo(k)) rhs_vf(eq)%sf(a_ol(k), i2, i3) = rhs_vf(eq)%sf(a_ol(k), i2, i3) + (creg(1)%lo(eq, &
+ & c1, c2, k) - fblo)/a_mlo(k)
+ if (a_hi(k)) rhs_vf(eq)%sf(a_oh(k), i2, i3) = rhs_vf(eq)%sf(a_oh(k), i2, &
+ & i3) + (fbhi - creg(1)%hi(eq, c1, c2, k))/a_mhi(k)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ else
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[c1, c2, f10, f20, dd1, dd2, fblo, fbhi, i2, i3]')
+ do k = 1, amr_reg_n
+ do c2w = 0, gmax2
+ do c1w = 0, gmax1
+ do eq = 1, sys_size
+ if (.not. a_act(k)) cycle
+ c1 = a_b1l(k) + c1w; c2 = a_b2l(k) + c2w
+ if (c1 > a_b1h(k) .or. c2 > a_b2h(k)) cycle
+ f20 = 0; if (d3) f20 = rr*c2
+ f10 = 0; if (d2) f10 = rr*c1
+ fblo = 0._wp; fbhi = 0._wp
+ do dd2 = 0, dd2_hi
+ do dd1 = 0, dd1_hi
+ fblo = fblo + freg(1)%lo(eq, f10 + dd1, f20 + dd2, k)
+ fbhi = fbhi + freg(1)%hi(eq, f10 + dd1, f20 + dd2, k)
+ end do
+ end do
+ fblo = fblo/real(nch, wp); fbhi = fbhi/real(nch, wp)
+ i2 = a_t2(k) + c1; i3 = a_t3(k) + c2
+ if (a_lo(k)) rhs_vf(eq)%sf(a_ol(k), i2, i3) = rhs_vf(eq)%sf(a_ol(k), i2, i3) + (creg(1)%lo(eq, &
+ & c1, c2, k) - fblo)/a_mlo(k)
+ if (a_hi(k)) rhs_vf(eq)%sf(a_oh(k), i2, i3) = rhs_vf(eq)%sf(a_oh(k), i2, &
+ & i3) + (fbhi - creg(1)%hi(eq, c1, c2, k))/a_mhi(k)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+
+ ! y-faces (n_glb > 0): transverse dims (x, z); x is always active (2 children)
+ if (n_glb > 0) then
+ nch = rr
+ if (p_glb > 0) nch = nch*rr
+ dd2_hi = merge(rr - 1, 0, p_glb > 0)
+ nact = 0; gmax1 = 0; gmax2 = 0
+ a_act = .false.
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ call s_amr_reflux_face_flags(sidx, ext, own_lo, own_hi, tlo, thi)
+ if (.not. (own_lo(2) .or. own_hi(2))) cycle
+ bl1 = tlo(1) - amr_region_lo(1); bh1 = thi(1) - amr_region_lo(1)
+ bl3 = tlo(3) - amr_region_lo(3); bh3 = thi(3) - amr_region_lo(3)
+ sreg = amr_reg_of(k)
+ a_act(sreg) = .true.; a_lo(sreg) = own_lo(2); a_hi(sreg) = own_hi(2)
+ a_ol(sreg) = amr_region_lo(2) - 1 - sidx(2); a_oh(sreg) = amr_region_hi(2) + 1 - sidx(2)
+ a_t1(sreg) = amr_region_lo(1) - sidx(1); a_t3(sreg) = amr_region_lo(3) - sidx(3)
+ a_b1l(sreg) = bl1; a_b1h(sreg) = bh1; a_b2l(sreg) = bl3; a_b2h(sreg) = bh3
+ a_mlo(sreg) = 1._wp; a_mhi(sreg) = 1._wp
+ if (own_lo(2)) a_mlo(sreg) = dy(a_ol(sreg))
+ if (own_hi(2)) a_mhi(sreg) = dy(a_oh(sreg))
+ ! cyl_coord (axisymmetric): the radial c/f flux correction is area-weighted - low/high face carries radius
+ ! y_cb, outside cell volume carries y_cc, so fold r_face/r_cell into the width (kernel divides by it).
+ if (cyl_coord) then
+ if (own_lo(2)) a_mlo(sreg) = a_mlo(sreg)*y_cc(a_ol(sreg))/y_cb(a_ol(sreg))
+ if (own_hi(2)) a_mhi(sreg) = a_mhi(sreg)*y_cc(a_oh(sreg))/y_cb(a_oh(sreg) - 1)
+ end if
+ nact = nact + 1
+ gmax1 = max(gmax1, bh1 - bl1); gmax2 = max(gmax2, bh3 - bl3)
+ end do
+ call s_amr_select_slot(save_cur)
+ if (nact > 0) then
+ $:GPU_UPDATE(device='[a_ol, a_oh, a_t1, a_t3, a_b1l, a_b1h, a_b2l, a_b2h, a_lo, a_hi, a_act, a_mlo, a_mhi]')
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[c1, c2, f10, f20, dd1, dd2, fblo, fbhi, i2, i3]')
+ do k = 1, amr_reg_n
+ do c2w = 0, gmax2
+ do c1w = 0, gmax1
+ do eq = 1, sys_size
+ if (.not. a_act(k)) cycle
+ c1 = a_b1l(k) + c1w; c2 = a_b2l(k) + c2w
+ if (c1 > a_b1h(k) .or. c2 > a_b2h(k)) cycle
+ f20 = 0; if (d3) f20 = rr*c2
+ f10 = rr*c1
+ fblo = 0._wp; fbhi = 0._wp
+ do dd2 = 0, dd2_hi
+ do dd1 = 0, rr - 1
+ fblo = fblo + freg(2)%lo(eq, f10 + dd1, f20 + dd2, k)
+ fbhi = fbhi + freg(2)%hi(eq, f10 + dd1, f20 + dd2, k)
+ end do
+ end do
+ fblo = fblo/real(nch, wp); fbhi = fbhi/real(nch, wp)
+ i2 = a_t1(k) + c1; i3 = a_t3(k) + c2
+ if (a_lo(k)) rhs_vf(eq)%sf(i2, a_ol(k), i3) = rhs_vf(eq)%sf(i2, a_ol(k), i3) + (creg(2)%lo(eq, &
+ & c1, c2, k) - fblo)/a_mlo(k)
+ if (a_hi(k)) rhs_vf(eq)%sf(i2, a_oh(k), i3) = rhs_vf(eq)%sf(i2, a_oh(k), &
+ & i3) + (fbhi - creg(2)%hi(eq, c1, c2, k))/a_mhi(k)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+
+ ! z-faces (p_glb > 0): transverse dims (x, y); both always active in 3D (4 children)
+ if (p_glb > 0) then
+ nch = rr*rr
+ nact = 0; gmax1 = 0; gmax2 = 0
+ a_act = .false.
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ call s_amr_select_slot(k)
+ call s_amr_reflux_face_flags(sidx, ext, own_lo, own_hi, tlo, thi)
+ if (.not. (own_lo(3) .or. own_hi(3))) cycle
+ bl1 = tlo(1) - amr_region_lo(1); bh1 = thi(1) - amr_region_lo(1)
+ bl2 = tlo(2) - amr_region_lo(2); bh2 = thi(2) - amr_region_lo(2)
+ sreg = amr_reg_of(k)
+ a_act(sreg) = .true.; a_lo(sreg) = own_lo(3); a_hi(sreg) = own_hi(3)
+ a_ol(sreg) = amr_region_lo(3) - 1 - sidx(3); a_oh(sreg) = amr_region_hi(3) + 1 - sidx(3)
+ a_t1(sreg) = amr_region_lo(1) - sidx(1); a_t2(sreg) = amr_region_lo(2) - sidx(2)
+ a_b1l(sreg) = bl1; a_b1h(sreg) = bh1; a_b2l(sreg) = bl2; a_b2h(sreg) = bh2
+ a_mlo(sreg) = 1._wp; a_mhi(sreg) = 1._wp
+ if (own_lo(3)) a_mlo(sreg) = dz(a_ol(sreg))
+ if (own_hi(3)) a_mhi(sreg) = dz(a_oh(sreg))
+ nact = nact + 1
+ gmax1 = max(gmax1, bh1 - bl1); gmax2 = max(gmax2, bh2 - bl2)
+ end do
+ call s_amr_select_slot(save_cur)
+ if (nact > 0) then
+ $:GPU_UPDATE(device='[a_ol, a_oh, a_t1, a_t2, a_b1l, a_b1h, a_b2l, a_b2h, a_lo, a_hi, a_act, a_mlo, a_mhi]')
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[c1, c2, f10, f20, dd1, dd2, fblo, fbhi, i2, i3]')
+ do k = 1, amr_reg_n
+ do c2w = 0, gmax2
+ do c1w = 0, gmax1
+ do eq = 1, sys_size
+ if (.not. a_act(k)) cycle
+ c1 = a_b1l(k) + c1w; c2 = a_b2l(k) + c2w
+ if (c1 > a_b1h(k) .or. c2 > a_b2h(k)) cycle
+ f20 = rr*c2
+ f10 = rr*c1
+ fblo = 0._wp; fbhi = 0._wp
+ do dd2 = 0, rr - 1
+ do dd1 = 0, rr - 1
+ fblo = fblo + freg(3)%lo(eq, f10 + dd1, f20 + dd2, k)
+ fbhi = fbhi + freg(3)%hi(eq, f10 + dd1, f20 + dd2, k)
+ end do
+ end do
+ fblo = fblo/real(nch, wp); fbhi = fbhi/real(nch, wp)
+ i2 = a_t1(k) + c1; i3 = a_t2(k) + c2
+ if (a_lo(k)) rhs_vf(eq)%sf(i2, i3, a_ol(k)) = rhs_vf(eq)%sf(i2, i3, a_ol(k)) + (creg(3)%lo(eq, &
+ & c1, c2, k) - fblo)/a_mlo(k)
+ if (a_hi(k)) rhs_vf(eq)%sf(i2, i3, a_oh(k)) = rhs_vf(eq)%sf(i2, i3, &
+ & a_oh(k)) + (fbhi - creg(3)%hi(eq, c1, c2, k))/a_mhi(k)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+
+ end subroutine s_amr_apply_reflux
+
+ !> Zero the fine registers (called by the subcycle driver before substep 1 - stage-1 overwrite cannot work across two substeps).
+ impure subroutine s_amr_zero_fine_registers()
+
+ integer :: d, eq, t1, t2, t1_hi, t2_hi, islot
+
+ if (.not. amr) return
+ ! Refresh the participation map + register capacity on a topology change; no-op (two integer compares) otherwise.
+ call s_amr_reg_prepare()
+ if (igr) return ! stage-1 IGR: restriction-only coupling (no captured fluxes)
+ if (.not. amr_rank_owns_block) return
+ islot = amr_reg_cur ! working block's DENSE register slot (local => captured by value in the device kernels below)
+ do d = 1, 3
+ if (allocated(freg(d)%lo)) then
+ t1_hi = ubound(freg(d)%lo, 2); t2_hi = ubound(freg(d)%lo, 3)
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do t2 = 0, t2_hi
+ do t1 = 0, t1_hi
+ do eq = 1, sys_size
+ freg(d)%lo(eq, t1, t2, islot) = 0._wp
+ freg(d)%hi(eq, t1, t2, islot) = 0._wp
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end do
+
+ end subroutine s_amr_zero_fine_registers
+
+ !> Berger-Colella state correction (subcycle mode only): after restriction, correct the first coarse cell OUTSIDE each block
+ !! face with the time-accumulated flux mismatch: low face: q += dt*(F_c_eff - Fbar_f_eff)/dx ; high face: q += dt*(Fbar_f_eff -
+ !! F_c_eff)/dx. Registers hold EFFECTIVE (rk3_w-weighted, substep-averaged) fluxes in subcycle mode.
+ impure subroutine s_amr_apply_reflux_state(q_cons)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons
+ integer :: d, sidx(3), ext(3), tlo(3), thi(3), olo(3), ohi(3), glo(3), ghi(3), woff(3)
+ logical :: own_lo(3), own_hi(3)
+ real(wp) :: w_lo(3), w_hi(3), mlo(3), mhi(3)
+
+ if (.not. amr) return
+ ! Refresh the participation map + register capacity on a topology change; no-op (two integer compares) otherwise.
+ call s_amr_reg_prepare()
+ if (igr) return ! stage-1 IGR: restriction-only coupling (no captured fluxes)
+ call s_amr_reflux_face_flags(sidx, ext, own_lo, own_hi, tlo, thi)
+ if (.not. (any(own_lo) .or. any(own_hi))) return
+ ! L0/L1 (coarse) frame for the shared kernel: outside cell = region boundary +/-1 in local (sidx-offset) coords; creg-local
+ ! loop range is the owned transverse overlap [tlo:thi] block-relative; ownership -> unit face weights; cell widths from the
+ ! global coarse grid (amr_ref_ratio = 2, dt = coarse step).
+ olo = 0; ohi = 0; glo = 0; ghi = 0; woff = 0; w_lo = 0._wp; w_hi = 0._wp; mlo = 1._wp; mhi = 1._wp
+ do d = 1, num_dims
+ olo(d) = amr_region_lo(d) - 1 - sidx(d); ohi(d) = amr_region_hi(d) + 1 - sidx(d)
+ glo(d) = tlo(d) - amr_region_lo(d); ghi(d) = thi(d) - amr_region_lo(d)
+ woff(d) = amr_region_lo(d) - sidx(d)
+ if (own_lo(d)) w_lo(d) = 1._wp
+ if (own_hi(d)) w_hi(d) = 1._wp
+ end do
+ if (own_lo(1)) mlo(1) = dx(olo(1))
+ if (own_hi(1)) mhi(1) = dx(ohi(1))
+ if (n_glb > 0) then
+ if (own_lo(2)) mlo(2) = dy(olo(2))
+ if (own_hi(2)) mhi(2) = dy(ohi(2))
+ ! cyl_coord (axisymmetric): area-weight the radial c/f correction by r_face/r_cell (mirror of s_amr_apply_reflux). L0/L1
+ ! coarse frame -> global y_cb/y_cc for the owned outside cell. r_+ = y_cb(olo(2)) low; r_- = y_cb(ohi(2)-1) high.
+ if (cyl_coord) then
+ if (own_lo(2)) mlo(2) = mlo(2)*y_cc(olo(2))/y_cb(olo(2))
+ if (own_hi(2)) mhi(2) = mhi(2)*y_cc(ohi(2))/y_cb(ohi(2) - 1)
+ end if
+ end if
+ if (p_glb > 0) then
+ if (own_lo(3)) mlo(3) = dz(olo(3))
+ if (own_hi(3)) mhi(3) = dz(ohi(3))
+ end if
+ call s_amr_reflux_apply_faces(q_cons, amr_reg_cur, 2, dt, olo, ohi, glo, ghi, woff, w_lo, w_hi, mlo, mhi)
+
+ end subroutine s_amr_apply_reflux_state
+
+ !> Shared Berger-Colella STATE reflux kernel: apply q(outside) += w*dtl*(F_coarse - Fbar_fine)/m on the low face and +=
+ !! w*dtl*(Fbar_fine - F_coarse)/m on the high face for each active dim, where F_coarse is creg and Fbar_fine averages freg over
+ !! the rr**(ndim-1) covering fine faces. Used by BOTH s_amr_apply_reflux_state (L0/L1, coarse/sidx frame, unit weights from
+ !! ownership, rr=2) and s_amr_reflux_to_parent (L2->L1, parent-fine frame, sibling-seam weights, rr=amr_ref_ratio). All framing
+ !! is caller-passed so the flux-correction math is single-sourced: islot - DENSE register slot (amr_reg_cur); rr - refinement
+ !! ratio (fine faces per coarse face per transverse dim); dtl - reflux dt; olo/ohi(d) - outside coarse-cell index just
+ !! below/above the block face in dim d; glo/ghi(d) - creg-local loop range in dim d (transverse for the two faces d' /= d);
+ !! woff(d) - transverse write origin so the cell index is woff(d) + g; w_lo/w_hi(d) - per-face weight (0 skips the write:
+ !! unowned face at np>1, or a fine-fine sibling-tile seam); mlo/mhi(d) - outside-cell width for the low/high face
+ !! (invalid/unused where weight is 0). A zero weight SKIPS the write (not multiply-by-0) because the outside index may be out of
+ !! bounds on an unowned face.
+ impure subroutine s_amr_reflux_apply_faces(q, islot, rr, dtl, olo, ohi, glo, ghi, woff, w_lo, w_hi, mlo, mhi)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q
+ integer, intent(in) :: islot, rr, olo(3), ohi(3), glo(3), ghi(3), woff(3)
+ real(wp), intent(in) :: dtl, w_lo(3), w_hi(3), mlo(3), mhi(3)
+ integer :: eq, g1, g2, f10, f20, dd1, dd2, nch, dd1_hi, dd2_hi, ol, oh, w2, w3, w1, gl1, gh1, gl2, gh2, gl3, gh3
+ real(wp) :: fblo, fbhi, wl, wh, ml, mh, wsum, rf
+
+ ! loop bounds hoisted to scalars: array-element bounds (glo(d)/ghi(d)) drive the collapsed inner loop and would force the
+ ! host arrays present on the device (an ACC present error)
+
+ gl1 = glo(1); gh1 = ghi(1); gl2 = glo(2); gh2 = ghi(2); gl3 = glo(3); gh3 = ghi(3)
+
+ ! x-faces: transverse (y, z)
+ if (w_lo(1) /= 0._wp .or. w_hi(1) /= 0._wp) then
+ nch = 1; if (n_glb > 0) nch = nch*rr; if (p_glb > 0) nch = nch*rr
+ dd1_hi = merge(rr - 1, 0, n_glb > 0); dd2_hi = merge(rr - 1, 0, p_glb > 0)
+ ol = olo(1); oh = ohi(1); w2 = woff(2); w3 = woff(3); wl = w_lo(1); wh = w_hi(1); ml = mlo(1); mh = mhi(1)
+ if (cyl_coord) then
+ ! axisymmetric x-face: area-weight Fbar_fine by fine-face radius (rebuilt from the coarse y_cb of transverse cell
+ ! w2+g1) - the rr covering fine faces sit at different radii. cyl reaches here only single-level (L0 frame), so
+ ! global y_cb is the correct coarse grid.
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[f10, f20, dd1, dd2, fblo, fbhi, wsum, rf]')
+ do eq = 1, sys_size
+ do g2 = gl3, gh3
+ do g1 = gl2, gh2
+ f20 = 0
+ f10 = rr*g1
+ fblo = 0._wp; fbhi = 0._wp; wsum = 0._wp
+ do dd1 = 0, dd1_hi
+ rf = y_cb(w2 + g1 - 1) + (real(dd1, wp) + 0.5_wp)*(y_cb(w2 + g1) - y_cb(w2 + g1 - 1))/real(rr, wp)
+ fblo = fblo + freg(1)%lo(eq, f10 + dd1, f20, islot)*rf
+ fbhi = fbhi + freg(1)%hi(eq, f10 + dd1, f20, islot)*rf
+ wsum = wsum + rf
+ end do
+ fblo = fblo/wsum; fbhi = fbhi/wsum
+ if (wl /= 0._wp) q(eq)%sf(ol, w2 + g1, w3 + g2) = q(eq)%sf(ol, w2 + g1, &
+ & w3 + g2) + wl*dtl*(creg(1)%lo(eq, g1, g2, islot) - fblo)/ml
+ if (wh /= 0._wp) q(eq)%sf(oh, w2 + g1, w3 + g2) = q(eq)%sf(oh, w2 + g1, &
+ & w3 + g2) + wh*dtl*(fbhi - creg(1)%hi(eq, g1, g2, islot))/mh
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ else
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[f10, f20, dd1, dd2, fblo, fbhi]')
+ do eq = 1, sys_size
+ do g2 = gl3, gh3
+ do g1 = gl2, gh2
+ f20 = 0; if (p_glb > 0) f20 = rr*g2
+ f10 = 0; if (n_glb > 0) f10 = rr*g1
+ fblo = 0._wp; fbhi = 0._wp
+ do dd2 = 0, dd2_hi
+ do dd1 = 0, dd1_hi
+ fblo = fblo + freg(1)%lo(eq, f10 + dd1, f20 + dd2, islot)
+ fbhi = fbhi + freg(1)%hi(eq, f10 + dd1, f20 + dd2, islot)
+ end do
+ end do
+ fblo = fblo/real(nch, wp); fbhi = fbhi/real(nch, wp)
+ if (wl /= 0._wp) q(eq)%sf(ol, w2 + g1, w3 + g2) = q(eq)%sf(ol, w2 + g1, &
+ & w3 + g2) + wl*dtl*(creg(1)%lo(eq, g1, g2, islot) - fblo)/ml
+ if (wh /= 0._wp) q(eq)%sf(oh, w2 + g1, w3 + g2) = q(eq)%sf(oh, w2 + g1, &
+ & w3 + g2) + wh*dtl*(fbhi - creg(1)%hi(eq, g1, g2, islot))/mh
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ end if
+ ! y-faces (n_glb > 0): transverse (x, z); x always active
+ if (n_glb > 0 .and. (w_lo(2) /= 0._wp .or. w_hi(2) /= 0._wp)) then
+ nch = rr; if (p_glb > 0) nch = nch*rr
+ dd2_hi = merge(rr - 1, 0, p_glb > 0)
+ ol = olo(2); oh = ohi(2); w1 = woff(1); w3 = woff(3); wl = w_lo(2); wh = w_hi(2); ml = mlo(2); mh = mhi(2)
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[f10, f20, dd1, dd2, fblo, fbhi]')
+ do eq = 1, sys_size
+ do g2 = gl3, gh3
+ do g1 = gl1, gh1
+ f20 = 0; if (p_glb > 0) f20 = rr*g2
+ f10 = rr*g1
+ fblo = 0._wp; fbhi = 0._wp
+ do dd2 = 0, dd2_hi
+ do dd1 = 0, rr - 1
+ fblo = fblo + freg(2)%lo(eq, f10 + dd1, f20 + dd2, islot)
+ fbhi = fbhi + freg(2)%hi(eq, f10 + dd1, f20 + dd2, islot)
+ end do
+ end do
+ fblo = fblo/real(nch, wp); fbhi = fbhi/real(nch, wp)
+ if (wl /= 0._wp) q(eq)%sf(w1 + g1, ol, w3 + g2) = q(eq)%sf(w1 + g1, ol, w3 + g2) + wl*dtl*(creg(2)%lo(eq, &
+ & g1, g2, islot) - fblo)/ml
+ if (wh /= 0._wp) q(eq)%sf(w1 + g1, oh, w3 + g2) = q(eq)%sf(w1 + g1, oh, &
+ & w3 + g2) + wh*dtl*(fbhi - creg(2)%hi(eq, g1, g2, islot))/mh
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ ! z-faces (p_glb > 0): transverse (x, y); both active in 3D
+ if (p_glb > 0 .and. (w_lo(3) /= 0._wp .or. w_hi(3) /= 0._wp)) then
+ nch = rr*rr
+ ol = olo(3); oh = ohi(3); w1 = woff(1); w2 = woff(2); wl = w_lo(3); wh = w_hi(3); ml = mlo(3); mh = mhi(3)
+ $:GPU_PARALLEL_LOOP(collapse=3, private='[f10, f20, dd1, dd2, fblo, fbhi]')
+ do eq = 1, sys_size
+ do g2 = gl2, gh2
+ do g1 = gl1, gh1
+ f20 = rr*g2
+ f10 = rr*g1
+ fblo = 0._wp; fbhi = 0._wp
+ do dd2 = 0, rr - 1
+ do dd1 = 0, rr - 1
+ fblo = fblo + freg(3)%lo(eq, f10 + dd1, f20 + dd2, islot)
+ fbhi = fbhi + freg(3)%hi(eq, f10 + dd1, f20 + dd2, islot)
+ end do
+ end do
+ fblo = fblo/real(nch, wp); fbhi = fbhi/real(nch, wp)
+ if (wl /= 0._wp) q(eq)%sf(w1 + g1, w2 + g2, ol) = q(eq)%sf(w1 + g1, w2 + g2, ol) + wl*dtl*(creg(3)%lo(eq, &
+ & g1, g2, islot) - fblo)/ml
+ if (wh /= 0._wp) q(eq)%sf(w1 + g1, w2 + g2, oh) = q(eq)%sf(w1 + g1, w2 + g2, &
+ & oh) + wh*dtl*(fbhi - creg(3)%hi(eq, g1, g2, islot))/mh
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ end subroutine s_amr_reflux_apply_faces
+
+ impure subroutine s_finalize_amr_registers()
+
+ integer :: d
+
+ if (.not. amr) return
+ do d = 1, 3
+ if (allocated(creg(d)%lo)) then
+ @:DEALLOCATE(creg(d)%lo, creg(d)%hi)
+ end if
+ if (allocated(freg(d)%lo)) then
+ @:DEALLOCATE(freg(d)%lo, freg(d)%hi)
+ end if
+ end do
+ @:DEALLOCATE(bjlo, bjhi, bo1, bo2, bt1lo, bt1hi, bt2lo, bt2hi, bclo, bchi, bactive)
+ @:DEALLOCATE(a_ol, a_oh, a_t1, a_t2, a_t3, a_b1l, a_b1h, a_b2l, a_b2h, a_lo, a_hi, a_act, a_mlo, a_mhi)
+ if (allocated(amr_reg_of)) deallocate (amr_reg_of)
+ amr_reg_n = 0; amr_reg_cur = 0
+
+ end subroutine s_finalize_amr_registers
+
+end module m_amr_registers
diff --git a/src/simulation/m_amr_regrid.fpp b/src/simulation/m_amr_regrid.fpp
new file mode 100644
index 0000000000..7309aa89c5
--- /dev/null
+++ b/src/simulation/m_amr_regrid.fpp
@@ -0,0 +1,2374 @@
+!>
+!!@file
+!!@brief Contains module m_amr_regrid
+
+#:include 'macros.fpp'
+
+!> @brief Dynamic regrid for the block-structured AMR level set: density-gradient tagging, Berger-Rigoutsos clustering, box shaping
+!! (pad/clamp/tile/IB merge), hierarchical child nesting, slot rebuild with cross-rank fine-state migration. Block/slot state lives
+!! in m_amr (and m_global_parameters); this module only drives it.
+module m_amr_regrid
+
+#ifdef MFC_MPI
+ use mpi !< per-node signature ALLREDUCE for the rank-invariant clustering, point-to-point for the fine-state migration
+#endif
+
+ use m_derived_types ! scalar_field, t_box
+ use m_box, only: f_morton ! B1: canonical merge order (shared 3D Morton key)
+ use m_global_parameters
+ use m_constants, only: mapCells
+ use m_mpi_proxy, only: s_mpi_abort
+ use m_mpi_common, only: s_mpi_allreduce_min, s_mpi_allreduce_max
+ use m_phase_timing, only: s_phase_tic, s_phase_toc, PH_RGHALO, PH_RGTAG, PH_RGCLUS, PH_RGSHAPE, PH_RGMIG, PH_RGBUILD, &
+ & PH_RGPART, PH_RGMOVE, PH_MGWAIT, PH_RBGATH, PH_RBOVL, PH_RBPUSH, PH_RBSLOT, PH_RBGEO, PH_RBTAIL, PH_RBFLUSH, PH_RBXCHG, &
+ & PH_RBREC, PH_RBTOPO, PH_MGSLOT, PH_MGPACK, PH_MGUNPK, PH_MGPUSH
+ use m_amr, only: s_amr_build_gather_plan, amr_gpl_valid, amr_slots, amr_cons_st, amr_stor_st, amr_loc_of, &
+ & s_amr_gather_chunk_post, s_amr_gather_chunk_send, s_amr_gather_consume_box, amr_gath_chunk, s_amr_cov_note, &
+ & amr_maxc_fit, amr_seam_pairs_dirty, amr_mesh_epoch, amr_xchg_coarse_ghosts, amr_cpat_mar, s_amr_alloc_slot, &
+ & s_amr_alloc_slot_stash, s_amr_prereserve_stash, s_amr_free_slot, s_amr_reduce_xchg_flag, s_amr_reconcile_slots, &
+ & s_amr_assign_block_owners, s_amr_gather_send_flush, s_amr_gather_coarse_patch_pbmv, s_amr_prolong_pbmv, &
+ & s_amr_exchange_coarse_cons_halo, s_lag_phys_to_cells, s_amr_body_bbox, s_amr_expand_box_over_bodies, s_amr_tile_box, &
+ & f_amr_seam_dim, f_amr_boxes_overlap, s_set_amr_fine_geometry, s_interpolate_coarse_to_fine, s_amr_setup_ib, f_l0_slot, &
+ & amr_gb_tag, amr_gb_win, amr_gb_cost, amr_gb_mig, amr_mig_snd, amr_mig_blk, amr_cad_tot, amr_cad_esc, amr_cad_armed, &
+ & amr_cl_maxdep, amr_cl_maxdep_leaf, amr_cl_lmax, amr_cl_ldepth, amr_cl_nodes, amr_cl_rb, amr_cl_rb_now, &
+ & amr_cl_shr_nodes, amr_cl_shr_rb, amr_cl_loc_nodes, amr_cl_loc_rb, amr_cl_shr_maxdep, s_amr_ranks_overlapping, &
+ & amr_cl_shr_nodes_r, amr_cl_shr_rb_r, amr_cl_loc_nodes_r, amr_cl_loc_rb_r, amr_cl_shr_maxdep_r, amr_cl_me_nodes_r, &
+ & amr_cl_me_rb_r, amr_my_blk, amr_n_my, s_amr_refresh_my_blocks, s_amr_fw_szi, f_amr_overlap_count, f_amr_rank_overlaps, &
+ & amr_tag_base, amr_mesh_epoch, amr_cl_wire_r, amr_gb_box
+ use m_amr_xchg_audit, only: s_xa_rec, XA_F4_SND, XA_F4_RCV ! I1a exchange accounting (migration family)
+ use m_acoustic_src, only: acoustic_supp_lo, acoustic_supp_hi
+ use m_active_box, only: ab_x, ab_y, ab_z, ab_active
+ use m_bubbles_EL, only: s_lag_cloud_bbox_local
+
+ implicit none
+
+ private
+ public :: s_amr_regrid, s_amr_check_seam_topology, s_amr_check_active_box_containment
+
+ !> Lagrangian bubble-cloud exclusion support: padded global coarse-index bbox (positions + mapCells smearing + stencil headroom
+ !! [+ drift margin at regrid]). Blocks and regrid boxes stay clear: a bubble inside a block loses two-way coupling (fine advance
+ !! skips the EL hooks, restriction discards the coarse result under the block). Recomputed collectively each regrid; guarded
+ !! rank-locally per stage.
+ integer :: lag_supp_lo(3), lag_supp_hi(3)
+ logical :: lag_supp_on = .false.
+
+contains
+
+ !> Abort on same-level seam topologies no halo reconciles (silent conservation leaks otherwise). Run whenever the block set
+ !! changes (regrid, restart); O(nblocks^2) on the replicated region metadata, identical on every rank. Two cases: (a) adjacency
+ !! WITHOUT the exact transverse match f_amr_seam requires - reachable only via IB body-bbox expansion (clustering merges any
+ !! too-close pair; tiling emits a regular grid) - which the fine-fine halo can never pair; (b) same-level box INTERSECTION -
+ !! reachable only via CHILD IB body-bbox expansion, which unlike the L1 path has no overlap-merge pass -
+ !! double-restricting/refluxing the shared cells.
+ impure subroutine s_amr_check_seam_topology()
+
+ integer :: xb, yb, d, t
+ logical :: adj, tover
+
+ do xb = 1, amr_num_blocks
+ do yb = 1, amr_num_blocks
+ if (xb == yb) cycle
+ if (amr_block_level(xb) /= amr_block_level(yb)) cycle
+ ! same-level INTERSECTION (different levels legitimately nest; tiling emits disjoint tiles, the L1 IB pass merges
+ ! overlapping boxes, but the CHILD IB body-bbox expansion has no overlap-merge pass)
+ if (f_amr_boxes_overlap(amr_region_lo_all(:,xb), amr_region_hi_all(:,xb), amr_region_lo_all(:,yb), &
+ & amr_region_hi_all(:,yb))) then
+ call s_mpi_abort("AMR: two same-level blocks INTERSECT (the child IB body-bbox expansion route can " &
+ & // "produce this - it has no overlap-merge pass): the overlapping cells would be " &
+ & // "restricted and refluxed twice, silently breaking conservation. Adjust the body/" &
+ & // "regrid inputs so body-expanded child boxes merge or separate.")
+ end if
+ do d = 1, num_dims
+ ! relaxed adjacency: touching faces in dim d with ANY transverse overlap
+ adj = amr_region_lo_all(d, yb) == amr_region_hi_all(d, xb) + 1
+ if (.not. adj) cycle
+ tover = .true.
+ do t = 1, num_dims
+ if (t /= d) tover = tover .and. amr_region_lo_all(t, xb) <= amr_region_hi_all(t, &
+ & yb) .and. amr_region_lo_all(t, yb) <= amr_region_hi_all(t, xb)
+ end do
+ if (tover .and. f_amr_seam_dim(xb, yb) == 0) then
+ call s_mpi_abort("AMR: two same-level blocks touch with PARTIAL transverse overlap (IB body-bbox " &
+ & // "expansion can produce this): the fine-fine seam halo only reconciles exact-match " &
+ & // "faces, so the shared-face flux would silently leak. Adjust amr_block/regrid inputs " // "so body-expanded boxes merge or separate.")
+ end if
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_check_seam_topology
+
+ !> Abort if any box exceeds the slot cap for its level. The slot coord/field arrays are allocated ONCE to
+ !! amr_ref_ratio*amr_maxc_fit fine cells, and a level-lev block spans amr_ref_ratio**lev fine cells per coarse cell, so its
+ !! coarse extent must be <= amr_maxc_fit/amr_ref_ratio**(lev-1). Every emitter enforces that via s_amr_tile_box; this checks the
+ !! invariant once, where the box set is final, rather than trusting each emitter to have done it.
+ !!
+ !! It exists because a violation is otherwise SILENT AND CATASTROPHIC: s_amr_build_block_coords sizes the fine coords from the
+ !! block's true extent, so an over-cap box writes past x_cb, corrupting the heap on EVERY regrid and surfacing much later as
+ !! "corrupted size vs. prev_size" inside an unrelated free(). One emitter did skip the cap (cfbacebe, the brand-new-region
+ !! branch) and finding it took a bounds-checked rebuild and a multi-hour hunt, because the crash site was nowhere near the bug.
+ !! Matches s_amr_tile_box's own floor (tc = max(tc, 1)) so a collapsed dim, whose cap divides to 0, is not flagged.
+ impure subroutine s_amr_check_box_caps(boxes, nboxes, box_level)
+
+ type(t_box), intent(in) :: boxes(:)
+ integer, intent(in) :: nboxes, box_level(:)
+ integer :: k, d, lev, cap, span
+
+ do k = 1, nboxes
+ lev = box_level(k)
+ if (lev < 1) cycle ! level-0 tiles are sized by the tile decomposition, not this cap
+ do d = 1, num_dims
+ cap = max(amr_maxc_fit(d)/amr_ref_ratio**(lev - 1), 1)
+ span = boxes(k)%hi(d) - boxes(k)%lo(d) + 1
+ if (span > cap) then
+ if (proc_rank == 0) print '(A,I0,A,I0,A,I0,A,I0)', ' [amr] box cap violated: level ', lev, ' dim ', d, &
+ & ' span ', span, ' > cap ', cap
+ call s_mpi_abort("AMR regrid: a fine box exceeds the slot cap for its level (span and cap printed above). " &
+ & // "The fine coord arrays are sized to amr_ref_ratio*amr_maxc_fit, so this would write " &
+ & // "past x_cb and corrupt the heap. A box emitter did not route through s_amr_tile_box.")
+ end if
+ end do
+ end do
+
+ end subroutine s_amr_check_box_caps
+
+ !> Invariant check (plan-based exchange I0): same-level boxes are pairwise DISJOINT. Guaranteed today by the cluster partition +
+ !! merge threshold + IB overlap-merge; relied on by the rebuild's overlap carry-forward and by per-peer unpack reordering in the
+ !! exchange plans (amr_plan_based_exchange.md) - enforced here rather than inherited as folklore. All levels share the global
+ !! coarse index space (see the cap formula in s_amr_check_box_caps), so the interval test is valid across parents. O(nboxes^2)
+ !! host integer compares per regrid - negligible at current box counts; replace with a sorted sweep in increment I7 if box
+ !! counts grow.
+ impure subroutine s_amr_check_box_disjoint(boxes, nboxes, box_level)
+
+ type(t_box), intent(in) :: boxes(:)
+ integer, intent(in) :: nboxes, box_level(:)
+ integer :: k, kk
+
+ do k = 1, nboxes
+ if (box_level(k) < 1) cycle
+ do kk = k + 1, nboxes
+ if (box_level(kk) /= box_level(k)) cycle
+ if (all(boxes(k)%lo <= boxes(kk)%hi .and. boxes(kk)%lo <= boxes(k)%hi)) then
+ if (proc_rank == 0) print '(A,I0,A,I0,A,I0)', ' [amr] same-level box overlap: level ', box_level(k), &
+ & ' boxes ', k, ' and ', kk
+ call s_mpi_abort("AMR regrid: two same-level boxes overlap (indices printed above). The overlap " &
+ & // "carry-forward and the exchange plans both assume same-level disjointness.")
+ end if
+ end do
+ end do
+
+ end subroutine s_amr_check_box_disjoint
+
+ !> Concatenated 1D tag signatures of box [blo0:bhi0], built from the tag range [ts:te] in ONE pass. Axis d occupies sig(off(d) :
+ !! off(d) + ext(d) - 1), and sig(off(d) + t - blo0(d)) counts the in-box tagged cells at position t along d. One signature
+ !! serves the trim, the in-box count AND every candidate split, replacing the up-to-num_dims+1 separate rescans of the tag list
+ !! the previous form needed. nsig returns the used length.
+ impure subroutine s_amr_box_sig(tags, ts, te, blo0, bhi0, sig, off, nsig)
+
+ integer, intent(in) :: tags(:,:), ts, te, blo0(3), bhi0(3)
+ integer, intent(out) :: sig(:), off(3), nsig
+ integer :: d, t, c(3)
+
+ nsig = 0
+ do d = 1, 3
+ off(d) = nsig + 1
+ if (d <= num_dims) nsig = nsig + (bhi0(d) - blo0(d) + 1)
+ end do
+ sig(1:nsig) = 0
+ do t = ts, te
+ c = tags(:,t)
+ if (c(1) < blo0(1) .or. c(1) > bhi0(1)) cycle
+ if (c(2) < blo0(2) .or. c(2) > bhi0(2)) cycle
+ if (c(3) < blo0(3) .or. c(3) > bhi0(3)) cycle
+ do d = 1, num_dims
+ sig(off(d) + c(d) - blo0(d)) = sig(off(d) + c(d) - blo0(d)) + 1
+ end do
+ end do
+
+ end subroutine s_amr_box_sig
+
+ !> Shrink box [blo:bhi] to the tight bbox of its tagged cells and return their count, both read off the signature of
+ !! [blo0:bhi0]. Equivalent to scanning the tag list: the per-axis MIN/MAX of the contained tags ARE the first and last nonzero
+ !! of that axis signature, and "any tagged" is "the signature sums nonzero". ok=.false. if none tagged. Collapsed dims (lo=hi=0)
+ !! survive unchanged, their signature being a single bin.
+ pure subroutine s_amr_trim_from_sig(sig, off, blo0, bhi0, blo, bhi, ok, ntag)
+
+ integer, intent(in) :: sig(:), off(3), blo0(3), bhi0(3)
+ integer, intent(inout) :: blo(3), bhi(3)
+ logical, intent(out) :: ok
+ integer, intent(out) :: ntag
+ integer :: d, t, lo, hi
+
+ ok = .false.
+ ntag = 0
+ do t = blo0(1), bhi0(1)
+ ntag = ntag + sig(off(1) + t - blo0(1))
+ end do
+ if (ntag == 0) return ! no tags in the box; every axis signature is empty too
+ do d = 1, num_dims
+ lo = -1; hi = -1
+ do t = blo0(d), bhi0(d)
+ if (sig(off(d) + t - blo0(d)) > 0) then
+ if (lo < 0) lo = t
+ hi = t
+ end if
+ end do
+ blo(d) = lo; bhi(d) = hi
+ end do
+ ok = .true.
+
+ end subroutine s_amr_trim_from_sig
+
+ !> Berger-Rigoutsos bisection of one (already tagged-trimmed) candidate box, read off the signature of [blo0:bhi0]: pick the
+ !! longest splittable axis, prefer a zero-signature hole (widest interior run), else the strongest signature inflection
+ !! (Laplacian sign change). ok=.false. if no axis admits a split leaving both children >= 2 cells. Slicing the signature to the
+ !! TRIMMED range is exact: trim shrinks only to the tags' own bbox, so no tag leaves the box. Integer-only => identical on all
+ !! ranks.
+ pure subroutine s_amr_find_split_sig(sig, off, blo0, blo, bhi, sax, spos, ok)
+
+ integer, intent(in) :: sig(:), off(3), blo0(3)
+ integer, intent(in) :: blo(3), bhi(3)
+ integer, intent(out) :: sax, spos
+ logical, intent(out) :: ok
+ !> Minimum child extent along the split axis, i.e. the smallest box the bisection may produce. 2 is the algorithmic floor;
+ !! amr_blocking_factor raises it, which is what stops the bisection over-generating. Measured 2026-08-27: with the floor at
+ !! 2 and amr_cluster_eff = 0.9 the recursion never converges on its own -- it splits until the amr_max_blocks cap stops it
+ !! (warning on EVERY regrid at five different caps), and the min-separation merge then collapses the result back. An 8x cap
+ !! bought 61%% more tree nodes for a 0.7%% change in the final box set. NOTE this is a minimum SIZE, not AMReX's blocking
+ !! factor: AMReX coarsens the TAG LATTICE, which also shrinks its global tag gather. S3.1 already deleted that gather here,
+ !! and coarsening a rank-local sparse list cannot dedup coarse cells that straddle a rank boundary without an extra
+ !! exchange, so the size floor is both simpler and the part that actually stops the over-generation.
+ integer :: min_child
+ integer :: axord(3), ext(3), d, ax, t, s, b
+ integer :: run, run_start, best_run, best_start, lap, prevlap, bestmag, bestpos
+
+ min_child = max(2, amr_blocking_factor)
+ ok = .false.; sax = 0; spos = 0
+ ext = bhi - blo + 1
+ axord = [1, 2, 3] ! sort axes by descending extent (deterministic bubble)
+ do d = 1, 2
+ do ax = 1, 3 - d
+ if (ext(axord(ax)) < ext(axord(ax + 1))) then
+ s = axord(ax); axord(ax) = axord(ax + 1); axord(ax + 1) = s
+ end if
+ end do
+ end do
+ do d = 1, 3
+ ax = axord(d)
+ if (ax > num_dims) cycle
+ if (ext(ax) < 2*min_child) cycle
+ b = off(ax) - blo0(ax) ! signature of position t on this axis is sig(b + t)
+ ! (1) widest interior zero run (box is trimmed => sig(blo)>0 and sig(bhi)>0, so any run is interior)
+ best_run = 0; best_start = -1; run = 0; run_start = -1
+ do t = blo(ax), bhi(ax)
+ if (sig(b + t) == 0) then
+ if (run == 0) run_start = t
+ run = run + 1
+ else
+ if (run > best_run) then; best_run = run; best_start = run_start; end if
+ run = 0
+ end if
+ end do
+ if (best_start > blo(ax)) then
+ spos = best_start
+ if (spos - blo(ax) >= min_child .and. bhi(ax) - spos + 1 >= min_child) then
+ sax = ax; ok = .true.; return
+ end if
+ end if
+ ! (2) strongest inflection: Laplacian sign change with the largest jump
+ bestmag = -1; bestpos = -1; prevlap = 0
+ do t = blo(ax) + 1, bhi(ax) - 1
+ lap = sig(b + t - 1) - 2*sig(b + t) + sig(b + t + 1)
+ if (t > blo(ax) + 1) then
+ if (((lap < 0) .neqv. (prevlap < 0)) .and. abs(lap - prevlap) > bestmag .and. t - blo(ax) >= min_child &
+ & .and. bhi(ax) - t + 1 >= min_child) then
+ bestmag = abs(lap - prevlap); bestpos = t
+ end if
+ end if
+ prevlap = lap
+ end do
+ if (bestpos > 0) then
+ sax = ax; spos = bestpos; ok = .true.; return
+ end if
+ end do
+
+ end subroutine s_amr_find_split_sig
+
+ !> True iff global level-0 cell (gi, gj, gk) lies inside any acoustic source support bbox.
+ pure logical function f_in_acoustic_support(gi, gj, gk) result(insup)
+
+ integer, intent(in) :: gi, gj, gk
+ integer :: s
+
+ insup = .false.
+ do s = 1, num_source
+ if (gi >= acoustic_supp_lo(1, s) .and. gi <= acoustic_supp_hi(1, s) .and. (n_glb == 0 .or. (gj >= acoustic_supp_lo(2, &
+ & s) .and. gj <= acoustic_supp_hi(2, s))) .and. (p_glb == 0 .or. (gk >= acoustic_supp_lo(3, &
+ & s) .and. gk <= acoustic_supp_hi(3, s)))) then
+ insup = .true.; return
+ end if
+ end do
+
+ end function f_in_acoustic_support
+
+ !> Clip a candidate regrid box (global indices) clear of every acoustic source support bbox: per overlapping source, remove the
+ !! overlap along the single axis/side keeping the largest remaining extent (deterministic: lower axis, then begin side, wins
+ !! ties). Only shrinks; may empty the box (hi < lo); the caller drops empties.
+ impure subroutine s_amr_clip_box_from_sources(lo, hi)
+
+ integer, intent(inout) :: lo(3), hi(3)
+ integer :: s, d, best_d, best_side, best_ext, ext_l, ext_r
+ logical :: ovl
+
+ do s = 1, num_source
+ if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) return ! emptied by an earlier clip
+ ovl = lo(1) <= acoustic_supp_hi(1, s) .and. hi(1) >= acoustic_supp_lo(1, s)
+ if (n_glb > 0) ovl = ovl .and. lo(2) <= acoustic_supp_hi(2, s) .and. hi(2) >= acoustic_supp_lo(2, s)
+ if (p_glb > 0) ovl = ovl .and. lo(3) <= acoustic_supp_hi(3, s) .and. hi(3) >= acoustic_supp_lo(3, s)
+ if (.not. ovl) cycle
+ best_d = 1; best_side = 1; best_ext = -1
+ do d = 1, num_dims
+ ext_l = acoustic_supp_lo(d, s) - lo(d) ! cells kept by [lo(d), supp_lo-1]
+ ext_r = hi(d) - acoustic_supp_hi(d, s) ! cells kept by [supp_hi+1, hi(d)]
+ if (ext_l > best_ext) then; best_ext = ext_l; best_d = d; best_side = 1; end if
+ if (ext_r > best_ext) then; best_ext = ext_r; best_d = d; best_side = 2; end if
+ end do
+ if (best_side == 1) then
+ hi(best_d) = acoustic_supp_lo(best_d, s) - 1
+ else
+ lo(best_d) = acoustic_supp_hi(best_d, s) + 1
+ end if
+ end do
+ ! safety net: clipping removed every overlap by construction - anything left is a bug
+ do s = 1, num_source
+ if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) return
+ ovl = lo(1) <= acoustic_supp_hi(1, s) .and. hi(1) >= acoustic_supp_lo(1, s)
+ if (n_glb > 0) ovl = ovl .and. lo(2) <= acoustic_supp_hi(2, s) .and. hi(2) >= acoustic_supp_lo(2, s)
+ if (p_glb > 0) ovl = ovl .and. lo(3) <= acoustic_supp_hi(3, s) .and. hi(3) >= acoustic_supp_lo(3, s)
+ if (ovl) call s_mpi_abort('amr regrid: acoustic source exclusion clip failed (internal error)')
+ end do
+
+ end subroutine s_amr_clip_box_from_sources
+
+ !> Recompute the global Lagrangian-cloud exclusion bbox (collective: allreduces the rank-local position extrema). pad_cells
+ !! covers smearing + stencil (+ drift until the next recompute). No-op (lag_supp_on = false) when no rank holds a bubble.
+ impure subroutine s_amr_compute_lag_supp(pad_cells)
+
+ integer, intent(in) :: pad_cells
+ real(wp), dimension(3) :: pmin_loc, pmax_loc, pmin_glb, pmax_glb
+ integer :: d
+
+ call s_lag_cloud_bbox_local(pmin_loc, pmax_loc)
+ do d = 1, 3
+ call s_mpi_allreduce_min(pmin_loc(d), pmin_glb(d))
+ call s_mpi_allreduce_max(pmax_loc(d), pmax_glb(d))
+ end do
+ lag_supp_on = pmin_glb(1) <= pmax_glb(1)
+ if (.not. lag_supp_on) return
+ call s_lag_phys_to_cells(pmin_glb, pmax_glb, pad_cells, lag_supp_lo, lag_supp_hi)
+
+ end subroutine s_amr_compute_lag_supp
+
+ !> True iff global level-0 cell (gi, gj, gk) lies inside the Lagrangian-cloud exclusion bbox.
+ pure logical function f_in_lag_support(gi, gj, gk) result(insup)
+
+ integer, intent(in) :: gi, gj, gk
+
+ insup = .false.
+ if (.not. lag_supp_on) return
+ insup = gi >= lag_supp_lo(1) .and. gi <= lag_supp_hi(1) .and. (n_glb == 0 .or. (gj >= lag_supp_lo(2) &
+ & .and. gj <= lag_supp_hi(2))) .and. (p_glb == 0 .or. (gk >= lag_supp_lo(3) &
+ & .and. gk <= lag_supp_hi(3)))
+
+ end function f_in_lag_support
+
+ !> Clip a candidate regrid box (global indices) clear of one support bbox: remove the overlap along the single axis/side that
+ !! keeps the largest remaining extent (deterministic: lower axis, then begin side, wins ties). Only shrinks; may empty the box
+ !! (hi < lo).
+ pure subroutine s_amr_clip_box_from_supp(lo, hi, slo, shi)
+
+ integer, intent(inout) :: lo(3), hi(3)
+ integer, intent(in) :: slo(3), shi(3)
+ integer :: d, best_d, best_side, best_ext, ext_l, ext_r
+ logical :: ovl
+
+ if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) return
+ ovl = lo(1) <= shi(1) .and. hi(1) >= slo(1)
+ if (n_glb > 0) ovl = ovl .and. lo(2) <= shi(2) .and. hi(2) >= slo(2)
+ if (p_glb > 0) ovl = ovl .and. lo(3) <= shi(3) .and. hi(3) >= slo(3)
+ if (.not. ovl) return
+ best_d = 1; best_side = 1; best_ext = -1
+ do d = 1, num_dims
+ ext_l = slo(d) - lo(d)
+ ext_r = hi(d) - shi(d)
+ if (ext_l > best_ext) then; best_ext = ext_l; best_d = d; best_side = 1; end if
+ if (ext_r > best_ext) then; best_ext = ext_r; best_d = d; best_side = 2; end if
+ end do
+ if (best_side == 1) then
+ hi(best_d) = slo(best_d) - 1
+ else
+ lo(best_d) = shi(best_d) + 1
+ end if
+
+ end subroutine s_amr_clip_box_from_supp
+
+ !> active_box + AMR containment: every active block must sit strictly inside the active window (one-cell margin). Two reasons:
+ !! the windowed coarse RK update would silently drop a reflux correction at a face cell outside the window (conservation leak),
+ !! and the coarse RHS only computes fluxes inside it. The window only GROWS (s_grow_active_box monotone, self-disabling at full
+ !! domain), so containment set at init and re-established each regrid holds between. Collective (same window/block metadata on
+ !! all ranks).
+ impure subroutine s_amr_check_active_box_containment()
+
+ integer :: k
+ logical :: ok
+
+ ! ab_active is only true at num_procs == 1 (m_active_box disables itself under MPI), so ab and block indices share
+ ! the same (global == local) index space
+
+ if ((.not. amr) .or. (.not. ab_active)) return
+ do k = 1, amr_num_blocks
+ ! L0 tiles span the base grid by construction; the containment rule is for fine blocks
+ if (amr_block_level(k) == 0) cycle
+ ok = amr_region_lo_all(1, k) > ab_x%beg .and. amr_region_hi_all(1, k) < ab_x%end
+ if (n_glb > 0) ok = ok .and. amr_region_lo_all(2, k) > ab_y%beg .and. amr_region_hi_all(2, k) < ab_y%end
+ if (p_glb > 0) ok = ok .and. amr_region_lo_all(3, k) > ab_z%beg .and. amr_region_hi_all(3, k) < ab_z%end
+ if (.not. ok) then
+ call s_mpi_abort('amr with active_box: an AMR block is not strictly inside the active ' &
+ & // 'window; place the initial block (with a one-cell margin) inside the ' &
+ & // 'initial non-ambient region plus buff_size')
+ end if
+ end do
+
+ end subroutine s_amr_check_active_box_containment
+
+ !> This rank's OWN tagged cells as GLOBAL level-0 coordinates. Each rank scans only its interior (0:m, 0:n, 0:p), which the
+ !! level-0 decomposition makes disjoint, so no global cell is emitted twice and a SUM reduction over these lists counts every
+ !! tagged cell exactly once. This replaces the ALLGATHERV of the global tag list (W4): per-rank memory and wire volume now scale
+ !! with the rank's OWN tag count instead of the global one.
+ impure subroutine s_amr_local_tags(tag_grid, sidx, tags, ntag)
+
+ logical, intent(in) :: tag_grid(0:,0:,0:)
+ integer, intent(in) :: sidx(3)
+ integer, allocatable, intent(out) :: tags(:,:)
+ integer, intent(out) :: ntag
+ integer :: ci, cj, ck
+
+ ntag = 0
+ do ck = 0, p; do cj = 0, n; do ci = 0, m
+ if (tag_grid(ci, cj, ck)) ntag = ntag + 1
+ end do; end do; end do
+ allocate (tags(3, max(ntag, 1)))
+ ntag = 0
+ do ck = 0, p; do cj = 0, n; do ci = 0, m
+ if (tag_grid(ci, cj, ck)) then
+ ntag = ntag + 1
+ tags(1, ntag) = ci + sidx(1)
+ tags(2, ntag) = 0
+ tags(3, ntag) = 0
+ if (n_glb > 0) tags(2, ntag) = cj + sidx(2)
+ if (p_glb > 0) tags(3, ntag) = ck + sidx(3)
+ end if
+ end do; end do; end do
+
+ end subroutine s_amr_local_tags
+
+ !> Grow the per-level pack buffers sidx(:) (int8 linear index) / skb(:) (parent box id) geometrically so at least nloc+extra
+ !! slots fit; preserves the first nloc entries. Amortized O(1) append for s_amr_pack_gwin_pairs.
+ impure subroutine s_amr_grow_pack(sidx, skb, nloc, extra)
+
+ integer(8), allocatable, intent(inout) :: sidx(:)
+ integer, allocatable, intent(inout) :: skb(:)
+ integer, intent(in) :: nloc, extra
+ integer :: cap, newcap
+ integer(8), allocatable :: t8(:)
+ integer, allocatable :: ti(:)
+
+ cap = 0
+ if (allocated(sidx)) cap = size(sidx)
+ if (nloc + extra <= cap) return
+ newcap = max(2*cap, max(nloc + extra, 1024))
+ allocate (t8(newcap), ti(newcap))
+ if (nloc > 0) then
+ t8(1:nloc) = sidx(1:nloc)
+ ti(1:nloc) = skb(1:nloc)
+ end if
+ call move_alloc(t8, sidx)
+ call move_alloc(ti, skb)
+
+ end subroutine s_amr_grow_pack
+
+ !> Pack this rank's OWNED tagged cells of the child window [mlo:mhi] as (linear-index, kb) pairs, appended to the per-level send
+ !! arrays sidx(:) (int8 linear index) / skb(:) (parent box id). The int8 encode matches the pass-2 decode, so gathering these
+ !! pairs across ranks and setting them into a per-parent dense window reproduces the old dense-window dedup (replicated/
+ !! overlapping tags collapse) and the (k,j,i) extraction order exactly -> byte-identical child boxes. One allgatherv per level
+ !! (caller) drops the collective count from O(#parent-boxes) to O(#levels). gwin is read, not modified.
+ impure subroutine s_amr_pack_gwin_pairs(gwin, mlo, mhi, mg, ng, kb, sidx, skb, nloc)
+
+ integer, intent(in) :: mlo(3), mhi(3), mg, ng, kb
+ logical, intent(in) :: gwin(mlo(1):,mlo(2):,mlo(3):)
+ integer(8), allocatable, intent(inout) :: sidx(:)
+ integer, allocatable, intent(inout) :: skb(:)
+ integer, intent(inout) :: nloc
+ integer :: gi, gj, gk
+
+ do gk = mlo(3), mhi(3)
+ do gj = mlo(2), mhi(2)
+ do gi = mlo(1), mhi(1)
+ if (.not. gwin(gi, gj, gk)) cycle
+ call s_amr_grow_pack(sidx, skb, nloc, 1)
+ nloc = nloc + 1
+ sidx(nloc) = int(gi, 8) + int(mg + 1, 8)*(int(gj, 8) + int(ng + 1, 8)*int(gk, 8))
+ skb(nloc) = kb
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_pack_gwin_pairs
+
+ !> Cluster a SPARSE tag list (level-0 cell coords, tags(1:3, 1:ntag_in)) into a LIST of separated block boxes, identically on
+ !! every rank. Caller builds the list (s_amr_local_tags / s_amr_pack_gwin_pairs); per-rank memory is O(#tagged), not O(global
+ !! grid). Berger-Rigoutsos recursive bisection until each box's tag efficiency reaches amr_cluster_eff (or it is atomic / the
+ !! amr_max_blocks cap is hit), then merges any two boxes whose amr_buf-padded extents come within buff_size (so no fine-fine
+ !! adjacency: separated boxes stay >= buff_size apart, nearby ones collapse to one box == the legacy bounding box). Boxes are
+ !! raw tagged extents; the caller pads, clamps, size-caps each.
+ impure subroutine s_amr_cluster(tags, ntag_in, boxes, nboxes, reduce)
+
+ integer, intent(in) :: tags(:,:), ntag_in
+ !> .true.: `tags` is this rank's LOCAL list and each node's signature is ALLREDUCEd, so the tree is driven by global counts
+ !! without any rank holding the global tag list. .false.: `tags` is already replicated on every rank.
+ logical, intent(in) :: reduce
+ type(t_box), allocatable, intent(out) :: boxes(:)
+ integer, intent(out) :: nboxes
+ integer, allocatable :: slo(:,:), shi(:,:), alo(:,:), ahi(:,:)
+ integer, allocatable :: sts(:), ste(:), wt(:,:)
+ integer, allocatable :: sdep(:) !< S3.0a: recursion depth carried with each stack entry
+ integer :: dep, mxdep
+ integer, allocatable :: sig(:) !< concatenated per-axis tag signature of the node's box
+ integer, allocatable :: ovr(:) !< S3.2a scratch: ranks overlapping the node's box
+ integer :: novr
+ integer :: blo0(3), bhi0(3), off(3), nsig
+
+#ifdef MFC_MPI
+ integer :: ierr
+#endif
+ integer(8) :: nnode
+ integer :: mg, ng, pg, t
+ integer :: cap, nacc, i, j, k, d, sax, spos, thr, ntag
+ integer(8), allocatable :: akey(:) !< B1: Morton key of each accepted box's lo, the canonical merge order
+ integer, allocatable :: gcnt(:), gdsp(:), sbx(:,:), gbx(:,:) !< S3.2b: union of the per-rank accepted boxes
+ integer :: ntot
+ !> S3.2b-2: the level-order walk. kpos/kbat index the nodes kept at the current depth; bsig concatenates the signatures of
+ !! that depth's SHARED nodes into the single buffer the one reduction covers, with bofs/blen/boff their slices.
+ integer, allocatable :: kpos(:), kbat(:), bofs(:), blen(:), boff(:,:), bsig(:)
+ integer :: ncur, nnxt, nkeep, nbat, nbuf
+ !> S3.2b-2b: a node is WIDE when its box spans more than this many ranks. Wide nodes keep the batched collective (every rank
+ !! overlaps them and needs the answer); narrow ones reduce among their few overlapping ranks. The threshold only has to keep
+ !! the WIDE COUNT at O(log P) -- measured, a rank participates in 6/8/10 shared nodes at np8/16/32 while the shared total is
+ !! 11/23/47 -- and 8 is one 2x2x2 brick of ranks, the shape a seam node actually has.
+ integer, parameter :: amr_cl_wide = 8
+ integer, allocatable :: bnov(:), bovr(:,:), wbuf(:)
+ logical, allocatable :: bwide(:)
+ integer, allocatable :: pidx(:), plist(:), scnt(:), rcnt(:), sdsp2(:), rdsp2(:), soff(:), roff(:)
+ integer, allocatable :: sbuf(:), rbuf(:), creq(:)
+ integer :: np2, q, rr, nsnd, nrcv, nreq2, tagc, nwb, o1 ! t is already a loop variable above
+ integer(8) :: bkey
+ integer(8) :: vol !< box volume; a global-bbox first pass can exceed 2**31 cells
+ integer :: blo(3), bhi(3), ts, te, lo, hi, tmp(3), tmp2(3)
+ logical :: ok, force, capped, changed, tooclose, mine
+ real(wp) :: eff
+
+ nboxes = 0
+ ! In reduce mode a rank with no local tags must still walk the tree and enter every ALLREDUCE, contributing zeros;
+ ! returning early here would deadlock the ranks that do have tags. An all-empty list ends the loop via the trim.
+ if (.not. reduce .and. ntag_in == 0) return
+ mg = m_glb; ng = 0; pg = 0
+ if (n_glb > 0) ng = n_glb
+ if (p_glb > 0) pg = p_glb
+
+ cap = amr_max_fine
+ allocate (slo(3, 4*cap + 8), shi(3, 4*cap + 8), alo(3, cap), ahi(3, cap))
+ allocate (sts(4*cap + 8), ste(4*cap + 8), wt(3, ntag_in), sdep(4*cap + 8))
+ allocate (sig(mg + ng + pg + 3)) ! bound: the three full domain extents; reused by every node
+ allocate (ovr(amr_cl_wide)) ! S3.2b-2b: only NARROW nodes are ever enumerated, so this no longer sizes with P
+ allocate (akey(cap)) ! B1 scratch
+ ! working copy of the tag list, partitioned in place as the tree descends so each node scans only its tags
+ do t = 1, ntag_in
+ wt(:,t) = tags(:,t)
+ end do
+ ncur = 1; slo(:,1) = [0, 0, 0]; shi(:,1) = [mg, ng, pg] ! first node trims to the global tagged bbox
+ sts(1) = 1; ste(1) = ntag_in
+ sdep(1) = 0; mxdep = 0; nnode = 0_8
+ nacc = 0; capped = .false.
+ allocate (kpos(4*cap + 8), kbat(4*cap + 8), bofs(4*cap + 8), blen(4*cap + 8), boff(3, 4*cap + 8))
+ allocate (bsig(4*(mg + ng + pg + 3)))
+ allocate (bnov(4*cap + 8), bwide(4*cap + 8), bovr(amr_cl_wide, 4*cap + 8))
+ allocate (pidx(0:max(num_procs - 1, 0)), plist(max(num_procs, 1)))
+ allocate (scnt(max(num_procs, 1)), rcnt(max(num_procs, 1)), sdsp2(max(num_procs, 1)), rdsp2(max(num_procs, 1)))
+ allocate (soff(max(num_procs, 1)), roff(max(num_procs, 1)))
+ allocate (wbuf(1), sbuf(1), rbuf(1), creq(1))
+ pidx = 0
+ ! S3.2b-2: LEVEL-ORDER descent. The old stack held mixed depths, so each SHARED node paid its own global reduction, and
+ ! the shared set grows with P (measured per regrid: 11/23/47/91 at np8/16/32/64) -- O(P) full-machine syncs, ~147,000 at
+ ! 1e5 ranks. Walking one whole depth at a time lets every shared node at that depth ride ONE reduction, so the count
+ ! becomes O(tree depth): shr_maxdep is 2*log2(P) - 3 (3/5/7/9 over those same rungs), i.e. ~30 at 1e5 ranks.
+ !
+ ! WHY ONE COLLECTIVE IS EVEN LEGAL once S3.2b stopped replicating the tree: a child's box lies inside its parent's, so
+ ! the ranks overlapping a child are a SUBSET of those overlapping its parent, and therefore every ancestor of a shared
+ ! (novr > 1) node is itself shared. No rank ever drops a shared node's ancestor, so every rank walks the whole shared
+ ! subtree, in the same deterministic order -- the per-depth batch is identical in content AND order on every rank, which
+ ! is exactly what a single collective needs. Rank-local nodes differ per rank and are excluded from the batch entirely.
+ !
+ ! Nodes 1:ncur are the current depth; children are appended past ncur and shifted down when the depth closes. Peak
+ ! occupancy is ncur + 2*ncur <= 3*cap, inside the 4*cap + 8 the arrays already carry.
+ do while (ncur > 0)
+ nkeep = 0; nbat = 0; nbuf = 0; nnxt = 0
+ ! pass 1: classify, and stash the signatures that need reducing. Rank-local nodes are NOT stashed (their
+ ! signatures would swamp the buffer); they recompute in pass 2, which is one extra tag pass over a small box.
+ do i = 1, ncur
+ blo0 = slo(:,i); bhi0 = shi(:,i)
+ ! S3.2b: a rank-local node's tags are ALL held by its one overlapping rank -- every other rank would contribute
+ ! zeros, so the reduction cannot change the answer and the subtree is that rank's alone.
+ ! S3.2b-2b: how many ranks the box spans, and whether THIS rank is one of them, both without enumerating the
+ ! set -- the enumeration writes one entry per overlapping rank, which is O(P) on a box spanning the machine.
+ novr = f_amr_overlap_count(blo0, bhi0)
+ mine = (num_procs == 1) .or. f_amr_rank_overlaps(blo0, bhi0, proc_rank)
+ ! counted BEFORE the drop, as the stack walk did: amr_cl_nodes/amr_cl_maxdep describe the TREE, which is the
+ ! same tree whether or not this rank descends the parts it does not overlap, and [amr-tree] compares across runs
+ nnode = nnode + 1_8; mxdep = max(mxdep, sdep(i))
+ ! A rank holds tags only inside its own subdomain, so a node its subdomain does not reach is one it would
+ ! contribute nothing but zeros to: drop the subtree and let the closing box ALLGATHERV carry back anything
+ ! accepted inside it. S3.2b did this for novr == 1; the scoped exchange below extends it to every NARROW node.
+ !
+ ! WIDE nodes are deliberately NOT dropped, and that is load-bearing rather than conservative. They are settled by
+ ! a collective over MPI_COMM_WORLD, which every rank must enter with the identical buffer length; if a rank
+ ! skipped a wide node it did not overlap, its batch would be short and the reduction would mismatch -- a hang or
+ ! silent corruption that appears only once some rank stops overlapping some wide box, i.e. only at scale. A wide
+ ! node's ancestors are all wide (ovr only shrinks downward), so every rank reaches every wide node and the batch
+ ! stays identical. A narrow node's members all walked its parent for the same reason, so p2p pairing is complete.
+ if (reduce .and. num_procs > 1 .and. .not. mine .and. novr <= amr_cl_wide) cycle
+ ! ONE pass over this node's tags yields the signature; trim, count and split all read it (no rescans).
+ call s_amr_box_sig(wt, sts(i), ste(i), blo0, bhi0, sig, off, nsig)
+ nkeep = nkeep + 1; kpos(nkeep) = i; kbat(nkeep) = 0
+ amr_cl_rb = amr_cl_rb + int(nsig, 8)*4_8
+ if (reduce) amr_cl_rb_now = amr_cl_rb_now + int(nsig, 8)*4_8
+ if (novr > 1) then
+ amr_cl_shr_nodes = amr_cl_shr_nodes + 1_8; amr_cl_shr_rb = amr_cl_shr_rb + int(nsig, 8)*4_8
+ amr_cl_shr_maxdep = max(amr_cl_shr_maxdep, sdep(i))
+ if (reduce) then
+ amr_cl_shr_nodes_r = amr_cl_shr_nodes_r + 1_8; amr_cl_shr_rb_r = amr_cl_shr_rb_r + int(nsig, 8)*4_8
+ amr_cl_shr_maxdep_r = max(amr_cl_shr_maxdep_r, sdep(i))
+ ! S3.2a-2: under the sparse per-depth exchange this rank pays for a shared node only if the node's box
+ ! reaches into its subdomain. Everything else is somebody else's message.
+ if (mine) then
+ amr_cl_me_nodes_r = amr_cl_me_nodes_r + 1_8; amr_cl_me_rb_r = amr_cl_me_rb_r + int(nsig, 8)*4_8
+ end if
+ end if
+ else
+ amr_cl_loc_nodes = amr_cl_loc_nodes + 1_8; amr_cl_loc_rb = amr_cl_loc_rb + int(nsig, 8)*4_8
+ if (reduce) then
+ amr_cl_loc_nodes_r = amr_cl_loc_nodes_r + 1_8; amr_cl_loc_rb_r = amr_cl_loc_rb_r + int(nsig, 8)*4_8
+ end if
+ end if
+ if (reduce .and. num_procs > 1 .and. novr > 1) then
+ call s_amr_fw_szi(bsig, nbuf + nsig)
+ nbat = nbat + 1; kbat(nkeep) = nbat
+ bofs(nbat) = nbuf; blen(nbat) = nsig; boff(:,nbat) = off
+ bnov(nbat) = novr; bwide(nbat) = (novr > amr_cl_wide)
+ bovr(1, nbat) = -1 ! defined for wide nodes too: Fortran does not promise .or. short-circuits
+ if (.not. bwide(nbat)) then
+ call s_amr_ranks_overlapping(blo0, bhi0, ovr, novr) ! bounded by amr_cl_wide, so never O(P)
+ bovr(1:novr,nbat) = ovr(1:novr)
+ end if
+ bsig(nbuf + 1:nbuf + nsig) = sig(1:nsig)
+ nbuf = nbuf + nsig
+ end if
+ end do
+#ifdef MFC_MPI
+ ! S3.2b-2b: the depth's reduction, SPLIT by how many ranks a node's box actually spans.
+ !
+ ! WIDE nodes are the shallow ones near the root. Every rank overlaps them and genuinely needs the answer, so they
+ ! ride ONE batched collective per depth (that is 2a). There are only O(log P) of them, and their volume is the
+ ! domain extent, which grows as P^(1/3) under weak scaling -- not as P.
+ !
+ ! NARROW nodes are the deep ones straddling a rank seam, and they are where the O(P) growth in the shared set lives
+ ! (measured per regrid: 11/23/47/91 shared at np8/16/32/64). Their overlap set is a small rank-coordinate brick, so
+ ! they reduce POINT-TO-POINT among exactly those ranks: each member ships its contribution to ovr(1), which sums and
+ ! ships the total back. Per-rank received volume then follows what a rank actually overlaps -- measured 17,280 /
+ ! 27,840 / 41,600 B at np8/16/32 (1.61x, 1.49x per doubling and decelerating) against 26,920 / 59,240 / 127,080 B
+ ! (2.20x, 2.15x) for what an ALLREDUCE hands every rank.
+ !
+ ! Both ends agree on message contents with NO negotiation: a rank's node list at a depth is a SUBSEQUENCE of the one
+ ! globally-ordered tree walk (ovr_child is contained in ovr_parent, so a rank that needs a child necessarily walked
+ ! its parent), and both sides enumerate nodes in ascending j -- so the nodes common to a pair appear in the same
+ ! relative order on both sides, and one aggregated message per peer per phase matches unambiguously.
+ nwb = 0
+ do j = 1, nbat
+ if (bwide(j)) nwb = nwb + blen(j)
+ end do
+ if (nwb > 0) then
+ call s_amr_fw_szi(wbuf, nwb)
+ o1 = 0
+ do j = 1, nbat
+ if (.not. bwide(j)) cycle
+ wbuf(o1 + 1:o1 + blen(j)) = bsig(bofs(j) + 1:bofs(j) + blen(j)); o1 = o1 + blen(j)
+ end do
+ call MPI_ALLREDUCE(MPI_IN_PLACE, wbuf, nwb, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierr)
+ amr_cl_wire_r = amr_cl_wire_r + int(nwb, 8)*4_8 ! a collective hands the WHOLE buffer to every rank
+ o1 = 0
+ do j = 1, nbat
+ if (.not. bwide(j)) cycle
+ bsig(bofs(j) + 1:bofs(j) + blen(j)) = wbuf(o1 + 1:o1 + blen(j)); o1 = o1 + blen(j)
+ end do
+ end if
+ ! peers for the narrow nodes: whoever roots a node I hold, plus whoever holds a node I root
+ np2 = 0
+ do j = 1, nbat
+ if (bwide(j)) cycle
+ if (bovr(1, j) == proc_rank) then
+ do t = 2, bnov(j)
+ rr = bovr(t, j)
+ if (pidx(rr) == 0) then; np2 = np2 + 1; plist(np2) = rr; pidx(rr) = np2; end if
+ end do
+ else
+ rr = bovr(1, j)
+ if (pidx(rr) == 0) then; np2 = np2 + 1; plist(np2) = rr; pidx(rr) = np2; end if
+ end if
+ end do
+ if (np2 > 0) then
+ scnt(1:np2) = 0; rcnt(1:np2) = 0
+ do j = 1, nbat
+ if (bwide(j)) cycle
+ if (bovr(1, j) == proc_rank) then
+ do t = 2, bnov(j); q = pidx(bovr(t, j)); rcnt(q) = rcnt(q) + blen(j); end do
+ else
+ q = pidx(bovr(1, j)); scnt(q) = scnt(q) + blen(j)
+ end if
+ end do
+ sdsp2(1) = 0; rdsp2(1) = 0
+ do q = 2, np2
+ sdsp2(q) = sdsp2(q - 1) + scnt(q - 1); rdsp2(q) = rdsp2(q - 1) + rcnt(q - 1)
+ end do
+ nsnd = sdsp2(np2) + scnt(np2); nrcv = rdsp2(np2) + rcnt(np2)
+ ! received: the members' contributions I sum as a root (phase A) + the totals sent back to me (phase B)
+ amr_cl_wire_r = amr_cl_wire_r + int(nrcv, 8)*4_8 + int(nsnd, 8)*4_8
+ call s_amr_fw_szi(sbuf, max(nsnd, 1)); call s_amr_fw_szi(rbuf, max(nrcv, 1))
+ call s_amr_fw_szi(creq, 2*np2)
+ ! phase A: every member ships its own contribution up to the node's root
+ soff(1:np2) = sdsp2(1:np2)
+ do j = 1, nbat
+ if (bwide(j) .or. bovr(1, j) == proc_rank) cycle
+ q = pidx(bovr(1, j))
+ sbuf(soff(q) + 1:soff(q) + blen(j)) = bsig(bofs(j) + 1:bofs(j) + blen(j)); soff(q) = soff(q) + blen(j)
+ end do
+ tagc = amr_tag_base(4) + int(mod(amr_mesh_epoch, 50_8))
+ nreq2 = 0
+ do q = 1, np2
+ if (rcnt(q) > 0) then
+ nreq2 = nreq2 + 1
+ call MPI_IRECV(rbuf(rdsp2(q) + 1), rcnt(q), MPI_INTEGER, plist(q), tagc, MPI_COMM_WORLD, creq(nreq2), ierr)
+ end if
+ end do
+ do q = 1, np2
+ if (scnt(q) > 0) then
+ nreq2 = nreq2 + 1
+ call MPI_ISEND(sbuf(sdsp2(q) + 1), scnt(q), MPI_INTEGER, plist(q), tagc, MPI_COMM_WORLD, creq(nreq2), ierr)
+ end if
+ end do
+ if (nreq2 > 0) call MPI_WAITALL(nreq2, creq, MPI_STATUSES_IGNORE, ierr)
+ ! the root sums its members in. Integer SUM is exact and order-independent, so the total is bit-identical to what
+ ! the machine-wide reduction produced -- the change is who is in the message, never the arithmetic.
+ roff(1:np2) = rdsp2(1:np2)
+ do j = 1, nbat
+ if (bwide(j) .or. bovr(1, j) /= proc_rank) cycle
+ do t = 2, bnov(j)
+ q = pidx(bovr(t, j))
+ bsig(bofs(j) + 1:bofs(j) + blen(j)) = bsig(bofs(j) + 1:bofs(j) + blen(j)) + rbuf(roff(q) + 1:roff(q) &
+ & + blen(j))
+ roff(q) = roff(q) + blen(j)
+ end do
+ end do
+ ! phase B: the total goes back down. Counts mirror phase A exactly, so the buffers swap roles.
+ roff(1:np2) = rdsp2(1:np2)
+ do j = 1, nbat
+ if (bwide(j) .or. bovr(1, j) /= proc_rank) cycle
+ do t = 2, bnov(j)
+ q = pidx(bovr(t, j))
+ rbuf(roff(q) + 1:roff(q) + blen(j)) = bsig(bofs(j) + 1:bofs(j) + blen(j)); roff(q) = roff(q) + blen(j)
+ end do
+ end do
+ nreq2 = 0
+ do q = 1, np2
+ if (scnt(q) > 0) then
+ nreq2 = nreq2 + 1
+ call MPI_IRECV(sbuf(sdsp2(q) + 1), scnt(q), MPI_INTEGER, plist(q), tagc + 50, MPI_COMM_WORLD, &
+ & creq(nreq2), ierr)
+ end if
+ end do
+ do q = 1, np2
+ if (rcnt(q) > 0) then
+ nreq2 = nreq2 + 1
+ call MPI_ISEND(rbuf(rdsp2(q) + 1), rcnt(q), MPI_INTEGER, plist(q), tagc + 50, MPI_COMM_WORLD, &
+ & creq(nreq2), ierr)
+ end if
+ end do
+ if (nreq2 > 0) call MPI_WAITALL(nreq2, creq, MPI_STATUSES_IGNORE, ierr)
+ soff(1:np2) = sdsp2(1:np2)
+ do j = 1, nbat
+ if (bwide(j) .or. bovr(1, j) == proc_rank) cycle
+ q = pidx(bovr(1, j))
+ bsig(bofs(j) + 1:bofs(j) + blen(j)) = sbuf(soff(q) + 1:soff(q) + blen(j)); soff(q) = soff(q) + blen(j)
+ end do
+ do q = 1, np2 ! clear only what was touched: a full wipe would be O(P) per depth
+ pidx(plist(q)) = 0
+ end do
+ end if
+#endif
+ ! pass 2: trim, accept or split every node kept at this depth
+ do j = 1, nkeep
+ i = kpos(j); blo = slo(:,i); bhi = shi(:,i); ts = sts(i); te = ste(i); dep = sdep(i)
+ blo0 = blo; bhi0 = bhi
+ if (kbat(j) > 0) then
+ off = boff(:,kbat(j))
+ sig(1:blen(kbat(j))) = bsig(bofs(kbat(j)) + 1:bofs(kbat(j)) + blen(kbat(j)))
+ nsig = blen(kbat(j))
+ else
+ ! rank-local: no reduction was needed, so the signature is recomputed here rather than carried. Safe because
+ ! pass 2 only ever partitions a node's OWN wt(:, ts:te) range, which is disjoint from every other node's.
+ call s_amr_box_sig(wt, ts, te, blo0, bhi0, sig, off, nsig)
+ end if
+ call s_amr_trim_from_sig(sig(1:nsig), off, blo0, bhi0, blo, bhi, ok, ntag)
+ if (.not. ok) cycle
+ vol = 1_8
+ do d = 1, num_dims; vol = vol*int(bhi(d) - blo(d) + 1, 8); end do
+ eff = real(ntag, wp)/real(max(vol, 1_8), wp)
+ call s_amr_find_split_sig(sig(1:nsig), off, blo0, blo, bhi, sax, spos, ok)
+ ! splitting now could overflow the amr_max_blocks cap. The level-order walk changes what is still pending when
+ ! this is asked, so the term counts the rest of THIS depth plus the children queued so far; B0b keeps the
+ ! bisection clear of the cap, so it stays inert (measured: the capped warning on 0 of 10 regrids).
+ force = (nacc + (nkeep - j) + nnxt + 1 >= cap)
+ if (eff >= amr_cluster_eff .or. .not. ok .or. force) then
+ if (nacc < cap) then; nacc = nacc + 1; alo(:,nacc) = blo; ahi(:,nacc) = bhi; end if
+ if (force .and. ok .and. eff < amr_cluster_eff) capped = .true.
+ else
+ ! partition wt(:, ts:te) in place: coord(sax) < spos to the front (low child), >= spos to the back (high)
+ lo = ts; hi = te
+ do while (lo <= hi)
+ if (wt(sax, lo) < spos) then
+ lo = lo + 1
+ else
+ tmp = wt(:,lo); wt(:,lo) = wt(:,hi); wt(:,hi) = tmp
+ hi = hi - 1
+ end if
+ end do
+ ! low child = [ts:lo-1], high child = [lo:te]; every parent tag lands in exactly one (box just trimmed+split)
+ slo(:,ncur + nnxt + 1) = blo; shi(:,ncur + nnxt + 1) = bhi; shi(sax, ncur + nnxt + 1) = spos - 1
+ sts(ncur + nnxt + 1) = ts; ste(ncur + nnxt + 1) = lo - 1; sdep(ncur + nnxt + 1) = dep + 1
+ slo(:,ncur + nnxt + 2) = blo; shi(:,ncur + nnxt + 2) = bhi; slo(sax, ncur + nnxt + 2) = spos
+ sts(ncur + nnxt + 2) = lo; ste(ncur + nnxt + 2) = te; sdep(ncur + nnxt + 2) = dep + 1
+ nnxt = nnxt + 2
+ end if
+ end do
+ ! close the depth: the children become the next current level
+ do i = 1, nnxt
+ slo(:,i) = slo(:,ncur + i); shi(:,i) = shi(:,ncur + i)
+ sts(i) = sts(ncur + i); ste(i) = ste(ncur + i); sdep(i) = sdep(ncur + i)
+ end do
+ ncur = nnxt
+ end do
+ deallocate (kpos, kbat, bofs, blen, boff, bsig, bnov, bwide, bovr, pidx, plist)
+ deallocate (scnt, rcnt, sdsp2, rdsp2, soff, roff, wbuf, sbuf, rbuf, creq)
+
+ ! S3.0a: record tree shape BEFORE the merge, so nacc is still the BR leaf count (the log2 denominator). Two independent
+ ! maxima -- the deepest call and the largest call -- because a single max cannot say whether a deep tree was also big.
+ amr_cl_nodes = amr_cl_nodes + nnode
+ if (mxdep > amr_cl_maxdep) then
+ amr_cl_maxdep = mxdep; amr_cl_maxdep_leaf = nacc
+ end if
+ if (nacc > amr_cl_lmax) then
+ amr_cl_lmax = nacc; amr_cl_ldepth = mxdep
+ end if
+
+#ifdef MFC_MPI
+ ! S3.2b: with rank-local subtrees walked ONLY by their owner, each rank now holds just the boxes from the subtrees it
+ ! owns. Union them once here. This is per-BOX global data, which the endstate permits, and it is tiny -- 6 ints per box
+ ! against the ~13,825 per-cell signature reductions per regrid it replaces. Ranks contribute in rank order, which is not
+ ! the order the serial traversal accepted them in; B1's canonical Morton sort immediately below is what makes the merged
+ ! result independent of that, and is the reason B1 had to land first.
+ if (reduce .and. num_procs > 1) then
+ allocate (gcnt(num_procs), gdsp(num_procs))
+ call MPI_ALLGATHER(nacc, 1, MPI_INTEGER, gcnt, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ gdsp(1) = 0
+ do i = 2, num_procs
+ gdsp(i) = gdsp(i - 1) + gcnt(i - 1)
+ end do
+ ntot = gdsp(num_procs) + gcnt(num_procs)
+ allocate (sbx(6, max(nacc, 1)), gbx(6, max(ntot, 1)))
+ do i = 1, nacc
+ sbx(1:3,i) = alo(:,i); sbx(4:6,i) = ahi(:,i)
+ end do
+ gcnt = gcnt*6; gdsp = gdsp*6
+ call MPI_ALLGATHERV(sbx, nacc*6, MPI_INTEGER, gbx, gcnt, gdsp, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ amr_gb_box = amr_gb_box + int(ntot, 8)*6_8*4_8 ! every rank receives the WHOLE global box list
+ ! the accepted-box array is sized to the cap; B0b keeps the bisection away from it, and a run that still reaches it
+ ! truncates here exactly as the serial `if (nacc < cap)` guard did.
+ nacc = min(ntot, cap)
+ do i = 1, nacc
+ alo(:,i) = gbx(1:3,i); ahi(:,i) = gbx(4:6,i)
+ end do
+ deallocate (gcnt, gdsp, sbx, gbx)
+ end if
+#endif
+
+ ! B1: canonicalise the merge input. The merge below scans in list order and fuses the FIRST too-close pair, so its
+ ! output is a function of the order boxes were ACCEPTED -- i.e. of the traversal. Sorting by Morton of lo makes it a
+ ! function of the box SET alone, which is what lets a scoped clusterer (S3.2) complete local subtrees in parallel, in
+ ! a different acceptance order, and still agree across ranks. Accepted boxes are disjoint, so their lo corners are
+ ! distinct and the key is a total order under f_morton's 21 bits/dim -- the same bound the block partition assumes.
+ ! The sort is stable, so even a key collision above that bound would only fall back to acceptance order, never split
+ ! the ranks. Morton rather than lexicographic because it keeps spatial neighbours adjacent, so the merge fuses near
+ ! pairs first and the fused bounding boxes stay compact.
+ do i = 1, nacc
+ akey(i) = f_morton(alo(1, i), alo(2, i), alo(3, i))
+ end do
+ do i = 2, nacc
+ bkey = akey(i); tmp = alo(:,i); tmp2 = ahi(:,i)
+ j = i - 1
+ do while (j >= 1)
+ if (akey(j) <= bkey) exit
+ akey(j + 1) = akey(j); alo(:,j + 1) = alo(:,j); ahi(:,j + 1) = ahi(:,j)
+ j = j - 1
+ end do
+ akey(j + 1) = bkey; alo(:,j + 1) = tmp; ahi(:,j + 1) = tmp2
+ end do
+
+ ! min-separation merge: two boxes are separated only if some active dim's gap reaches thr; else fuse to their bounding box
+ thr = buff_size + 2*amr_buf
+ changed = .true.
+ do while (changed)
+ changed = .false.
+ outer: do i = 1, nacc - 1
+ do j = i + 1, nacc
+ tooclose = .true.
+ do d = 1, num_dims
+ if (max(alo(d, i), alo(d, j)) - min(ahi(d, i), ahi(d, j)) - 1 >= thr) tooclose = .false.
+ end do
+ if (tooclose) then
+ alo(:,i) = min(alo(:,i), alo(:,j)); ahi(:,i) = max(ahi(:,i), ahi(:,j))
+ ! B1: remove by shifting down, not by swapping with the last entry, so the list stays in the
+ ! canonical order the sort established and later fusions keep preferring spatial neighbours.
+ do k = j, nacc - 1
+ alo(:,k) = alo(:,k + 1); ahi(:,k) = ahi(:,k + 1)
+ end do
+ nacc = nacc - 1; changed = .true.
+ exit outer
+ end if
+ end do
+ end do outer
+ end do
+ if (capped .and. proc_rank == 0) print '(A,I0)', ' [amr] WARNING: tag clustering capped at amr_max_blocks = ', cap
+
+ nboxes = nacc
+ do i = 1, nacc ! grid-efficiency denominator: coarse volume the accepted boxes cover
+ amr_n_covered = amr_n_covered + int(ahi(1, i) - alo(1, i) + 1, 8)*int(ahi(2, i) - alo(2, i) + 1, 8)*int(ahi(3, &
+ & i) - alo(3, i) + 1, 8)
+ end do
+ allocate (boxes(nboxes))
+ do i = 1, nboxes
+ boxes(i)%lo = alo(:,i); boxes(i)%hi = ahi(:,i)
+ end do
+ deallocate (slo, shi, alo, ahi, sts, ste, wt, sdep, sig, ovr, akey)
+
+ end subroutine s_amr_cluster
+
+ !> Regrid: tag by relative density gradient, cluster (Berger-Rigoutsos + min-separation merge) into separated boxes, pad/clamp/
+ !! size-cap each, rebuild every active slot. Each new slot prolongs from coarse then overwrites its overlap with whichever OLD
+ !! slot(s) covered it (rank-local; a split copies from one old slot, a merge from both). Called between steps only. No-op if
+ !! nothing is tagged or the box set is unchanged.
+ impure subroutine s_amr_regrid(q_cons_base)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_base
+ logical, allocatable :: tag_grid(:,:,:)
+ type(t_box), allocatable :: boxes(:)
+ integer :: sidx(3), nboxes
+ integer :: old_np
+ ! heap, not stack: these are O(global boxes) and overflow a default stack at large box
+ ! counts. Unsaved local allocatables are deallocated automatically on every return path.
+ integer, allocatable :: box_level(:)
+ integer, allocatable :: old_ilo(:,:), old_ext(:,:)
+ integer, allocatable :: old_level(:)
+ logical, allocatable :: old_owns(:)
+ logical :: same
+ integer :: i
+ !> S3.2a-2: this rank's shallow-phase participation, and its max over ranks
+ integer(8) :: me_l(3), me_g(3), hl_l(3), hl_g(3)
+
+#ifdef MFC_MPI
+ integer :: mierr
+#endif
+
+ allocate (box_level(amr_max_fine), old_ilo(3, amr_max_blocks), old_ext(3, amr_max_blocks), old_level(amr_max_blocks), &
+ & old_owns(amr_max_blocks))
+
+ ! valid coarse CONS ghosts at internal rank boundaries: the tag sweep reads +/-1 across seams and the rebuild prolongation
+ ! reads past the new intersection (ALL ranks call: pairwise per-direction exchange; complete no-op at np=1).
+
+ call s_phase_tic(PH_RGHALO); call s_amr_exchange_coarse_cons_halo(q_cons_base); call s_phase_toc(PH_RGHALO)
+ do i = 1, sys_size
+ $:GPU_UPDATE(host='[q_cons_base(i)%sf]')
+ end do
+
+ ! Lagrangian-cloud exclusion bbox for this regrid (collective): smearing (mapCells) + stencil headroom (2) + drift
+ ! margin until the next regrid (amr_buf)
+ if (bubbles_lagrange) call s_amr_compute_lag_supp(mapCells + 2 + amr_buf)
+
+ call s_phase_tic(PH_RGTAG); call s_amr_regrid_tag_cells(q_cons_base, tag_grid, sidx); call s_phase_toc(PH_RGTAG)
+ call s_amr_cad_count(tag_grid, sidx) ! [amr-cad] cadence containment audit (counts only; report at finalize)
+ call s_phase_tic(PH_RGCLUS); call s_amr_regrid_cluster_tags(tag_grid, sidx, boxes, nboxes); call s_phase_toc(PH_RGCLUS)
+ if (nboxes == 0) return ! nothing tagged on any rank; keep the current blocks
+ call s_phase_tic(PH_RGSHAPE); call s_amr_regrid_shape_boxes(boxes, nboxes); call s_phase_toc(PH_RGSHAPE)
+ if (nboxes == 0) return ! every box was confined to the domain margin
+ call s_amr_regrid_nest_children(boxes, nboxes, box_level)
+ call s_amr_check_box_caps(boxes, nboxes, box_level) ! invariant: no box may exceed its level's slot cap
+ call s_amr_check_box_disjoint(boxes, nboxes, box_level) ! invariant: same-level boxes are pairwise disjoint
+ call s_amr_regrid_boxes_unchanged(boxes, nboxes, box_level, same)
+ if (same) return ! identical box set and levels: keep the live slots
+ call s_phase_tic(PH_RGMIG); call s_amr_regrid_stash_migrate(boxes, nboxes, box_level, old_np, old_ilo, old_ext, &
+ & old_level, old_owns); call s_phase_toc(PH_RGMIG)
+ call s_phase_tic(PH_RGBUILD); call s_amr_regrid_rebuild_slots(q_cons_base, boxes, nboxes, old_np, old_ilo, old_ext, &
+ & old_level, old_owns); call s_phase_toc(PH_RGBUILD)
+
+ ! TRACK S: the quantities that must stay O(1) in problem size. Reported per regrid on rank 0
+ ! because wall time at one problem size cannot see them.
+ ! S3.2a-2: rank_time_wrt is a namelist flag, so this branch is entered by every rank and the reduction is safe here.
+ ! MAX rather than rank 0's own value: rank 0 owns a domain CORNER and overlaps the fewest shared boxes of anyone.
+ if (rank_time_wrt) then
+ me_l = [amr_cl_me_nodes_r, amr_cl_me_rb_r, amr_cl_wire_r]
+ me_g = me_l
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(me_l, me_g, 3, MPI_INTEGER8, MPI_MAX, MPI_COMM_WORLD, mierr)
+#endif
+ end if
+ ! EVERY rank must enter this collective -- it was originally written inside the `proc_rank == 0`
+ ! guard below, so one rank called ALLREDUCE while the other seven ran ahead into different
+ ! collectives and the job died with MPI_ERR_TRUNCATE. Reduce on all ranks; print on rank 0.
+ hl_l = [int(amr_n_touch_max, 8), int(amr_n_touch, 8), int(amr_n_my, 8)]
+ hl_g = hl_l
+ if (rank_time_wrt) then
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(hl_l, hl_g, 3, MPI_INTEGER8, MPI_MAX, MPI_COMM_WORLD, mierr)
+#endif
+ end if
+ if (rank_time_wrt .and. proc_rank == 0) then
+ ! MEMORY SCALING: bytes this rank holds that are sized by the GLOBAL block count, against the bytes
+ ! sized by what it actually OWNS. glob/own rising with P is the memory face of limit 3 -- the same
+ ! replicated metadata whose gather costs 96 ms/step and whose scan costs 333-583 ms/step at 1e5 ranks.
+ ! Counted from the declared shapes: 12 ints of geometry (region lo/hi, isect lo/hi) + level + owner +
+ ! my_blk + several O(block) scratch/logical arrays, ~15 ints and 3 logicals per block.
+ print '(A,I0,A,I0)', '[amr-grideff] tagged ', amr_n_tagged, ' covered ', amr_n_covered
+ print '(A,I0,A,I0,A,I0)', '[amr-mem] glob_bytes ', int(amr_max_blocks, 8)*18_8*4_8, ' own_blocks ', amr_n_my, &
+ & ' max_blocks ', amr_max_blocks
+ ! HALO PROBE: distinct blocks whose metadata this rank read since the last regrid, against the blocks it
+ ! OWNS. touch/own ~ O(1) means a distributed metadata design carries a BOUNDED halo; touch ~ nboxes means
+ ! every rank needs everything and distribution cannot help. This gates the whole limit-3 project.
+ ! MAX over ranks, not rank 0's own value. rank 0 owns a domain CORNER and is the LEAST connected rank
+ ! in the machine -- the [amr-scope-me] instrument beside this one already carries that warning, and the
+ ! first version of this probe ignored it and reported a corner rank's halo as if it were the machine's.
+ print '(A,I0,A,I0,A,I0)', '[amr-halo] touch_max ', hl_g(1), ' touch_now ', hl_g(2), ' own ', hl_g(3)
+ print '(A,I0,A,I0,A,I0,A,I0,A,I0)', '[amr-scope-me] me_nodes_max ', me_g(1), ' me_rb_max ', me_g(2), ' wire_max ', &
+ & me_g(3), ' shr_nodes_all ', amr_cl_shr_nodes_r, ' shr_rb_all ', amr_cl_shr_rb_r
+ print '(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)', '[amr-scale] nboxes ', nboxes, ' ntag_bytes ', amr_gb_tag, ' gwin_bytes ', &
+ & amr_gb_win, ' cost_bytes ', amr_gb_cost, ' box_bytes ', amr_gb_box, ' cells ', int(m_glb + 1, 8)*int(n_glb + 1, &
+ & 8)*int(p_glb + 1, 8) ! int8: int32 overflows past ~1290^3
+ print '(A,I0,A,I0,A,I0)', '[amr-mig] blocks_moved ', amr_mig_blk, ' sends ', amr_mig_snd, ' bytes ', amr_gb_mig
+ print '(A,I0,A,I0,A,I0,A,I0,A,I0)', '[amr-scope] shr_nodes ', amr_cl_shr_nodes, ' shr_rb ', amr_cl_shr_rb, &
+ & ' loc_nodes ', amr_cl_loc_nodes, ' loc_rb ', amr_cl_loc_rb, ' shr_maxdep ', amr_cl_shr_maxdep
+ print '(A,I0,A,I0,A,I0,A,I0,A,I0)', '[amr-scope-r] shr_nodes ', amr_cl_shr_nodes_r, ' shr_rb ', amr_cl_shr_rb_r, &
+ & ' loc_nodes ', amr_cl_loc_nodes_r, ' loc_rb ', amr_cl_loc_rb_r, ' shr_maxdep ', amr_cl_shr_maxdep_r
+ print '(A,I0,A,I0,A,I0,A,I0,A,I0,A,I0)', '[amr-tree] maxdep ', amr_cl_maxdep, ' maxdep_leaf ', amr_cl_maxdep_leaf, &
+ & ' lmax ', amr_cl_lmax, ' ldepth ', amr_cl_ldepth, ' nodes ', amr_cl_nodes, ' rbytes ', amr_cl_rb
+ end if
+
+ ! HALO PROBE reset: AFTER the regrid's own global walks (clustering, owner assignment) so the count that
+ ! follows measures ONLY what the STEP path touches -- which is the halo a distributed metadata design must
+ ! carry. Keying the reset on the mesh epoch instead (the first version) folded the regrid's global passes
+ ! in and reported touch == nboxes, which answers a question nobody asked.
+ amr_n_touch_max = max(amr_n_touch_max, amr_n_touch)
+ if (allocated(amr_touch)) then
+ amr_touch = .false.; amr_n_touch = 0
+ end if
+
+ end subroutine s_amr_regrid
+
+ !> Regrid phase 1: per-cell tag field (density-gradient criterion), skipping the two global boundary cells per active dim and
+ !! suppressing tags over the acoustic source supports and the Lagrangian-cloud exclusion bbox. sidx returns the rank's global
+ !! start offsets for the sparse union in phase 2.
+ impure subroutine s_amr_regrid_tag_cells(q_cons_base, tag_grid, sidx)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_cons_base
+ logical, allocatable, intent(inout) :: tag_grid(:,:,:)
+ integer, intent(out) :: sidx(3)
+ integer :: tg_lo(3), tg_hi(3), ci, cj, ck
+ real(wp) :: r0, g
+
+ ! 1) per-cell tag field (density-gradient criterion), skipping the two global boundary cells per active dim
+
+ sidx = 0
+ sidx(1) = start_idx(1)
+ if (n_glb > 0) sidx(2) = start_idx(2)
+ if (p_glb > 0) sidx(3) = start_idx(3)
+ tg_lo = 0; tg_hi = 0
+ tg_lo(1) = merge(1, 0, sidx(1) == 0); tg_hi(1) = merge(m - 1, m, sidx(1) + m == m_glb)
+ if (n_glb > 0) then; tg_lo(2) = merge(1, 0, sidx(2) == 0); tg_hi(2) = merge(n - 1, n, sidx(2) + n == n_glb); end if
+ if (p_glb > 0) then; tg_lo(3) = merge(1, 0, sidx(3) == 0); tg_hi(3) = merge(p - 1, p, sidx(3) + p == p_glb); end if
+ allocate (tag_grid(0:m,0:n,0:p)); tag_grid = .false.
+ do ck = tg_lo(3), tg_hi(3)
+ do cj = tg_lo(2), tg_hi(2)
+ do ci = tg_lo(1), tg_hi(1)
+ ! total density gradient (sum of the continuity variables): degenerates to the single-fluid tagger, immune to
+ ! trace-fluid noise. Matched-density composition-only interfaces are invisible (documented limit).
+ r0 = max(abs(f_amr_rho_tot_sf(q_cons_base, ci, cj, ck)), 1.e-30_wp)
+ g = abs(f_amr_rho_tot_sf(q_cons_base, ci + 1, cj, ck) - f_amr_rho_tot_sf(q_cons_base, ci - 1, cj, ck))
+ if (n_glb > 0) g = max(g, abs(f_amr_rho_tot_sf(q_cons_base, ci, cj + 1, ck) - f_amr_rho_tot_sf(q_cons_base, &
+ & ci, cj - 1, ck)))
+ if (p_glb > 0) g = max(g, abs(f_amr_rho_tot_sf(q_cons_base, ci, cj, ck + 1) - f_amr_rho_tot_sf(q_cons_base, &
+ & ci, cj, ck - 1)))
+ ! 2*r0 normalizes the 2-cell central difference (rho at i+1..i-1); the 2 is the stencil span, NOT amr_ref_ratio
+ if (g/(2._wp*r0) > amr_tag_eps) tag_grid(ci, cj, ck) = .true.
+ if (tag_grid(ci, cj, ck)) amr_n_tagged = amr_n_tagged + 1_8 ! grid-efficiency numerator
+ ! the acoustic source support stays coarse (its spatials are coarse cell indices): suppress tags there so
+ ! the clusterer splits around the source
+ if (acoustic_source .and. tag_grid(ci, cj, ck)) then
+ if (f_in_acoustic_support(ci + sidx(1), cj + sidx(2), ck + sidx(3))) tag_grid(ci, cj, ck) = .false.
+ end if
+ ! the Lagrangian bubble cloud stays coarse (two-way coupling lives on the coarse grid): suppress tags over
+ ! its padded bbox
+ if (bubbles_lagrange .and. tag_grid(ci, cj, ck)) then
+ if (f_in_lag_support(ci + sidx(1), cj + sidx(2), ck + sidx(3))) tag_grid(ci, cj, ck) = .false.
+ end if
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_regrid_tag_cells
+
+ !> [amr-cad] cadence containment audit: count this rank's level-1 tags, and how many fall OUTSIDE the pre-regrid level-1
+ !! coverage - a feature that evolved unrefined since the last regrid because amr_buf did not cover its drift over amr_regrid_int
+ !! steps. Counts only (reported once by s_amr_cov_report); the first refinement from scratch is skipped (every tag is new by
+ !! construction). Region bounds are GLOBAL coarse cells; tag_grid is rank-local, so paint each region's clip with this subdomain
+ !! into a local mask first.
+ impure subroutine s_amr_cad_count(tag_grid, sidx)
+
+ logical, intent(in) :: tag_grid(0:,0:,0:)
+ integer, intent(in) :: sidx(3)
+ logical, allocatable :: cov(:,:,:)
+ integer :: k, ci, cj, ck, bl(3), bh(3)
+ logical :: any_l1
+
+ ! skip the FIRST regrid: it populates the hierarchy from the seed block, so nearly every tag is
+ ! legitimately outside the old coverage (measured 47% escaped on S0 from the t=0 transient alone).
+ ! The instrument measures STEADY-STATE containment - regrid 2 onward.
+
+ if (.not. amr_cad_armed) then
+ amr_cad_armed = .true.
+ return
+ end if
+ any_l1 = .false.
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) == 1) any_l1 = .true.
+ end do
+ if (.not. any_l1) return
+ allocate (cov(0:m,0:n,0:p)); cov = .false.
+ do k = 1, amr_num_blocks
+ if (amr_block_level(k) /= 1) cycle
+ bl = 0; bh = 0
+ bl(1) = max(amr_region_lo_all(1, k) - sidx(1), 0); bh(1) = min(amr_region_hi_all(1, k) - sidx(1), m)
+ if (n_glb > 0) then
+ bl(2) = max(amr_region_lo_all(2, k) - sidx(2), 0); bh(2) = min(amr_region_hi_all(2, k) - sidx(2), n)
+ end if
+ if (p_glb > 0) then
+ bl(3) = max(amr_region_lo_all(3, k) - sidx(3), 0); bh(3) = min(amr_region_hi_all(3, k) - sidx(3), p)
+ end if
+ if (bl(1) > bh(1) .or. bl(2) > bh(2) .or. bl(3) > bh(3)) cycle
+ cov(bl(1):bh(1),bl(2):bh(2),bl(3):bh(3)) = .true.
+ end do
+ do ck = 0, p
+ do cj = 0, n
+ do ci = 0, m
+ if (tag_grid(ci, cj, ck)) then
+ amr_cad_tot = amr_cad_tot + 1
+ if (.not. cov(ci, cj, ck)) amr_cad_esc = amr_cad_esc + 1
+ end if
+ end do
+ end do
+ end do
+ deallocate (cov)
+
+ end subroutine s_amr_cad_count
+
+ !> Regrid phase 2: build this rank's OWN sparse tag list, then cluster it with per-node signature reductions into a list of
+ !! separated candidate boxes (nboxes = 0 if nothing is tagged on any rank).
+ impure subroutine s_amr_regrid_cluster_tags(tag_grid, sidx, boxes, nboxes)
+
+ logical, allocatable, intent(inout) :: tag_grid(:,:,:)
+ integer, intent(in) :: sidx(3)
+ type(t_box), allocatable, intent(out) :: boxes(:)
+ integer, intent(out) :: nboxes
+ integer, allocatable :: tags(:,:)
+ integer :: ntag
+
+ ! 2) build this rank's LOCAL tag list, then cluster it; the tree is driven by reduced signatures, so it stays rank-invariant
+
+ call s_amr_local_tags(tag_grid, sidx, tags, ntag)
+ deallocate (tag_grid)
+ call s_amr_cluster(tags, ntag, boxes, nboxes, .true.)
+ deallocate (tags)
+
+ end subroutine s_amr_regrid_cluster_tags
+
+ !> Regrid phase 3: pad + clamp + size-cap each box, clip it clear of the acoustic/Lagrangian supports and the active window,
+ !! expand it over immersed bodies, then tile oversized boxes (non-IB) or merge overlapping ones (IB).
+ impure subroutine s_amr_regrid_shape_boxes(boxes, nboxes)
+
+ type(t_box), allocatable, intent(inout) :: boxes(:)
+ integer, intent(inout) :: nboxes
+ integer :: lo(3), hi(3), k, kk
+ logical :: merged
+
+ ! 3) pad + clamp + size-cap each box (amr_maxc_fit lets each box move freely across rank boundaries); drop margin-only boxes
+
+ k = 0
+ do kk = 1, nboxes
+ lo = boxes(kk)%lo; hi = boxes(kk)%hi
+ lo(1) = max(lo(1) - amr_buf, buff_size); hi(1) = min(hi(1) + amr_buf, m_glb - buff_size)
+ ! IB keeps the size-cap CLAMP (a body needs one contiguous block; splitting a body across tiles is untested); the
+ ! general path leaves boxes full-size and TILES them (below) into <= amr_maxc_fit sub-blocks with a fine-fine halo
+ if (ib .and. hi(1) - lo(1) + 1 > amr_maxc_fit(1)) hi(1) = lo(1) + amr_maxc_fit(1) - 1
+ if (n_glb > 0) then
+ lo(2) = max(lo(2) - amr_buf, buff_size); hi(2) = min(hi(2) + amr_buf, n_glb - buff_size)
+ if (ib .and. hi(2) - lo(2) + 1 > amr_maxc_fit(2)) hi(2) = lo(2) + amr_maxc_fit(2) - 1
+ else
+ lo(2) = 0; hi(2) = 0
+ end if
+ if (p_glb > 0) then
+ lo(3) = max(lo(3) - amr_buf, buff_size); hi(3) = min(hi(3) + amr_buf, p_glb - buff_size)
+ if (ib .and. hi(3) - lo(3) + 1 > amr_maxc_fit(3)) hi(3) = lo(3) + amr_maxc_fit(3) - 1
+ else
+ lo(3) = 0; hi(3) = 0
+ end if
+ ! keep candidate boxes clear of every acoustic source support (the source acts on the coarse grid only); clipping
+ ! only shrinks, so boxes stay disjoint - empties drop below
+ if (acoustic_source) call s_amr_clip_box_from_sources(lo, hi)
+ if (bubbles_lagrange .and. lag_supp_on) call s_amr_clip_box_from_supp(lo, hi, lag_supp_lo, lag_supp_hi)
+ ! active_box: boxes stay strictly inside the active window (the windowed coarse update would drop reflux corrections
+ ! at faces outside it). Tags cannot arise outside (frozen-ambient exterior), so only the amr_buf padding is ever cut
+ ! - and the cut cells are ambient. np=1 only (ab_active is false under MPI).
+ if (ab_active) then
+ lo(1) = max(lo(1), ab_x%beg + 1); hi(1) = min(hi(1), ab_x%end - 1)
+ if (n_glb > 0) then; lo(2) = max(lo(2), ab_y%beg + 1); hi(2) = min(hi(2), ab_y%end - 1); end if
+ if (p_glb > 0) then; lo(3) = max(lo(3), ab_z%beg + 1); hi(3) = min(hi(3), ab_z%end - 1); end if
+ end if
+ ! a fine block that PARTIALLY covers an immersed body is an untested regime (ghost prolongation through body-interior
+ ! cells, refluxing across the body): any box overlapping a body's bounding box expands to contain the whole body plus
+ ! margin
+ if (ib) call s_amr_expand_box_over_bodies(lo, hi)
+ if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) cycle ! confined to the domain margin
+ k = k + 1; boxes(k)%lo = lo; boxes(k)%hi = hi
+ end do
+ nboxes = k
+ if (nboxes == 0) return
+
+ ! max_grid_size tiling (non-IB): split any box larger than amr_maxc_fit into contiguous <= amr_maxc_fit sub-blocks so a
+ ! whole block fits a rank's local solver scratch. Tiles are adjacent; the block-to-block fine-fine halo
+ ! (s_amr_fine_fine_halo) makes the seams conservative and the reflux skips fine-fine faces. (IB keeps the clamp - above.)
+ if (.not. ib) then
+ block
+ type(t_box), allocatable :: tiled(:)
+ integer :: kk2, ntl, capt
+ allocate (tiled(amr_max_blocks))
+ ntl = 0; capt = 0
+ do kk2 = 1, nboxes
+ call s_amr_tile_box(boxes(kk2)%lo, boxes(kk2)%hi, tiled, ntl, amr_max_fine, capt)
+ end do
+ if (capt == 1 .and. proc_rank == 0) print '(A,I0)', ' [amr] WARNING: tiling capped at amr_max_blocks = ', &
+ & amr_max_blocks
+ deallocate (boxes); call move_alloc(tiled, boxes)
+ nboxes = ntl
+ end block
+ end if
+
+ if (ib) then
+ ! body-containment expansion can make boxes overlap (bisection guarantees disjoint boxes, but two boxes near one body
+ ! both grow over it): merge pairs closer than a 2-cell gap to a bbox until none remain. Overlapping blocks would
+ ! double-restrict/reflux; a 1-cell gap with transverse overlap gives the two blocks a COINCIDENT outside coarse
+ ! cell, which the batched reflux apply writes from both blocks in ONE kernel - an unsynchronized read-modify-write
+ ! (the clusterer's min-separation merge guarantees a >= 2 gap everywhere else; this restores it after expansion).
+ merged = .true.
+ do while (merged)
+ merged = .false.
+ outer: do k = 1, nboxes - 1
+ do kk = k + 1, nboxes
+ if (boxes(k)%lo(1) <= boxes(kk)%hi(1) + 1 .and. boxes(k)%hi(1) >= boxes(kk)%lo(1) - 1 .and. (n_glb == 0 &
+ & .or. (boxes(k)%lo(2) <= boxes(kk)%hi(2) + 1 .and. boxes(k)%hi(2) >= boxes(kk)%lo(2) - 1)) &
+ & .and. (p_glb == 0 .or. (boxes(k)%lo(3) <= boxes(kk)%hi(3) + 1 .and. boxes(k)%hi(3) &
+ & >= boxes(kk)%lo(3) - 1))) then
+ boxes(k)%lo = min(boxes(k)%lo, boxes(kk)%lo)
+ boxes(k)%hi = max(boxes(k)%hi, boxes(kk)%hi)
+ boxes(kk) = boxes(nboxes); nboxes = nboxes - 1
+ if (boxes(k)%hi(1) - boxes(k)%lo(1) + 1 > amr_maxc_fit(1) .or. (n_glb > 0 .and. boxes(k)%hi(2) &
+ & - boxes(k)%lo(2) + 1 > amr_maxc_fit(2)) .or. (p_glb > 0 .and. boxes(k)%hi(3) - boxes(k)%lo(3) &
+ & + 1 > amr_maxc_fit(3))) then
+ call s_mpi_abort('amr regrid: merging body-containing blocks exceeds ' &
+ & // 'the per-rank block size cap')
+ end if
+ merged = .true.
+ exit outer
+ end if
+ end do
+ end do outer
+ end do
+ ! the expansion may also have grown a box onto an acoustic source support or the Lagrangian cloud: the constraints
+ ! (contain the body, exclude the source/cloud) cannot both hold - fail closed
+ if (acoustic_source .or. (bubbles_lagrange .and. lag_supp_on)) then
+ do k = 1, nboxes
+ lo = boxes(k)%lo; hi = boxes(k)%hi
+ if (acoustic_source) call s_amr_clip_box_from_sources(lo, hi)
+ if (bubbles_lagrange .and. lag_supp_on) call s_amr_clip_box_from_supp(lo, hi, lag_supp_lo, lag_supp_hi)
+ if (ab_active) then
+ lo(1) = max(lo(1), ab_x%beg + 1); hi(1) = min(hi(1), ab_x%end - 1)
+ if (n_glb > 0) then; lo(2) = max(lo(2), ab_y%beg + 1); hi(2) = min(hi(2), ab_y%end - 1); end if
+ if (p_glb > 0) then; lo(3) = max(lo(3), ab_z%beg + 1); hi(3) = min(hi(3), ab_z%end - 1); end if
+ end if
+ if (any(lo /= boxes(k)%lo) .or. any(hi /= boxes(k)%hi)) then
+ call s_mpi_abort('amr regrid: a block must contain an immersed body AND stay ' &
+ & // 'clear of an acoustic source support / Lagrangian bubble cloud - the ' &
+ & // 'constraints conflict; move the body, source, or cloud apart')
+ end if
+ end do
+ end if
+ end if
+
+ end subroutine s_amr_regrid_shape_boxes
+
+ !> Regrid phase 3b: multi-level nesting - hierarchically append level-l child boxes (sensor-on-fine, parents-first) inside each
+ !! level-(l-1) box, for l = 2..amr_max_level. Sets box_level for every box (1 for the L0->L1 boxes).
+ impure subroutine s_amr_regrid_nest_children(boxes, nboxes, box_level)
+
+ type(t_box), allocatable, intent(inout) :: boxes(:)
+ integer, intent(inout) :: nboxes
+ integer, intent(inout) :: box_level(:)
+ integer :: i
+
+ ! 3b) multi-level nesting: hierarchically append a level-l box nested inside each level-(l-1) box, for l = 2..amr_max_level.
+ ! Parents-first ordering (every level-(l-1) box precedes its level-l children) so the build loop fills a parent before its
+ ! child's gather-from-parent reads it. SENSOR-ON-FINE: each child's extent is the density-gradient sensor run on the
+ ! parent-level FINE solution (the still-live OLD level-(l-1) blocks, read here BEFORE the step-5 stash), coarsened to
+ ! L0-cell
+ ! granularity and clustered - children track features inside the parent, not a fixed centre. A brand-new region with no old
+ ! fine data falls back to a centred inset (sensor takes over next regrid); a parent with a smooth fine solution gets no
+ ! child.
+ ! Tagging only places boxes - conservation (restrict/reflux) is independent of where they sit. np=1 + non-IB (multi-level
+ ! distribution / IB nesting are future work). Regions stay in L0 cell indices.
+
+ box_level(1:nboxes) = 1
+ if (amr_max_level >= 2) then
+ ! the nesting loop below APPENDS level-l child boxes into `boxes` (up to amr_max_blocks total). The non-IB path already
+ ! grew `boxes` to amr_max_blocks via the tiling move_alloc; the IB path (only merges, never grows) leaves `boxes` at the
+ ! cluster count, so grow it here or the child appends overrun the allocation.
+ if (size(boxes) < amr_max_blocks) then
+ block
+ type(t_box), allocatable :: grown(:)
+ allocate (grown(amr_max_blocks))
+ grown(1:nboxes) = boxes(1:nboxes)
+ call move_alloc(grown, boxes)
+ end block
+ end if
+ block
+ integer :: kb, ins(3), clo(3), chi(3), lev, plo, phi, newlo, ob, obi, ncb, kc, mlo(3), mhi(3)
+ integer :: mg, ng, pg, nct, np_lev, nloc_send, gi, gj, gk, ntot_g
+ integer(8) :: jrem !< decode remainder spans an xy plane, which can exceed 2**31 cells
+ integer, allocatable :: ctags(:,:), skb(:), gkb(:)
+ integer(8), allocatable :: sidx(:), gidx(:)
+ logical, allocatable :: gwin(:,:,:), covered(:)
+ !> S3.3c: does THIS rank hold any level-(lev-1) block overlapping parent kb? Only then does it need the parent's
+ !! dense window at all. `covered` stays REPLICATED (every rank must agree) and is recovered with ONE LOR reduction
+ !! over the parents: the union over ranks of "my blocks overlapping kb" is exactly "all blocks overlapping kb",
+ !! since each block has exactly one owner.
+ logical, allocatable :: mine(:)
+ integer, allocatable :: mlo_all(:,:), mhi_all(:,:)
+ logical :: any_tag
+ type(t_box), allocatable :: cboxes(:)
+ !> S3.3a: one rank CLUSTERS each parent's window instead of every rank clustering every parent. powner is the
+ !! assignment (replicated, computed with no communication); mych_* is this rank's own children, emitted without the
+ !! global slot cap because a rank cannot see the global count mid-pass; gch_* is the assembled global list. The
+ !! children are replayed into `boxes` in (kb, emission) order afterwards, which is exactly the order the serial loop
+ !! produced them in -- so the box list, its truncation at amr_max_fine, and box_level are unchanged.
+ integer, allocatable :: powner(:)
+ integer, allocatable :: mych(:,:) !< (7, n): lo(3), hi(3), kb
+ integer, allocatable :: gch(:,:)
+ integer :: nmych, ntot_ch, ich, jch
+ integer, allocatable :: chhead(:), chord(:) !< counting-sort scratch for the canonical child order
+ !> S3.3b: the pair exchange is TARGETED -- a rank sends each parent's tags only to that parent's owner, so send
+ !! volume is O(this rank's tagged cells) and receive volume O(its assigned parents' tags), instead of every rank
+ !! receiving every rank's pairs (the O(P) `gwin_bytes` term).
+ integer, allocatable :: phead(:), pord(:)
+ integer(8), allocatable :: tidx(:)
+ integer, allocatable :: tkb(:)
+#ifdef MFC_MPI
+ integer :: ierr, ip
+ integer, allocatable :: rcnt(:), rdsp(:), scnt(:), sdsp(:)
+#endif
+
+ ! host-refresh the live (old) blocks' conserved state: the fine sensor below reads the flat store on the host,
+ ! but the step-5 stash's GPU_UPDATE(host) runs AFTER this nesting - so the host copy is stale here
+ do ob = 1, amr_num_blocks
+ if (amr_block_level(ob) == 0) cycle ! L0 tiles are not regrid-managed and carry no fine sensor
+ if (.not. amr_owns_all(ob)) cycle ! np>1: only the owner holds this old block's fine state
+ $:GPU_UPDATE(host='[amr_cons_st(:, :, :, :, amr_loc_of(ob))]')
+ end do
+ ! Fine-sensor tags accumulate in a GLOBAL L0 frame: at np>1 an old block is read only by its owner, but its tag
+ ! footprint can fall in ANOTHER rank's subdomain. Each parent's nesting window [mlo:mhi] is small vs the global
+ ! grid,
+ ! so a WINDOW-LOCAL dense field gwin (per parent, below) holds each owner's tags; s_amr_pack_gwin_pairs extracts
+ ! them
+ ! as (linear-index, kb) pairs, one per-level allgatherv unions all parents' pairs across ranks, and pass 2 rebuilds
+ ! each parent's window from them (no O(global-grid) tag field, no local slice; the clusterer consumes the sparse
+ ! per-parent list directly).
+ mg = m_glb; ng = 0; pg = 0
+ if (n_glb > 0) ng = n_glb
+ if (p_glb > 0) pg = p_glb
+
+ plo = 1; phi = nboxes ! [plo:phi] = the boxes at the previous level (lev-1) to nest inside
+ do lev = 2, amr_max_level
+ newlo = nboxes + 1
+ ! COLLECT -> ONE COMMUNICATE -> PROCESS, per level: the per-parent cross-rank union is batched into a SINGLE
+ ! allgatherv per level, so the collective count is O(#levels) not O(#parent-boxes). Pass 1 tags each parent's
+ ! window from OWNED obs and appends this rank's tagged cells as (linear-index, parent-kb) pairs; one allgatherv
+ ! unions them; Pass 2 rebuilds each parent's dense window from the gathered pairs whose gkb==kb, reproducing the
+ ! old dense-window dedup and the (k,j,i) extraction order exactly -> each parent's ctags set (and thus its child
+ ! boxes) is byte-identical.
+ np_lev = phi - plo + 1
+ if (np_lev < 1) exit ! nothing nested at the previous level -> no deeper levels possible
+ allocate (covered(plo:phi), mlo_all(3,plo:phi), mhi_all(3,plo:phi), mine(plo:phi))
+ covered = .false.; mine = .false.
+ ! S3.3c: ONE pass over this rank's OWNED level-(lev-1) blocks, not `do ob = 1, amr_num_blocks` inside
+ ! `do kb = plo, phi`. That nested form was O(parents x GLOBAL blocks) on every rank -- both factors scale
+ ! with P, so it was the O(P^2) term in the regrid. Here the outer loop is O(local blocks) and `covered`,
+ ! which must stay replicated, is recovered with a single LOR over the parents.
+ call s_amr_refresh_my_blocks()
+ do obi = 1, amr_n_my
+ ob = amr_my_blk(obi)
+ if (amr_block_level(ob) /= lev - 1) cycle
+ do kb = plo, phi
+ if (boxes(kb)%lo(1) > amr_region_hi_all(1, ob) .or. boxes(kb)%hi(1) < amr_region_lo_all(1, ob)) cycle
+ if (n_glb > 0) then
+ if (boxes(kb)%lo(2) > amr_region_hi_all(2, ob) .or. boxes(kb)%hi(2) < amr_region_lo_all(2, &
+ & ob)) cycle
+ end if
+ if (p_glb > 0) then
+ if (boxes(kb)%lo(3) > amr_region_hi_all(3, ob) .or. boxes(kb)%hi(3) < amr_region_lo_all(3, &
+ & ob)) cycle
+ end if
+ mine(kb) = .true.; covered(kb) = .true.
+ end do
+ end do
+#ifdef MFC_MPI
+ if (num_procs > 1) call MPI_ALLREDUCE(MPI_IN_PLACE, covered, np_lev, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr)
+#endif
+ nloc_send = 0
+ ! S3.3a: assign each parent a clustering owner. Round-robin over kb both balances the parents across ranks
+ ! and is a pure function of kb and num_procs, so every rank agrees without communicating. Pass 2 below then
+ ! processes ONLY its own parents, which deletes the per-parent rescan of the whole gathered pair list
+ ! (O(parents x global tags) on EVERY rank) and the replicated clustering along with it.
+ allocate (powner(plo:phi), mych(7, amr_max_fine))
+ do kb = plo, phi
+ powner(kb) = mod(kb - plo, max(num_procs, 1))
+ end do
+ nmych = 0
+ ! Pass 1: collect (no comm)
+ do kb = plo, phi
+ ! nesting window: children keep an amr_cpat_mar margin from the parent boundary so their ghost
+ ! prolongation reads valid parent interior cells
+ mlo = boxes(kb)%lo; mhi = boxes(kb)%hi
+ mlo(1) = mlo(1) + amr_cpat_mar; mhi(1) = mhi(1) - amr_cpat_mar
+ if (n_glb > 0) then; mlo(2) = mlo(2) + amr_cpat_mar; mhi(2) = mhi(2) - amr_cpat_mar; end if
+ if (p_glb > 0) then; mlo(3) = mlo(3) + amr_cpat_mar; mhi(3) = mhi(3) - amr_cpat_mar; end if
+ mlo_all(:,kb) = mlo; mhi_all(:,kb) = mhi
+ if (mhi(1) < mlo(1)) cycle ! too small to nest a child in x
+ if (n_glb > 0 .and. mhi(2) < mlo(2)) cycle
+ if (p_glb > 0 .and. mhi(3) < mlo(3)) cycle
+
+ ! sensor-on-fine: tag from this rank's OWNED level-(lev-1) blocks overlapping the parent window
+ ! (amr_block_level still holds the old levels here - it is reset to box_level at step 5b, below).
+ ! S3.3c: `covered` and `mine` are already known from the pre-pass above, so this no longer scans the
+ ! global block list, and a rank with nothing to contribute allocates no dense window at all -- that
+ ! allocate+zero was O(parents x window volume) of pure waste on every non-contributing rank.
+ ! The parent's OWNER still builds a window when IB is on, because the body tags are its to add.
+ if (.not. (mine(kb) .or. (ib .and. powner(kb) == proc_rank))) cycle
+ allocate (gwin(mlo(1):mhi(1),mlo(2):mhi(2),mlo(3):mhi(3)))
+ gwin = .false.; any_tag = .false.
+ do obi = 1, amr_n_my
+ ob = amr_my_blk(obi)
+ if (amr_block_level(ob) /= lev - 1) cycle
+ if (boxes(kb)%lo(1) > amr_region_hi_all(1, ob) .or. boxes(kb)%hi(1) < amr_region_lo_all(1, ob)) cycle
+ if (n_glb > 0) then
+ if (boxes(kb)%lo(2) > amr_region_hi_all(2, ob) .or. boxes(kb)%hi(2) < amr_region_lo_all(2, &
+ & ob)) cycle
+ end if
+ if (p_glb > 0) then
+ if (boxes(kb)%lo(3) > amr_region_hi_all(3, ob) .or. boxes(kb)%hi(3) < amr_region_lo_all(3, &
+ & ob)) cycle
+ end if
+ call s_amr_tag_child_from_fine(ob, mlo, mhi, gwin, any_tag)
+ end do
+ ! IB: always refine the body region at this level, even where the density sensor is quiet - mark the body's
+ ! L0-frame bbox into gwin so it is clustered into a child (mirrors the L1 expand at :3836). Containment
+ ! margin
+ ! = max(amr_buf, 4) + amr_cpat_mar: the child window (mlo:mhi) is the parent inset by amr_cpat_mar, and
+ ! clamping the tag to that window can eat up to amr_cpat_mar of the body's stencil margin at the
+ ! parent-adjacent side. The parent (widened in s_amr_expand_box_over_bodies by
+ ! (amr_max_level-1)*amr_cpat_mar)
+ ! now clears the body enough that this window contains the body plus max(amr_buf, 4), so the tag survives
+ ! the
+ ! inset with a full image-point stencil of fluid on every side: the body SURFACE is refined at every level
+ ! and
+ ! the C/F boundary sits a full stencil off it, in fluid.
+ if (ib) then
+ block
+ integer :: ib_i, bb_lo(3), bb_hi(3), gii, gjj, gkk
+ do ib_i = 1, num_ibs
+ call s_amr_body_bbox(ib_i, max(amr_buf, 4) + amr_cpat_mar, bb_lo, bb_hi)
+ ! clamp the body bbox to this parent's nesting window (s_amr_body_bbox returns GLOBAL L0
+ ! cell indices, same frame as mlo/mhi)
+ bb_lo = max(bb_lo, mlo); bb_hi = min(bb_hi, mhi)
+ if (bb_hi(1) < bb_lo(1)) cycle
+ if (n_glb > 0 .and. bb_hi(2) < bb_lo(2)) cycle
+ if (p_glb > 0 .and. bb_hi(3) < bb_lo(3)) cycle
+ covered(kb) = .true.
+ do gkk = bb_lo(3), bb_hi(3)
+ do gjj = bb_lo(2), bb_hi(2)
+ do gii = bb_lo(1), bb_hi(1)
+ gwin(gii, gjj, gkk) = .true.
+ end do
+ end do
+ end do
+ end do
+ end block
+ end if
+ ! extract THIS rank's OWNED tagged cells as (linear-index, kb) pairs into the per-level send arrays. The
+ ! int8 linear index matches the pass-2 decode, so the gathered pairs reproduce the same window coords. gwin
+ ! is read, then freed.
+ call s_amr_pack_gwin_pairs(gwin, mlo, mhi, mg, ng, kb, sidx, skb, nloc_send)
+ deallocate (gwin)
+ end do
+
+ ! COMMUNICATE: one allgatherv per level (np>1)
+ if (.not. allocated(sidx)) then
+ allocate (sidx(0), skb(0)) ! this rank owned no tags at this level
+ end if
+#ifdef MFC_MPI
+ if (num_procs > 1) then
+ ! S3.3b: bucket this rank's pairs by the DESTINATION owner (stable counting sort -- pass 1 appends in
+ ! kb order, and round-robin ownership interleaves the destinations), then exchange only what each rank
+ ! actually needs. Pass 2 rebuilds a DENSE window and re-extracts in (k,j,i) order, so ctags does not
+ ! depend on the order pairs arrive in and the box set is unchanged.
+ allocate (rcnt(num_procs), rdsp(num_procs), scnt(num_procs), sdsp(num_procs))
+ allocate (phead(num_procs), pord(max(nloc_send, 1)))
+ phead = 0
+ do i = 1, nloc_send
+ ip = powner(skb(i)) + 1; phead(ip) = phead(ip) + 1
+ end do
+ scnt = phead
+ sdsp(1) = 0
+ do ip = 2, num_procs
+ sdsp(ip) = sdsp(ip - 1) + scnt(ip - 1)
+ end do
+ phead = sdsp + 1
+ do i = 1, nloc_send
+ ip = powner(skb(i)) + 1; pord(phead(ip)) = i; phead(ip) = phead(ip) + 1
+ end do
+ allocate (tidx(max(nloc_send, 1)), tkb(max(nloc_send, 1)))
+ do i = 1, nloc_send
+ tidx(i) = sidx(pord(i)); tkb(i) = skb(pord(i))
+ end do
+ call MPI_ALLTOALL(scnt, 1, MPI_INTEGER, rcnt, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ rdsp(1) = 0
+ do ip = 2, num_procs
+ rdsp(ip) = rdsp(ip - 1) + rcnt(ip - 1)
+ end do
+ ntot_g = rdsp(num_procs) + rcnt(num_procs)
+ amr_gb_win = amr_gb_win + int(ntot_g, 8)*(8_8 + 8_8) ! now the RECEIVED volume, i.e. O(local)
+ allocate (gidx(max(ntot_g, 1)), gkb(max(ntot_g, 1)))
+ call MPI_ALLTOALLV(tidx, scnt, sdsp, MPI_INTEGER8, gidx, rcnt, rdsp, MPI_INTEGER8, MPI_COMM_WORLD, ierr)
+ call MPI_ALLTOALLV(tkb, scnt, sdsp, MPI_INTEGER, gkb, rcnt, rdsp, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ deallocate (rcnt, rdsp, scnt, sdsp, phead, pord, tidx, tkb)
+ else
+ call move_alloc(sidx, gidx); call move_alloc(skb, gkb)
+ ntot_g = nloc_send
+ end if
+#else
+ call move_alloc(sidx, gidx); call move_alloc(skb, gkb)
+ ntot_g = nloc_send
+#endif
+ if (allocated(sidx)) deallocate (sidx)
+ if (allocated(skb)) deallocate (skb)
+
+ ! Pass 2: process (no comm). S3.3a: OWN PARENTS ONLY. The global `nboxes + 1 > amr_max_fine` guard cannot
+ ! be evaluated here any more -- a rank does not see the other ranks' children -- so children are emitted into
+ ! mych without a cap and the replay below applies the cap in the canonical order, which is the same order and
+ ! therefore the same truncation the serial loop performed.
+ do kb = plo, phi
+ if (powner(kb) /= proc_rank) cycle
+ if (nmych + 1 > amr_max_fine) exit ! local buffer full (bounded by the same global cap)
+ mlo = mlo_all(:,kb); mhi = mhi_all(:,kb)
+ if (mhi(1) < mlo(1)) cycle ! too small to nest a child in x
+ if (n_glb > 0 .and. mhi(2) < mlo(2)) cycle
+ if (p_glb > 0 .and. mhi(3) < mlo(3)) cycle
+
+ ! rebuild this parent's dense window from the gathered pairs whose gkb==kb: setting .true. once per gathered
+ ! cell reproduces the old per-parent dedup (replicated/overlapping tags collapse), and the (k,j,i) sparse
+ ! extract below matches the old scan order -> byte-identical ctags.
+ allocate (gwin(mlo(1):mhi(1),mlo(2):mhi(2),mlo(3):mhi(3)))
+ gwin = .false.
+ do i = 1, ntot_g
+ if (gkb(i) /= kb) cycle
+ gk = int(gidx(i)/(int(mg + 1, 8)*int(ng + 1, 8)))
+ jrem = gidx(i) - int(gk, 8)*int(mg + 1, 8)*int(ng + 1, 8)
+ gj = int(jrem/int(mg + 1, 8))
+ gi = int(jrem - int(gj, 8)*int(mg + 1, 8))
+ gwin(gi, gj, gk) = .true.
+ end do
+ nct = 0
+ do gk = mlo(3), mhi(3); do gj = mlo(2), mhi(2); do gi = mlo(1), mhi(1)
+ if (gwin(gi, gj, gk)) nct = nct + 1
+ end do; end do; end do
+ allocate (ctags(3, max(nct, 1)))
+ nct = 0
+ do gk = mlo(3), mhi(3); do gj = mlo(2), mhi(2); do gi = mlo(1), mhi(1)
+ if (gwin(gi, gj, gk)) then
+ nct = nct + 1
+ ctags(1, nct) = gi; ctags(2, nct) = gj; ctags(3, nct) = gk
+ end if
+ end do; end do; end do
+ deallocate (gwin)
+ any_tag = nct > 0
+
+ ! smooth here - no child
+ if (covered(kb) .and. .not. any_tag) then; deallocate (ctags); cycle; end if
+
+ if (covered(kb)) then
+ ! cluster the fine-tagged L0 cells into child boxes, pad by amr_buf, clamp into the nesting window
+ call s_amr_cluster(ctags, nct, cboxes, ncb, .false.) ! ctags is already replicated on every rank
+ deallocate (ctags)
+ do kc = 1, ncb
+ if (nboxes + 1 > amr_max_fine) exit
+ clo = cboxes(kc)%lo; chi = cboxes(kc)%hi
+ clo(1) = max(clo(1) - amr_buf, mlo(1)); chi(1) = min(chi(1) + amr_buf, mhi(1))
+ if (n_glb > 0) then
+ clo(2) = max(clo(2) - amr_buf, mlo(2)); chi(2) = min(chi(2) + amr_buf, mhi(2))
+ else
+ clo(2) = 0; chi(2) = 0
+ end if
+ if (p_glb > 0) then
+ clo(3) = max(clo(3) - amr_buf, mlo(3)); chi(3) = min(chi(3) + amr_buf, mhi(3))
+ else
+ clo(3) = 0; chi(3) = 0
+ end if
+ ! IB: a child clustered from the (widened) body tag must fully contain every overlapping body -
+ ! expand over bodies (mirrors the L1 expand at :3836), then re-clamp to the nesting window so the
+ ! child stays nested. Because the parent was widened by (amr_max_level-1)*amr_cpat_mar, its nesting
+ ! window (mlo:mhi) already contains the body plus max(amr_buf, 4), so the re-clamp does NOT cut the
+ ! body's stencil: the child CONTAINS the body bbox and the C/F boundary lands a full image-point
+ ! stencil off the surface, in fluid (surface refined, not just the interior).
+ if (ib) then
+ call s_amr_expand_box_over_bodies(clo, chi)
+ clo(1) = max(clo(1), mlo(1)); chi(1) = min(chi(1), mhi(1))
+ if (n_glb > 0) then; clo(2) = max(clo(2), mlo(2)); chi(2) = min(chi(2), mhi(2)); end if
+ if (p_glb > 0) then; clo(3) = max(clo(3), mlo(3)); chi(3) = min(chi(3), mhi(3)); end if
+ end if
+ ! slot cap: a level-lev block's fine grid spans amr_ref_ratio**lev*(its L0 extent) cells while the
+ ! slot holds amr_ref_ratio*amr_maxc_fit (max_f* = amr_ref_ratio*amr_maxc_fit - 1), so a child's L0
+ ! extent must be <= amr_maxc_fit/amr_ref_ratio**(lev-1) - HALVING once per level, not a fixed /2.
+ ! At lev = 2 that is amr_maxc_fit/2 (unchanged); at lev = 3 a fixed /2 admits a box twice what the
+ ! slot holds. VERIFIED to fail without this: m = 255, amr_max_level = 3, amr_buf = 48, np = 1 -
+ ! the fixed /2 keeps ONE oversized level-3 box where this keeps 2, and the run dies in
+ ! s_amr_free_slot ("Invalid descriptor", core dumped) on the corrupted field descriptor. It takes
+ ! all three of a big grid, depth 3 AND a wide buffer: boxes track the FEATURE, so scaling only the
+ ! grid leaves them far below either cap and both versions agree.
+ ! TILE a wider feature into adjacent sub-blocks (like the L1 tiling): the per-stage
+ ! fine-fine halo
+ ! (s_amr_fine_fine_halo, level-aware) matches the shared seam flux and the L2->L1 reflux skips those
+ ! fine-fine faces. Subcycle used to keep ONE capped child instead - under-refining a wide feature -
+ ! because s_amr_advance_children advanced children per-block with no L2-L2 halo; it now advances
+ ! siblings transposed with the level-filtered halo interposed, so both drivers tile alike.
+ block
+ type(t_box) :: l2t(amr_max_blocks)
+ integer :: nl2, cpd, it
+ nl2 = 0; cpd = 0
+ call s_amr_tile_box(clo, chi, l2t, nl2, amr_max_blocks, cpd, &
+ & amr_maxc_fit/amr_ref_ratio**(lev - 1))
+ do it = 1, nl2
+ if (nmych + 1 > amr_max_fine) exit
+ nmych = nmych + 1
+ mych(1:3,nmych) = l2t(it)%lo; mych(4:6,nmych) = l2t(it)%hi; mych(7, nmych) = kb
+ end do
+ end block
+ end do
+ if (allocated(cboxes)) deallocate (cboxes)
+ else
+ deallocate (ctags) ! brand-new region: no fine tags to cluster
+ ! brand-new region (no old fine data yet): centred inset so the child still appears this regrid
+ ins = 0
+ ins(1) = max((boxes(kb)%hi(1) - boxes(kb)%lo(1) + 1)/4, amr_cpat_mar)
+ if (n_glb > 0) ins(2) = max((boxes(kb)%hi(2) - boxes(kb)%lo(2) + 1)/4, amr_cpat_mar)
+ if (p_glb > 0) ins(3) = max((boxes(kb)%hi(3) - boxes(kb)%lo(3) + 1)/4, amr_cpat_mar)
+ clo = boxes(kb)%lo + ins; chi = boxes(kb)%hi - ins
+ if (chi(1) < clo(1)) cycle ! inset left no interior in x
+ if (n_glb > 0 .and. chi(2) < clo(2)) cycle
+ if (p_glb > 0 .and. chi(3) < clo(3)) cycle
+ ! Tile to the SAME slot cap as the clustered path above. The inset bounds the child as a FRACTION of
+ ! its parent, which is not the constraint that matters: the slot coord arrays are allocated once to
+ ! amr_ref_ratio*amr_maxc_fit, so the child must be bounded in ABSOLUTE cells. A parent of span 63
+ ! (an ordinary tile - s_amr_tile_box splits a wide region into 63 and 64, not 64 and 64) gives
+ ! ins = 63/4 = 15 and a child of span 33 against a level-2 cap of 32; s_amr_build_block_coords then
+ ! sizes fcb from the TRUE extent and writes one past x_cb. Span 64 gives exactly 32 and is fine, so a
+ ! one-cell difference in the parent flipped it.
+ block
+ type(t_box) :: nrt(amr_max_blocks)
+ integer :: nnr, nrc, it2
+ nnr = 0; nrc = 0
+ call s_amr_tile_box(clo, chi, nrt, nnr, amr_max_blocks, nrc, amr_maxc_fit/amr_ref_ratio**(lev - 1))
+ do it2 = 1, nnr
+ if (nmych + 1 > amr_max_fine) exit
+ nmych = nmych + 1
+ mych(1:3,nmych) = nrt(it2)%lo; mych(4:6,nmych) = nrt(it2)%hi; mych(7, nmych) = kb
+ end do
+ end block
+ end if
+ end do
+
+ ! S3.3a: assemble the children. Every parent has exactly ONE owner and that owner emitted its children in
+ ! order, so ONE allgatherv of the child BOXES (7 ints each: lo, hi, parent kb -- per-box global data, which
+ ! the endstate permits, ~67 KB against the 144 MB per-cell gather above) plus a STABLE sort by kb reproduces
+ ! the (kb ascending, emission) order the serial loop appended in. Box list, truncation at amr_max_fine and
+ ! box_level are therefore unchanged -- the gate for this increment is bit-identity.
+#ifdef MFC_MPI
+ if (num_procs > 1) then
+ allocate (rcnt(num_procs), rdsp(num_procs))
+ call MPI_ALLGATHER(nmych, 1, MPI_INTEGER, rcnt, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ rdsp(1) = 0
+ do ip = 2, num_procs
+ rdsp(ip) = rdsp(ip - 1) + rcnt(ip - 1)
+ end do
+ ntot_ch = rdsp(num_procs) + rcnt(num_procs)
+ allocate (gch(7, max(ntot_ch, 1)))
+ rcnt = rcnt*7; rdsp = rdsp*7
+ call MPI_ALLGATHERV(mych, nmych*7, MPI_INTEGER, gch, rcnt, rdsp, MPI_INTEGER, MPI_COMM_WORLD, ierr)
+ amr_gb_box = amr_gb_box + int(ntot_ch, 8)*7_8*4_8 ! likewise: the whole global child list
+ deallocate (rcnt, rdsp)
+ else
+ ntot_ch = nmych
+ allocate (gch(7, max(ntot_ch, 1))); gch(:,1:ntot_ch) = mych(:,1:ntot_ch)
+ end if
+#else
+ ntot_ch = nmych
+ allocate (gch(7, max(ntot_ch, 1))); gch(:,1:ntot_ch) = mych(:,1:ntot_ch)
+#endif
+ ! stable counting sort by parent kb
+ allocate (chhead(plo:phi), chord(max(ntot_ch, 1)))
+ chhead = 0
+ do ich = 1, ntot_ch
+ chhead(gch(7, ich)) = chhead(gch(7, ich)) + 1
+ end do
+ jch = 1
+ do kb = plo, phi
+ ich = chhead(kb); chhead(kb) = jch; jch = jch + ich
+ end do
+ do ich = 1, ntot_ch
+ kb = gch(7, ich)
+ chord(chhead(kb)) = ich; chhead(kb) = chhead(kb) + 1
+ end do
+ do jch = 1, ntot_ch
+ ich = chord(jch)
+ if (nboxes + 1 > amr_max_fine) exit ! pool full - stop nesting (same order, same truncation)
+ nboxes = nboxes + 1
+ boxes(nboxes)%lo = gch(1:3,ich); boxes(nboxes)%hi = gch(4:6,ich)
+ box_level(nboxes) = lev
+ end do
+ deallocate (gch, chhead, chord, powner, mych)
+
+ deallocate (gidx, gkb, covered, mine, mlo_all, mhi_all) ! per-level scratch - freed every level
+ plo = newlo; phi = nboxes ! the boxes just appended are the parents for the next level
+ if (phi < plo) exit ! nothing nested at this level -> no deeper levels possible
+ end do
+ if (nboxes >= amr_max_fine .and. proc_rank == 0) print '(A)', &
+ & ' [amr] NOTE: block pool full during multi-level nesting; some boxes were not refined further'
+ end block
+ end if
+
+ end subroutine s_amr_regrid_nest_children
+
+ ! 4) unchanged? (same count, boxes AND levels as the live slots -> keep them; a rebuild would reproduce them exactly).
+ ! The level must be compared too: a box that keeps its coordinates but changes refinement level would otherwise slip
+ ! through with a stale amr_block_level, corrupting the level-aware coupling.
+ impure subroutine s_amr_regrid_boxes_unchanged(boxes, nboxes, box_level, same)
+
+ type(t_box), intent(in) :: boxes(:)
+ integer, intent(in) :: nboxes, box_level(:)
+ logical, intent(out) :: same
+ integer :: k, ks
+
+ ! regrid manages only the FINE band [l0_slot_off+1 ..] of the shared pool; the level-0 L0-tile prefix (coexist) is not
+ ! part of the box set, so compare against the fine block count and index slots through f_l0_slot.
+
+ same = .false.
+ if (nboxes == amr_num_blocks - l0_slot_off) then
+ same = .true.
+ do k = 1, nboxes
+ ks = f_l0_slot(k)
+ if (any(boxes(k)%lo /= amr_slots(ks)%region%lo) .or. any(boxes(k)%hi /= amr_slots(ks)%region%hi) .or. box_level(k) &
+ & /= amr_block_level(ks)) same = .false.
+ end do
+ end if
+
+ end subroutine s_amr_regrid_boxes_unchanged
+
+ !> DEVICE pack of an owned old block's stash into the migration wire buffer (wp wire, stp store): the store is
+ !! device-authoritative during the rebuild, so pack where the data lives; the copyout hands the host MPI buffer back as one
+ !! contiguous transfer of exactly the interior. Wire layout (gi fastest, then gj, gk, ii) matches the old host pack
+ !! byte-for-byte, so the message set and [amr-xa] F4 totals are unchanged.
+ impure subroutine s_amr_mig_pack_device(loc, e1, e2, e3, buf)
+
+ integer, intent(in) :: loc, e1, e2, e3
+ real(wp), intent(inout), contiguous :: buf(:)
+ integer :: ii, gk, gj, gi, n1, n2, n3
+
+ n1 = e1 + 1; n2 = e2 + 1; n3 = e3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyout='[buf]')
+ do ii = 1, sys_size
+ do gk = 0, e3
+ do gj = 0, e2
+ do gi = 0, e1
+ buf(1 + gi + n1*(gj + n2*(gk + n3*(ii - 1)))) = real(amr_stor_st(gi, gj, gk, ii, loc), wp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_mig_pack_device
+
+ !> DEVICE unpack of a received old block into its stash replica (mirror of the pack; the copyin stages the wire buffer).
+ !! Replaces the host cast loop AND the full-slot device push it required.
+ impure subroutine s_amr_mig_unpack_device(loc, e1, e2, e3, buf)
+
+ integer, intent(in) :: loc, e1, e2, e3
+ real(wp), intent(in), contiguous :: buf(:)
+ integer :: ii, gk, gj, gi, n1, n2, n3
+
+ n1 = e1 + 1; n2 = e2 + 1; n3 = e3 + 1
+ $:GPU_PARALLEL_LOOP(collapse=4, copyin='[buf]')
+ do ii = 1, sys_size
+ do gk = 0, e3
+ do gj = 0, e2
+ do gi = 0, e1
+ amr_stor_st(gi, gj, gk, ii, loc) = real(buf(1 + gi + n1*(gj + n2*(gk + n3*(ii - 1)))), stp)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_mig_unpack_device
+
+ !> DEVICE cons->stor stash copy of one owned old block's fine interior (the store is device-authoritative; no host staging).
+ impure subroutine s_amr_stash_copy_device(loc, e1, e2, e3)
+
+ integer, intent(in) :: loc, e1, e2, e3
+ integer :: ii, gk, gj, gi
+
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do ii = 1, sys_size
+ do gk = 0, e3
+ do gj = 0, e2
+ do gi = 0, e1
+ amr_stor_st(gi, gj, gk, ii, loc) = amr_cons_st(gi, gj, gk, ii, loc)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_stash_copy_device
+
+ !> DEVICE overlap carry-forward: overwrite the new block's prolonged cons (slot column vloc, extents vm/vn/vp) with the covering
+ !! old block's stashed fine detail (column vold, extents ve*), shifted by sh. Guards mirror the old host loop.
+ impure subroutine s_amr_overlap_copy_device(vloc, vold, vm, vn, vp, sh, ve1, ve2, ve3)
+
+ integer, intent(in) :: vloc, vold, vm, vn, vp, sh(3), ve1, ve2, ve3
+ integer :: i, fi, fj, fk, ofi, ofj, ofk, sh1, sh2, sh3
+ logical :: vd2, vd3
+
+ sh1 = sh(1); sh2 = sh(2); sh3 = sh(3)
+ vd2 = n_glb > 0; vd3 = p_glb > 0
+ $:GPU_PARALLEL_LOOP(collapse=4, private='[ofi, ofj, ofk]')
+ do i = 1, sys_size
+ do fk = 0, vp
+ do fj = 0, vn
+ do fi = 0, vm
+ ofk = fk + sh3; ofj = fj + sh2; ofi = fi + sh1
+ if (vd3 .and. (ofk < 0 .or. ofk > ve3)) cycle
+ if (vd2 .and. (ofj < 0 .or. ofj > ve2)) cycle
+ if (ofi < 0 .or. ofi > ve1) cycle
+ amr_cons_st(fi, fj, fk, i, vloc) = amr_stor_st(ofi, ofj, ofk, i, vold)
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ end subroutine s_amr_overlap_copy_device
+
+ !> Regrid phase 5: stash every live slot's fine interior (dead-between-steps q_cons_stor bounce), record the old block set
+ !! (old_*), commit the new regions/levels/owners, and migrate each stashed old block point-to-point to the ranks that now own an
+ !! overlapping new block.
+ impure subroutine s_amr_regrid_stash_migrate(boxes, nboxes, box_level, old_np, old_ilo, old_ext, old_level, old_owns)
+
+ type(t_box), intent(in) :: boxes(:)
+ integer, intent(in) :: nboxes, box_level(:)
+ integer, intent(out) :: old_np, old_ilo(:,:), old_ext(:,:), old_level(:)
+ logical, intent(out) :: old_owns(:)
+ integer :: old_chi(3, amr_max_blocks), old_owner(amr_max_blocks)
+ integer :: k, i, ks
+ integer :: np_l !< local mirror of old_np: an INTENT(OUT) dummy is not allowed in the
+ ! BLOCK specification expressions below (F2018 restricted expressions)
+
+ ! 5) stash every live slot's fine interior (dead-between-steps q_cons_stor bounce), keeping its old intersection origin
+
+ ! old_* are indexed in the regrid's own dense FINE-block space [1..old_np], which maps to shared-pool slot f_l0_slot(k);
+ ! under coexist the level-0 L0-tile prefix [1..l0_slot_off] is not regrid-managed and must not be stashed or migrated.
+
+ call s_phase_tic(PH_RGPART)
+ old_np = amr_num_blocks - l0_slot_off
+ np_l = old_np
+ do k = 1, old_np
+ ks = f_l0_slot(k)
+ ! GLOBAL block origin + extents (replicated, valid on every rank - not the owner-only isect), so the cross-rank
+ ! migration below and the overlap-copy's index shift are correct even where this rank did not own the old block
+ old_ilo(:,k) = amr_region_lo_all(:,ks)
+ old_chi(:,k) = amr_region_hi_all(:,ks) ! old COARSE hi (for the P2P migration overlap test below)
+ ! fine extent = (2**level)*footprint - 1: a level-2 block is 4x its L0 footprint, so stashing/migrating it with the
+ ! level-1 factor (2x) truncates half its fine cells. Level-1 blocks (2**1 = 2) are byte-identical to before.
+ old_ext(1, k) = (amr_ref_ratio**amr_block_level(ks))*(amr_region_hi_all(1, ks) - amr_region_lo_all(1, ks) + 1) - 1
+ old_ext(2, k) = merge((amr_ref_ratio**amr_block_level(ks))*(amr_region_hi_all(2, ks) - amr_region_lo_all(2, &
+ & ks) + 1) - 1, 0, n_glb > 0)
+ old_ext(3, k) = merge((amr_ref_ratio**amr_block_level(ks))*(amr_region_hi_all(3, ks) - amr_region_lo_all(3, &
+ & ks) + 1) - 1, 0, p_glb > 0)
+ old_owner(k) = amr_block_owner(ks)
+ ! overlap-copy must match levels: an old L2's stash is in the 4x parent-fine frame
+ old_level(k) = amr_block_level(ks)
+ old_owns(k) = amr_owns_all(ks)
+ if (old_owns(k)) then
+ ! DEVICE-side stash: the store is device-authoritative, so copy cons->stor where the data lives instead of
+ ! staging two full-slot transfers through the host (the old pull/host-copy/push). A mid-rebuild grow's
+ ! device->host round trip preserves this stash by construction (s_amr_st_reserve's contract); the host
+ ! mirror of amr_stor_st stays stale, which is fine - the migration pack and the overlap carry-forward
+ ! below are device kernels now and no host reader of the stash remains. (The kernel lives in its own
+ ! subroutine: amdflang drops target regions nested in BLOCK constructs from the device image - the host
+ ! registers them and the first launch dies on HSA_STATUS_ERROR_INVALID_SYMBOL_NAME.)
+ call s_amr_stash_copy_device(amr_loc_of(ks), old_ext(1, k), old_ext(2, k), old_ext(3, k))
+ ! non-polytropic QBMM: the side-state bounces through pb/mv_stor exactly like q_cons (both stors are dead between
+ ! steps)
+ if (qbmm .and. .not. polytropic) then
+ $:GPU_UPDATE(host='[amr_slots(ks)%pb_f%sf, amr_slots(ks)%mv_f%sf]')
+ amr_slots(ks)%pb_stor%sf(0:old_ext(1, k),0:old_ext(2, k),0:old_ext(3, k),:, &
+ & :) = amr_slots(ks)%pb_f%sf(0:old_ext(1, k),0:old_ext(2, k),0:old_ext(3, k),:,:)
+ amr_slots(ks)%mv_stor%sf(0:old_ext(1, k),0:old_ext(2, k),0:old_ext(3, k),:, &
+ & :) = amr_slots(ks)%mv_f%sf(0:old_ext(1, k),0:old_ext(2, k),0:old_ext(3, k),:,:)
+ end if
+ end if
+ end do
+ ! coarse pb/mv host-current for the per-block re-prolongation below
+ if (qbmm .and. .not. polytropic) then
+ $:GPU_UPDATE(host='[pb_ts(1)%sf, mv_ts(1)%sf]')
+ end if
+
+ ! set the regions + assign owners BEFORE the migration (P2P needs the new owners) and before the owner-dependent
+ ! geometry (else s_set_amr_fine_geometry sizes the whole-block owner from a stale amr_block_owner)
+ ! the fine band ends at f_l0_slot(nboxes); the level-0 tile prefix below it keeps its regions, levels and owners (a plain
+ ! nboxes here is what overran the prefix and deadlocked the first regrid under coexist)
+ amr_num_blocks = f_l0_slot(nboxes)
+ do k = 1, nboxes
+ ks = f_l0_slot(k)
+ amr_region_lo_all(:,ks) = boxes(k)%lo; amr_region_hi_all(:,ks) = boxes(k)%hi
+ ! box_level(k) is the refinement level assigned during the hierarchical nesting above (1 for L0->L1 boxes, l for a
+ ! box nested at level l). Setting it every regrid resets a stale level when a slot is reused across levels.
+ amr_block_level(ks) = box_level(k)
+ end do
+ ! block set changed: dirty the cached seam-pair AND overlap-rank lists NOW - the rebuild's per-block P2P gathers
+ ! (s_amr_regrid_rebuild_slots) consume the overlap lists with the NEW boxes, so flagging after them would be too late
+ amr_seam_pairs_dirty = .true.
+ amr_mesh_epoch = amr_mesh_epoch + 1
+ ! Proper-nesting guard: each level>=2 block must be covered by EXACTLY ONE parent-level block. f_amr_parent_block (and
+ ! the gather/reflux that key off it) take the FIRST overlap, so a fine tile straddling two parent tiles - an internal
+ ! parent-level tile seam crossed by a nested feature - would silently couple to only one parent (wrong coarse BC + a
+ ! conservation leak on the other). Abort fail-closed instead. Replicated boxes -> every rank aborts together.
+ block
+ integer :: bk, bkk, npar
+ do bk = 1, nboxes
+ if (box_level(bk) < 2) cycle
+ npar = 0
+ do bkk = 1, nboxes
+ if (box_level(bkk) == box_level(bk) - 1 .and. f_amr_boxes_overlap(boxes(bk)%lo, boxes(bk)%hi, boxes(bkk)%lo, &
+ & boxes(bkk)%hi)) npar = npar + 1
+ end do
+ if (npar /= 1) call s_mpi_abort('amr multi-level: a level>=2 block overlaps more than one (or no) ' &
+ & // 'parent-level block - a fine tile straddling a parent-tile seam is unsupported (gather/reflux ' &
+ & // 'couple to a single parent); reduce max_grid_size or the refined feature extent')
+ end do
+ end block
+ amr_num_levels = maxval(box_level(1:nboxes))
+ call s_amr_assign_block_owners()
+ ! The partition is decided here and NOTHING has moved yet; everything below redistributes data.
+ call s_phase_toc(PH_RGPART)
+ call s_phase_tic(PH_RGMOVE)
+
+#ifdef MFC_MPI
+ ! Cross-rank fine-state migration: the overlap-copy below preserves each covering old block's fine detail by reading
+ ! amr_slots(kk)%q_cons_stor, but an old block may be owned by a rank OTHER than the one now owning a covering new block.
+ ! POINT-TO-POINT (mirrors s_amr_gather_coarse_patch): each old owner sends its stashed fine state ONLY to the distinct
+ ! new-block owners whose region overlaps that old block. A rank that did not receive old block kk never reads it - the
+ ! overlap-copy's per-(k,kk) index guard skips every cell of a non-overlapping pair. No-op at np=1 (single owner, local).
+ if (num_procs > 1) then
+ block
+ integer :: kk, k2, ierr2, rr, nrq
+ integer :: cnt(np_l), scol(np_l), rcol(np_l)
+ integer :: nsnd, nrcv, nsreq, maxsnd, maxrcv
+ logical :: getk(np_l), isdest(0:num_procs - 1)
+ real(wp), allocatable :: spack(:,:), rpack(:,:)
+ integer, allocatable :: rq(:)
+ ! I4a right-sizing: pack/request pools sized to the blocks ACTUALLY sent/received, not old_np columns of the
+ ! largest block each plus an O(old_np x ranks) request array - at production counts those allocated GBs per
+ ! regrid for a handful of live columns. Message set, sizes, tags, and order are UNCHANGED (byte-exact gate:
+ ! identical [amr-xa] F4 totals).
+ nrcv = 0; maxrcv = 0
+ do kk = 1, old_np
+ cnt(kk) = sys_size*(old_ext(1, kk) + 1)*(old_ext(2, kk) + 1)*(old_ext(3, kk) + 1)
+ ! I need old block kk iff I own a NEW block overlapping it (and do not already hold kk locally)
+ getk(kk) = .false.
+ rcol(kk) = 0
+ if (.not. old_owns(kk)) then
+ do k2 = 1, nboxes
+ if (amr_block_owner(f_l0_slot(k2)) == proc_rank .and. f_amr_boxes_overlap(boxes(k2)%lo, boxes(k2)%hi, &
+ & old_ilo(:,kk), old_chi(:,kk))) then
+ getk(kk) = .true.; exit
+ end if
+ end do
+ end if
+ if (getk(kk)) then
+ nrcv = nrcv + 1; rcol(kk) = nrcv; maxrcv = max(maxrcv, cnt(kk))
+ end if
+ end do
+ ! pre-pass over my owned blocks: which are sent anywhere, and how many sends in total (sizes rq exactly)
+ nsnd = 0; nsreq = 0; maxsnd = 0
+ do kk = 1, old_np
+ scol(kk) = 0
+ if (.not. old_owns(kk)) cycle
+ isdest = .false.
+ do k2 = 1, nboxes
+ rr = amr_block_owner(f_l0_slot(k2))
+ if (rr /= proc_rank .and. f_amr_boxes_overlap(boxes(k2)%lo, boxes(k2)%hi, old_ilo(:,kk), old_chi(:, &
+ & kk))) isdest(rr) = .true.
+ end do
+ if (.not. any(isdest)) cycle
+ nsnd = nsnd + 1; scol(kk) = nsnd; maxsnd = max(maxsnd, cnt(kk))
+ nsreq = nsreq + count(isdest)
+ end do
+ ! a received old block needs a live slot to unpack its q_cons_stor into (freed by the rebuild's early-free or
+ ! the reconcile below) - STASH-ONLY: a replica never touches q_prim/rhs, and full slots across the np-scaled
+ ! replica set of a migration-heavy regrid are what OOMed the W8 gate's np=4 arm
+ call s_phase_tic(PH_MGSLOT)
+ call s_amr_prereserve_stash(getk, old_np)
+ do kk = 1, old_np
+ if (getk(kk)) call s_amr_alloc_slot_stash(f_l0_slot(kk))
+ end do
+ call s_phase_toc(PH_MGSLOT)
+ allocate (rq(max(nsreq + nrcv, 1)), spack(max(maxsnd, 1), max(nsnd, 1)), rpack(max(maxrcv, 1), max(nrcv, 1)))
+ nrq = 0
+ do kk = 1, old_np ! post receives for the old blocks I need
+ if (.not. getk(kk)) cycle
+ nrq = nrq + 1
+ call s_xa_rec(XA_F4_RCV, 2, cnt(kk), kk)
+ call MPI_IRECV(rpack(1, rcol(kk)), cnt(kk), mpi_p, old_owner(kk), kk, MPI_COMM_WORLD, rq(nrq), ierr2)
+ end do
+ call s_phase_tic(PH_MGPACK)
+ do kk = 1, old_np ! pack + send each old block I own to every distinct new-owner (/= me) overlapping it
+ if (scol(kk) == 0) cycle ! not mine, or no remote destination (pre-pass above)
+ isdest = .false.
+ do k2 = 1, nboxes
+ rr = amr_block_owner(f_l0_slot(k2))
+ if (rr /= proc_rank .and. f_amr_boxes_overlap(boxes(k2)%lo, boxes(k2)%hi, old_ilo(:,kk), old_chi(:, &
+ & kk))) isdest(rr) = .true.
+ end do
+ amr_mig_blk = amr_mig_blk + 1_8
+ call s_amr_mig_pack_device(amr_loc_of(f_l0_slot(kk)), old_ext(1, kk), old_ext(2, kk), old_ext(3, kk), &
+ & spack(1:cnt(kk),scol(kk)))
+ do rr = 0, num_procs - 1
+ if (.not. isdest(rr)) cycle
+ nrq = nrq + 1
+ amr_mig_snd = amr_mig_snd + 1_8
+ amr_gb_mig = amr_gb_mig + int(cnt(kk), 8)*8_8
+ call s_xa_rec(XA_F4_SND, 1, cnt(kk), kk)
+ call MPI_ISEND(spack(1, scol(kk)), cnt(kk), mpi_p, rr, kk, MPI_COMM_WORLD, rq(nrq), ierr2)
+ end do
+ end do
+ call s_phase_toc(PH_MGPACK)
+ call s_phase_tic(PH_MGWAIT)
+ if (nrq > 0) call MPI_WAITALL(nrq, rq, MPI_STATUSES_IGNORE, ierr2)
+ call s_phase_toc(PH_MGWAIT)
+ do kk = 1, old_np ! unpack the received old blocks into their replicated q_cons_stor slots (DEVICE-direct:
+ ! the copyin stages exactly the packed interior, and the replica lands device-side where the store is
+ ! authoritative - no host cast loop and no full-slot push, and a mid-rebuild grow preserves it)
+ if (.not. getk(kk)) cycle
+ call s_phase_tic(PH_MGUNPK)
+ call s_amr_mig_unpack_device(amr_loc_of(f_l0_slot(kk)), old_ext(1, kk), old_ext(2, kk), old_ext(3, kk), &
+ & rpack(1:cnt(kk),rcol(kk)))
+ call s_phase_toc(PH_MGUNPK)
+ end do
+ deallocate (rq, spack, rpack)
+ end block
+ end if
+#endif
+ call s_phase_toc(PH_RGMOVE) ! outside MFC_MPI so the bracket is balanced in serial builds
+
+ end subroutine s_amr_regrid_stash_migrate
+
+ !> Regrid phase 6: build each new slot - geometry (collective), prolong from coarse, overwrite the overlap from every covering
+ !! stashed old block - then reconcile the slot pool, rebuild the fine IB state, and re-validate the seam topology.
+ impure subroutine s_amr_regrid_rebuild_slots(q_cons_base, boxes, nboxes, old_np, old_ilo, old_ext, old_level, old_owns)
+
+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_base
+ type(t_box), intent(in) :: boxes(:)
+ integer, intent(in) :: nboxes, old_np, old_ilo(:,:), old_ext(:,:), old_level(:)
+ logical, intent(in) :: old_owns(:)
+ integer :: sh(3), k, kk, i, fi, fj, fk, ofi, ofj, ofk, ks, kks, ohi(3)
+ integer :: c_lo, c_hi
+ integer, allocatable :: last_use(:)
+
+ ! 6) build each new slot: geometry (collective on all ranks), prolong, then overlap-copy from every covering old slot
+ ! box k lives in shared-pool slot ks = f_l0_slot(k) (identity without L0 tiles); old block kk in slot kks
+
+ ! W8 transient: last_use(kk) = the last new box whose region overlaps old block kk, i.e. the last iteration whose
+ ! overlap-copy (or pbmv copy) can read kk's stash. Holding EVERY stashed/received old block until the reconcile is
+ ! what peaks device memory at np >= 2 - the replica count grows with np - so old-only slots are freed as soon as
+ ! their last covering box is built (the loop below), and the freed dense indices recycle into the very next allocs.
+ ! Region overlap (all regions are L0-cell coords at every level) is a superset of every per-cell stash read.
+
+ allocate (last_use(old_np)); last_use = 0
+ do kk = 1, old_np
+ ohi = old_ilo(:,kk)
+ ohi(1) = ohi(1) + (old_ext(1, kk) + 1)/amr_ref_ratio**old_level(kk) - 1
+ if (n_glb > 0) ohi(2) = ohi(2) + (old_ext(2, kk) + 1)/amr_ref_ratio**old_level(kk) - 1
+ if (p_glb > 0) ohi(3) = ohi(3) + (old_ext(3, kk) + 1)/amr_ref_ratio**old_level(kk) - 1
+ do k = 1, nboxes
+ if (f_amr_boxes_overlap(boxes(k)%lo, boxes(k)%hi, old_ilo(:,kk), ohi)) last_use(kk) = k
+ end do
+ end do
+
+ ! gather-batching step 1: derive the whole loop's gather message set up front; step 2 executes the exchange from it
+ call s_amr_build_gather_plan(nboxes)
+
+ c_lo = 1
+ do k = 1, nboxes
+ ! gather-batching step 2 (amr_regrid_gather_batching.md): at each chunk boundary, pre-post the chunk's recvs and
+ ! issue its sends (level>=2 sends whose parent shares the chunk are deferred to the child's consume below), so the
+ ! per-box rendezvous becomes one wait per owned box against an exchange already in flight
+ if (mod(k - 1, amr_gath_chunk) == 0) then
+ c_lo = k; c_hi = min(k + amr_gath_chunk - 1, nboxes)
+ call s_phase_tic(PH_RBGATH)
+ call s_amr_gather_chunk_post(c_lo, c_hi)
+ call s_amr_gather_chunk_send(q_cons_base, c_lo, c_hi)
+ call s_phase_toc(PH_RBGATH)
+ end if
+ ! free the old-only slots consumed by iterations before this one (last_use = k - 1 fires exactly once; a slot
+ ! serving as a NEW owned box keeps living - the reconcile decides it)
+ do kk = 1, old_np
+ if (last_use(kk) /= k - 1) cycle
+ kks = f_l0_slot(kk)
+ if (kks <= amr_num_blocks) then
+ if (amr_block_owner(kks) == proc_rank) cycle
+ end if
+ call s_amr_free_slot(kks)
+ end do
+ ks = f_l0_slot(k)
+ amr_cur = ks
+ ! owned slot needs its arrays before geometry/prolong
+ call s_phase_tic(PH_RBSLOT)
+ if (amr_block_owner(ks) == proc_rank) call s_amr_alloc_slot(ks)
+ call s_phase_toc(PH_RBSLOT)
+ call s_phase_tic(PH_RBGEO)
+ call s_set_amr_fine_geometry(boxes(k)%lo, boxes(k)%hi)
+ call s_phase_toc(PH_RBGEO)
+ ! fine-level distribution: consume this new block's coarse patch out of the chunk exchange (all ranks - before the
+ ! owner-only cycle, which is what lets the chunk request arrays be reused; q_cons_base is host-current with valid
+ ! ghosts from the exchange at the top of s_amr_regrid)
+ call s_phase_tic(PH_RBGATH); call s_amr_gather_consume_box(q_cons_base, k, c_lo); call s_phase_toc(PH_RBGATH)
+ ! non-polytropic QBMM: gather the coarse pb/mv patch too (ALL ranks - P2P; owners re-prolong from it below)
+ if (qbmm .and. .not. polytropic) call s_amr_gather_coarse_patch_pbmv(pb_ts(1)%sf, mv_ts(1)%sf, .false.)
+ if (.not. amr_rank_owns_block) cycle
+ call s_amr_cov_note(old_np, old_ilo, old_ext, old_level) ! [amr-cov] rebuild-gather coverage split
+ ! prolong and overlap carry-forward are both DEVICE kernels now: the slot is built entirely in place where the
+ ! store is authoritative, and the per-box full-slot push (PH_RBPUSH) is gone.
+ call s_phase_tic(PH_RBOVL); call s_interpolate_coarse_to_fine()
+ call s_phase_toc(PH_RBOVL)
+ ! every old block's stashed fine state is now replicated in amr_slots(kk)%q_cons_stor (migration above), so copy the
+ ! overlap from EVERY covering old block regardless of owner - sh is the old->new LOCAL fine index shift. A level>=2
+ ! block
+ ! SKIPS this: old_ilo/sh are the L0 index frame, but a child's amr_isect_lo is its PARENT-fine frame, so the shift is
+ ! wrong. It re-prolongs from its (freshly-built, parents-first) parent each regrid instead; the coupling keeps
+ ! conservation. Detail-preserving same-level L2 migration (parent-fine overlap) is a later increment.
+ call s_phase_tic(PH_RBOVL)
+ if (amr_block_level(amr_cur) < 2) then
+ do kk = 1, old_np
+ ! same-level overlap only (a child's stash is 4x-framed)
+ if (old_level(kk) /= amr_block_level(amr_cur)) cycle
+ kks = f_l0_slot(kk)
+ ! old LOCAL fine index = new LOCAL fine index + sh (collapsed dims sh=0)
+ sh = amr_ref_ratio*(amr_isect_lo - old_ilo(:,kk))
+ call s_amr_overlap_copy_device(amr_loc_of(ks), amr_loc_of(kks), amr_slots(ks)%m, amr_slots(ks)%n, &
+ & amr_slots(ks)%p, sh, old_ext(1, kk), old_ext(2, kk), old_ext(3, kk))
+ end do
+ end if
+ call s_phase_toc(PH_RBOVL)
+ ! non-polytropic QBMM: prolong the side-state from coarse (piecewise-constant), then overwrite the overlap with the
+ ! old blocks' fine data (same index shift)
+ if (qbmm .and. .not. polytropic) then
+ call s_amr_prolong_pbmv()
+ ! level>=2 re-prolongs only (the L0-frame overlap shift is wrong for a child)
+ if (amr_block_level(amr_cur) < 2) then
+ do kk = 1, old_np
+ if (old_level(kk) /= amr_block_level(amr_cur)) cycle ! same-level overlap only
+ if (.not. old_owns(kk)) cycle
+ kks = f_l0_slot(kk)
+ sh = amr_ref_ratio*(amr_isect_lo - old_ilo(:,kk))
+ do fk = 0, amr_slots(ks)%p
+ ofk = fk + sh(3)
+ if (p_glb > 0 .and. (ofk < 0 .or. ofk > old_ext(3, kk))) cycle
+ do fj = 0, amr_slots(ks)%n
+ ofj = fj + sh(2)
+ if (n_glb > 0 .and. (ofj < 0 .or. ofj > old_ext(2, kk))) cycle
+ do fi = 0, amr_slots(ks)%m
+ ofi = fi + sh(1)
+ if (ofi < 0 .or. ofi > old_ext(1, kk)) cycle
+ amr_slots(ks)%pb_f%sf(fi, fj, fk,:,:) = amr_slots(kks)%pb_stor%sf(ofi, ofj, ofk,:,:)
+ amr_slots(ks)%mv_f%sf(fi, fj, fk,:,:) = amr_slots(kks)%mv_stor%sf(ofi, ofj, ofk,:,:)
+ end do
+ end do
+ end do
+ end do
+ end if
+ $:GPU_UPDATE(device='[amr_slots(ks)%pb_f%sf, amr_slots(ks)%mv_f%sf]')
+ end if
+ ! whole-block-per-rank: no fine-fine halo; the new block's ghost shell is (re)prolonged by the next fine advance
+ end do
+ deallocate (last_use)
+ amr_gpl_valid = .false. ! the plan describes THIS rebuild's box loop only; per-step gathers never consult it
+
+ ! Drain the deferred gather sends now that every box has been posted: one WAITALL per rebuild instead of
+ ! a per-box rendezvous. MUST happen before the send buffers are reused or freed.
+ call s_phase_tic(PH_RBTAIL)
+ call s_phase_tic(PH_RBFLUSH); call s_amr_gather_send_flush(); call s_phase_toc(PH_RBFLUSH)
+ ! ONE allreduce for the whole loop; sets amr_xchg_coarse_ghosts if ANY block needs it
+ call s_phase_tic(PH_RBXCHG); call s_amr_reduce_xchg_flag(); call s_phase_toc(PH_RBXCHG)
+ ! lazy sizing: free the transient regrid slots (old blocks this rank stashed/received but does not now own); the
+ ! new-owned slots were allocated in the build loop, so this only frees - a rank keeps just its owned blocks' fine arrays
+ call s_phase_tic(PH_RBREC); call s_amr_reconcile_slots(); call s_phase_toc(PH_RBREC)
+ ! rebuild every block's fine-grid IB state for the NEW geometry (markers/ghost points/image points recomputed from the
+ ! body definitions; no state carries across regrids)
+ if (ib) call s_amr_setup_ib()
+ call s_amr_select_slot(1)
+ call s_phase_tic(PH_RBTOPO); call s_amr_check_seam_topology(); call s_phase_toc(PH_RBTOPO)
+ call s_phase_toc(PH_RBTAIL) ! abort on seam topologies no halo reconciles (silent leak otherwise)
+
+ end subroutine s_amr_regrid_rebuild_slots
+
+ !> Sensor-on-fine child tagging: OR-accumulate density-gradient tags from an OLD fine block's solution into an L0-cell tag grid,
+ !! restricted to a parent nesting window. Reads amr_slots(ob)%q_cons on the HOST (caller host-refreshes the cont range first;
+ !! the step-5 stash's GPU_UPDATE runs later). Fine cell (fi,fj,fk) covers L0 cell (ci,cj,ck) with fi = rr*(ci-olo(1))+d etc.;
+ !! the gradient uses one-sided differences at the fine-interior edges so no stale fine ghost is read. Only decides placement -
+ !! conservation is enforced downstream by restrict/reflux regardless of box extent.
+ impure subroutine s_amr_tag_child_from_fine(ob, win_lo, win_hi, ctag, any_tag)
+
+ integer, intent(in) :: ob, win_lo(3), win_hi(3)
+ logical, intent(inout) :: ctag(win_lo(1):,win_lo(2):,win_lo(3):)
+ logical, intent(inout) :: any_tag
+ integer :: rr, ci, cj, ck, fi, fj, fk, d1, d2, d3, fm1, fm2, fm3, olo(3), lo(3), hi(3)
+ real(wp) :: r0, g
+ logical :: tagged
+
+ rr = amr_slots(ob)%amr_ref_ratio
+ olo = amr_region_lo_all(:,ob)
+ fm1 = amr_slots(ob)%m; fm2 = amr_slots(ob)%n; fm3 = amr_slots(ob)%p
+ ! overlap of this old block with the parent window, in L0 cells
+ lo(1) = max(win_lo(1), amr_region_lo_all(1, ob)); hi(1) = min(win_hi(1), amr_region_hi_all(1, ob))
+ lo(2) = merge(max(win_lo(2), amr_region_lo_all(2, ob)), 0, n_glb > 0)
+ hi(2) = merge(min(win_hi(2), amr_region_hi_all(2, ob)), 0, n_glb > 0)
+ lo(3) = merge(max(win_lo(3), amr_region_lo_all(3, ob)), 0, p_glb > 0)
+ hi(3) = merge(min(win_hi(3), amr_region_hi_all(3, ob)), 0, p_glb > 0)
+ do ck = lo(3), hi(3)
+ do cj = lo(2), hi(2)
+ do ci = lo(1), hi(1)
+ tagged = .false.
+ do d3 = 0, merge(rr - 1, 0, p_glb > 0)
+ fk = (ck - olo(3))*rr + d3
+ do d2 = 0, merge(rr - 1, 0, n_glb > 0)
+ fj = (cj - olo(2))*rr + d2
+ do d1 = 0, rr - 1
+ fi = (ci - olo(1))*rr + d1
+ r0 = max(abs(f_amr_rho_tot_st(amr_loc_of(ob), fi, fj, fk)), 1.e-30_wp)
+ g = abs(f_amr_rho_tot_st(amr_loc_of(ob), min(fi + 1, fm1), fj, &
+ & fk) - f_amr_rho_tot_st(amr_loc_of(ob), max(fi - 1, 0), fj, fk))
+ if (n_glb > 0) g = max(g, abs(f_amr_rho_tot_st(amr_loc_of(ob), fi, min(fj + 1, fm2), &
+ & fk) - f_amr_rho_tot_st(amr_loc_of(ob), fi, max(fj - 1, 0), fk)))
+ if (p_glb > 0) g = max(g, abs(f_amr_rho_tot_st(amr_loc_of(ob), fi, fj, min(fk + 1, &
+ & fm3)) - f_amr_rho_tot_st(amr_loc_of(ob), fi, fj, max(fk - 1, 0))))
+ ! 2*r0 normalizes the 2-cell central difference; the 2 is the stencil span, NOT amr_ref_ratio
+ if (g/(2._wp*r0) > amr_tag_eps) tagged = .true.
+ end do
+ end do
+ end do
+ if (tagged) then
+ ctag(ci, cj, ck) = .true.
+ any_tag = .true.
+ end if
+ end do
+ end do
+ end do
+
+ end subroutine s_amr_tag_child_from_fine
+
+ !> Total density (sum of the continuity variables) at one cell: the regrid tag field. Reduces to variable 1 for one fluid. Two
+ !! sources, one body: `_st` reads a refined block out of the flat store, `_sf` the level-0 monolithic field.
+ #:for RSFX, RSRC in [('st', 'amr_cons_st'), ('sf', '')]
+ pure function f_amr_rho_tot_${RSFX}$(${'loc' if RSRC else 'q'}$, ci, cj, ck) result(r)
+
+ #:if RSRC
+ integer, intent(in) :: loc !< flat-store slot
+ #:else
+ type(scalar_field), dimension(:), intent(in) :: q
+ #:endif
+ integer, intent(in) :: ci, cj, ck
+ real(wp) :: r
+ integer :: f
+
+ r = 0._wp
+ do f = eqn_idx%cont%beg, eqn_idx%cont%end
+ #:if RSRC
+ r = r + real(amr_cons_st(ci, cj, ck, f, loc), wp)
+ #:else
+ r = r + real(q(f)%sf(ci, cj, ck), wp)
+ #:endif
+ end do
+
+ end function f_amr_rho_tot_${RSFX}$
+ #:endfor
+end module m_amr_regrid
diff --git a/src/simulation/m_amr_restart.fpp b/src/simulation/m_amr_restart.fpp
new file mode 100644
index 0000000000..8abe78975c
--- /dev/null
+++ b/src/simulation/m_amr_restart.fpp
@@ -0,0 +1,503 @@
+!>
+!!@file
+!!@brief Contains module m_amr_restart
+
+#:include 'macros.fpp'
+
+!> @brief AMR fine-level restart I/O: writes/reads the fine-level restart file alongside the level-0 restart (serial per-rank
+!! unformatted files, or one shared MPI-IO file under parallel_io). Split out of m_amr; block/slot state stays in m_amr (and
+!! m_global_parameters).
+module m_amr_restart
+
+#ifdef MFC_MPI
+ use mpi !< MPI-IO for the parallel_io AMR restart file
+#endif
+
+ use m_derived_types ! scalar_field
+ use m_global_parameters
+ use m_constants, only: amr_restart_blk_hdr_ints, amr_restart_blk_own_ints
+ use m_mpi_proxy, only: s_mpi_abort
+ use m_mpi_common, only: s_mpi_allreduce_integer_min
+ use m_amr, only: s_amr_reduce_xchg_flag, amr_slots, amr_cons_st, amr_loc_of, amr_seam_pairs_dirty, amr_mesh_epoch, &
+ & s_amr_alloc_slot, s_amr_reconcile_slots, s_amr_assign_block_owners, s_amr_gather_coarse_patch_pbmv, s_amr_prolong_pbmv, &
+ & s_set_amr_fine_geometry
+ use m_amr_regrid, only: s_amr_check_seam_topology
+
+ implicit none
+
+ private
+ public :: s_write_amr_restart, s_read_amr_restart
+
+contains
+
+ !> Write the fine-level restart file for save step t_step alongside the level-0 restart (whose format stays untouched): the
+ !! writing rank count, the active-block count, and for EACH block its box + each rank's intersection-local fine conservative
+ !! state. Serial mode: one unformatted file per rank inside its level-0 step directory. Parallel mode: one shared MPI-IO file
+ !! (3-int global header [np, nboxes, sys_size], then per block a 7-int box+level header, a 3*np-int per-rank fine-extents record
+ !! [m,n,p per rank, 0s for non-owners; validated on read], then the ranks' fine blocks concatenated in rank order). Same rank
+ !! count + decomposition required to restart (enforced by the extents record).
+ impure subroutine s_write_amr_restart(t_step)
+
+ integer, intent(in) :: t_step
+ character(LEN=path_len + 3*name_len) :: file_loc
+ integer :: i, k
+
+#ifdef MFC_MPI
+ integer :: ifile, ierr, cnt, idx, fi, fj, fk, reg(6), bhdr(amr_restart_blk_hdr_ints), ibytes, sbytes
+ integer :: myext(3)
+ integer, allocatable :: myown_all(:)
+ integer, dimension(MPI_STATUS_SIZE) :: status
+ integer(kind=MPI_OFFSET_KIND) :: my_cnt, my_off, disp0, ddisp
+ integer(kind=MPI_OFFSET_KIND), allocatable :: my_cnt_vec(:), my_off_vec(:), tot_cnt_vec(:)
+ logical :: file_exist
+ real(stp), allocatable :: buf(:)
+#endif
+
+ if (.not. amr) return
+ ! host consumer: fine state is device-current during stepping (pull every owned slot)
+ do k = 1, amr_num_blocks
+ if (amr_owns_all(k)) then
+ $:GPU_UPDATE(host='[amr_cons_st(:, :, :, :, amr_loc_of(k))]')
+ end if
+ end do
+
+ if (.not. parallel_io) then
+ ! per-rank file in the step directory just created by the level-0 serial write
+ write (file_loc, '(A,I0,A,I0,A)') trim(case_dir) // '/p_all/p', proc_rank, '/', t_step, '/amr_fine.dat'
+ open (2, FILE=trim(file_loc), form='unformatted', STATUS='new')
+ write (2) num_procs, amr_num_blocks, sys_size
+ do k = 1, amr_num_blocks
+ ! per-block header: region box, refinement LEVEL (a level-l block's fine extent is amr_ref_ratio**l, not
+ ! amr_ref_ratio, of the region - the reader needs the level to rebuild multi-level geometry), extents
+ write (2) amr_slots(k)%region%lo, amr_slots(k)%region%hi, amr_block_level(k), amr_slots(k)%m, amr_slots(k)%n, &
+ & amr_slots(k)%p
+ if (amr_owns_all(k)) then
+ do i = 1, sys_size
+ write (2) amr_cons_st(0:amr_slots(k)%m,0:amr_slots(k)%n,0:amr_slots(k)%p,i, amr_loc_of(k))
+ end do
+ end if
+ end do
+ close (2)
+ else
+#ifdef MFC_MPI
+ ibytes = storage_size(0)/8; sbytes = storage_size(0._stp)/8
+ write (file_loc, '(A,I0,A)') 'amr_', t_step, '.dat'
+ file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
+ inquire (FILE=trim(file_loc), EXIST=file_exist)
+ if (file_exist .and. proc_rank == 0) then
+ call MPI_FILE_DELETE(file_loc, mpi_info_int, ierr)
+ end if
+ call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, ior(MPI_MODE_WRONLY, MPI_MODE_CREATE), mpi_info_int, ifile, ierr)
+ ! MPI-IO file handles default to MPI_ERRORS_RETURN: failures silent unless checked
+ if (ierr /= MPI_SUCCESS) call s_mpi_abort('amr restart write: MPI_FILE_OPEN failed for ' // trim(file_loc))
+ ! FORMAT v2: NEGATIVE rank count marks the compact per-block ownership record (see m_constants). A v1 reader
+ ! sees a rank mismatch and aborts with its existing message rather than misparsing the block records.
+ if (proc_rank == 0) call MPI_FILE_WRITE_AT(ifile, int(0, MPI_OFFSET_KIND), [-num_procs, amr_num_blocks, sys_size], 3, &
+ & MPI_INTEGER, status, ierr)
+ disp0 = int(3*ibytes, MPI_OFFSET_KIND) ! running byte offset past the 3-int global header
+ ! hoist per-block metadata collectives: one EXSCAN/ALLREDUCE/ALLGATHER over ALL blocks
+ allocate (my_cnt_vec(amr_num_blocks), my_off_vec(amr_num_blocks), tot_cnt_vec(amr_num_blocks))
+ allocate (myown_all(amr_restart_blk_own_ints*amr_num_blocks))
+ do k = 1, amr_num_blocks
+ cnt = sys_size*(amr_slots(k)%m + 1)*(amr_slots(k)%n + 1)*(amr_slots(k)%p + 1)
+ if (.not. amr_owns_all(k)) cnt = 0
+ my_cnt_vec(k) = int(cnt, MPI_OFFSET_KIND)
+ myown_all(amr_restart_blk_own_ints*(k - 1) + 1:amr_restart_blk_own_ints*k) = 0
+ if (amr_owns_all(k)) myown_all(amr_restart_blk_own_ints*(k - 1) + 1:amr_restart_blk_own_ints*k) = [proc_rank + 1, &
+ & amr_slots(k)%m, amr_slots(k)%n, amr_slots(k)%p]
+ end do
+ my_off_vec = int(0, MPI_OFFSET_KIND)
+ call MPI_EXSCAN(my_cnt_vec, my_off_vec, amr_num_blocks, MPI_OFFSET, MPI_SUM, MPI_COMM_WORLD, ierr)
+ if (proc_rank == 0) my_off_vec = int(0, MPI_OFFSET_KIND)
+ call MPI_ALLREDUCE(my_cnt_vec, tot_cnt_vec, amr_num_blocks, MPI_OFFSET, MPI_SUM, MPI_COMM_WORLD, ierr)
+ ! Per-block (owner + 1, m, n, p): every rank contributes zeros except the one owner, so a MAX reduction recovers the
+ ! record exactly. This carries the same information the v1 3*num_procs extent vector did -- readers rebuild it from
+ ! their own decomposition and abort on mismatch, catching a different ownership pattern or load_balance split that
+ ! would otherwise silently misalign the concatenated per-rank data slices below -- in O(blocks) rather than
+ ! O(blocks x ranks), in memory AND in the file.
+ call MPI_ALLREDUCE(MPI_IN_PLACE, myown_all, amr_restart_blk_own_ints*amr_num_blocks, MPI_INTEGER, MPI_MAX, &
+ & MPI_COMM_WORLD, ierr)
+ do k = 1, amr_num_blocks
+ cnt = int(my_cnt_vec(k), kind(cnt))
+ my_off = my_off_vec(k)
+ if (proc_rank == 0) then
+ ! amr_restart_blk_hdr_ints-int per-block header: region box (6) + refinement LEVEL (a level-l block's fine
+ ! extent is amr_ref_ratio**l, not amr_ref_ratio, of the region - the reader needs the level to rebuild
+ ! multi-level geometry). Header layout is single-sourced in m_constants so both readers stay in lockstep.
+ bhdr(1:3) = amr_slots(k)%region%lo; bhdr(4:6) = amr_slots(k)%region%hi
+ bhdr(amr_restart_blk_hdr_ints) = amr_block_level(k)
+ call MPI_FILE_WRITE_AT(ifile, disp0, bhdr, amr_restart_blk_hdr_ints, MPI_INTEGER, status, ierr)
+ end if
+ if (proc_rank == 0) then
+ call MPI_FILE_WRITE_AT(ifile, disp0 + int(amr_restart_blk_hdr_ints*ibytes, MPI_OFFSET_KIND), &
+ & myown_all(amr_restart_blk_own_ints*(k - 1) + 1), amr_restart_blk_own_ints, &
+ & MPI_INTEGER, status, ierr)
+ end if
+ ddisp = disp0 + int((amr_restart_blk_hdr_ints + amr_restart_blk_own_ints)*ibytes, MPI_OFFSET_KIND)
+ allocate (buf(max(cnt, 1)))
+ idx = 0
+ ! cnt == 0 on a non-owning rank, where buf is the 1-element placeholder and this slot's q_cons is not allocated
+ ! (lazy owned-only sizing) while its m/n/p metadata IS replicated - so packing would run the full extent loop over
+ ! an unallocated slot and overrun buf. The collective WRITE_AT_ALL below still runs on every rank, with cnt = 0.
+ if (cnt > 0) then
+ do i = 1, sys_size
+ do fk = 0, amr_slots(k)%p
+ do fj = 0, amr_slots(k)%n
+ do fi = 0, amr_slots(k)%m
+ idx = idx + 1
+ buf(idx) = amr_cons_st(fi, fj, fk, i, amr_loc_of(k))
+ end do
+ end do
+ end do
+ end do
+ end if
+ call MPI_FILE_WRITE_AT_ALL(ifile, ddisp + my_off*int(sbytes, MPI_OFFSET_KIND), buf, cnt*mpi_io_type, mpi_io_p, &
+ & status, ierr)
+ if (ierr /= MPI_SUCCESS) &
+ & call s_mpi_abort('amr restart write: data write failed (disk full/quota?); the file is unusable')
+ deallocate (buf)
+ disp0 = ddisp + tot_cnt_vec(k)*int(sbytes, MPI_OFFSET_KIND)
+ end do
+ deallocate (my_cnt_vec, my_off_vec, tot_cnt_vec, myown_all)
+ ! close is where buffered MPI-IO data flushes on many stacks - a failure here truncates the file
+ call MPI_FILE_CLOSE(ifile, ierr)
+ if (ierr /= MPI_SUCCESS) call s_mpi_abort('amr restart write: MPI_FILE_CLOSE failed; the file may be truncated')
+#endif
+ end if
+
+ end subroutine s_write_amr_restart
+
+ !> Restore the fine level from the AMR restart file at t_step_start (n_start under cfl_dt), if one exists: for each saved block
+ !! rebuild the box via s_set_amr_fine_geometry, then read each rank's intersection-local fine state (exact stp round-trip).
+ !! parallel_io REPARTITIONS across rank counts (each block is one contiguous region-sized chunk under whole-block ownership,
+ !! re-assigned to this run's owners); serial (per-rank files) still needs the writing rank count. restored = false on a fresh
+ !! start, or - with a one-line warning - on a legacy restart without the file; the caller then re-prolongs from coarse.
+ !! Collective: ALL ranks call it together.
+ impure subroutine s_read_amr_restart(restored)
+
+ logical, intent(out) :: restored
+ character(LEN=path_len + 3*name_len) :: file_loc
+ character(LEN=300) :: msg
+ logical :: file_exist
+ integer :: i, k, ts, have_loc, have_glb, ghdr(3), reg(6), lvl, rm, rn, rp
+ logical, allocatable :: had_data(:)
+
+#ifdef MFC_MPI
+ integer :: ifile, ierr, cnt, idx, fi, fj, fk, ibytes, sbytes, np_old, bhdr(amr_restart_blk_hdr_ints)
+ integer :: myext(3)
+ integer, allocatable :: wext(:), rext(:), myext_all(:), wext_all(:), myown_all(:)
+ integer :: orec, fown(amr_restart_blk_own_ints), mown(amr_restart_blk_own_ints)
+ logical :: v2
+ integer, dimension(MPI_STATUS_SIZE) :: status
+ integer(kind=MPI_OFFSET_KIND) :: my_cnt, my_off, disp0, ddisp, fsz
+ integer(kind=MPI_OFFSET_KIND), allocatable :: blk_base(:), my_cnt_vec(:), my_off_vec(:)
+ real(stp), allocatable :: buf(:)
+#endif
+
+ restored = .false.
+ if (.not. amr) return
+ if (cfl_dt) then
+ ts = n_start
+ else
+ ts = t_step_start
+ end if
+ if (ts == 0) return ! fresh start: the fine level is prolonged from the pre_process ICs
+
+ if (.not. parallel_io) then
+ write (file_loc, '(A,I0,A,I0,A)') trim(case_dir) // '/p_all/p', proc_rank, '/', ts, '/amr_fine.dat'
+ else
+ write (file_loc, '(A,I0,A)') 'amr_', ts, '.dat'
+ file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
+ end if
+ inquire (FILE=trim(file_loc), EXIST=file_exist)
+ have_loc = merge(1, 0, file_exist)
+ call s_mpi_allreduce_integer_min(have_loc, have_glb)
+ if (have_glb == 0) then
+ if (proc_rank == 0) then
+ print '(A)', &
+ & ' [amr] WARNING: no AMR restart file at this step; the fine level is re-initialized by ' &
+ & // 'prolongation from coarse (fine-level accuracy is lost across this restart)'
+ end if
+ return
+ end if
+
+ if (.not. parallel_io) then
+ open (2, FILE=trim(file_loc), form='unformatted', ACTION='read', STATUS='old')
+ read (2) ghdr
+ if (ghdr(1) /= num_procs) then
+ write (msg, &
+ & '(A,I0,A,I0,A)') 'amr restart rank-count mismatch: the serial (non-parallel_io) AMR restart ' &
+ & // 'file was written with ', ghdr(1), ' ranks but this run has ', num_procs, &
+ & '; restart with the same rank count, or use parallel_io (which repartitions across rank counts)'
+ call s_mpi_abort(trim(msg))
+ end if
+ if (ghdr(3) /= sys_size) then
+ write (msg, '(A,I0,A,I0,A)') 'amr restart sys_size mismatch: the AMR restart file has ', ghdr(3), &
+ & ' conserved variables but this run has ', sys_size, &
+ & '; the physics configuration ' &
+ & // '(num_fluids/model_eqns/bubbles/chemistry) must match the run that wrote the restart'
+ call s_mpi_abort(trim(msg))
+ end if
+ if (ghdr(2) < 1 .or. ghdr(2) > amr_max_blocks) then
+ call s_mpi_abort('amr restart: the file holds more fine blocks than amr_max_blocks ' &
+ & // 'in this run; restart with amr_max_blocks at least the written block count')
+ end if
+ amr_num_blocks = ghdr(2)
+ allocate (had_data(amr_num_blocks))
+ ! PASS 1: read every block's region + (present iff rm>=0, i.e. this rank owned it at write) the owner's fine state.
+ ! Whole-block ownership is decomposition-deterministic, so the file's data-presence flag drives the read here; the owner
+ ! map is rebuilt from the regions in pass 2.
+ do k = 1, amr_num_blocks
+ read (2) reg, lvl, rm, rn, rp
+ ! corrupt/foreign-file guard: a box outside the global domain would drive the geometry build and coordinate reads
+ ! out of bounds silently in release builds
+ if (reg(1) < 0 .or. reg(4) > m_glb .or. reg(1) > reg(4) .or. (n_glb > 0 .and. (reg(2) < 0 .or. reg(5) > n_glb &
+ & .or. reg(2) > reg(5))) .or. (p_glb > 0 .and. (reg(3) < 0 .or. reg(6) > p_glb .or. reg(3) > reg(6)))) then
+ call s_mpi_abort('amr restart: corrupt block record (box outside the global domain)')
+ end if
+ if (lvl < 1 .or. lvl > amr_max_level) then
+ call s_mpi_abort('amr restart: corrupt block record (block level outside 1..amr_max_level)')
+ end if
+ amr_region_lo_all(:,k) = reg(1:3); amr_region_hi_all(:,k) = reg(4:6)
+ ! set the level BEFORE the owner/geometry rebuild below: s_amr_assign_block_owners and s_set_amr_fine_geometry key
+ ! off amr_block_level to place L>=2 blocks under their parent
+ amr_block_level(k) = lvl
+ had_data(k) = rm >= 0
+ if (had_data(k)) then
+ ! whole-block owner extents are region-derived per level (a level-l block covers amr_ref_ratio**l fine cells per
+ ! L0 cell of its region, not amr_ref_ratio); a stored extent that disagrees is corrupt
+ if (rm /= (amr_ref_ratio**lvl)*(reg(4) - reg(1) + 1) - 1 .or. rn /= merge((amr_ref_ratio**lvl)*(reg(5) &
+ & - reg(2) + 1) - 1, 0, n_glb > 0) .or. rp /= merge((amr_ref_ratio**lvl)*(reg(6) - reg(3) + 1) - 1, 0, &
+ & p_glb > 0)) then
+ call s_mpi_abort('amr restart: block fine extents disagree with the region (corrupt file)')
+ end if
+ ! serial (same rank count): had_data == this run's ownership, so this is the owned slot
+ call s_amr_alloc_slot(k)
+ ! zero the whole host column first: the read fills only the interior, but the push below covers the
+ ! full padded column, and since the device-native grow the host pad bytes are otherwise UNDEFINED
+ ! (the old grow's device->host pull used to leave them as the device's zeros)
+ amr_cons_st(:,:,:,:,amr_loc_of(k)) = 0._stp
+ do i = 1, sys_size
+ read (2) amr_cons_st(0:rm,0:rn,0:rp,i, amr_loc_of(k))
+ end do
+ ! Push THIS block before the next s_amr_alloc_slot: allocating a slot can grow the shared flat store, and
+ ! s_amr_st_reserve preserves the growth by pulling device->host first - which would overwrite the blocks read
+ ! above with the device copy that has not been written yet (restored fine state becomes NaN). The store is
+ ! device-authoritative at every alloc point; a host writer must close that gap itself.
+ $:GPU_UPDATE(device='[amr_cons_st(:, :, :, :, amr_loc_of(k))]')
+ end if
+ end do
+ close (2)
+ ! PASS 2: rebuild whole-block owners from the regions, then each block's geometry under the correct owner; verify the
+ ! data read (write-owner) matches who owns the block in this run
+ call s_amr_assign_block_owners()
+ ! free any init slots not in the restart set (had_data slots stay: they are owned)
+ call s_amr_reconcile_slots()
+ do k = 1, amr_num_blocks
+ amr_cur = k
+ call s_set_amr_fine_geometry(amr_region_lo_all(:,k), amr_region_hi_all(:,k))
+ if (had_data(k) .neqv. amr_owns_all(k)) then
+ call s_mpi_abort('amr restart decomposition mismatch: the file''s block ownership differs from this' &
+ & // ' run''s (identical decomposition - rank count and load_balance settings - required)')
+ end if
+ end do
+ call s_amr_reduce_xchg_flag()
+ deallocate (had_data)
+ else
+#ifdef MFC_MPI
+ ibytes = storage_size(0)/8; sbytes = storage_size(0._stp)/8
+ call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
+ ! MPI-IO errors are silent by default (MPI_ERRORS_RETURN on file handles) and a read past EOF is not even an error - it
+ ! returns short with an uninitialized tail. Grab the size up front; the exact expected byte count is compared after the
+ ! layout records are consumed below.
+ if (ierr /= MPI_SUCCESS) call s_mpi_abort('amr restart read: MPI_FILE_OPEN failed for ' // trim(file_loc))
+ call MPI_FILE_GET_SIZE(ifile, fsz, ierr)
+ call MPI_FILE_READ_AT_ALL(ifile, int(0, MPI_OFFSET_KIND), ghdr, 3, MPI_INTEGER, status, ierr)
+ ! Repartition-on-restart: the writer's rank count sets only the file layout (the 3*np_old per-block extents record).
+ ! Whole-block ownership makes each block's fine data one contiguous region-sized chunk, so ANY new rank count can read
+ ! it
+ ! - pass 2 re-assigns owners for THIS run and each new owner reads its whole blocks. np_old == num_procs is
+ ! byte-identical to the same-rank path (and keeps the layout check).
+ ! FORMAT: a NEGATIVE rank count marks v2, whose per-block record is (owner + 1, m, n, p) -- 4 ints instead of the
+ ! v1 3*np_old extent vector that made the FILE O(blocks x ranks). v1 files stay readable; only v2 is written.
+ v2 = ghdr(1) < 0
+ np_old = abs(ghdr(1))
+ orec = merge(amr_restart_blk_own_ints, 3*np_old, v2)
+ if (ghdr(3) /= sys_size) then
+ write (msg, '(A,I0,A,I0,A)') 'amr restart sys_size mismatch: the AMR restart file has ', ghdr(3), &
+ & ' conserved variables but this run has ', sys_size, &
+ & '; the physics configuration ' &
+ & // '(num_fluids/model_eqns/bubbles/chemistry) must match the run that wrote the restart'
+ call s_mpi_abort(trim(msg))
+ end if
+ if (ghdr(2) < 1 .or. ghdr(2) > amr_max_blocks) then
+ call s_mpi_abort('amr restart: the file holds more fine blocks than amr_max_blocks ' &
+ & // 'in this run; restart with amr_max_blocks at least the written block count')
+ end if
+ amr_num_blocks = ghdr(2)
+ allocate (wext(3*np_old), rext(3*num_procs), blk_base(amr_num_blocks))
+ ! PASS 1: read every block's region (collective) and lay out the file offsets. Under whole-block ownership the per-block
+ ! data size is fixed by the region (one owner holds all sys_size*cells), so all offsets are known before the owner map
+ ! is rebuilt in pass 2.
+ disp0 = int(3*ibytes, MPI_OFFSET_KIND)
+ do k = 1, amr_num_blocks
+ call MPI_FILE_READ_AT_ALL(ifile, disp0, bhdr, amr_restart_blk_hdr_ints, MPI_INTEGER, status, ierr)
+ reg = bhdr(1:6); lvl = bhdr(amr_restart_blk_hdr_ints)
+ ! corrupt/foreign-file guard: a box outside the global domain would drive the geometry build and coordinate reads
+ ! out of bounds silently in release builds
+ if (reg(1) < 0 .or. reg(4) > m_glb .or. reg(1) > reg(4) .or. (n_glb > 0 .and. (reg(2) < 0 .or. reg(5) > n_glb &
+ & .or. reg(2) > reg(5))) .or. (p_glb > 0 .and. (reg(3) < 0 .or. reg(6) > p_glb .or. reg(3) > reg(6)))) then
+ call s_mpi_abort('amr restart: corrupt block record (box outside the global domain)')
+ end if
+ if (lvl < 1 .or. lvl > amr_max_level) then
+ call s_mpi_abort('amr restart: corrupt block record (block level outside 1..amr_max_level)')
+ end if
+ amr_region_lo_all(:,k) = reg(1:3); amr_region_hi_all(:,k) = reg(4:6)
+ ! set the level before the owner/geometry rebuild: s_amr_assign_block_owners and s_set_amr_fine_geometry key off
+ ! amr_block_level to place L>=2 blocks under their parent
+ amr_block_level(k) = lvl
+ blk_base(k) = disp0
+ ! data size is region-derived per level: a level-l block covers amr_ref_ratio**l fine cells per L0 cell
+ cnt = sys_size*((amr_ref_ratio**lvl)*(reg(4) - reg(1) + 1))*merge((amr_ref_ratio**lvl)*(reg(5) - reg(2) + 1), 1, &
+ & n_glb > 0)*merge((amr_ref_ratio**lvl)*(reg(6) - reg(3) + 1), 1, p_glb > 0)
+ disp0 = disp0 + int((amr_restart_blk_hdr_ints + orec)*ibytes, MPI_OFFSET_KIND) + int(cnt, &
+ & MPI_OFFSET_KIND)*int(sbytes, MPI_OFFSET_KIND)
+ end do
+ ! PASS 2: rebuild whole-block owners from the regions, then per block build geometry under the correct owner, validate
+ ! the writer's layout, and read this rank's owned slice at its offset.
+ call s_amr_assign_block_owners()
+ ! allocate this run's owned blocks (frees any stale init slots) before the read below
+ call s_amr_reconcile_slots()
+ do k = 1, amr_num_blocks
+ amr_cur = k
+ call s_set_amr_fine_geometry(amr_region_lo_all(:,k), amr_region_hi_all(:,k))
+ end do
+ call s_amr_reduce_xchg_flag()
+ ! hoist per-block metadata collectives: one ALLGATHER/EXSCAN over ALL blocks
+ allocate (my_cnt_vec(amr_num_blocks), my_off_vec(amr_num_blocks))
+ ! v1 needs the O(blocks x ranks) gather to reproduce the file's layout record; v2 needs O(blocks).
+ if (v2) then
+ allocate (myown_all(amr_restart_blk_own_ints*amr_num_blocks))
+ else
+ allocate (myext_all(3*amr_num_blocks), wext_all(3*num_procs*amr_num_blocks))
+ end if
+ do k = 1, amr_num_blocks
+ cnt = sys_size*(amr_slots(k)%m + 1)*(amr_slots(k)%n + 1)*(amr_slots(k)%p + 1)
+ if (.not. amr_owns_all(k)) cnt = 0
+ my_cnt_vec(k) = int(cnt, MPI_OFFSET_KIND)
+ if (v2) then
+ myown_all(amr_restart_blk_own_ints*(k - 1) + 1:amr_restart_blk_own_ints*k) = 0
+ if (amr_owns_all(k)) myown_all(amr_restart_blk_own_ints*(k - 1) + 1:amr_restart_blk_own_ints*k) = [proc_rank &
+ & + 1, amr_slots(k)%m, amr_slots(k)%n, amr_slots(k)%p]
+ else
+ myext_all(3*(k - 1) + 1:3*(k - 1) + 3) = 0
+ if (amr_owns_all(k)) myext_all(3*(k - 1) + 1:3*(k - 1) + 3) = [amr_slots(k)%m, amr_slots(k)%n, amr_slots(k)%p]
+ end if
+ end do
+ my_off_vec = int(0, MPI_OFFSET_KIND)
+ call MPI_EXSCAN(my_cnt_vec, my_off_vec, amr_num_blocks, MPI_OFFSET, MPI_SUM, MPI_COMM_WORLD, ierr)
+ if (proc_rank == 0) my_off_vec = int(0, MPI_OFFSET_KIND)
+ ! same rank count: validate the writer's per-rank layout against this run's decomposition (a re-derived load_balance
+ ! split would silently misalign every rank's slice). Repartitioning (np_old /= num_procs) intentionally uses a DIFFERENT
+ ! decomposition, so the layout cannot match - skip the check; whole-block ownership makes each block one contiguous
+ ! chunk
+ ! the new owner reads wholly, and the file-size check below still fails closed on a truncated/corrupt file.
+ if (np_old == num_procs) then
+ if (v2) then
+ call MPI_ALLREDUCE(MPI_IN_PLACE, myown_all, amr_restart_blk_own_ints*amr_num_blocks, MPI_INTEGER, MPI_MAX, &
+ & MPI_COMM_WORLD, ierr)
+ else
+ call MPI_ALLGATHER(myext_all, 3*amr_num_blocks, MPI_INTEGER, wext_all, 3*amr_num_blocks, MPI_INTEGER, &
+ & MPI_COMM_WORLD, ierr)
+ end if
+ end if
+ if (.not. allocated(wext)) allocate (wext(3*np_old))
+ if (.not. allocated(rext)) allocate (rext(3*num_procs))
+ do k = 1, amr_num_blocks
+ cnt = int(my_cnt_vec(k), kind(cnt))
+ my_off = my_off_vec(k)
+ if (np_old == num_procs .and. v2) then
+ call MPI_FILE_READ_AT_ALL(ifile, blk_base(k) + int(amr_restart_blk_hdr_ints*ibytes, MPI_OFFSET_KIND), fown, &
+ & amr_restart_blk_own_ints, MPI_INTEGER, status, ierr)
+ mown = myown_all(amr_restart_blk_own_ints*(k - 1) + 1:amr_restart_blk_own_ints*k)
+ if (any(fown /= mown)) then
+ call s_mpi_abort('amr restart: the per-block owner/extent record in the file does not match ' &
+ & // 'this run''s decomposition; with the same rank count the ownership and ' &
+ & // '(with load_balance) the weighted splits must match the run that wrote the restart')
+ end if
+ else if (np_old == num_procs) then
+ call MPI_FILE_READ_AT_ALL(ifile, blk_base(k) + int(amr_restart_blk_hdr_ints*ibytes, MPI_OFFSET_KIND), wext, &
+ & 3*np_old, MPI_INTEGER, status, ierr)
+ do i = 0, num_procs - 1
+ rext(3*i + 1:3*i + 3) = wext_all(3*amr_num_blocks*i + 3*(k - 1) + 1:3*amr_num_blocks*i + 3*(k - 1) + 3)
+ end do
+ if (any(rext /= wext)) then
+ call s_mpi_abort('amr restart: the per-rank fine-block layout in the file does not match ' &
+ & // 'this run''s decomposition; with the same rank count the ownership and ' &
+ & // '(with load_balance) the weighted splits must match the run that wrote the restart')
+ end if
+ end if
+ ddisp = blk_base(k) + int((amr_restart_blk_hdr_ints + orec)*ibytes, MPI_OFFSET_KIND)
+ allocate (buf(max(cnt, 1)))
+ call MPI_FILE_READ_AT_ALL(ifile, ddisp + my_off*int(sbytes, MPI_OFFSET_KIND), buf, cnt*mpi_io_type, mpi_io_p, &
+ & status, ierr)
+ ! zero the whole host column first: the unpack fills only the interior, but the push covers the full
+ ! padded column, and since the device-native grow the host pad bytes are otherwise UNDEFINED. Owner only:
+ ! every rank walks the block loop for the collective reads, and a non-owner's amr_loc_of(k) is not a slot.
+ if (cnt > 0) amr_cons_st(:,:,:,:,amr_loc_of(k)) = 0._stp
+ idx = 0
+ do i = 1, sys_size
+ do fk = 0, amr_slots(k)%p
+ do fj = 0, amr_slots(k)%n
+ do fi = 0, amr_slots(k)%m
+ idx = idx + 1
+ amr_cons_st(fi, fj, fk, i, amr_loc_of(k)) = buf(idx)
+ end do
+ end do
+ end do
+ end do
+ deallocate (buf)
+ end do
+ deallocate (blk_base, my_cnt_vec, my_off_vec)
+ if (allocated(myown_all)) deallocate (myown_all)
+ if (allocated(myext_all)) deallocate (myext_all)
+ if (allocated(wext_all)) deallocate (wext_all)
+ ! disp0 now equals the exact byte count a complete file must have: a truncated file (crashed writer, filesystem hiccup)
+ ! passes every layout check above but returns short reads with garbage tails - fail closed instead of restoring
+ ! uninitialized data as the fine level
+ if (disp0 /= fsz) then
+ call s_mpi_abort('amr restart read: file size does not match the expected layout ' &
+ & // '(truncated or corrupt amr restart file)')
+ end if
+ call MPI_FILE_CLOSE(ifile, ierr)
+#endif
+ end if
+
+ ! push restored fine state to the device (mirrors s_populate_amr_fine's push; host reads above)
+ do k = 1, amr_num_blocks
+ if (amr_owns_all(k)) then
+ $:GPU_UPDATE(device='[amr_cons_st(:, :, :, :, amr_loc_of(k))]')
+ end if
+ end do
+ ! non-polytropic QBMM: the restart file carries q_cons only; re-prolong each block's side-state from the restored coarse
+ ! pb/mv (one-time piecewise-constant smoothing)
+ if (qbmm .and. .not. polytropic) then
+ do k = 1, amr_num_blocks
+ call s_amr_select_slot(k)
+ ! gather coarse pb/mv patch on ALL ranks (P2P), then owners re-prolong from it
+ call s_amr_gather_coarse_patch_pbmv(pb_ts(1)%sf, mv_ts(1)%sf, .false.)
+ if (amr_owns_all(k)) call s_amr_prolong_pbmv()
+ end do
+ end if
+ call s_amr_select_slot(1)
+ ! restored levels without a regrid: the per-level fill waves iterate 2..amr_num_levels, so leaving it at the
+ ! default 1 would silently skip every level>=2 fill until the first regrid recomputes it
+ amr_num_levels = max(1, maxval(amr_block_level(1:amr_num_blocks)))
+ amr_seam_pairs_dirty = .true. ! restored a new block set: the cached seam-pair list must be rebuilt
+ amr_mesh_epoch = amr_mesh_epoch + 1
+ call s_amr_check_seam_topology() ! abort on seam topologies no halo reconciles (e.g. restart mode-switch)
+ restored = .true.
+
+ end subroutine s_read_amr_restart
+
+end module m_amr_restart
diff --git a/src/simulation/m_amr_xchg_audit.fpp b/src/simulation/m_amr_xchg_audit.fpp
new file mode 100644
index 0000000000..d882c68a2f
--- /dev/null
+++ b/src/simulation/m_amr_xchg_audit.fpp
@@ -0,0 +1,207 @@
+!>
+!!@file
+!!@brief Contains module m_amr_xchg_audit
+
+#:include 'macros.fpp'
+
+!> @brief I1a of the plan-based exchange program (docs/documentation/amr_plan_based_exchange.md): per-call-site accounting of every
+!! AMR point-to-point MPI transfer. Records what is ACTUALLY sent at the MPI call itself - never re-derived from the metadata the
+!! callers read - so the I2+ plan conversions have a ground-truth baseline (message counts, words, tag ranges) and a per-family
+!! conservation check (global sends == global recvs) that runs at finalize. Recording is a few integer adds per message; the report
+!! prints under rank_time_wrt like the other [amr-*] instruments. Per-xfer identity headers and the destination-tiling assert are
+!! I1b and layer on this registry.
+module m_amr_xchg_audit
+
+ use m_precision_select
+ use m_global_parameters, only: rank_time_wrt, proc_rank
+ use m_mpi_proxy, only: s_mpi_abort
+
+#ifdef MFC_MPI
+ use mpi
+#endif
+
+ implicit none
+
+ ! Exchange families (amr_plan_based_exchange.md, "The exchange-family inventory").
+ ! XA_FL0 covers the ten s_l0_* tile-routing sites outside the seven families (instrumented
+ ! read-only pending the D-l0 decision); XA_F4 is migration.
+ integer, parameter :: XA_F1 = 1, XA_F2 = 2, XA_F3 = 3, XA_F4 = 4, XA_F5 = 5, XA_F6 = 6, XA_F7 = 7, XA_FL0 = 8
+ integer, parameter :: XA_NFAM = 8
+
+ ! Call-site registry. One id per PHYSICAL MPI call site (fypp twins get their own ids where
+ ! they carry different payloads). Names are assigned in init; the id constants are the
+ ! documentation at the call sites.
+ integer, parameter :: XA_F1_SND = 1 !< s_amr_gather_coarse_patch pooled ISEND
+ integer, parameter :: XA_F1_RCV = 2 !< s_amr_gather_coarse_patch IRECV
+ integer, parameter :: XA_F3_SND = 3 !< s_amr_gather_coarse_patch_pbmv blocking SEND
+ integer, parameter :: XA_F3_RCV = 4 !< s_amr_gather_coarse_patch_pbmv IRECV
+ integer, parameter :: XA_F2_SND = 5 !< s_amr_gather_from_parent pooled ISEND (cons+stor instantiations)
+ integer, parameter :: XA_F2_RCV = 6 !< s_amr_gather_from_parent blocking RECV
+ integer, parameter :: XA_F4_SND = 7 !< s_amr_regrid_stash_migrate ISEND
+ integer, parameter :: XA_F4_RCV = 8 !< s_amr_regrid_stash_migrate IRECV
+ integer, parameter :: XA_F5_FACE_SND = 9 !< reflux face ISEND (freg lo/hi, tags 2*D/2*D+1)
+ integer, parameter :: XA_F5_FACE_RCV = 10 !< reflux face IRECV
+ integer, parameter :: XA_F5_FREG_SND = 11 !< freg-to-parent SEND (tags 40+)
+ integer, parameter :: XA_F5_FREG_RCV = 12 !< freg-to-parent RECV
+ integer, parameter :: XA_F6_XY = 13 !< seam halo SENDRECV, x-side of the pair (tag 4200 out)
+ integer, parameter :: XA_F6_YX = 14 !< seam halo SENDRECV, y-side of the pair (tag 4201 out)
+ integer, parameter :: XA_F7A_SND = 15 !< s_restrict_fine_to_coarse ISEND
+ integer, parameter :: XA_F7A_RCV = 16 !< s_restrict_fine_to_coarse RECV
+ integer, parameter :: XA_F7B_SND = 17 !< s_amr_restrict_to_parent SEND
+ integer, parameter :: XA_F7B_RCV = 18 !< s_amr_restrict_to_parent RECV
+ integer, parameter :: XA_F7C_SND = 19 !< s_amr_scatter_pbmv ISEND
+ integer, parameter :: XA_F7C_RCV = 20 !< s_amr_scatter_pbmv RECV
+ integer, parameter :: XA_L0_FILL_SND = 21 !< s_l0_fill_tiles_from_coarse SEND
+ integer, parameter :: XA_L0_FILL_RCV = 22 !< s_l0_fill_tiles_from_coarse RECV
+ integer, parameter :: XA_L0_SCAT_SND = 23 !< s_l0_scatter_tiles_to_coarse SEND
+ integer, parameter :: XA_L0_SCAT_RCV = 24 !< s_l0_scatter_tiles_to_coarse RECV
+ integer, parameter :: XA_L0_RFLX_SND = 25 !< s_l0_add_reflux_to_tiles SEND
+ integer, parameter :: XA_L0_RFLX_RCV = 26 !< s_l0_add_reflux_to_tiles RECV
+ integer, parameter :: XA_L0_REST_SND = 27 !< s_l0_restrict_to_tiles SEND (tag 4400+k)
+ integer, parameter :: XA_L0_REST_RCV = 28 !< s_l0_restrict_to_tiles RECV
+ integer, parameter :: XA_L0_MIGR_SND = 29 !< s_l0_migrate_tile SEND (tag 4300)
+ integer, parameter :: XA_L0_MIGR_RCV = 30 !< s_l0_migrate_tile RECV
+ integer, parameter :: XA_F1W_SND = 31 !< s_amr_stage_fill_wave per-peer aggregated q ISEND (I2a)
+ integer, parameter :: XA_F1W_RCV = 32 !< s_amr_stage_fill_wave per-peer aggregated q IRECV
+ integer, parameter :: XA_F3W_SND = 33 !< s_amr_stage_fill_wave per-peer aggregated pb/mv ISEND
+ integer, parameter :: XA_F3W_RCV = 34 !< s_amr_stage_fill_wave per-peer aggregated pb/mv IRECV
+ integer, parameter :: XA_F2W_SND = 35 !< s_amr_parent_fill_wave per-peer aggregated ISEND (I3)
+ integer, parameter :: XA_F2W_RCV = 36 !< s_amr_parent_fill_wave per-peer aggregated IRECV
+ integer, parameter :: XA_F6W_SND = 37 !< s_amr_fine_fine_halo per-peer aggregated ISEND (I5-F6)
+ integer, parameter :: XA_F6W_RCV = 38 !< s_amr_fine_fine_halo per-peer aggregated IRECV
+ integer, parameter :: XA_F5W_FACE_SND = 39 !< s_amr_reflux_faces_wave ISEND (I5-F5a, zero-copy)
+ integer, parameter :: XA_F5W_FACE_RCV = 40 !< s_amr_reflux_faces_wave IRECV
+ integer, parameter :: XA_F5W_FREG_SND = 41 !< s_amr_freg_wave ISEND (I5-F5b)
+ integer, parameter :: XA_F5W_FREG_RCV = 42 !< s_amr_freg_wave IRECV
+ integer, parameter :: XA_F7W_SND = 43 !< s_amr_restrict_l1_wave per-peer aggregated ISEND (I5b)
+ integer, parameter :: XA_F7W_RCV = 44 !< s_amr_restrict_l1_wave per-peer aggregated IRECV
+ integer, parameter :: XA_F7BW_SND = 45 !< s_amr_restrict_parent_wave per-peer aggregated ISEND (I5b)
+ integer, parameter :: XA_F7BW_RCV = 46 !< s_amr_restrict_parent_wave per-peer aggregated IRECV
+ integer, parameter :: XA_NSITE = 46
+ integer, parameter :: xa_fam(XA_NSITE) = [XA_F1, XA_F1, XA_F3, XA_F3, XA_F2, XA_F2, XA_F4, XA_F4, XA_F5, XA_F5, XA_F5, XA_F5, &
+ & XA_F6, XA_F6, XA_F7, XA_F7, XA_F7, XA_F7, XA_F7, XA_F7, XA_FL0, XA_FL0, XA_FL0, XA_FL0, &
+ & XA_FL0, XA_FL0, XA_FL0, XA_FL0, XA_FL0, XA_FL0, XA_F1, XA_F1, XA_F3, XA_F3, XA_F2, XA_F2, &
+ & XA_F6, XA_F6, XA_F5, XA_F5, XA_F5, XA_F5, XA_F7, XA_F7, XA_F7, XA_F7]
+
+ ! dir 1 = send, 2 = recv; a SENDRECV site records both.
+ integer(8) :: xa_msgs(XA_NSITE, 2) = 0_8
+ integer(8) :: xa_words(XA_NSITE, 2) = 0_8
+ integer :: xa_tag_min(XA_NSITE) = huge(0)
+ integer :: xa_tag_max(XA_NSITE) = -huge(0)
+
+ ! I1b: per-xfer identity header (amr_plan_based_exchange.md "I1b implementation binding").
+ ! XA_NH real(wp) words - [site, blk, bl(3), bh(3)] as exact integer-valued reals - are
+ ! PREPENDED to each converted family's wire payload under MFC_DEBUG and verified at unpack,
+ ! so a plan/pack disagreement (wrong slab, wrong block, crossed families) aborts at the
+ ! receiver instead of silently corrupting the patch. Zero in production, so every wire
+ ! count/offset adds XA_NH unconditionally and the release arithmetic is untouched.
+#ifdef MFC_DEBUG
+ integer, parameter :: XA_NH = 8
+#else
+ integer, parameter :: XA_NH = 0
+#endif
+
+ private; public :: s_xa_rec, s_xa_report, s_xa_reset, XA_NH, s_xa_hdr_pack, s_xa_hdr_check, XA_F1_SND, XA_F1_RCV, XA_F3_SND, &
+ & XA_F3_RCV, XA_F2_SND, XA_F2_RCV, XA_F4_SND, XA_F4_RCV, XA_F5_FACE_SND, XA_F5_FACE_RCV, XA_F5_FREG_SND, XA_F5_FREG_RCV, &
+ & XA_F6_XY, XA_F6_YX, XA_F7A_SND, XA_F7A_RCV, XA_F7B_SND, XA_F7B_RCV, XA_F7C_SND, XA_F7C_RCV, XA_L0_FILL_SND, &
+ & XA_L0_FILL_RCV, XA_L0_SCAT_SND, XA_L0_SCAT_RCV, XA_L0_RFLX_SND, XA_L0_RFLX_RCV, XA_L0_REST_SND, XA_L0_REST_RCV, &
+ & XA_L0_MIGR_SND, XA_L0_MIGR_RCV, XA_F1W_SND, XA_F1W_RCV, XA_F3W_SND, XA_F3W_RCV, XA_F2W_SND, XA_F2W_RCV, XA_F6W_SND, &
+ & XA_F6W_RCV, XA_F5W_FACE_SND, XA_F5W_FACE_RCV, XA_F5W_FREG_SND, XA_F5W_FREG_RCV, XA_F7W_SND, XA_F7W_RCV, XA_F7BW_SND, &
+ & XA_F7BW_RCV
+
+contains
+
+ !> Record one transfer at the MPI call site itself. idir: 1 = send, 2 = recv. nwords is the MPI count argument verbatim; tag is
+ !! the tag argument verbatim.
+ impure subroutine s_xa_rec(isite, idir, nwords, tag)
+
+ integer, intent(in) :: isite, idir, nwords, tag
+
+ xa_msgs(isite, idir) = xa_msgs(isite, idir) + 1_8
+ xa_words(isite, idir) = xa_words(isite, idir) + int(nwords, 8)
+ xa_tag_min(isite) = min(xa_tag_min(isite), tag)
+ xa_tag_max(isite) = max(xa_tag_max(isite), tag)
+
+ end subroutine s_xa_rec
+
+ !> Write the XA_NH-word identity header into buf(1:XA_NH): the sending site id, the block the payload is for, and the slab [bl,
+ !! bh] the sender packed. Call only under `if (XA_NH > 0)`.
+ impure subroutine s_xa_hdr_pack(buf, isite, blk, bl, bh)
+
+ real(wp), intent(inout) :: buf(:)
+ integer, intent(in) :: isite, blk, bl(3), bh(3)
+
+ buf(1) = real(isite, wp); buf(2) = real(blk, wp)
+ buf(3:5) = real(bl, wp); buf(6:8) = real(bh, wp)
+
+ end subroutine s_xa_hdr_pack
+
+ !> Verify a received header against what THIS unpack believes it is consuming. isite is the expected SENDING site id (the
+ !! matched _SND constant). Aborts with both sides on mismatch - a plan/pack disagreement caught at the wire, before it corrupts
+ !! the patch.
+ impure subroutine s_xa_hdr_check(buf, isite, blk, bl, bh)
+
+ real(wp), intent(in) :: buf(:)
+ integer, intent(in) :: isite, blk, bl(3), bh(3)
+ integer :: got(8), i
+ character(len=256) :: msg
+
+ got = nint(buf(1:8))
+ if (got(1) /= isite .or. got(2) /= blk .or. any(got(3:5) /= bl) .or. any(got(6:8) /= bh)) then
+ write (msg, &
+ & '(A,I0,A,I0,A,3(I0,1x),A,3(I0,1x),A,I0,A,I0,A,3(I0,1x),A,3(I0,1x))') &
+ & 'amr xchg header mismatch: expected site ', isite, ' blk ', blk, ' lo ', (bl(i), i=1, 3), 'hi ', (bh(i), &
+ & i=1, 3), '| got site ', got(1), ' blk ', got(2), ' lo ', (got(i), i=3, 5), 'hi ', (got(i), i=6, 8)
+ call s_mpi_abort(trim(msg))
+ end if
+
+ end subroutine s_xa_hdr_check
+
+ !> Zero the accumulators (a future per-window use; finalize-report runs cumulative).
+ impure subroutine s_xa_reset()
+
+ xa_msgs = 0_8; xa_words = 0_8
+ xa_tag_min = huge(0); xa_tag_max = -huge(0)
+
+ end subroutine s_xa_reset
+
+ !> Finalize-time report + the per-family conservation check: global send msgs/words must equal global recv msgs/words within
+ !! each family (every family's sites are internally matched; a violation means a dropped, duplicated, or misattributed
+ !! transfer). Collective over MPI_COMM_WORLD - call it from a point every rank reaches (module finalize).
+ impure subroutine s_xa_report()
+
+ integer(8) :: fam_m(XA_NFAM, 2), fam_w(XA_NFAM, 2)
+ integer(8) :: gm(XA_NFAM, 2), gw(XA_NFAM, 2)
+ integer :: i, f
+ character(len=3), parameter :: fam_name(XA_NFAM) = ['F1 ', 'F2 ', 'F3 ', 'F4 ', 'F5 ', 'F6 ', 'F7 ', 'L0 ']
+
+ fam_m = 0_8; fam_w = 0_8
+ do i = 1, XA_NSITE
+ f = xa_fam(i)
+ fam_m(f,:) = fam_m(f,:) + xa_msgs(i,:)
+ fam_w(f,:) = fam_w(f,:) + xa_words(i,:)
+ end do
+ gm = fam_m; gw = fam_w
+#ifdef MFC_MPI
+ block
+ integer :: ierr
+ call MPI_ALLREDUCE(fam_m, gm, XA_NFAM*2, MPI_INTEGER8, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(fam_w, gw, XA_NFAM*2, MPI_INTEGER8, MPI_SUM, MPI_COMM_WORLD, ierr)
+ end block
+#endif
+ if (rank_time_wrt .and. proc_rank == 0) then
+ do f = 1, XA_NFAM
+ if (gm(f, 1) == 0_8 .and. gm(f, 2) == 0_8) cycle
+ write (0, '(A,A,A,I0,A,I0,A,I0,A,I0,A)') '[amr-xa] ', fam_name(f), ' snd ', gm(f, 1), ' msgs ', gw(f, 1), &
+ & ' words | rcv ', gm(f, 2), ' msgs ', gw(f, 2), ' words'
+ end do
+ end if
+ ! conservation: what the senders posted is what the receivers took, family by family
+ do f = 1, XA_NFAM
+ @:ASSERT(gm(f, 1) == gm(f, 2), "amr xchg audit: send/recv MESSAGE count mismatch in family "//fam_name(f))
+ @:ASSERT(gw(f, 1) == gw(f, 2), "amr xchg audit: send/recv WORD count mismatch in family "//fam_name(f))
+ end do
+
+ end subroutine s_xa_report
+
+end module m_amr_xchg_audit
diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp
index 3c95195278..8086f41772 100644
--- a/src/simulation/m_body_forces.fpp
+++ b/src/simulation/m_body_forces.fpp
@@ -59,12 +59,12 @@ contains
if (n > 0) then
if (p > 0) then
- @:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))
+ @:ALLOCATE(rhoM(-buff_size:buff_size + m_alloc, -buff_size:buff_size + n_alloc, -buff_size:buff_size + p_alloc))
else
- @:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))
+ @:ALLOCATE(rhoM(-buff_size:buff_size + m_alloc, -buff_size:buff_size + n_alloc, 0:0))
end if
else
- @:ALLOCATE(rhoM(-buff_size:buff_size + m, 0:0, 0:0))
+ @:ALLOCATE(rhoM(-buff_size:buff_size + m_alloc, 0:0, 0:0))
end if
if (bf_spatial_support) then
diff --git a/src/simulation/m_bubbles_EE.fpp b/src/simulation/m_bubbles_EE.fpp
index e2d354e86d..12ca630d29 100644
--- a/src/simulation/m_bubbles_EE.fpp
+++ b/src/simulation/m_bubbles_EE.fpp
@@ -52,14 +52,15 @@ contains
$:GPU_UPDATE(device='[rs, vs]')
$:GPU_UPDATE(device='[ps, ms]')
- @:ALLOCATE(divu%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(divu%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(divu)
- @:ALLOCATE(bub_adv_src(0:m, 0:n, 0:p))
- @:ALLOCATE(bub_r_src(0:m, 0:n, 0:p, 1:nb))
- @:ALLOCATE(bub_v_src(0:m, 0:n, 0:p, 1:nb))
- @:ALLOCATE(bub_p_src(0:m, 0:n, 0:p, 1:nb))
- @:ALLOCATE(bub_m_src(0:m, 0:n, 0:p, 1:nb))
+ @:ALLOCATE(bub_adv_src(0:m_alloc, 0:n_alloc, 0:p_alloc))
+ @:ALLOCATE(bub_r_src(0:m_alloc, 0:n_alloc, 0:p_alloc, 1:nb))
+ @:ALLOCATE(bub_v_src(0:m_alloc, 0:n_alloc, 0:p_alloc, 1:nb))
+ @:ALLOCATE(bub_p_src(0:m_alloc, 0:n_alloc, 0:p_alloc, 1:nb))
+ @:ALLOCATE(bub_m_src(0:m_alloc, 0:n_alloc, 0:p_alloc, 1:nb))
if (adap_dt .and. f_is_default(adap_dt_tol)) adap_dt_tol = dflt_adap_dt_tol
diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp
index 62a512ef13..752dc5d513 100644
--- a/src/simulation/m_bubbles_EL.fpp
+++ b/src/simulation/m_bubbles_EL.fpp
@@ -127,11 +127,12 @@ contains
end if
do i = 1, q_beta_idx
- @:ALLOCATE(q_beta(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(q_beta(i)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(q_beta(i))
if (lag_params%kahan_summation) then
- @:ALLOCATE(kahan_comp(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(kahan_comp(i)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(kahan_comp(i))
end if
end do
@@ -184,26 +185,26 @@ contains
$:GPU_UPDATE(device='[moving_lag_bubbles, lag_pressure_force, lag_gravity_force, lag_vel_model, lag_drag_model]')
if (lag_params%vel_model > 0 .and. lag_params%pressure_force) then
- @:ALLOCATE(grad_p_x(0:m, 0:n, 0:p))
- @:ALLOCATE(fd_coeff_x_pgrad(-fd_number:fd_number, 0:m))
+ @:ALLOCATE(grad_p_x(0:m_alloc, 0:n_alloc, 0:p_alloc))
+ @:ALLOCATE(fd_coeff_x_pgrad(-fd_number:fd_number, 0:m_alloc))
call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_pgrad, buff_size, fd_number, fd_order)
$:GPU_UPDATE(device='[fd_coeff_x_pgrad]')
if (n > 0) then
- @:ALLOCATE(grad_p_y(0:m, 0:n, 0:p))
- @:ALLOCATE(fd_coeff_y_pgrad(-fd_number:fd_number, 0:n))
+ @:ALLOCATE(grad_p_y(0:m_alloc, 0:n_alloc, 0:p_alloc))
+ @:ALLOCATE(fd_coeff_y_pgrad(-fd_number:fd_number, 0:n_alloc))
call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_pgrad, buff_size, fd_number, fd_order)
$:GPU_UPDATE(device='[fd_coeff_y_pgrad]')
end if
if (p > 0) then
- @:ALLOCATE(grad_p_z(0:m, 0:n, 0:p))
- @:ALLOCATE(fd_coeff_z_pgrad(-fd_number:fd_number, 0:p))
+ @:ALLOCATE(grad_p_z(0:m_alloc, 0:n_alloc, 0:p_alloc))
+ @:ALLOCATE(fd_coeff_z_pgrad(-fd_number:fd_number, 0:p_alloc))
call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_pgrad, buff_size, fd_number, fd_order)
$:GPU_UPDATE(device='[fd_coeff_z_pgrad]')
end if
end if
- @:ALLOCATE(cell_list_start(0:m, 0:n, 0:p))
- @:ALLOCATE(cell_list_count(0:m, 0:n, 0:p))
+ @:ALLOCATE(cell_list_start(0:m_alloc, 0:n_alloc, 0:p_alloc))
+ @:ALLOCATE(cell_list_count(0:m_alloc, 0:n_alloc, 0:p_alloc))
@:ALLOCATE(cell_list_idx(1:lag_params%nBubs_glb))
call s_read_input_bubbles(q_cons_vf, bc_type)
@@ -1969,6 +1970,28 @@ contains
end subroutine s_write_restart_lag_bubbles
+ !> Physical-space bounding box of this rank's Lagrangian bubbles (committed step positions, register 1). Rank-local: the caller
+ !! allreduces if it needs the global cloud. Returns pmin > pmax when the rank holds no bubbles.
+ impure subroutine s_lag_cloud_bbox_local(pmin, pmax)
+
+ real(wp), dimension(3), intent(out) :: pmin, pmax
+ real(wp) :: x1n, x2n, x3n, x1x, x2x, x3x
+ integer :: k
+
+ x1n = huge(1._wp); x2n = huge(1._wp); x3n = huge(1._wp)
+ x1x = -huge(1._wp); x2x = -huge(1._wp); x3x = -huge(1._wp)
+ $:GPU_PARALLEL_LOOP(private='[k]', reduction='[[x1n, x2n, x3n], [x1x, x2x, x3x]]', reductionOp='[MIN, MAX]', copy='[x1n, &
+ & x2n, x3n, x1x, x2x, x3x]')
+ do k = 1, n_el_bubs_loc
+ x1n = min(x1n, mtn_pos(k, 1, 1)); x1x = max(x1x, mtn_pos(k, 1, 1))
+ x2n = min(x2n, mtn_pos(k, 2, 1)); x2x = max(x2x, mtn_pos(k, 2, 1))
+ x3n = min(x3n, mtn_pos(k, 3, 1)); x3x = max(x3x, mtn_pos(k, 3, 1))
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ pmin = [x1n, x2n, x3n]; pmax = [x1x, x2x, x3x]
+
+ end subroutine s_lag_cloud_bbox_local
+
!> Compute the maximum and minimum radius of each bubble
subroutine s_calculate_lag_bubble_stats()
diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp
index bc72c87bdf..b629fe5c0c 100644
--- a/src/simulation/m_cbc.fpp
+++ b/src/simulation/m_cbc.fpp
@@ -12,6 +12,7 @@ module m_cbc
use m_global_parameters
use m_variables_conversion
use m_compute_cbc
+ use m_riemann_state, only: flux_rsx_vf, flux_src_rsx_vf
use m_constants, only: riemann_solver_hll, model_eqns_gamma_law, recon_type_weno, recon_type_muscl
use m_thermochem, only: get_mixture_energy_mass, get_mixture_specific_heat_cv_mass, get_mixture_specific_heat_cp_mass, &
& gas_constant, get_mixture_molecular_weight, get_species_enthalpies_rt, molecular_weights, get_species_specific_heats_r, &
@@ -461,18 +462,17 @@ contains
end subroutine s_associate_cbc_coefficients_pointers
!> Apply characteristic boundary conditions by modifying fluxes near domain boundaries
- subroutine s_cbc(q_prim_vf, flux_vf, flux_src_vf, cbc_dir_norm, cbc_loc_norm, ix, iy, iz)
-
- type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf
- integer, intent(in) :: cbc_dir_norm, cbc_loc_norm
- type(int_bounds_info), intent(in) :: ix, iy, iz
- real(wp) :: drho_dt
- real(wp) :: dpres_dt
- real(wp) :: dgamma_dt
- real(wp) :: dpi_inf_dt
- real(wp) :: dqv_dt
- real(wp) :: dpres_ds
+ subroutine s_cbc(q_prim_vf, cbc_dir_norm, cbc_loc_norm, ix, iy, iz)
+
+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
+ integer, intent(in) :: cbc_dir_norm, cbc_loc_norm
+ type(int_bounds_info), intent(in) :: ix, iy, iz
+ real(wp) :: drho_dt
+ real(wp) :: dpres_dt
+ real(wp) :: dgamma_dt
+ real(wp) :: dpi_inf_dt
+ real(wp) :: dqv_dt
+ real(wp) :: dpres_ds
#:if USING_AMD
real(wp), dimension(20) :: L
@@ -519,7 +519,7 @@ contains
$:GPU_UPDATE(device='[cbc_dir, cbc_loc]')
- call s_initialize_cbc(q_prim_vf, flux_vf, flux_src_vf, ix, iy, iz)
+ call s_initialize_cbc(q_prim_vf, ix, iy, iz)
call s_associate_cbc_coefficients_pointers(cbc_dir, cbc_loc)
@@ -922,15 +922,14 @@ contains
! The reshaping of outputted data and disssociation of the FD and PI coefficients, or CBC coefficients, respectively, based
! on selected CBC coordinate direction.
- call s_finalize_cbc(flux_vf, flux_src_vf)
+ call s_finalize_cbc()
end subroutine s_cbc
!> Set up the selected CBC for the current boundary
- subroutine s_initialize_cbc(q_prim_vf, flux_vf, flux_src_vf, ix, iy, iz)
+ subroutine s_initialize_cbc(q_prim_vf, ix, iy, iz)
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
- type(scalar_field), dimension(sys_size), intent(in) :: flux_vf, flux_src_vf
type(int_bounds_info), intent(in) :: ix, iy, iz
integer :: i, j, k, r !< Generic loop iterators
! Configuring the coordinate direction indexes and flags
@@ -984,7 +983,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_rsx_vf_l(j, k, r, i) = flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r)*sign(1._wp, -1._wp*cbc_loc)
+ flux_rsx_vf_l(j, k, r, i) = flux_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -995,7 +994,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_rsx_vf_l(j, k, r, eqn_idx%mom%beg) = flux_vf(eqn_idx%mom%beg)%sf(dj*((m - 1) - 2*j) + j, k, r)
+ flux_rsx_vf_l(j, k, r, eqn_idx%mom%beg) = flux_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, eqn_idx%mom%beg)
end do
end do
end do
@@ -1007,7 +1006,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_rsx_vf_l(j, k, r, i) = flux_src_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r)
+ flux_src_rsx_vf_l(j, k, r, i) = flux_src_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, i)
end do
end do
end do
@@ -1018,8 +1017,8 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_rsx_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_vf(eqn_idx%adv%beg)%sf(dj*((m - 1) - 2*j) + j, &
- & k, r)*sign(1._wp, -1._wp*cbc_loc)
+ flux_src_rsx_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, &
+ & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1058,7 +1057,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_rsy_vf_l(j, k, r, i) = flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r)*sign(1._wp, -1._wp*cbc_loc)
+ flux_rsy_vf_l(j, k, r, i) = flux_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, i)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1069,7 +1068,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_rsy_vf_l(j, k, r, eqn_idx%mom%beg + 1) = flux_vf(eqn_idx%mom%beg + 1)%sf(k, dj*((n - 1) - 2*j) + j, r)
+ flux_rsy_vf_l(j, k, r, eqn_idx%mom%beg + 1) = flux_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, eqn_idx%mom%beg + 1)
end do
end do
end do
@@ -1081,7 +1080,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_rsy_vf_l(j, k, r, i) = flux_src_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r)
+ flux_src_rsy_vf_l(j, k, r, i) = flux_src_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, i)
end do
end do
end do
@@ -1092,8 +1091,8 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_rsy_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_vf(eqn_idx%adv%beg)%sf(k, &
- & dj*((n - 1) - 2*j) + j, r)*sign(1._wp, -1._wp*cbc_loc)
+ flux_src_rsy_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, &
+ & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1132,7 +1131,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_rsz_vf_l(j, k, r, i) = flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j)*sign(1._wp, -1._wp*cbc_loc)
+ flux_rsz_vf_l(j, k, r, i) = flux_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, i)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1143,7 +1142,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_rsz_vf_l(j, k, r, eqn_idx%mom%end) = flux_vf(eqn_idx%mom%end)%sf(r, k, dj*((p - 1) - 2*j) + j)
+ flux_rsz_vf_l(j, k, r, eqn_idx%mom%end) = flux_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, eqn_idx%mom%end)
end do
end do
end do
@@ -1155,7 +1154,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_rsz_vf_l(j, k, r, i) = flux_src_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j)
+ flux_src_rsz_vf_l(j, k, r, i) = flux_src_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, i)
end do
end do
end do
@@ -1166,8 +1165,8 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_rsz_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_vf(eqn_idx%adv%beg)%sf(r, k, &
- & dj*((p - 1) - 2*j) + j)*sign(1._wp, -1._wp*cbc_loc)
+ flux_src_rsz_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, &
+ & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1182,10 +1181,9 @@ contains
end subroutine s_initialize_cbc
!> Deallocation and/or the disassociation procedures that are necessary in order to finalize the CBC application
- subroutine s_finalize_cbc(flux_vf, flux_src_vf)
+ subroutine s_finalize_cbc()
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf
- integer :: i, j, k, r !< Generic loop iterators
+ integer :: i, j, k, r !< Generic loop iterators
! Determining the indicial shift based on CBC location
dj = max(0, cbc_loc)
@@ -1198,7 +1196,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_rsx_vf_l(j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
+ flux_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, i) = flux_rsx_vf_l(j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1208,7 +1206,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_vf(eqn_idx%mom%beg)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_rsx_vf_l(j, k, r, eqn_idx%mom%beg)
+ flux_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, eqn_idx%mom%beg) = flux_rsx_vf_l(j, k, r, eqn_idx%mom%beg)
end do
end do
end do
@@ -1220,7 +1218,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_src_rsx_vf_l(j, k, r, i)
+ flux_src_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, i) = flux_src_rsx_vf_l(j, k, r, i)
end do
end do
end do
@@ -1231,8 +1229,8 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_vf(eqn_idx%adv%beg)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_src_rsx_vf_l(j, k, r, &
- & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
+ flux_src_rsx_vf(dj*((m - 1) - 2*j) + j, k, r, eqn_idx%adv%beg) = flux_src_rsx_vf_l(j, k, r, &
+ & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1247,7 +1245,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_rsy_vf_l(j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
+ flux_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, i) = flux_rsy_vf_l(j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1258,7 +1256,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_vf(eqn_idx%mom%beg + 1)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_rsy_vf_l(j, k, r, eqn_idx%mom%beg + 1)
+ flux_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, eqn_idx%mom%beg + 1) = flux_rsy_vf_l(j, k, r, eqn_idx%mom%beg + 1)
end do
end do
end do
@@ -1270,7 +1268,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_src_rsy_vf_l(j, k, r, i)
+ flux_src_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, i) = flux_src_rsy_vf_l(j, k, r, i)
end do
end do
end do
@@ -1281,8 +1279,8 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_vf(eqn_idx%adv%beg)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_src_rsy_vf_l(j, k, r, &
- & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
+ flux_src_rsx_vf(k, dj*((n - 1) - 2*j) + j, r, eqn_idx%adv%beg) = flux_src_rsy_vf_l(j, k, r, &
+ & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1298,7 +1296,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_rsz_vf_l(j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
+ flux_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, i) = flux_rsz_vf_l(j, k, r, i)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
@@ -1309,7 +1307,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_vf(eqn_idx%mom%end)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_rsz_vf_l(j, k, r, eqn_idx%mom%end)
+ flux_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, eqn_idx%mom%end) = flux_rsz_vf_l(j, k, r, eqn_idx%mom%end)
end do
end do
end do
@@ -1321,7 +1319,7 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_src_rsz_vf_l(j, k, r, i)
+ flux_src_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, i) = flux_src_rsz_vf_l(j, k, r, i)
end do
end do
end do
@@ -1332,8 +1330,8 @@ contains
do r = is3%beg, is3%end
do k = is2%beg, is2%end
do j = -1, buff_size
- flux_src_vf(eqn_idx%adv%beg)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_src_rsz_vf_l(j, k, r, &
- & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
+ flux_src_rsx_vf(r, k, dj*((p - 1) - 2*j) + j, eqn_idx%adv%beg) = flux_src_rsz_vf_l(j, k, r, &
+ & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc)
end do
end do
end do
diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp
index 0c1bc8f2da..2c3ecce53a 100644
--- a/src/simulation/m_checker.fpp
+++ b/src/simulation/m_checker.fpp
@@ -11,7 +11,8 @@ module m_checker
use m_global_parameters
use m_mpi_proxy
use m_helper
- use m_constants, only: recon_type_weno, recon_type_muscl
+ use m_constants, only: recon_type_weno, recon_type_muscl, time_stepper_rk3, BC_RIEMANN_EXTRAP, BC_CHAR_SLIP_WALL, &
+ & BC_CHAR_SUP_OUTFLOW
implicit none
@@ -34,6 +35,92 @@ contains
end if
end if
+ if (active_box) then
+ ! Declared limitation rather than a silent runtime downgrade: the active box is a single global region, so under
+ ! decomposition the ranks whose subdomain it misses would idle while the covering ranks do all the work. Making it
+ ! multi-rank is a load-balance problem, not a geometry one, and is deferred. Fail closed so a production multi-rank
+ ! run cannot quietly get full-domain compute plus a warning line.
+ ! lint: runtime-check num_procs is the MPI rank count, not a case-file value
+ @:PROHIBIT(num_procs > 1, &
+ & "active_box supports a single MPI rank only: a single global active region leaves the " &
+ & // "ranks it does not cover idle, so multi-rank support needs load balancing and is not yet " &
+ & // "implemented. Unset active_box or run on one rank.")
+ end if
+
+ ! lint: runtime-check num_procs is the MPI rank count, not a case-file value
+ @:PROHIBIT(load_balance .and. num_procs == 1, "load_balance requires more than one MPI rank")
+
+ if (amr) then
+ ! Euler-Euler bubbles disabled under amr (2026-08-25): the mpp_lim pre-conversion rescale
+ ! and the pb/mv quadrature side-state force per-block special cases through the batched
+ ! advance (Phase 2); the support was retired rather than carried. qbmm requires
+ ! bubbles_euler, so this also gates all AMR QBMM paths.
+ ! 6-equation: internal-energy equations prolong/restrict on the generic conservative
+ ! path; cell-local per-stage pressure relaxation also runs per fine block, mirroring
+ ! the coarse stage order.
+ ! Riemann-extrapolation BCs modify the WENO coefficient rows near the domain boundary;
+ ! the fine advance reuses or block-locally recomputes those arrays, and neither form
+ ! carries the coarse boundary special-casing onto an interior block correctly.
+ ! The s_cbc call sites key on the bc value alone: during the fine advance they would apply the
+ ! characteristic treatment at fine-block edges in the DOMAIN INTERIOR, against CBC scratch sized to
+ ! the coarse subdomain. Support needs an advance-aware gate, not inheritance.
+ ! hypoelasticity supported: stress components prolong via the generic conservative-linear
+ ! path; the swap/restore recomputes the spacing-dependent FD coefficients per grid.
+ ! MHD gated ON MEASURED EVIDENCE: B/psi ride the generic conservative machinery, but the
+ ! per-component prolongation/reflux is not divergence-preserving - on a magnetized 2D
+ ! Brio-Wu the c/f seam is a continuous O(1) monopole source GLM cleaning spreads but
+ ! cannot remove (max|divB| 0.53 block-interior, 0.36 far-field vs the no-AMR 1.4e-3
+ ! cleaning background; HLLD, with no GLM coupling, NaNs outright). MHD needs
+ ! divergence-preserving (constrained-transport class) prolongation and reflux for B.
+ ! 1D MHD/RMHD is exempt: div(B) = d(Bx)/dx and 1D evolves only By/Bz (Bx is the uniform
+ ! Bx0 parameter), so div(B) is IDENTICALLY zero - the failure mode is structurally
+ ! absent and By/Bz reflux/restrict as ordinary conserved scalars.
+ ! IGR supported with restriction-only coarse/fine coupling (stage 1): the fine block runs
+ ! its own fixed-iteration sigma solve, seeded and Dirichlet-bounded by the converged
+ ! coarse sigma; Berger-Colella reflux is not yet captured from the fused IGR flux
+ ! kernels, so seam conservation is truncation-order, not exact.
+ ! The fine block's sigma Dirichlet seed is injected from the OWNER's LOCAL coarse jac
+ ! (s_amr_igr_swap_sigma), clamped to the owner's buffer bounds - unlike q_cons it is NOT
+ ! P2P-gathered, so a block whose footprint or ghost shell crosses a rank boundary reads
+ ! clamped edge values, not the neighbour's sigma. Fail-closed at np>1.
+ ! lint: runtime-check num_procs is the MPI rank count, not a case-file value
+ @:PROHIBIT(igr .and. num_procs > 1, &
+ & "amr with the IGR solver is only supported at num_procs = 1: the fine block's sigma (jac) Dirichlet seed is injected from the owner's LOCAL coarse jac (not P2P-gathered like q_cons), so a block crossing a rank boundary would read clamped edge values")
+ ! Lagrangian bubbles supported with the cloud EXCLUDED from fine blocks (two-way coupling
+ ! lives on the coarse grid): regrid suppresses tags and clips boxes around the cloud's
+ ! padded bbox; a per-stage guard aborts if the cloud reaches a block.
+ ! 2D axisymmetric supported: geometric sources read the live grid arrays the fine swap
+ ! replaces, and the axis-singularity viscous treatment is skipped on fine blocks (blocks
+ ! cannot touch the axis - the domain-edge clamp keeps them buff_size inside).
+ ! 3D cylindrical gated: its per-stage azimuthal Fourier filter is a global operation
+ ! incompatible with the block-local fine advance.
+ ! 2D axisymmetric conservation (radius-weighted restriction + area-weighted reflux) is
+ ! implemented for the L0/L1 coarse frame only. Multi-level folds/refluxes in the
+ ! PARENT-FINE frame (host-only per-block coords) are not radius-weighted - fail-closed
+ ! under cyl_coord.
+ ! static-body IB AMR (SP20) + prescribed-motion moving bodies (SP21): fixed or
+ ! analytically-moving (moving_ibm==1) bodies resolved on a static fine block. Multi-body
+ ! (num_ibs>1) supported - every body shares the one static block and reuses the
+ ! multi-body-capable core IB setup. Force/torque-driven motion (moving_ibm==2) and STL
+ ! geometry remain gated (unvalidated).
+ ! dynamic regrid with bodies (static or prescribed-motion): candidate boxes expand to
+ ! fully contain every body at its LIVE position (partial coverage is untested),
+ ! overlapping expansions merge, and the fine IB state is rebuilt from the geometry after
+ ! every regrid. Between regrids a moving body's containment is guarded per substage
+ ! (abort if it reaches the block boundary).
+ ! active_box supported (np=1 by active_box's own gate): blocks must sit strictly inside
+ ! the monotonically-growing active window (init check + regrid clamp; the windowed coarse
+ ! update would drop reflux corrections at faces outside it), and the fine advance disables
+ ! the coarse-indexed windowing on the swapped block grid.
+ ! no acoustic_source gate: acoustic sources act on the coarse grid only (spatial support
+ ! precomputed as coarse cell indices). A startup check aborts if the support overlaps the
+ ! user-placed initial block; dynamic regrid keeps its boxes clear of the support (tags
+ ! suppressed, candidate boxes clipped), so the source region stays coarse.
+ ! lint: runtime-check num_procs is the MPI rank count, not a case-file value
+ @:PROHIBIT(amr_max_level > 1 .and. ib .and. num_procs > 1, &
+ & "multi-level AMR (amr_max_level > 1) with immersed boundaries is only supported at num_procs = 1 (the fine-IB image-point stencil is not decomposition-exact across a rank seam)")
+ end if
+
if (ib .and. chemistry) then
call s_check_inputs_ib_injection
end if
diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp
index 22bde22e12..1d25f82991 100644
--- a/src/simulation/m_data_output.fpp
+++ b/src/simulation/m_data_output.fpp
@@ -20,6 +20,9 @@ module m_data_output
use m_ibm
use m_boundary_common
use m_constants, only: model_eqns_5eq, precision_single
+ use m_load_weight, only: load_weight, s_compute_load_weight, s_report_load_imbalance
+ use m_rank_timing, only: s_report_rank_time
+ use m_sfc_partition, only: s_compute_sfc_partition, s_report_sfc_partition
implicit none
@@ -54,6 +57,22 @@ contains
type(scalar_field), intent(inout), optional :: beta
type(integer_field), dimension(1:num_dims,-1:1), intent(in) :: bc_type
+ ! One load-weight compute serves both writers (s_compute_sfc_partition reads the host copy).
+
+ if (load_weight_wrt .or. sfc_partition_wrt) then
+ call s_compute_load_weight()
+ $:GPU_UPDATE(host='[load_weight%sf]')
+ end if
+
+ if (load_weight_wrt) call s_report_load_imbalance
+
+ if (rank_time_wrt) call s_report_rank_time
+
+ if (sfc_partition_wrt) then
+ call s_compute_sfc_partition()
+ call s_report_sfc_partition
+ end if
+
if (.not. parallel_io) then
call s_write_serial_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, bc_type, beta)
else
@@ -462,6 +481,15 @@ contains
end do
end do
end if
+
+ if (load_weight_wrt) then
+ write (file_path, '(A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/load_weight.', proc_rank, '.', t_step, '.dat'
+ open (2, FILE=trim(file_path))
+ do j = 0, m
+ write (2, FMT) x_cb(j), load_weight%sf(j, 0, 0)
+ end do
+ close (2)
+ end if
end if
if (precision == precision_single) then
@@ -546,6 +574,18 @@ contains
close (2)
end do
end if
+
+ if (load_weight_wrt) then
+ write (file_path, '(A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/load_weight.', proc_rank, '.', t_step, '.dat'
+ open (2, FILE=trim(file_path))
+ do j = 0, m
+ do k = 0, n
+ write (2, FMT) x_cb(j), y_cb(k), load_weight%sf(j, k, 0)
+ end do
+ write (2, *)
+ end do
+ close (2)
+ end if
end if
if (precision == precision_single) then
@@ -644,6 +684,21 @@ contains
close (2)
end do
end if
+
+ if (load_weight_wrt) then
+ write (file_path, '(A,I2.2,A,I6.6,A)') trim(t_step_dir) // '/load_weight.', proc_rank, '.', t_step, '.dat'
+ open (2, FILE=trim(file_path))
+ do j = 0, m
+ do k = 0, n
+ do l = 0, p
+ write (2, FMT) x_cb(j), y_cb(k), z_cb(l), load_weight%sf(j, k, l)
+ end do
+ write (2, *)
+ end do
+ write (2, *)
+ end do
+ close (2)
+ end if
end if
end subroutine s_write_serial_data_files
diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp
index 8bfc807d71..764ca64137 100644
--- a/src/simulation/m_global_parameters.fpp
+++ b/src/simulation/m_global_parameters.fpp
@@ -161,6 +161,18 @@ module m_global_parameters
! idwint are the same otherwise. Stands for "InDices With BUFFer".
type(int_bounds_info) :: idwbuff(1:3)
$:GPU_DECLARE(create='[idwbuff]')
+ !> ALLOCATION bounds for the solver working set, as distinct from the RUNTIME bounds in idwbuff. The AMR fine advance points the
+ !! solver at a block (s_amr_swap_to_fine rewrites m/idwint/idwbuff), but the arrays stay as allocated - so every array the fine
+ !! advance touches must be sized to the LARGEST grid it will ever see, which is the coarse subdomain or a refined block,
+ !! whichever is bigger. Conflating the two is what forces the block size cap to shrink with rank count (see
+ !! @ref amr_block_batching and amr_max_grid_size). Equal to idwbuff unless amr_max_grid_size pins a cap larger than the
+ !! subdomain, so this is a no-op for every non-AMR run.
+ type(int_bounds_info) :: idwbuff_alloc(1:3)
+
+ !> Interior allocation extents, the m/n/p counterpart of idwbuff_alloc above. For the scratch that sizes on bare m/n/p instead
+ !! of idwbuff: m_riemann_solvers, m_weno, and the x/y/z_cb grid-coordinate family. Equal to m/n/p unless amr_max_grid_size pins
+ !! a cap larger than the subdomain, so this is a no-op for every non-AMR run.
+ integer :: m_alloc, n_alloc, p_alloc
!> @name Herschel-Bulkley non-Newtonian viscosity: per-fluid flags and parameter arrays.
!> @{
@@ -315,8 +327,110 @@ module m_global_parameters
!> @{!
!> @}
+ !> 2a: the current fine block's computed prim vars (mom, E) were preloaded from the batched conversion
+ !! (s_amr_convert_prim_batch); s_compute_rhs skips its per-block conversion bit-identically. Host-only.
+ logical :: amr_prim_preloaded = .false.
+ !> true on the current block's single owner rank: amr_block_owner(amr_cur) == proc_rank (always true at np=1); kept by
+ !! s_set_amr_fine_geometry
+ logical :: amr_rank_owns_block = .true.
+
+ !> Current AMR fine-block box in level-0 cell indices; mirrors amr_fine%region at all times (kept by s_set_amr_fine_geometry) so
+ !! m_amr_registers can read it without a use-cycle through m_amr.
+ integer :: amr_region_lo(3) = 0, amr_region_hi(3) = 0
+
+ !> The block's coarse footprint driving the coarse<->fine gather/scatter, per dim (kept by s_set_amr_fine_geometry; collapsed
+ !! dims 0:0). Under whole-block ownership it is the ENTIRE block on its owner and empty (lo > hi) on every other rank
+ !! (amr_rank_owns_block = nonempty in all active dims). Frame is level-dependent: a LEVEL-1 block records GLOBAL level-0 cell
+ !! indices; a LEVEL>=2 owner records its PARENT block's fine-cell frame, amr_ref_ratio*(region - parent_region_lo) with the
+ !! parent's amr_ref_ratio (a level-l block's coarse side is level l-1). Local fine index 0 maps to footprint cell amr_isect_lo;
+ !! the owner holds amr_ref_ratio*(footprint width) fine cells per dim.
+ integer :: amr_isect_lo(3) = 0, amr_isect_hi(3) = 0
+
+ !> Number of currently-active AMR fine-block slots (>= 1; grows with max_grid_size tiling, multi-block regrid, and nesting) and
+ !! the working slot index selecting which slot the per-block machinery (advance/reflux/restrict/regrid/IO) operates on. Read by
+ !! m_amr and m_amr_registers (mirrors, no use-cycle).
+ integer :: amr_num_blocks = 1, amr_cur = 1
+ !> Unification pool layout (L0 tiles + AMR fine blocks in one amr_slots pool). Tiles-PREFIX: level-0 L0 tiles in slots
+ !! [1:l0_slot_off], regrid-managed fine blocks in [l0_slot_off+1 : l0_slot_off+amr_max_fine]. amr_max_fine = fine-block cap
+ !! (regrid/nesting limit); amr_max_blocks = total pool. Uncombined: l0_slot_off=0, amr_max_fine=amr_max_blocks (today's
+ !! behavior).
+ integer :: amr_max_fine = 0, l0_slot_off = 0
+
+ !> Per-slot mirror storage (allocated 1:amr_max_blocks by the AMR module): the region box, the rank's intersection, and its
+ !! ownership flag for every active block. s_set_amr_fine_geometry writes the current slot's entry; s_amr_select_slot copies a
+ !! slot's entry back into the working mirrors above so the per-block advance and the single coarse flux-register capture can
+ !! visit each block in turn without a use-cycle through m_amr.
+ integer, allocatable :: amr_region_lo_all(:,:), amr_region_hi_all(:,:)
+ integer, allocatable :: amr_isect_lo_all(:,:), amr_isect_hi_all(:,:)
+ logical, allocatable :: amr_owns_all(:)
+ !> Multi-level nesting (amr_multilevel.md): the refinement level of each active block (1..amr_max_level). A level-l block
+ !! refines a covering level-(l-1) region, so its coupling coarse side is level l-1 (L0 when l==1). amr_num_levels is the deepest
+ !! level currently populated. The block region stays in L0 cell indices at every level (the fine extent per dim is
+ !! amr_ref_ratio**level * region-width - 1).
+ integer, allocatable :: amr_block_level(:)
+ integer :: amr_num_levels = 1
+
+ !> Fine-level distribution map: SFC/work-balanced single-owner rank per active block. Governs ownership - amr_rank_owns_block =
+ !! (amr_block_owner(amr_cur) == proc_rank) - with point-to-point coarse<->fine gather/scatter between the owner and overlapping
+ !! ranks. See docs/documentation/amr_fine_distribution.md.
+ integer, allocatable :: amr_block_owner(:)
+
+ !> Monotone mesh epoch (plan-based exchange, amr_plan_based_exchange.md): incremented at EVERY site that sets
+ !! amr_seam_pairs_dirty and at the end of each slot reconciliation (exchange plans bake local slot indices, so a renumbering
+ !! invalidates them even when the box set is unchanged). The boolean cannot serve as plan staleness: it is CONSUMED by whichever
+ !! lazy seam-cache rebuild fires first, and ownership can change with no regrid. Declared here (not m_amr) so m_amr_registers
+ !! can key its participation-map rebuild on it without a use-cycle; m_amr re-exports it, so its historical importers are
+ !! unchanged.
+ integer(8) :: amr_mesh_epoch = 0
+
+ !> Participation-local flux-register index (m_amr_registers): global block slot -> dense register slot, 0 when this rank neither
+ !! owns block g, owns g's parent, nor reflux-face-participates in it. The 12 flux-register arrays are sized and swept by
+ !! amr_reg_n (the dense count), not amr_num_blocks - the register footprint was the O(GLOBAL boxes) device-memory term that
+ !! killed weak scaling at np32. Rebuilt by s_amr_reg_prepare on every mesh-epoch change; per-rank CONTENT differs (it is a local
+ !! index). Host-only: every device kernel receives dense slots by value or sweeps 1..amr_reg_n directly.
+ integer, allocatable :: amr_reg_of(:)
+ integer :: amr_reg_n = 0
+ !> Dense register slot of the working block (amr_reg_of(amr_cur), 0 if unmapped); kept by s_amr_select_slot so the per-block
+ !! register sites read it exactly where they read amr_cur today.
+ integer :: amr_reg_cur = 0
+
+ !> HALO PROBE. Every block whose metadata this rank reads goes through s_amr_select_slot, so counting the DISTINCT slots it
+ !! touches between regrids measures exactly the halo a distributed metadata design would have to carry. This is the measurement
+ !! the whole "limit 3" project rests on and nobody has taken it: if distinct-touched is O(local) the distribution works; if it
+ !! is O(global blocks) it cannot, and the architecture needs rethinking before Phases 1-4 are built. Reset per mesh epoch
+ !! because that is when a halo would be rebuilt. Cost is one logical test per call, on a path that is already O(what it
+ !! measures).
+ !> GRID EFFICIENCY: coarse cells the tagger FLAGGED, against coarse cells the accepted boxes actually COVER. tagged/covered near
+ !! 1 means refinement is tight; 0.3 means 70% of the refined volume was never asked for, which inflates the geometric advantage
+ !! and therefore the quoted payoff. Standard AMR practice reports it and MFC never has; `amr_tag_eps` and `amr_buf` are exactly
+ !! the knobs it prices.
+ integer(8) :: amr_n_tagged = 0, amr_n_covered = 0
+ logical, allocatable :: amr_touch(:)
+ integer :: amr_n_touch = 0, amr_n_touch_max = 0
+ integer(8) :: amr_touch_epoch = -1_8
+
contains
+ !> Make block slot islot the working slot: set amr_cur and copy its stored mirrors (region, intersection, ownership) into the
+ !! working globals the per-block machinery reads. Deterministic on all ranks (each holds the same slot metadata for the boxes it
+ !! intersects). No-op storage on ranks without a block (owns = F).
+ subroutine s_amr_select_slot(islot)
+
+ integer, intent(in) :: islot
+
+ if (allocated(amr_touch)) then
+ if (.not. amr_touch(islot)) then
+ amr_touch(islot) = .true.; amr_n_touch = amr_n_touch + 1
+ end if
+ end if
+ amr_cur = islot
+ amr_region_lo = amr_region_lo_all(:,islot); amr_region_hi = amr_region_hi_all(:,islot)
+ amr_isect_lo = amr_isect_lo_all(:,islot); amr_isect_hi = amr_isect_hi_all(:,islot)
+ amr_rank_owns_block = amr_owns_all(islot)
+ if (allocated(amr_reg_of)) amr_reg_cur = amr_reg_of(islot)
+
+ end subroutine s_amr_select_slot
+
!> Assigns default values to the user inputs before reading them in. This enables for an easier consistency check of these
!! parameters once they are read from the input file.
impure subroutine s_assign_default_values_to_user_inputs
@@ -492,6 +606,34 @@ contains
collision_time = dflt_real
ib_coefficient_of_friction = dflt_real
ib_state_wrt = .false.
+ load_balance = .false.
+ rank_time_wrt = .false.
+ amr = .false.
+ amr_block_beg(:) = 0
+ amr_block_end(:) = 0
+ amr_regrid_int = 0
+ amr_tag_eps = 0.1_wp
+ amr_buf = 3
+ amr_subcycle = .false.
+ ! 4 was indefensible: it caps the GLOBAL box count at four, so any real refinement binds
+ ! immediately and silently truncates the refined region (the clusterer/tiler warn, but the answer
+ ! has already changed). amr_max_blocks sizes REPLICATED METADATA only - slots are allocated
+ ! lazily for owned blocks - so a large pool costs ~11 kB/box/rank and nothing else.
+ amr_max_blocks = 1024
+ amr_max_grid_size = 0 ! 0 = derive the cap from the decomposition (rank-dependent, the historical behaviour)
+ amr_max_level = 1
+ amr_cluster_eff = 0.7_wp
+ ! B0b: 4, not 1. At 1 the floor is the algorithmic minimum of 2 and the bisection does not converge on its own --
+ ! it splits until amr_max_blocks stops it (measured: the `clustering capped` warning on 10 of 10 regrids, and lmax
+ ! exactly = amr_max_blocks), so `force`, which reads the GLOBAL accepted count, is live on every regrid. That blocks
+ ! any scoped clustering, where a rank finishing a private subtree cannot see that count. 4 is the smallest value
+ ! measured to stop the saturation; 8/16 would distort the 128^2-and-smaller test grids.
+ amr_blocking_factor = 4
+ amr_ref_ratio = 2
+ l0_ntile = 0
+ l0_migrate_step = 0
+ l0_rebalance_interval = 0
+ partition_tile_size = 8
many_ib_patch_parallelism = .false.
! Bubble modeling (sim-specific)
@@ -505,6 +647,7 @@ contains
#:endif
adv_n = .false.
+ active_box = .false.
adap_dt = .false.
adap_dt_tol = dflt_adap_dt_tol
adap_dt_max_iters = dflt_adap_dt_max_iters
@@ -917,9 +1060,26 @@ contains
& bubbles_lagrange, m, n, p, num_dims, igr, ib, fd_number)
$:GPU_UPDATE(device='[idwint, idwbuff]')
+ ! Allocation bounds: the coarse subdomain, widened to hold a refined block when amr_max_grid_size pins one larger than it.
+ ! A pinned cap of C coarse cells is amr_ref_ratio*C - 1 fine cells plus the same ghost shell. Identical to idwbuff whenever
+ ! the cap is derived (amr_max_grid_size = 0) or fits the subdomain, which is every run today.
+ idwbuff_alloc = idwbuff
+ if (amr .and. amr_max_grid_size > 0) then
+ do i = 1, num_dims
+ idwbuff_alloc(i)%end = max(idwbuff(i)%end, amr_ref_ratio*amr_max_grid_size - 1 - idwbuff(i)%beg)
+ end do
+ end if
+
+ ! Inverts idwbuff's definition (end = m - beg, m_helper_basic.fpp): recovers the interior extent the allocation bound
+ ! implies. Identically m/n/p whenever idwbuff_alloc == idwbuff, and 0 for a collapsed dim (beg = end = 0).
+ m_alloc = idwbuff_alloc(1)%end + idwbuff_alloc(1)%beg
+ n_alloc = idwbuff_alloc(2)%end + idwbuff_alloc(2)%beg
+ p_alloc = idwbuff_alloc(3)%end + idwbuff_alloc(3)%beg
+
! Configuring Coordinate Direction Indexes
if (bubbles_euler) then
- @:ALLOCATE(ptil( idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(ptil( idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end if
$:GPU_UPDATE(device='[fd_order, fd_number]')
@@ -981,26 +1141,28 @@ contains
$:GPU_UPDATE(device='[turb_pos, synth_L]')
end if
- ! Allocating grid variables for the x-, y- and z-directions
- @:ALLOCATE(x_cb(-1 - buff_size:m + buff_size))
- @:ALLOCATE(x_cc(-buff_size:m + buff_size))
- @:ALLOCATE(dx(-buff_size:m + buff_size))
+ ! Allocating grid variables for the x-, y- and z-directions. Sized on *_alloc, not m/n/p: s_amr_swap_to_fine writes a
+ ! block's own coordinates into these arrays out to slot%m + buff_size, so they must hold the largest block, not just the
+ ! coarse subdomain.
+ @:ALLOCATE(x_cb(-1 - buff_size:m_alloc + buff_size))
+ @:ALLOCATE(x_cc(-buff_size:m_alloc + buff_size))
+ @:ALLOCATE(dx(-buff_size:m_alloc + buff_size))
@:PREFER_GPU(x_cb)
@:PREFER_GPU(x_cc)
@:PREFER_GPU(dx)
if (n == 0) return
- @:ALLOCATE(y_cb(-1 - buff_size:n + buff_size))
- @:ALLOCATE(y_cc(-buff_size:n + buff_size))
- @:ALLOCATE(dy(-buff_size:n + buff_size))
+ @:ALLOCATE(y_cb(-1 - buff_size:n_alloc + buff_size))
+ @:ALLOCATE(y_cc(-buff_size:n_alloc + buff_size))
+ @:ALLOCATE(dy(-buff_size:n_alloc + buff_size))
@:PREFER_GPU(y_cb)
@:PREFER_GPU(y_cc)
@:PREFER_GPU(dy)
if (p == 0) return
- @:ALLOCATE(z_cb(-1 - buff_size:p + buff_size))
- @:ALLOCATE(z_cc(-buff_size:p + buff_size))
- @:ALLOCATE(dz(-buff_size:p + buff_size))
+ @:ALLOCATE(z_cb(-1 - buff_size:p_alloc + buff_size))
+ @:ALLOCATE(z_cc(-buff_size:p_alloc + buff_size))
+ @:ALLOCATE(dz(-buff_size:p_alloc + buff_size))
@:PREFER_GPU(z_cb)
@:PREFER_GPU(z_cc)
@:PREFER_GPU(dz)
diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp
index 3dce0a5ae7..d5fce08d98 100644
--- a/src/simulation/m_hypoelastic.fpp
+++ b/src/simulation/m_hypoelastic.fpp
@@ -16,7 +16,8 @@ module m_hypoelastic
private; public :: s_initialize_hypoelastic_module, s_finalize_hypoelastic_module, &
& s_compute_hypoelastic_rhs_finite_diff_per_sweep, s_compute_hypoelastic_rhs_iface, &
- & s_compute_hypoelastic_rhs_axisym_geom_iface, s_compute_hypoelastic_rhs_axisym_geom_dual_pass, s_compute_damage_state
+ & s_compute_hypoelastic_rhs_axisym_geom_iface, s_compute_hypoelastic_rhs_axisym_geom_dual_pass, s_compute_damage_state, &
+ & s_hypoelastic_update_fd_coeffs
real(wp), allocatable, dimension(:) :: Gs_hypo
$:GPU_DECLARE(create='[Gs_hypo]')
@@ -42,13 +43,15 @@ contains
integer :: i
@:ALLOCATE(Gs_hypo(1:num_fluids))
- @:ALLOCATE(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p))
- @:ALLOCATE(du_dx_hypo(0:m,0:n,0:p))
+ @:ALLOCATE(rho_K_field(0:m_alloc,0:n_alloc,0:p_alloc), G_K_field(0:m_alloc,0:n_alloc,0:p_alloc))
+ @:ALLOCATE(du_dx_hypo(0:m_alloc,0:n_alloc,0:p_alloc))
if (n > 0) then
- @:ALLOCATE(du_dy_hypo(0:m,0:n,0:p), dv_dx_hypo(0:m,0:n,0:p), dv_dy_hypo(0:m,0:n,0:p))
+ @:ALLOCATE(du_dy_hypo(0:m_alloc,0:n_alloc,0:p_alloc), dv_dx_hypo(0:m_alloc,0:n_alloc,0:p_alloc))
+ @:ALLOCATE(dv_dy_hypo(0:m_alloc,0:n_alloc,0:p_alloc))
if (p > 0) then
- @:ALLOCATE(du_dz_hypo(0:m,0:n,0:p), dv_dz_hypo(0:m,0:n,0:p))
- @:ALLOCATE(dw_dx_hypo(0:m,0:n,0:p), dw_dy_hypo(0:m,0:n,0:p), dw_dz_hypo(0:m,0:n,0:p))
+ @:ALLOCATE(du_dz_hypo(0:m_alloc,0:n_alloc,0:p_alloc), dv_dz_hypo(0:m_alloc,0:n_alloc,0:p_alloc))
+ @:ALLOCATE(dw_dx_hypo(0:m_alloc,0:n_alloc,0:p_alloc), dw_dy_hypo(0:m_alloc,0:n_alloc,0:p_alloc), &
+ & dw_dz_hypo(0:m_alloc,0:n_alloc,0:p_alloc))
end if
end if
@@ -57,15 +60,30 @@ contains
end do
$:GPU_UPDATE(device='[Gs_hypo]')
- @:ALLOCATE(fd_coeff_x_hypo(-fd_number:fd_number, 0:m))
+ @:ALLOCATE(fd_coeff_x_hypo(-fd_number:fd_number, 0:m_alloc))
if (n > 0) then
- @:ALLOCATE(fd_coeff_y_hypo(-fd_number:fd_number, 0:n))
+ @:ALLOCATE(fd_coeff_y_hypo(-fd_number:fd_number, 0:n_alloc))
end if
if (p > 0) then
- @:ALLOCATE(fd_coeff_z_hypo(-fd_number:fd_number, 0:p))
+ @:ALLOCATE(fd_coeff_z_hypo(-fd_number:fd_number, 0:p_alloc))
end if
! Computing centered finite difference coefficients
+ call s_hypoelastic_update_fd_coeffs()
+
+ end subroutine s_initialize_hypoelastic_module
+
+ !> (Re)compute the centered finite-difference coefficients from the current grid globals (m/n/p, x/y/z_cc) and push them to the
+ !! device. Called at init and by the AMR fine-block swap/restore, where the grid globals flip between the coarse grid and a 2:1
+ !! fine block: the coefficients are spacing-dependent, so reusing coarse ones on the fine grid would silently halve every
+ !! velocity gradient in the stress source.
+ impure subroutine s_hypoelastic_update_fd_coeffs()
+
+ ! the AMR fine-IB setup swaps grids BEFORE this module initializes (s_initialize_modules
+ ! order); no RHS runs until after init, so skipping is correct - init then computes the
+ ! coarse coefficients and every subsequent swap/restore recomputes for the active grid
+ if (.not. allocated(fd_coeff_x_hypo)) return
+
call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_hypo, buff_size, fd_number, fd_order)
$:GPU_UPDATE(device='[fd_coeff_x_hypo]')
if (n > 0) then
@@ -77,7 +95,7 @@ contains
$:GPU_UPDATE(device='[fd_coeff_z_hypo]')
end if
- end subroutine s_initialize_hypoelastic_module
+ end subroutine s_hypoelastic_update_fd_coeffs
!> Legacy FD-based hypoelastic RHS (Mode 1: HLL). Uses finite-difference velocity gradients computed from cell-centered
!! primitive variables. Called once per direction inside the dim-split loop. Supports 1D/2D/3D Cartesian and cylindrical
diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp
index 7d54dba978..6560637747 100644
--- a/src/simulation/m_ibm.fpp
+++ b/src/simulation/m_ibm.fpp
@@ -4,6 +4,53 @@
#:include 'macros.fpp'
+!> @brief Per-block fine-grid immersed-boundary state for single-body AMR (SP20 static, SP21 prescribed-motion). A SEPARATE module
+!! from m_ibm: declaring these non-declare-target derived-type allocatables inside m_ibm corrupts CCE's OpenMP declare-target
+!! descriptor table for m_ibm's ghost_points and aborts its @:ALLOCATE with "lib-4425: Uninitialized descriptor for ALLOCATE
+!! statement argument" (even for a non-AMR IBM run, which never touches this state). Keeps m_ibm's compiled image identical to the
+!! pre-AMR-IB baseline. Do not fold these declarations back into m_ibm.
+module m_ibm_fine
+
+ use m_derived_types
+
+ implicit none
+
+ !> Per-block fine IB state: each AMR slot keeps a HOST-side copy of its markers field, computed from the geometry at fine
+ !! resolution so the body is resolved on the fine block, then COPIED into m_ibm's declare-target ib_markers for the fine
+ !! advance's setup / per-substep moving recompute / correct-state and copied back. markers%sf is host-only parking storage (no
+ !! device mapping): the declare-target ib_markers is allocated once and NEVER reallocated/move_alloc'd/pointer-swapped, so the
+ !! swap syncs via GPU_UPDATE rather than churning the device present table (detach/attach/move_alloc of a declared array
+ !! corrupts it on Cray). Fine ghost-point lists park on-device in gp_park (below), not here; num_gps records each slot's
+ !! ghost-point count across a swap.
+ type ib_fine_state
+ type(integer_field) :: markers
+ integer :: num_gps
+ end type ib_fine_state
+ type(ib_fine_state), allocatable :: ib_fine(:)
+ integer :: num_gps_save
+
+ !> Device-resident park for the coarse and fine ghost-point lists across an AMR fine swap; replaces the per-slot host
+ !! ib_fine%gps. The declare-target ghost_points and ALL its consumers run on-device, so the swap copies between gp_park and
+ !! ghost_points with on-device kernels (no host round-trip). Column j (1..nslots) parks fine slot j's list; column
+ !! ib_coarse_slot parks the coarse list. Mapped dynamically via move_alloc + GPU_ENTER_DATA (the amr_cg idiom) so the bare
+ !! derived-type allocatable gets a valid descriptor - a direct @:ALLOCATE aborts with lib-4425 on CCE OpenMP-offload.
+ type(ghost_point), allocatable :: gp_park(:,:)
+
+ !> The coarse ghost points AND coarse markers park (host copies) across a fine swap in an EXTRA ib_fine slot rather than
+ !! dedicated module variables: adding ANY new module-level derived-type allocatable here corrupts a sibling allocatable's
+ !! descriptor on CCE OpenMP-offload (the plain-IBM lib-4425 class), so reuse ib_fine's proven-safe storage. ib_coarse_slot
+ !! indexes that slot (= nslots+1).
+ integer :: ib_coarse_slot = 0
+
+ !> Fine-block ghost-point capacity (= buffered fine-block cell count), set by s_ibm_alloc_fine before s_ibm_setup sizes the
+ !! declare-target ghost_points once to hold the larger of the coarse and fine lists. 0 when AMR-IB is inactive.
+ integer(kind=8) :: fine_gps_cap = 0_8
+
+ !> Bounds for the ib_markers marker field, sized once to enclose BOTH coarse and fine blocks so the declare-target ib_markers
+ !! holds either without a reallocation/pointer-swap. Set by s_ibm_alloc_fine, read by s_ibm_setup.
+ integer :: mkr_lo(3) = 0, mkr_hi(3) = 0
+end module m_ibm_fine
+
!> @brief Ghost-node immersed boundary method: locates ghost/image points, computes interpolation coefficients, and corrects the
!! flow state
module m_ibm
@@ -23,11 +70,17 @@ module m_ibm
use m_collisions
use m_thermochem, only: num_species, gas_constant, get_mixture_molecular_weight, get_mixture_energy_mass
+ ! Fine-IB AMR state (ib_fine/num_gps_save/mkr bounds) lives in a separate module, kept OUT of m_ibm's compiled image: on CCE
+ ! OpenMP-offload, declaring those derived-type allocatables here corrupts the declare-target descriptor for ghost_points and
+ ! aborts its @:ALLOCATE with lib-4425. See m_ibm_fine.
+ use m_ibm_fine
+
implicit none
private :: s_compute_image_points, s_compute_interpolation_coeffs, s_interpolate_image_point, s_find_ghost_points, &
& s_find_num_ghost_points
- ; public :: s_initialize_ibm_module, s_ibm_setup, s_ibm_correct_state, s_finalize_ibm_module
+ ; public :: ib_gbl_idx_lookup, s_initialize_ibm_module, s_ibm_setup, s_ibm_correct_state, s_finalize_ibm_module, &
+ & s_ibm_alloc_fine, s_ibm_setup_fine, s_ibm_swap_to_fine, s_ibm_restore_from_fine, num_gps
type(integer_field), public :: ib_markers
$:GPU_DECLARE(create='[ib_markers]')
@@ -53,7 +106,15 @@ contains
!> Allocates memory for the variables in the IBM module
impure subroutine s_initialize_ibm_module()
- if (p > 0) then
+ if (amr .and. ib) then
+ ! Size the declare-target ib_markers for the DEEPEST fine level: it must hold an L2 (4x) block's markers
+ ! when swapped to a fine block and conform to the level-aware park slots (s_ibm_alloc_fine) the whole-array
+ ! park/restore copies assign to/from. ib_markers is device-mapped once here and never reallocated (Cray
+ ! present-table), so the widening must happen at this ALLOCATE. At amr_max_level = 1 the bounds reduce to
+ ! the plain coarse extents (byte-identical).
+ call s_ibm_marker_bounds()
+ @:ALLOCATE(ib_markers%sf(mkr_lo(1):mkr_hi(1), mkr_lo(2):mkr_hi(2), mkr_lo(3):mkr_hi(3)))
+ else if (p > 0) then
@:ALLOCATE(ib_markers%sf(-buff_size:m+buff_size, -buff_size:n+buff_size, -buff_size:p+buff_size))
else
@:ALLOCATE(ib_markers%sf(-buff_size:m+buff_size, -buff_size:n+buff_size, 0:0))
@@ -70,8 +131,9 @@ contains
!> Initializes the values of various IBM variables, such as ghost points and image points.
impure subroutine s_ibm_setup()
- integer :: i, j, k
- integer(kind=8) :: max_num_gps
+ integer :: i, j, k
+ integer(kind=8) :: max_num_gps, fine_gps_est, total_gps
+ type(ghost_point), allocatable :: tmp_park(:,:)
call nvtxStartRange("SETUP-IBM-MODULE")
@@ -122,14 +184,38 @@ contains
else
max_num_gps = int(num_gps, 8)
end if
+ ! AMR-IB: the fine blocks swap their (larger) ghost-point list into this same declare-target ghost_points,
+ ! allocated ONCE here and never reallocated (a realloc/move_alloc of a declare-target allocatable corrupts
+ ! the Cray present table), so size it to hold the fine list too. fine_gps_cap (deepest block's buffered CELL
+ ! count, set by s_ibm_alloc_fine) is a volume bound; ghost points live in a gp_layers-thick shell at the body
+ ! surface, so refine it with a surface estimate: the fine list for any block is bounded by the whole-body
+ ! coarse count (global: a seam-spanning block's buffered marker region reaches into neighbor-owned surface)
+ ! scaled by the surface refinement factor amr_ref_ratio**(level*(num_dims-1)), x4 margin (discretization +
+ ! prescribed motion), floored for bodies under-resolved at the coarse spacing. min() with the volume bound so
+ ! capacity (and gp_park = cap x nslots+1 device words) never exceeds the previous sizing; the overflow
+ ! PROHIBITs at the swap/rebuild sites remain the hard backstop.
+ if (allocated(ib_fine)) then
+ call s_mpi_allreduce_integer_sum(int(num_gps, 8), total_gps)
+ fine_gps_est = min(fine_gps_cap, 4_8*total_gps*int(amr_ref_ratio, 8)**(amr_max_level*(num_dims - 1)) + 4096_8)
+ max_num_gps = max(max_num_gps, fine_gps_est)
+ end if
! set the size of the ghost point arrays to be the amount of points total, plus a factor of 2 buffer
$:GPU_UPDATE(device='[num_gps]')
+ ! ghost_points is GPU_DECLARE'd and @:ALLOCATE establishes its device mapping; no explicit copyin (contents
+ ! are written by the device pipeline below) - an extra dynamic map on top of the declared entry corrupts
+ ! CCE-OMP's descriptor (lib-4425)
@:ALLOCATE(ghost_points(1:max_num_gps))
-
- $:GPU_ENTER_DATA(copyin='[ghost_points]')
+ ! AMR-IB: device-resident park for the coarse/fine ghost-point swap (replaces host ib_fine%gps). move_alloc +
+ ! GPU_ENTER_DATA (the amr_cg idiom) gives the bare derived-type allocatable a valid descriptor and device
+ ! mapping; a direct @:ALLOCATE of it aborts with lib-4425 on CCE OpenMP-offload.
+ if (allocated(ib_fine)) then
+ allocate (tmp_park(1:max_num_gps,1:ib_coarse_slot))
+ call move_alloc(tmp_park, gp_park)
+ $:GPU_ENTER_DATA(create='[gp_park]')
+ end if
! Ghost-cell IBM, Tseng & Ferziger JCP (2003), Mittal & Iaccarino ARFM (2005)
- call s_find_ghost_points(ghost_points)
+ call s_find_ghost_points()
call s_apply_levelset(ghost_points, num_gps)
call s_compute_image_points(ghost_points)
@@ -575,7 +661,7 @@ contains
if (p == 0) gp_layers_z = 0
$:GPU_PARALLEL_LOOP(private='[i, j, k, ii, jj, kk, is_gp]', copy='[num_gps_local]', firstprivate='[gp_layers, &
- & gp_layers_z]', collapse=3)
+ & gp_layers_z]', copyin='[ib_markers%sf]', collapse=3)
do i = 0, m
do j = 0, n
do k = 0, p
@@ -608,14 +694,19 @@ contains
end subroutine s_find_num_ghost_points
!> Locate all ghost points in the domain
- subroutine s_find_ghost_points(ghost_points_in)
-
- type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points_in
- integer :: i, j, k, ii, jj, kk, gp_layers_z !< Iterator variables
- integer :: xp, yp, zp !< periodicities
- integer :: count, count_i, local_idx
- integer :: patch_id, encoded_patch_id, neighborhood_patch_id
- logical :: is_gp
+ subroutine s_find_ghost_points()
+
+ ! Operates on the declare-target module-global ghost_points directly, not a dummy argument: the on-device parallel loop
+ ! writes it and the on-device sort below reorders it, both under the SAME declare-target name on the device, so nothing
+ ! ever crosses host<->device here.
+ integer :: i, j, k, ii, jj, kk, gp_layers_z !< Iterator variables
+ integer :: xp, yp, zp !< periodicities
+ integer :: count, count_i, local_idx
+ integer :: patch_id, encoded_patch_id, neighborhood_patch_id
+ logical :: is_gp
+ integer :: a, b !< insertion-sort indices
+ logical :: less !< lexicographic comparison result
+ type(ghost_point) :: tmp !< insertion-sort scratch element
count = 0
count_i = 0
@@ -623,7 +714,8 @@ contains
if (p == 0) gp_layers_z = 0
$:GPU_PARALLEL_LOOP(private='[i, j, k, ii, jj, kk, is_gp, local_idx, patch_id, encoded_patch_id, neighborhood_patch_id, &
- & xp, yp, zp]', copyin='[count, count_i, glb_bounds]', firstprivate='[gp_layers, gp_layers_z]', collapse=3)
+ & xp, yp, zp]', copyin='[count, count_i, glb_bounds, ib_markers%sf]', firstprivate='[gp_layers, &
+ & gp_layers_z]', collapse=3)
do i = 0, m
do j = 0, n
do k = 0, p
@@ -647,39 +739,39 @@ contains
local_idx = count
$:END_GPU_ATOMIC_CAPTURE()
- ghost_points_in(local_idx)%loc = [i, j, k]
+ ghost_points(local_idx)%loc = [i, j, k]
encoded_patch_id = ib_markers%sf(i, j, k)
call s_decode_patch_periodicity(encoded_patch_id, patch_id, xp, yp, zp)
call s_get_neighborhood_idx(patch_id, neighborhood_patch_id)
- ghost_points_in(local_idx)%ib_patch_id = neighborhood_patch_id
- ghost_points_in(local_idx)%x_periodicity = xp
- ghost_points_in(local_idx)%y_periodicity = yp
- ghost_points_in(local_idx)%z_periodicity = zp
- ghost_points_in(local_idx)%slip = patch_ib(neighborhood_patch_id)%slip
+ ghost_points(local_idx)%ib_patch_id = neighborhood_patch_id
+ ghost_points(local_idx)%x_periodicity = xp
+ ghost_points(local_idx)%y_periodicity = yp
+ ghost_points(local_idx)%z_periodicity = zp
+ ghost_points(local_idx)%slip = patch_ib(neighborhood_patch_id)%slip
if ((x_cc(i) - dx(i)) < glb_bounds(1)%beg) then
- ghost_points_in(local_idx)%DB(1) = -1
+ ghost_points(local_idx)%DB(1) = -1
else if ((x_cc(i) + dx(i)) > glb_bounds(1)%end) then
- ghost_points_in(local_idx)%DB(1) = 1
+ ghost_points(local_idx)%DB(1) = 1
else
- ghost_points_in(local_idx)%DB(1) = 0
+ ghost_points(local_idx)%DB(1) = 0
end if
if ((y_cc(j) - dy(j)) < glb_bounds(2)%beg) then
- ghost_points_in(local_idx)%DB(2) = -1
+ ghost_points(local_idx)%DB(2) = -1
else if ((y_cc(j) + dy(j)) > glb_bounds(2)%end) then
- ghost_points_in(local_idx)%DB(2) = 1
+ ghost_points(local_idx)%DB(2) = 1
else
- ghost_points_in(local_idx)%DB(2) = 0
+ ghost_points(local_idx)%DB(2) = 0
end if
if (p /= 0) then
if ((z_cc(k) - dz(k)) < glb_bounds(3)%beg) then
- ghost_points_in(local_idx)%DB(3) = -1
+ ghost_points(local_idx)%DB(3) = -1
else if ((z_cc(k) + dz(k)) > glb_bounds(3)%end) then
- ghost_points_in(local_idx)%DB(3) = 1
+ ghost_points(local_idx)%DB(3) = 1
else
- ghost_points_in(local_idx)%DB(3) = 0
+ ghost_points(local_idx)%DB(3) = 0
end if
end if
end if
@@ -689,6 +781,35 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
+ ! The atomic capture above assigns array slots in thread-completion order, so the ghost-point LIST order is nondeterministic
+ ! on the GPU and differs from the CPU's serial order. An order-sensitive consumer downstream (e.g. the surface-force
+ ! reduction) then produces a backend-dependent result, which the discrete image-point stencil amplifies -> the moving
+ ! AMR-IB golden diverges across backends. Reorder into deterministic lexicographic (i,j,k) order with a single-thread
+ ! ON-DEVICE insertion sort (num_gps ~ O(1e2); the single-trip outer loop pins it to one thread). Sorting on the device is
+ ! deliberate: a host round-trip here needs a GPU_UPDATE of the declare-target ghost_points, which fails Cray OpenACC's
+ ! present-table lookup and aborts CCE OpenMP-offload with lib-4425 in the AMR fine path (this routine runs mid-swap, see
+ ! s_ibm_swap_to_fine). Only moving AMR-IB rebuilds the list on-device per substep, so only it needs the ordering; non-AMR
+ ! runs keep the original (unsorted) order.
+ if (.not. amr) return
+ $:GPU_PARALLEL_LOOP(private='[a, b, tmp, less]')
+ do local_idx = 1, 1
+ do a = 2, num_gps
+ tmp = ghost_points(a)
+ b = a - 1
+ do
+ if (b < 1) exit
+ less = tmp%loc(1) < ghost_points(b)%loc(1) .or. (tmp%loc(1) == ghost_points(b)%loc(1) .and. (tmp%loc(2) &
+ & < ghost_points(b)%loc(2) .or. (tmp%loc(2) == ghost_points(b)%loc(2) .and. tmp%loc(3) &
+ & < ghost_points(b)%loc(3))))
+ if (.not. less) exit
+ ghost_points(b + 1) = ghost_points(b)
+ b = b - 1
+ end do
+ ghost_points(b + 1) = tmp
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
end subroutine s_find_ghost_points
!> Compute the interpolation coefficients for image points
@@ -705,7 +826,8 @@ contains
integer :: patch_id
logical :: is_cell_center
- $:GPU_PARALLEL_LOOP(private='[q, i, j, k, ii, jj, kk, dist, buf, gp, interp_coeffs, eta, alpha, patch_id, is_cell_center]')
+ $:GPU_PARALLEL_LOOP(private='[q, i, j, k, ii, jj, kk, dist, buf, gp, interp_coeffs, eta, alpha, patch_id, &
+ & is_cell_center]', copyin='[ib_markers%sf]')
do q = 1, num_gps
gp = ghost_points_in(q)
! Get the interpolation points
@@ -925,13 +1047,41 @@ contains
!> Resets the current indexes of immersed boundaries and replaces them after updating
!> the position of each moving immersed boundary
- impure subroutine s_update_mib(num_ibs)
+ impure subroutine s_update_mib(num_ibs, th)
integer, intent(in) :: num_ibs
- integer :: i, j, k, z_gp_layers
+ !> AMR subcycling: fine sub-time fraction in [0,1] of the coarse step. When present and >= 0 the moving body is snapshotted
+ !! to the linear interpolation between its coarse t^n position (step_*) and t^{n+1} position (current) - matching the
+ !! fluid-ghost lerp the subcycle applies - and restored afterwards. Absent/negative => current position.
+ real(wp), intent(in), optional :: th
+ integer :: i, j, k, z_gp_layers
+ logical :: snap
+ real(wp) :: sc(3, num_ibs), sa(3, num_ibs) !< body centroids/angles saved across the snapshot
call nvtxStartRange("UPDATE-MIBM")
+ snap = .false.
+ if (present(th)) then
+ if (th >= 0._wp) snap = .true.
+ end if
+ if (snap) then
+ ! The body position/angles were just updated on device by the RK body-motion loop (m_time_steppers);
+ ! sync to host before the host-side sub-time interpolation reads them, else the fine block is built at
+ ! the stale t^n position on GPU (host stays current on CPU, so this only bites GPU).
+ $:GPU_UPDATE(host='[patch_ib(1:num_ibs)]')
+ do i = 1, num_ibs
+ sc(1, i) = patch_ib(i)%x_centroid; sc(2, i) = patch_ib(i)%y_centroid; sc(3, i) = patch_ib(i)%z_centroid
+ sa(:,i) = patch_ib(i)%angles
+ if (patch_ib(i)%moving_ibm /= 0) then
+ patch_ib(i)%x_centroid = (1._wp - th)*patch_ib(i)%step_x_centroid + th*sc(1, i)
+ patch_ib(i)%y_centroid = (1._wp - th)*patch_ib(i)%step_y_centroid + th*sc(2, i)
+ patch_ib(i)%z_centroid = (1._wp - th)*patch_ib(i)%step_z_centroid + th*sc(3, i)
+ patch_ib(i)%angles = (1._wp - th)*patch_ib(i)%step_angles + th*sa(:,i)
+ end if
+ end do
+ $:GPU_UPDATE(device='[patch_ib(1:num_ibs)]')
+ end if
+
! Clears the existing immersed boundary indices
z_gp_layers = 0; if (p /= 0) z_gp_layers = gp_layers + 1
$:GPU_PARALLEL_LOOP(private='[i, j, k]')
@@ -957,7 +1107,16 @@ contains
call nvtxStartRange("COMPUTE-GHOST-POINTS")
! recalculate the ghost point locations and coefficients
call s_find_num_ghost_points(num_gps)
- call s_find_ghost_points(ghost_points)
+ ! the ghost_points capacity (a setup-time heuristic) can be outgrown when the moving surface's discrete cell count increases
+ ! (body entering the domain, bodies separating, rotating non-convex geometry); the fill below has no bound check, so
+ ! overflow would be a silent device out-of-bounds write. size(ghost_points) is the ACTIVE array's capacity: the coarse
+ ! list here, or the fine slot's own (larger) list when the AMR advance has swapped it in.
+ @:PROHIBIT(num_gps > size(ghost_points), &
+ & "moving IB: the ghost-point count outgrew the ghost-point array capacity; the body's surface-cell count increased beyond the setup-time sizing")
+ ! num_gps is GPU_DECLARE'd and the on-device insertion sort (and any kernel reading it) uses the
+ ! device copy - mirror the init path's update or a changed count leaves the device one step stale
+ $:GPU_UPDATE(device='[num_gps]')
+ call s_find_ghost_points()
call nvtxEndRange
call nvtxStartRange("COMPUTE-IMAGE-POINTS")
@@ -966,6 +1125,15 @@ contains
call s_compute_interpolation_coeffs(ghost_points)
call nvtxEndRange
+ if (snap) then
+ do i = 1, num_ibs
+ patch_ib(i)%x_centroid = sc(1, i); patch_ib(i)%y_centroid = sc(2, i); patch_ib(i)%z_centroid = sc(3, i)
+ patch_ib(i)%angles = sa(:,i)
+ if (patch_ib(i)%moving_ibm /= 0) call s_update_ib_rotation_matrix(i)
+ end do
+ $:GPU_UPDATE(device='[patch_ib(1:num_ibs)]')
+ end if
+
call nvtxEndRange
end subroutine s_update_mib
@@ -1572,6 +1740,183 @@ contains
end subroutine s_update_ib_lookup
+ !> Compute the deepest-level marker-field bounds into the module mkr_lo/mkr_hi. Encloses BOTH the coarse block (m/n/p with
+ !! ghosts) AND the deepest fine block a rank can own (level amr_max_level). A level-l block has amr_ref_ratio**l * base_ext - 1
+ !! interior cells per active dim, base_ext = amr_block_end(d) - amr_block_beg(d) + 1 (the user-specified footprint in coarse
+ !! cells). The max() keeps the coarse extent as the floor so the coarse layout is never shrunk. At amr_max_level = 1,
+ !! amr_ref_ratio gives the correct sizing for any supported refinement ratio. Called from s_initialize_ibm_module (to size the
+ !! declare-target ib_markers before the device map) and s_ibm_alloc_fine.
+ impure subroutine s_ibm_marker_bounds()
+
+ mkr_lo(1) = -buff_size
+ mkr_hi(1) = max(m, amr_ref_ratio**amr_max_level*(amr_block_end(1) - amr_block_beg(1) + 1) - 1) + buff_size
+ mkr_lo(2) = -buff_size
+ if (n_glb > 0) then
+ mkr_hi(2) = max(n, amr_ref_ratio**amr_max_level*(amr_block_end(2) - amr_block_beg(2) + 1) - 1) + buff_size
+ else
+ mkr_hi(2) = n + buff_size
+ end if
+ if (p > 0) then
+ mkr_lo(3) = -buff_size
+ mkr_hi(3) = max(p, amr_ref_ratio**amr_max_level*(amr_block_end(3) - amr_block_beg(3) + 1) - 1) + buff_size
+ else
+ mkr_lo(3) = 0; mkr_hi(3) = 0
+ end if
+
+ end subroutine s_ibm_marker_bounds
+
+ !> Allocate the per-slot fine-IB marker fields (static-body AMR). One integer field per AMR slot, sized to the max buffered fine
+ !! extents (mirrors the coarse ib_markers bounds); ghost-point lists start empty, filled by s_ibm_setup_fine. No-op unless amr
+ !! .and. ib.
+ impure subroutine s_ibm_alloc_fine(nslots, f1_lo, f1_hi, f2_lo, f2_hi, f3_lo, f3_hi)
+
+ integer, intent(in) :: nslots, f1_lo, f1_hi, f2_lo, f2_hi, f3_lo, f3_hi
+ integer :: islot
+
+ call s_ibm_marker_bounds()
+ @:PROHIBIT(f1_hi > mkr_hi(1) .or. f2_hi > mkr_hi(2) .or. (p > 0 .and. f3_hi > mkr_hi(3)), &
+ & "AMR fine IB: fine block extent exceeds the deepest-level ib_markers bounds; the copy-based fine-marker swap needs ib_markers sized to enclose the fine block")
+
+ ! ghost-point capacity: upper bound for the deepest fine block = its buffered cell count. Computed from the widened mkr
+ ! bounds so it matches ib_markers (the declare-target never reallocated on Cray GPU). s_ibm_setup reads this to size the
+ ! shared declare-target ghost_points.
+ fine_gps_cap = int(mkr_hi(1) - mkr_lo(1) + 1, 8)*int(mkr_hi(2) - mkr_lo(2) + 1, 8)*int(max(mkr_hi(3) - mkr_lo(3) + 1, 1), 8)
+
+ ! Extra slot (nslots+1) parks the coarse markers during a fine swap - reusing an ib_fine slot avoids adding a new
+ ! module-level derived-type allocatable (which corrupts descriptors on CCE OpenMP, lib-4425). markers%sf is HOST-only park
+ ! storage (no ACC_SETUP / device map); the declare-target ib_markers holds the active data and the swap copies to/from it.
+ ! The fine ghost-point lists park on-device in gp_park (sized here via fine_gps_cap, allocated in s_ibm_setup).
+ ib_coarse_slot = nslots + 1
+ allocate (ib_fine(1:ib_coarse_slot))
+ do islot = 1, ib_coarse_slot
+ allocate (ib_fine(islot)%markers%sf(mkr_lo(1):mkr_hi(1),mkr_lo(2):mkr_hi(2),mkr_lo(3):mkr_hi(3)))
+ ib_fine(islot)%markers%sf = 0
+ ib_fine(islot)%num_gps = 0
+ end do
+
+ end subroutine s_ibm_alloc_fine
+
+ !> Swap the module IB globals (ib_markers/ghost_points/num_gps) to fine slot islot's stored state; the coarse state parks in the
+ !! save slot (host copies of markers and ghost points). MUST be paired with s_ibm_restore_from_fine. Grid globals must already
+ !! be swapped to the fine block.
+ impure subroutine s_ibm_swap_to_fine(islot, gps_on_device)
+
+ integer, intent(in) :: islot
+ logical, intent(in) :: gps_on_device !< fine ghost points already present on device (per-stage correct path)
+ integer :: n_c, n_f, csl, fsl, a
+
+ ! ib_markers: declare-target field, allocated once and device-resident; NEVER pointer-swapped or detach-attach'd (that
+ ! corrupts the Cray present table and leaves the device descriptor pointing at the stale coarse array). Park the coarse
+ ! markers as a host copy, then on the correct/moving path copy this slot's fine markers in and push to device. On the setup
+ ! path s_ibm_setup_fine rebuilds the fine markers directly in ib_markers.
+
+ $:GPU_UPDATE(host='[ib_markers%sf]')
+ ib_fine(ib_coarse_slot)%markers%sf = ib_markers%sf
+ if (gps_on_device) then
+ ib_markers%sf = ib_fine(islot)%markers%sf
+ $:GPU_UPDATE(device='[ib_markers%sf]')
+ end if
+
+ ! ghost_points and gp_park are both device-resident and NEVER move_alloc'd/reallocated after setup (that corrupts the Cray
+ ! present table). Park the coarse list into gp_park's coarse column, then on the correct/moving path pull this slot's fine
+ ! list in - both via on-device kernels, no host round-trip (all ghost_points consumers run on-device). This also removes
+ ! the whole-array ghost_points GPU_UPDATE that amdflang lowered to a per-element custom mapper (ROCm HSA OUT_OF_RESOURCES
+ ! abort). On the setup path the fine list does not exist yet - s_ibm_setup_fine fills ghost_points in place next. These
+ ! swap/restore kernels carry an AMD-only defaultmap(present:allocatable): AMD's default='present' emits no defaultmap, so
+ ! flang otherwise generates a map ENTRY for these device-resident allocatable derived-type arrays (ghost_points/gp_park)
+ ! that it lowers to a per-element custom mapper - the offload runtime then busy-loops for minutes recursing through
+ ! targetDataBegin/targetDataEnd (same amdflang per-element-mapper failure as the removed whole-array GPU_UPDATE above).
+ ! defaultmap(present:allocatable) asserts them present with NO map entry, so no mapper is generated. CCE gets this via its
+ ! default='present'.
+ n_c = num_gps
+ @:PROHIBIT(int(n_c, 8) > size(gp_park, dim=1, kind=8), "AMR fine IB: coarse ghost-point count exceeds the gp_park capacity")
+ csl = ib_coarse_slot
+ $:GPU_PARALLEL_LOOP(private='[a]', firstprivate='[n_c, csl]', &
+ & extraOmpArgs=("defaultmap(present:allocatable)" if MFC_COMPILER == "LLVMFlang" else None))
+ do a = 1, n_c
+ gp_park(a, csl) = ghost_points(a)
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ num_gps_save = num_gps
+ num_gps = ib_fine(islot)%num_gps
+ if (gps_on_device) then
+ n_f = num_gps
+ fsl = islot
+ $:GPU_PARALLEL_LOOP(private='[a]', firstprivate='[n_f, fsl]', &
+ & extraOmpArgs=("defaultmap(present:allocatable)" if MFC_COMPILER == "LLVMFlang" else None))
+ do a = 1, n_f
+ ghost_points(a) = gp_park(a, fsl)
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+ $:GPU_UPDATE(device='[num_gps]')
+
+ end subroutine s_ibm_swap_to_fine
+
+ !> Restore the coarse IB globals saved by s_ibm_swap_to_fine, parking the (possibly updated) fine state back in slot islot.
+ impure subroutine s_ibm_restore_from_fine(islot)
+
+ integer, intent(in) :: islot
+ integer :: n_c, n_f, csl, fsl, a
+
+ ! Mirror s_ibm_swap_to_fine: save this slot's (freshly computed / motion-updated) fine markers back to its host store, then
+ ! copy the parked coarse markers into the device-resident ib_markers. The fine and coarse ghost-point lists are
+ ! parked/restored via on-device kernels between gp_park and ghost_points. No pointer-swap/detach/move_alloc of the declared
+ ! arrays.
+
+ $:GPU_UPDATE(host='[ib_markers%sf]')
+ ib_fine(islot)%markers%sf = ib_markers%sf
+ ib_markers%sf = ib_fine(ib_coarse_slot)%markers%sf
+ $:GPU_UPDATE(device='[ib_markers%sf]')
+
+ n_f = num_gps
+ fsl = islot
+ $:GPU_PARALLEL_LOOP(private='[a]', firstprivate='[n_f, fsl]', &
+ & extraOmpArgs=("defaultmap(present:allocatable)" if MFC_COMPILER == "LLVMFlang" else None))
+ do a = 1, n_f
+ gp_park(a, fsl) = ghost_points(a)
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ ib_fine(islot)%num_gps = num_gps
+ num_gps = num_gps_save
+ n_c = num_gps
+ csl = ib_coarse_slot
+ $:GPU_PARALLEL_LOOP(private='[a]', firstprivate='[n_c, csl]', &
+ & extraOmpArgs=("defaultmap(present:allocatable)" if MFC_COMPILER == "LLVMFlang" else None))
+ do a = 1, n_c
+ ghost_points(a) = gp_park(a, csl)
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ $:GPU_UPDATE(device='[num_gps]')
+
+ end subroutine s_ibm_restore_from_fine
+
+ !> Compute the fine-grid IB state (markers, ghost points, levelset, image points, interpolation coeffs) for the current block.
+ !! The grid globals must be swapped to the fine block AND the IB globals swapped to this slot (s_ibm_swap_to_fine) first: the
+ !! pipeline writes into the module globals, which then hold this slot's fine state. Mirrors the static-body portion of
+ !! s_ibm_setup at fine resolution.
+ impure subroutine s_ibm_setup_fine()
+
+ ib_markers%sf = 0
+ $:GPU_UPDATE(device='[ib_markers%sf]')
+ call s_apply_ib_patches(ib_markers)
+ $:GPU_UPDATE(host='[ib_markers%sf]')
+
+ call s_find_num_ghost_points(num_gps)
+ $:GPU_UPDATE(device='[num_gps]')
+ ! ghost_points is allocated once (s_ibm_setup, sized to the fine-block cell-count cap) and filled in place; never
+ ! reallocated here (a realloc/move_alloc of the declare-target array corrupts the Cray present table). The cap bounds any
+ ! block's ghost-point count, so this cannot overflow.
+ @:PROHIBIT(int(num_gps, 8) > size(ghost_points, kind=8), &
+ & "AMR fine IB: ghost-point count exceeds the ghost_points capacity sized at s_ibm_setup")
+
+ call s_find_ghost_points()
+ call s_apply_levelset(ghost_points, num_gps)
+ call s_compute_image_points(ghost_points)
+ call s_compute_interpolation_coeffs(ghost_points)
+
+ end subroutine s_ibm_setup_fine
+
!> Finalize the IBM module
impure subroutine s_finalize_ibm_module()
@@ -1591,6 +1936,19 @@ contains
if (allocated(ghost_points)) then
@:DEALLOCATE(ghost_points)
end if
+ ! gp_park is device-mapped (GPU_ENTER_DATA); @:DEALLOCATE unmaps and frees it (amr_cg idiom).
+ if (allocated(gp_park)) then
+ @:DEALLOCATE(gp_park)
+ end if
+ if (allocated(ib_fine)) then
+ do i = 1, size(ib_fine)
+ ! markers%sf is host-only parking storage (no device mapping) - plain deallocate
+ if (associated(ib_fine(i)%markers%sf)) then
+ deallocate (ib_fine(i)%markers%sf)
+ end if
+ end do
+ deallocate (ib_fine)
+ end if
if (collision_model > 0) call s_finalize_collisions_module()
#ifdef MFC_MPI
if (num_procs > 1) then
diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp
index 5f1fa9d73b..8f7119f826 100644
--- a/src/simulation/m_igr.fpp
+++ b/src/simulation/m_igr.fpp
@@ -18,7 +18,7 @@ module m_igr
implicit none
private; public :: s_initialize_igr_module, s_igr_iterative_solve, s_igr_riemann_solver, s_igr_sigma_x, s_igr_flux_add, &
- & s_finalize_igr_module
+ & s_finalize_igr_module, jac, jac_old
!> @cond
#ifdef __NVCOMPILER_GPU_UNIFIED_MEM
@@ -105,11 +105,13 @@ contains
end if
#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
- @:ALLOCATE(jac(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
- @:ALLOCATE(jac_rhs(-1:m,-1:n,-1:p))
+ @:ALLOCATE(jac(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ @:ALLOCATE(jac_rhs(-1:m_alloc,-1:n_alloc,-1:p_alloc))
if (igr_iter_solver == 1) then ! Jacobi iteration
- @:ALLOCATE(jac_old(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(jac_old(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end if
#else
! create map
@@ -117,31 +119,37 @@ contains
nv_uvm_temp_on_gpu(1:nv_uvm_igr_temps_on_gpu) = 1
if (nv_uvm_temp_on_gpu(1) == 1) then
- @:ALLOCATE(jac(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(jac(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:PREFER_GPU(jac)
else
- allocate (jac_host(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
+ ! _alloc bounds mirroring the on-GPU branch: the AMR fine advance can exceed coarse extents
+ allocate (jac_host(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end,idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
- jac(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end) => jac_host(:,:,:)
+ jac(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end,idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end) => jac_host(:,:,:)
end if
if (nv_uvm_temp_on_gpu(2) == 1) then
- @:ALLOCATE(jac_rhs(-1:m,-1:n,-1:p))
+ @:ALLOCATE(jac_rhs(-1:m_alloc,-1:n_alloc,-1:p_alloc))
@:PREFER_GPU(jac_rhs)
else
- allocate (jac_rhs_host(-1:m,-1:n,-1:p))
- jac_rhs(-1:m,-1:n,-1:p) => jac_rhs_host(:,:,:)
+ allocate (jac_rhs_host(-1:m_alloc,-1:n_alloc,-1:p_alloc))
+ jac_rhs(-1:m_alloc,-1:n_alloc,-1:p_alloc) => jac_rhs_host(:,:,:)
end if
if (igr_iter_solver == 1) then ! Jacobi iteration
if (nv_uvm_temp_on_gpu(3) == 1) then
- @:ALLOCATE(jac_old(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(jac_old(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:PREFER_GPU(jac_old)
else
- allocate (jac_old_host(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end,idwbuff(3)%beg:idwbuff(3)%end))
+ allocate (jac_old_host(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end,idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
- jac_old(idwbuff(1)%beg:idwbuff(1)%end,idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end) => jac_old_host(:,:,:)
+ jac_old(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end,idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end) => jac_old_host(:,:,:)
end if
end if
#endif
@@ -300,7 +308,10 @@ contains
end do
$:END_GPU_PARALLEL_LOOP()
- call s_populate_F_igr_buffers(bc_type, jac_sf)
+ ! AMR fine advance: the block's jac ghost shell holds frozen Dirichlet data prolonged
+ ! from the converged coarse sigma (seeded by s_amr_igr_swap_sigma); the physical-BC/halo
+ ! populate would write wrong (coarse-indexed) data on the swapped block grid
+ if (.not. amr_in_fine_advance) call s_populate_F_igr_buffers(bc_type, jac_sf)
if (igr_iter_solver == 1) then ! Jacobi iteration
$:GPU_PARALLEL_LOOP(private='[j, k, l]', collapse=3)
diff --git a/src/simulation/m_load_balance.fpp b/src/simulation/m_load_balance.fpp
new file mode 100644
index 0000000000..e9f7e2de89
--- /dev/null
+++ b/src/simulation/m_load_balance.fpp
@@ -0,0 +1,247 @@
+!>
+!!@file
+!!@brief Contains module m_load_balance
+
+#:include 'macros.fpp'
+
+!> @brief Weighted static Cartesian decomposition.
+module m_load_balance
+
+ use m_derived_types
+ use m_global_parameters
+ use m_mpi_common
+ use m_box, only: f_equal_splits, f_weighted_splits
+
+ implicit none
+
+ private
+ public :: s_load_balance_rebalance
+
+contains
+
+ !> True if cumulative offsets off(0:parts) differ from the equal-split boundaries for g cells over parts ranks (same remainder
+ !! distribution as s_mpi_decompose_computational_domain).
+ pure function f_offsets_differ_from_equal(off, g, parts) result(differs)
+
+ integer, dimension(0:), intent(in) :: off
+ integer, intent(in) :: g, parts
+ logical :: differs
+
+ differs = any(off /= f_equal_splits(g, parts))
+
+ end function f_offsets_differ_from_equal
+
+ !> True iff, for one axis's cumulative offsets, every part's AMR-block intersection satisfies the mirror-decomposition scratch
+ !! cap 2*(isect cells) - 1 <= part cells - 1 (the per-dim bound s_initialize_amr_module aborts on). Per-axis-part checks equal
+ !! per-rank-box checks: a rank owns the block iff its intersection is nonempty in every active dim, and each per-dim
+ !! intersection depends only on that axis's part index.
+ pure function f_amr_isect_fits(off, n_parts, pbeg, pend) result(ok)
+
+ integer, dimension(0:), intent(in) :: off
+ integer, intent(in) :: n_parts, pbeg, pend
+ logical :: ok
+ integer :: r, ilo, ihi
+
+ ok = .true.
+ do r = 0, n_parts - 1
+ ilo = max(pbeg, off(r)); ihi = min(pend, off(r + 1) - 1)
+ if (ihi >= ilo .and. 2*(ihi - ilo + 1) - 1 > off(r + 1) - off(r) - 1) ok = .false.
+ end do
+
+ end function f_amr_isect_fits
+
+ !> Read the first advection variable at the equal layout from the restart file, build global per-axis marginals. Allocates
+ !! wx(0:m_glb), wy(0:n_glb), wz(0:p_glb); caller deallocates. Requires a valid eqn_idx%adv%beg (call s_initialize_eqn_idx
+ !! first).
+ impure subroutine s_probe_field_marginals(wx, wy, wz)
+
+ real(wp), allocatable, dimension(:), intent(out) :: wx, wy, wz
+
+#ifdef MFC_MPI
+ real(stp), allocatable, dimension(:,:,:) :: probe
+ real(wp), allocatable, dimension(:) :: lx, ly, lz
+ integer(MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK, WP_MOK, MOK, var_MOK, disp
+ integer, dimension(3) :: sizes_glb, sizes_loc
+ integer :: view, ifile, ierr, v, data_size
+ integer :: lb_start(3), j, k, l
+ character(LEN=path_len + 2*name_len) :: file_loc
+ character(len=10) :: step_str
+ logical :: file_exist
+#endif
+
+ allocate (wx(0:m_glb), wy(0:n_glb), wz(0:p_glb))
+ wx = 1._wp; wy = 1._wp; wz = 1._wp
+
+#ifdef MFC_MPI
+ ! Restart file path (mirrors s_read_parallel_data_files non-file_per_process path)
+ if (cfl_dt) then
+ write (step_str, '(I0)') n_start
+ else
+ write (step_str, '(I0)') t_step_start
+ end if
+ write (file_loc, '(A)') trim(step_str) // '.dat'
+ file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // trim(file_loc)
+
+ inquire (FILE=trim(file_loc), EXIST=file_exist)
+ if (.not. file_exist) then
+#ifdef MFC_DEBUG
+ if (proc_rank == 0) print *, '[load_balance] probe: restart file missing, using equal decomposition: ' // trim(file_loc)
+#endif
+ return
+ end if
+
+ ! Pick first advection variable (void fraction / bubble-concentration signal)
+ v = eqn_idx%adv%beg
+
+ m_MOK = int(m_glb + 1, MPI_OFFSET_KIND)
+ n_MOK = int(n_glb + 1, MPI_OFFSET_KIND)
+ p_MOK = int(p_glb + 1, MPI_OFFSET_KIND)
+ WP_MOK = int(storage_size(0._stp)/8, MPI_OFFSET_KIND)
+ MOK = int(1._wp, MPI_OFFSET_KIND)
+ var_MOK = int(v, MPI_OFFSET_KIND)
+ disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1)
+
+ ! Full 3-element assignment (conforming for all num_dims); MPI calls slice (1:num_dims).
+ sizes_glb = [m_glb + 1, n_glb + 1, p_glb + 1]
+ sizes_loc = [m + 1, n + 1, p + 1]
+
+ call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb(1:num_dims), sizes_loc(1:num_dims), start_idx(1:num_dims), &
+ & MPI_ORDER_FORTRAN, mpi_io_p, view, ierr)
+ call MPI_TYPE_COMMIT(view, ierr)
+
+ call MPI_FILE_OPEN(MPI_COMM_WORLD, trim(file_loc), MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
+ call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, view, 'native', mpi_info_int, ierr)
+
+ data_size = (m + 1)*(n + 1)*(p + 1)
+ allocate (probe(0:m,0:n,0:p))
+ call MPI_FILE_READ_ALL(ifile, probe, data_size*mpi_io_type, mpi_io_p, MPI_STATUS_IGNORE, ierr)
+ call MPI_FILE_CLOSE(ifile, ierr)
+ call MPI_TYPE_FREE(view, ierr)
+
+ ! Bin into local per-axis marginals (lb_start guards inactive dimensions)
+ lb_start = 0
+ lb_start(1) = start_idx(1)
+ if (num_dims >= 2) lb_start(2) = start_idx(2)
+ if (num_dims >= 3) lb_start(3) = start_idx(3)
+
+ allocate (lx(0:m_glb), ly(0:n_glb), lz(0:p_glb))
+ lx = 0._wp; ly = 0._wp; lz = 0._wp
+
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ lx(lb_start(1) + j) = lx(lb_start(1) + j) + real(probe(j, k, l), wp)
+ ly(lb_start(2) + k) = ly(lb_start(2) + k) + real(probe(j, k, l), wp)
+ lz(lb_start(3) + l) = lz(lb_start(3) + l) + real(probe(j, k, l), wp)
+ end do
+ end do
+ end do
+
+ call MPI_ALLREDUCE(lx, wx, m_glb + 1, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(ly, wy, n_glb + 1, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(lz, wz, p_glb + 1, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+
+ deallocate (probe, lx, ly, lz)
+#endif
+
+ end subroutine s_probe_field_marginals
+
+ !> One-shot weighted re-decomposition at init (no-op if load_balance is off or the weighted splits match the equal splits on
+ !! every axis). Reads one advection variable from the restart file at the equal layout to build per-axis weight marginals.
+ impure subroutine s_load_balance_rebalance()
+
+ real(wp), allocatable, dimension(:) :: wx, wy, wz, vx, vy, vz
+ integer, allocatable, dimension(:) :: ox, oy, oz
+ real(wp) :: amr_w(3), ff, scale
+ integer :: lmin, recon_order, pc(3), try
+ logical :: changed
+
+ if (.not. load_balance) return
+
+ ! Populate eqn_idx so s_probe_field_marginals can pick eqn_idx%adv%beg. s_initialize_eqn_idx
+ ! is pure index arithmetic (no allocations); safe to call here and again at its normal site
+ ! in s_initialize_global_parameters_module.
+ call s_initialize_eqn_idx(nmom, nb, six_eqn_alf_is_advected=.true.)
+
+ if (recon_type == recon_type_weno) then
+ recon_order = weno_order
+ else
+ recon_order = muscl_order
+ end if
+ if (igr) recon_order = igr_order
+
+ lmin = num_stcls_min*recon_order
+ if (bubbles_euler) then
+ ! EE-bubble source cost is flat across void magnitude (calibration note in m_load_weight),
+ ! so the first-advection-alpha marginal is not a load signal here: use uniform marginals
+ ! and let only the AMR fine-work injection move split planes.
+ allocate (wx(0:m_glb), wy(0:n_glb), wz(0:p_glb))
+ wx = 1._wp; wy = 1._wp; wz = 1._wp
+ else
+ call s_probe_field_marginals(wx, wy, wz)
+ end if
+
+ ! Only axes split across >1 ranks must satisfy the min-cells floor; a single-rank axis
+ ! (incl. collapsed 1D/2D) owns all its cells and is always feasible.
+ @:PROHIBIT(num_procs_x > 1 .and. (m_glb + 1) < num_procs_x*lmin, "load_balance: x-axis too small for min cells per rank")
+ @:PROHIBIT(num_procs_y > 1 .and. (n_glb + 1) < num_procs_y*lmin, "load_balance: y-axis too small for min cells per rank")
+ @:PROHIBIT(num_procs_z > 1 .and. (p_glb + 1) < num_procs_z*lmin, "load_balance: z-axis too small for min cells per rank")
+
+ allocate (ox(0:num_procs_x), oy(0:num_procs_y), oz(0:num_procs_z))
+ allocate (vx(0:m_glb), vy(0:n_glb), vz(0:p_glb))
+
+ ! AMR fine-work injection: each block-covered coarse cell costs an extra 2**num_dims (interleaved;
+ ! x2 subcycled) fine-cell RHS evals per coarse step, so the block's axis projections gain
+ ! fine_factor * (block transverse cells) in each marginal's own units (per-cell scale =
+ ! sum(w_axis)/total cells per axis: the probe's marginal sums are all equal, the missing-file
+ ! fallback's are per-index and differ across axes).
+ amr_w = 0._wp
+ pc = 1
+ if (amr) then
+ pc(1) = amr_block_end(1) - amr_block_beg(1) + 1
+ if (n_glb > 0) pc(2) = amr_block_end(2) - amr_block_beg(2) + 1
+ if (p_glb > 0) pc(3) = amr_block_end(3) - amr_block_beg(3) + 1
+ ff = real(2**(num_dims + merge(1, 0, amr_subcycle)), wp)/(real(m_glb + 1, wp)*real(n_glb + 1, wp)*real(p_glb + 1, wp))
+ amr_w(1) = ff*sum(wx)*real(pc(2), wp)*real(pc(3), wp)
+ amr_w(2) = ff*sum(wy)*real(pc(1), wp)*real(pc(3), wp)
+ amr_w(3) = ff*sum(wz)*real(pc(1), wp)*real(pc(2), wp)
+ end if
+
+ ! Deterministic feasibility clamp: if the weighted boxes would violate the AMR scratch cap on any
+ ! rank, halve the amr contribution and re-split (<= 3 retries; the final fallback drops it, governed
+ ! by s_initialize_amr_module's own init check). Pure arithmetic on rank-identical arrays, so every
+ ! rank takes the same branches.
+ scale = 1._wp
+ do try = 1, 4
+ if (try == 4) scale = 0._wp
+ vx = wx; vy = wy; vz = wz
+ if (amr .and. scale > 0._wp) then
+ vx(amr_block_beg(1):amr_block_end(1)) = vx(amr_block_beg(1):amr_block_end(1)) + scale*amr_w(1)
+ if (n_glb > 0) vy(amr_block_beg(2):amr_block_end(2)) = vy(amr_block_beg(2):amr_block_end(2)) + scale*amr_w(2)
+ if (p_glb > 0) vz(amr_block_beg(3):amr_block_end(3)) = vz(amr_block_beg(3):amr_block_end(3)) + scale*amr_w(3)
+ end if
+ ox = f_weighted_splits(vx, num_procs_x, lmin)
+ oy = f_weighted_splits(vy, num_procs_y, lmin)
+ oz = f_weighted_splits(vz, num_procs_z, lmin)
+ if (.not. amr) exit
+ if (f_amr_isect_fits(ox, num_procs_x, amr_block_beg(1), amr_block_end(1)) .and. (n_glb == 0 .or. f_amr_isect_fits(oy, &
+ & num_procs_y, amr_block_beg(2), amr_block_end(2))) .and. (p_glb == 0 .or. f_amr_isect_fits(oz, num_procs_z, &
+ & amr_block_beg(3), amr_block_end(3)))) exit
+ scale = 0.5_wp*scale
+ end do
+#ifdef MFC_DEBUG
+ if (amr .and. scale < 1._wp .and. proc_rank == 0) then
+ print *, '[load_balance] amr weight softened to fit the fine block per rank; scale =', scale
+ end if
+#endif
+
+ changed = f_offsets_differ_from_equal(ox, m_glb + 1, num_procs_x) .or. f_offsets_differ_from_equal(oy, n_glb + 1, &
+ & num_procs_y) .or. f_offsets_differ_from_equal(oz, p_glb + 1, num_procs_z)
+
+ if (changed) call s_apply_weighted_offsets(ox, oy, oz)
+
+ deallocate (wx, wy, wz, vx, vy, vz, ox, oy, oz)
+
+ end subroutine s_load_balance_rebalance
+
+end module m_load_balance
diff --git a/src/simulation/m_load_weight.fpp b/src/simulation/m_load_weight.fpp
new file mode 100644
index 0000000000..4ada44ac7b
--- /dev/null
+++ b/src/simulation/m_load_weight.fpp
@@ -0,0 +1,170 @@
+!>
+!!@file
+!!@brief Contains module m_load_weight
+
+#:include 'macros.fpp'
+
+!> @brief Diagnostic per-cell compute-cost weight field + per-rank load-imbalance metric.
+module m_load_weight
+
+ use m_derived_types
+ use m_global_parameters
+ use m_constants, only: K_bub, K_ib, K_pc
+ use m_mpi_proxy
+ use m_mpi_common
+ use m_active_box, only: ab_active, ab_x, ab_y, ab_z
+ use m_bubbles_EL, only: q_beta
+ use m_ibm, only: ib_markers
+ use m_phase_change, only: pc_iter_count
+
+ implicit none
+
+ private
+ public :: s_initialize_load_weight_module, s_finalize_load_weight_module, s_compute_load_weight, s_report_load_imbalance, &
+ & load_weight
+
+ type(scalar_field) :: load_weight !< per-cell modeled compute-cost weight
+ $:GPU_DECLARE(create='[load_weight]')
+
+ ! Cost coefficients K_bub/K_ib/K_pc from m_constants (shared with the AMR block-owner cost weighting).
+
+contains
+
+ impure subroutine s_initialize_load_weight_module
+
+ if (.not. load_weight_wrt .and. .not. sfc_partition_wrt) return
+ @:ALLOCATE(load_weight%sf(idwint(1)%beg:idwint(1)%end, idwint(2)%beg:idwint(2)%end, idwint(3)%beg:idwint(3)%end))
+ @:ACC_SETUP_SFs(load_weight)
+
+ end subroutine s_initialize_load_weight_module
+
+ impure subroutine s_finalize_load_weight_module
+
+ if (.not. load_weight_wrt .and. .not. sfc_partition_wrt) return
+ @:DEALLOCATE(load_weight%sf)
+
+ end subroutine s_finalize_load_weight_module
+
+ !> Base cost 1 everywhere; cells outside the active box get 0 (frozen).
+ impure subroutine s_compute_load_weight()
+
+ integer :: j, k, l
+ integer :: jlo, jhi, klo, khi, llo, lhi
+
+ if (.not. load_weight_wrt .and. .not. sfc_partition_wrt) return
+
+ if (ab_active) then
+ jlo = ab_x%beg; jhi = ab_x%end
+ klo = ab_y%beg; khi = ab_y%end
+ llo = ab_z%beg; lhi = ab_z%end
+ else
+ jlo = 0; jhi = m; klo = 0; khi = n; llo = 0; lhi = p
+ end if
+
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ if (j >= jlo .and. j <= jhi .and. k >= klo .and. k <= khi .and. l >= llo .and. l <= lhi) then
+ load_weight%sf(j, k, l) = 1._wp
+ else
+ load_weight%sf(j, k, l) = 0._wp
+ end if
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+
+ ! EE bubbles: NO weight contribution. Calibration (rank_time_wrt vs load_weight_wrt,
+ ! bubblescreen -n 4) showed measured RHS-time imbalance flat (~1.02-1.03) across
+ ! vf0 = 4e-5 -> 0.1 (2500x void range), while a K_bub*void term manufactured up to 1.59x
+ ! modeled imbalance. The EE bubble source (s_compute_bubble_EE_source, inside s_compute_rhs)
+ ! is a roughly-uniform per-cell term whose cost does NOT scale with void magnitude -- not a
+ ! load-imbalance driver, so no weight. (K_bub is an EL per-bubble-ODE constant; N/A to EE.)
+ ! A future EE regime -- QBMM, adv_n number-density, very high resolution -- with real EE
+ ! imbalance: re-add with an EE-specific coefficient calibrated against measured rank_time.
+
+ ! EL bubble contributor: K_bub * per-cell bubble void fraction.
+ ! q_beta(1)%sf holds the liquid volume fraction (1 - alpha_bub) after s_smear_voidfraction;
+ ! 1 - q_beta(1)%sf is the smeared bubble void fraction, a per-cell count proxy.
+ if (bubbles_lagrange) then
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ if (j >= jlo .and. j <= jhi .and. k >= klo .and. k <= khi .and. l >= llo .and. l <= lhi) then
+ load_weight%sf(j, k, l) = load_weight%sf(j, k, l) + K_bub*(1.0_wp - real(q_beta(1)%sf(j, k, l), wp))
+ end if
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ ! IB contributor: K_ib per IB-marked interior cell.
+ if (ib) then
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ if (j >= jlo .and. j <= jhi .and. k >= klo .and. k <= khi .and. l >= llo .and. l <= lhi) then
+ if (ib_markers%sf(j, k, l) /= 0) then
+ load_weight%sf(j, k, l) = load_weight%sf(j, k, l) + real(K_ib, stp)
+ end if
+ end if
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ ! Phase-change contributor: K_pc * per-cell Newton-iteration count from s_infinite_relaxation_k.
+ if (relax) then
+ $:GPU_PARALLEL_LOOP(collapse=3)
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ if (j >= jlo .and. j <= jhi .and. k >= klo .and. k <= khi .and. l >= llo .and. l <= lhi) then
+ load_weight%sf(j, k, l) = load_weight%sf(j, k, l) + real(K_pc*real(pc_iter_count(j, k, l), wp), stp)
+ end if
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
+ end subroutine s_compute_load_weight
+
+ !> Print per-rank load-imbalance metric: max/mean of per-rank weight sums.
+ impure subroutine s_report_load_imbalance
+
+ real(wp) :: w_local, w_sum, w_max, w_mean, imbalance
+ integer :: j, k, l, ierr
+
+ if (.not. load_weight_wrt) return
+ w_local = 0._wp
+ $:GPU_PARALLEL_LOOP(collapse=3, reduction='[[w_local]]', reductionOp='[+]')
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ w_local = w_local + real(load_weight%sf(j, k, l), wp)
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(w_local, w_sum, 1, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(w_local, w_max, 1, mpi_p, MPI_MAX, MPI_COMM_WORLD, ierr)
+#else
+ w_sum = w_local; w_max = w_local
+#endif
+ w_mean = w_sum/real(num_procs, wp)
+ imbalance = w_max/max(w_mean, tiny(1._wp))
+ if (proc_rank == 0) then
+ print '(A,F8.3,A,ES12.5,A,ES12.5)', '[load_weight] imbalance(max/mean)=', imbalance, ' w_max=', w_max, ' w_mean=', &
+ & w_mean
+ end if
+
+ end subroutine s_report_load_imbalance
+
+end module m_load_weight
diff --git a/src/simulation/m_phase_timing.fpp b/src/simulation/m_phase_timing.fpp
new file mode 100644
index 0000000000..31970f31a5
--- /dev/null
+++ b/src/simulation/m_phase_timing.fpp
@@ -0,0 +1,262 @@
+!>
+!!@file
+!!@brief Per-phase wall-time budget for the AMR step, gated on rank_time_wrt.
+!!
+!! WHY THIS EXISTS. Profiling MFC one layer at a time - GPU kernels (rocprofv3), MPI calls (a PMPI
+!! shim), inter-operation gaps - gives each layer's share of a DIFFERENT denominator, so the pieces have
+!! to be reconciled by inference and the reconciliation is easy to get wrong. Two changes were built and
+!! reverted on such inferences before this existed. These brackets instead sum to the measured step-loop
+!! wall and print the RESIDUAL, so what is unaccounted for is visible rather than assumed.
+!!
+!! Measured budget at 400^3/np=8/cap 32 when this landed: rhs 45.3%, regrid 13.0%, reflux 11.8%,
+!! gather 10.5%, coarse base grid 5.5%, seam 3.1%, residual 7.1%. AMR machinery is ~40% of wall against
+!! 5.5% for the base-grid physics.
+!!
+!! Each bracket does a device sync first, so a phase's time includes the GPU work it launched (host-only
+!! timing would attribute launch cost to the phase and execution cost to whoever synced next).
+#:include 'macros.fpp'
+
+!> @brief Per-phase wall-time budget for the AMR step: brackets that sum to the measured step-loop wall and report the residual, so
+!! time attribution needs no cross-layer inference. Gated on rank_time_wrt.
+module m_phase_timing
+
+ use m_derived_types
+ use m_global_parameters
+ use m_mpi_common
+
+ implicit none
+
+ private
+ public :: s_phase_tic, s_phase_toc, s_phase_report, PH_N, PH_HALO, PH_GATHER, PH_GFILL, PH_SEAM, PH_RHS, PH_RK, PH_REFLUX, &
+ & PH_RGHALO, PH_RGTAG, PH_RGCLUS, PH_RGSHAPE, PH_RGMIG, PH_RGBUILD, PH_REGRID, PH_L0, PH_COARSE
+ public :: PH_RBGATH, PH_RBOVL, PH_RBPUSH, PH_RBWAIT, PH_RBALLOC, PH_RBUNPK
+ public :: PH_SWAP, PH_RBOWN, PH_RBUPD, PH_RBPACK, PH_RBRSV
+ public :: PH_RBSEAM, PH_RBPOST, PH_RBGEO, PH_RBSLOT, PH_RBTAIL
+ public :: PH_RBSEND, PH_RBFLUSH, PH_RBXCHG, PH_RBREC, PH_RBTOPO
+ public :: PH_PGALL, PH_PGSEND, PH_PGRECV
+ public :: PH_RFP2P, PH_RFAPP, PH_RFRECV, PH_RFWAIT
+ public :: PH_RESTR, PH_RGPART, PH_RGMOVE, PH_MGWAIT
+ public :: PH_MGSLOT, PH_MGPACK, PH_MGUNPK, PH_MGPUSH
+ public :: PH_GWPLAN, PH_GWPACK, PH_GWWAIT
+ public :: PH_RSWAVE, PH_RSREST, PH_RSRFP
+ public :: PH_CVTB, PH_BHALO
+
+ integer, parameter :: PH_HALO = 1 !< coarse cons halo exchange (hoisted, once per stage)
+ integer, parameter :: PH_GATHER = 2 !< per-block coarse-patch gather (P2P)
+ integer, parameter :: PH_GFILL = 3 !< ghost prolongation from the gathered patch
+ integer, parameter :: PH_SEAM = 4 !< fine-fine seam halo
+ integer, parameter :: PH_RHS = 5 !< fine-block s_compute_rhs
+ integer, parameter :: PH_RK = 6 !< fine-block RK update + relax + IB
+ integer, parameter :: PH_REFLUX = 7 !< reflux (p2p faces + apply)
+ integer, parameter :: PH_REGRID = 8 !< regrid / reassignment
+ integer, parameter :: PH_L0 = 9 !< L0 tile advance
+ integer, parameter :: PH_COARSE = 10 !< coarse (non-AMR) solver work
+ !> Regrid sub-phases. NESTED inside PH_REGRID, so they must NOT be summed with the top-level phases - the report prints them as
+ !! a separate breakdown. Added because regrid measured 42% of wall at amr_regrid_int=2 while the optimisation effort was aimed
+ !! at rhs (19%).
+ integer, parameter :: PH_RGHALO = 11 !< coarse cons halo before tagging
+ integer, parameter :: PH_RGTAG = 12 !< tag cells
+ integer, parameter :: PH_RGCLUS = 13 !< cluster tags into boxes
+ integer, parameter :: PH_RGSHAPE = 14 !< shape/nest/cap/unchanged checks
+ integer, parameter :: PH_RGMIG = 15 !< stash + migrate old blocks
+ integer, parameter :: PH_RGBUILD = 16 !< rebuild slots (per-box gather lives here)
+ !> rg:build internals. The three candidate costs inside s_amr_regrid_rebuild_slots' per-box loop. Needed because cap32-vs-cap64
+ !! scaling (cost ~ N^0.39) fits NONE of them alone: the O(N^2) old-box scan predicts 29x, the per-box rendezvous 5.4x, the
+ !! volume-driven H2D copy the WRONG SIGN.
+ integer, parameter :: PH_RBGATH = 17 !< (a) per-box collective gather
+ integer, parameter :: PH_RBOVL = 18 !< (b) interpolate + O(old_np) overlap carry-forward
+ integer, parameter :: PH_RBPUSH = 19 !< (c) per-box full-slot host->device update
+ !> The MPI_WAITALL inside the REGRID-path gather only (gated by amr_rg_gather, since the same routine also serves the per-step
+ !! path). rb:gath MINUS this is the gather's HOST work.
+ integer, parameter :: PH_RBWAIT = 20
+ !> Splitting the gather's HOST half. rb:wait was measured; the rest was attributed to the per-box allocate by CODE READING only,
+ !! and the byte-proportional scaling fits the unpack equally well. These two brackets discriminate.
+ integer, parameter :: PH_RBALLOC = 21 !< allocate/deallocate of rbuf,reqs,srank
+ integer, parameter :: PH_RBUNPK = 22 !< post-wait unpack of rbuf into amr_cg
+ !> Per-block grid-state reconfiguration: s_amr_swap_to_fine + the idwint push + s_amr_restore_coarse. TOP-LEVEL (parallel to
+ !! rhs), not nested. This is what level-batching removes; it was previously unbracketed, and s_amr_restore_coarse used to sit
+ !! inside PH_RHS, so the rhs bracket was charged half a swap pair.
+ integer, parameter :: PH_SWAP = 23
+ !> Splitting the gather's remaining HOST work (rb:gath minus wait/mem/unpk). The per-box allocate and the unpack were both
+ !! REFUTED by measurement (0.002-0.010 s and 0.026-0.104 s), so these four cover what is actually left.
+ integer, parameter :: PH_RBOWN = 24 !< owner's own-box local unpack (s_amr_unpack_patch)
+ integer, parameter :: PH_RBUPD = 25 !< owner's per-box sys_size host->device push of amr_cg
+ integer, parameter :: PH_RBPACK = 26 !< non-owner host pack loop into the send pool
+ integer, parameter :: PH_RBRSV = 27 !< s_amr_gsnd_reserve - includes its force-drain MPI_WAITALL and pool resize
+ !> Round 2: round 1 accounted for only 46.9%% of rb:gath and 70.0%% of rg:build, leaving 18.1%% of wall unexplained inside
+ !! regrid. These five cover every remaining region on that path.
+ integer, parameter :: PH_RBSEAM = 28 !< s_amr_build_seam_pairs (O(nblocks^2)) called from inside the gather
+ integer, parameter :: PH_RBPOST = 29 !< the nsrc count + IRECV posting loop (per-(box,source) geometry)
+ integer, parameter :: PH_RBGEO = 30 !< s_set_amr_fine_geometry - per box on EVERY rank
+ integer, parameter :: PH_RBSLOT = 31 !< s_amr_alloc_slot (owner only)
+ integer, parameter :: PH_RBTAIL = 32 !< post-loop tail: send flush, xchg reduce, reconcile, seam topology check
+ !> Round 3. Round 2 closed rg:build to 100.0%% but left 11.9%% of wall inside rb:gath unexplained after SEVEN refuted code-read
+ !! candidates; the only unbracketed code left in that routine is the non-owner ISEND and two scalar geometry calls. rb:tail
+ !! (8.8%% of wall, imbalance 2.6) is split into its four collectives to separate barrier skew from work.
+ integer, parameter :: PH_RBSEND = 33 !< the non-owner MPI_ISEND (rendezvous-sized: 1.5-3 MB)
+ integer, parameter :: PH_RBFLUSH = 34 !< s_amr_gather_send_flush - one WAITALL over all deferred sends
+ integer, parameter :: PH_RBXCHG = 35 !< s_amr_reduce_xchg_flag - MPI_ALLREDUCE, i.e. a barrier
+ integer, parameter :: PH_RBREC = 36 !< s_amr_reconcile_slots
+ integer, parameter :: PH_RBTOPO = 37 !< s_amr_check_seam_topology
+ !> THE LEVEL>=2 PATH. `s_amr_gather_coarse_patch` returns at its FIRST branch for any block with level >= 2, into
+ !! `s_amr_gather_from_parent` - so every rb:* bracket above instruments only the level-1 path, which is 64 of 224 boxes. The
+ !! other 160 (71%%) were never measured. That is why EIGHT successive candidates each came back at ~0.
+ integer, parameter :: PH_PGALL = 38 !< s_amr_gather_from_parent (the whole level>=2 path)
+ integer, parameter :: PH_PGSEND = 39 !< parent owner: s_amr_gather_from_parent_field_cons (pack + send)
+ integer, parameter :: PH_PGRECV = 40 !< block owner: s_amr_recv_parent_patch
+ !> Decomposing REFLUX, whose per-call cost grows 19x between the 40-80 and 80-160 windows at a CONSTANT 64 level-1 blocks
+ !! (imbalance 1.17, so it is real work, not waiting on a straggler). The owner already posts ISENDs + one WAITALL; each
+ !! PARTICIPATING non-owner does 6 BLOCKING MPI_RECVs per block. rf:recv's CALL COUNT therefore measures how many blocks this
+ !! rank participates in - if participation grows as the refined region spreads across ranks, that is the mechanism; if it is
+ !! flat and ms/call grows instead, it is not.
+ integer, parameter :: PH_RFP2P = 41 !< s_amr_p2p_reflux_faces (the whole exchange)
+ integer, parameter :: PH_RFAPP = 42 !< s_amr_apply_reflux (local correction)
+ integer, parameter :: PH_RFRECV = 43 !< non-owner blocking-RECV branch; CALL COUNT = participation
+ integer, parameter :: PH_RFWAIT = 44 !< owner's MPI_WAITALL over its posted ISENDs
+ !> The post-stage per-block restrict/reflux-to-parent chain (m_time_steppers, the reverse islot loop). Same per-box blocking P2P
+ !! shape as PH_REFLUX, runs once per STEP over every block on every rank, and was entirely UNBRACKETED - it sits inside the
+ !! 3.7-6.3%% residual. Its exit skew becomes the next step's entry skew, so it is the candidate for super-linear growth.
+ integer, parameter :: PH_RESTR = 45
+ !> The p4est 'complementarity' split of the regrid: PART decides the new partition (cluster, nest, assign owners) and moves
+ !! NOTHING; MOVE is the data redistribution that follows. They are fused in s_amr_regrid_stash_migrate, so migration cost cannot
+ !! be priced without this boundary - and every load-balance scheme in the literature needs it.
+ integer, parameter :: PH_RGPART = 46
+ integer, parameter :: PH_RGMOVE = 47
+ !> The WAITALL inside the migration exchange. rg:move measures 103 MiB/s effective, far below intra-node bandwidth, so it is
+ !! suspected wait-bound rather than volume-bound. If mg:wait is most of rg:move, cutting migration VOLUME (SFC hysteresis) will
+ !! not convert to time.
+ integer, parameter :: PH_MGWAIT = 48
+ !> The rg:move work split (I4b pricing): slot = s_amr_alloc_slot_stash for received replicas (contains any store GROWTH - see
+ !! s_amr_st_reserve), pack/unpk = the device pack/unpack kernels + their wire-slice transfers. mg:push is DEAD since the
+ !! device-side migration (the per-received-slot full push it timed is deleted); the id stays so old budgets parse.
+ integer, parameter :: PH_MGSLOT = 49
+ integer, parameter :: PH_MGPACK = 50
+ integer, parameter :: PH_MGUNPK = 51
+ integer, parameter :: PH_MGPUSH = 52
+ !> The stage-fill wave's internal split (I6 pricing): plan = the two replicated list walks, pack = the device pack kernels +
+ !! their copyout transfers, wait = the single WAITALL. The residual of `gather` minus these three is recv/send posting + consume
+ !! bookkeeping.
+ integer, parameter :: PH_GWPLAN = 53
+ integer, parameter :: PH_GWPACK = 54
+ integer, parameter :: PH_GWWAIT = 55
+ !> restr's internal split (the np16 rung made restr the largest inter-node growth): wave = s_amr_freg_wave (the F5b wire), rest
+ !! = the restrict kernels, rfp = the level>=2 reflux-to-parent applies.
+ integer, parameter :: PH_RSWAVE = 56
+ integer, parameter :: PH_RSREST = 57
+ integer, parameter :: PH_RSRFP = 58
+ !> 2a: the batched cons->prim conversion over all owned fine blocks (s_amr_convert_prim_batch, once per stage)
+ integer, parameter :: PH_CVTB = 59
+ !> The BASE-GRID halo exchange (s_populate_variables_buffers) inside s_compute_rhs. It sits inside PH_COARSE, which is why the
+ !! uniform (amr=F) arm reported 95%% 'coarse' and no communication at all - the one number needed to say how much of AMR's 31%%
+ !! communication share is AMR's own rather than the solver's baseline.
+ integer, parameter :: PH_BHALO = 60
+ integer, parameter :: PH_N = 60
+ character(len=8), parameter :: PH_NAME(PH_N) = [character(len=8)::'halo','gather', 'gfill', 'seam', 'rhs', 'rk', 'reflux', &
+ & 'regrid', 'L0', 'coarse', 'rg:halo', 'rg:tag', 'rg:clus', 'rg:shape', 'rg:mig', 'rg:build', 'rb:gath', 'rb:ovl', &
+ & 'rb:push', 'rb:wait', 'rb:mem', 'rb:unpk', 'swap', 'rb:own', 'rb:upd', 'rb:pack', 'rb:rsv', 'rb:seam', 'rb:post', &
+ & 'rb:geo', 'rb:slot', 'rb:tail', 'rb:send', 'rb:flush', 'rb:xchg', 'rb:rec', 'rb:topo', 'pg:all', 'pg:send', &
+ & 'pg:recv', 'rf:p2p', 'rf:app', 'rf:recv', 'rf:wait', 'restr', 'rg:part', 'rg:move', 'mg:wait', 'mg:slot', &
+ & 'mg:pack', 'mg:unpk', 'mg:push', 'gw:plan', 'gw:pack', 'gw:wait', 'rs:wave', 'rs:rest', 'rs:rfp', 'cvt:bat', &
+ & 'b:halo']
+
+ real(wp) :: acc(PH_N) = 0._wp
+ !> Entry count per phase. Time alone cannot distinguish "this region is slow" from "this region runs far more often than
+ !! assumed"; eight code-read attributions were refuted by brackets before this column existed, and the ninth candidate had no
+ !! code left to blame. ms/call is what tells the two apart.
+ integer(8) :: ncall(PH_N) = 0
+ integer(8) :: tic_c(PH_N) = 0
+ integer :: depth(PH_N) = 0
+ real(wp) :: t_wall0 = -1._wp
+
+contains
+
+ impure subroutine s_phase_tic(id)
+
+ integer, intent(in) :: id
+ integer(8) :: c, rate
+
+ if (.not. rank_time_wrt) return
+ depth(id) = depth(id) + 1
+ if (depth(id) > 1) return ! outermost bracket only, so nesting cannot double count
+ $:GPU_WAIT()
+ call system_clock(c, rate)
+ tic_c(id) = c
+ ncall(id) = ncall(id) + 1
+ if (t_wall0 < 0._wp) t_wall0 = real(c, wp)/real(rate, wp)
+
+ end subroutine s_phase_tic
+
+ impure subroutine s_phase_toc(id)
+
+ integer, intent(in) :: id
+ integer(8) :: c, rate
+
+ if (.not. rank_time_wrt) return
+ if (depth(id) <= 0) then; depth(id) = 0; return; end if
+ depth(id) = depth(id) - 1
+ if (depth(id) > 0) return
+ $:GPU_WAIT()
+ call system_clock(c, rate)
+ acc(id) = acc(id) + real(c - tic_c(id), wp)/real(rate, wp)
+
+ end subroutine s_phase_toc
+
+ !> Print the budget on rank 0. `wall` is the caller's measured step-loop wall so the RESIDUAL - the part no bracket covers - is
+ !! reported instead of being silently absorbed.
+ impure subroutine s_phase_report(wall)
+
+ real(wp), intent(in) :: wall
+ real(wp) :: tot, gmax(PH_N), gsum(PH_N)
+ integer(8) :: gcall(PH_N)
+ integer :: i, ierr, ip
+ !> Per-rank times for the phases whose IMBALANCE moves with simulation time. mean/max cannot say WHICH rank is slow or
+ !! whether it is the one holding more work, which is what the rhs skew (1.09 -> 2.90 between the 80- and 160-step windows)
+ !! actually needs.
+ integer, parameter :: NPR = 4
+ integer, parameter :: PR_ID(NPR) = [PH_RHS, PH_REFLUX, PH_GATHER, PH_SEAM]
+ real(wp), allocatable :: prank(:,:)
+
+ if (.not. rank_time_wrt) return
+ tot = sum(acc)
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(acc, gmax, PH_N, mpi_p, MPI_MAX, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(acc, gsum, PH_N, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(ncall, gcall, PH_N, MPI_INTEGER8, MPI_SUM, MPI_COMM_WORLD, ierr)
+#else
+ gmax = acc; gsum = acc*real(num_procs, wp); gcall = ncall*int(num_procs, 8)
+#endif
+ allocate (prank(0:num_procs - 1,NPR))
+ do i = 1, NPR
+#ifdef MFC_MPI
+ call MPI_GATHER(acc(PR_ID(i)), 1, mpi_p, prank(0, i), 1, mpi_p, 0, MPI_COMM_WORLD, ierr)
+#else
+ prank(0, i) = acc(PR_ID(i))
+#endif
+ end do
+ if (proc_rank == 0) then
+ do i = 1, NPR
+ write (*, '(A,A8,A)', advance='no') '[phase-rank] ', PH_NAME(PR_ID(i)), ' :'
+ do ip = 0, num_procs - 1
+ write (*, '(F10.2)', advance='no') prank(ip, i)
+ end do
+ write (*, '(A)') ''
+ end do
+ end if
+ deallocate (prank)
+ if (proc_rank /= 0) return
+ print '(A)', '[phase] PHASE BUDGET'
+ print '(A,F10.3,A)', '[phase] step-loop wall = ', wall, ' s'
+ print '(A)', '[phase] name mean s max s % wall imbalance calls/rank ms/call'
+ do i = 1, PH_N
+ if (gsum(i) <= 0._wp) cycle
+ print '(A,A8,F10.3,F9.3,F9.1,A,F8.3,I12,F11.4)', '[phase] ', PH_NAME(i), gsum(i)/real(num_procs, wp), gmax(i), &
+ & 100._wp*(gsum(i)/real(num_procs, wp))/wall, '%', gmax(i)/max(gsum(i)/real(num_procs, wp), tiny(1._wp)), &
+ & gcall(i)/int(num_procs, 8), 1000._wp*(gsum(i)/real(num_procs, wp))/max(real(gcall(i)/int(num_procs, 8), wp), &
+ & 1._wp)
+ end do
+ print '(A,F10.3,F19.1,A)', '[phase] RESIDUAL', wall - sum(gsum)/real(num_procs, wp), &
+ & 100._wp*(wall - sum(gsum)/real(num_procs, wp))/wall, '%'
+
+ end subroutine s_phase_report
+
+end module m_phase_timing
diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp
index abb77a1f35..02cb25aa67 100644
--- a/src/simulation/m_qbmm.fpp
+++ b/src/simulation/m_qbmm.fpp
@@ -13,6 +13,7 @@ module m_qbmm
use m_mpi_proxy
use m_variables_conversion
use m_helper_basic
+ use m_riemann_state, only: flux_rsx_vf
use m_helper
use m_constants, only: bubble_model_keller_miksis, bubble_model_rayleigh_plesset
@@ -395,12 +396,11 @@ contains
end subroutine s_initialize_qbmm_module
!> Compute the QBMM right-hand side source terms for bubble moment transport equations
- subroutine s_compute_qbmm_rhs(idir, q_cons_vf, q_prim_vf, rhs_vf, flux_n_vf, pb, rhs_pb)
+ subroutine s_compute_qbmm_rhs(idir, q_cons_vf, q_prim_vf, rhs_vf, pb, rhs_pb)
integer, intent(in) :: idir
type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf, q_prim_vf
type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
- type(scalar_field), dimension(sys_size), intent(in) :: flux_n_vf
real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb
! TODO :: I think that this should be stp as well.
@@ -439,44 +439,44 @@ contains
select case (idir)
case (1)
- nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j - 1, k, &
- & l) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l)
- nR_dot = flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j - 1, k, &
- & l) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)
- nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j - 1, k, &
- & l) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)
+ nb_dot = flux_rsx_vf(j - 1, k, l, eqn_idx%bub%beg + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + (i - 1)*nmom)
+ nR_dot = flux_rsx_vf(j - 1, k, l, eqn_idx%bub%beg + 1 + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + 1 + (i - 1)*nmom)
+ nR2_dot = flux_rsx_vf(j - 1, k, l, eqn_idx%bub%beg + 3 + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + 3 + (i - 1)*nmom)
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, &
& i) - 3._wp*gam/(dx(j)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
case (2)
- nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k - 1, &
- & l) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l)
- nR_dot = flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k - 1, &
- & l) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)
- nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k - 1, &
- & l) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)
+ nb_dot = flux_rsx_vf(j, k - 1, l, eqn_idx%bub%beg + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + (i - 1)*nmom)
+ nR_dot = flux_rsx_vf(j, k - 1, l, eqn_idx%bub%beg + 1 + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + 1 + (i - 1)*nmom)
+ nR2_dot = flux_rsx_vf(j, k - 1, l, eqn_idx%bub%beg + 3 + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + 3 + (i - 1)*nmom)
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, &
& i) - 3._wp*gam/(dy(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
case (3)
if (is_axisym) then
- nb_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, &
- & l)*(flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, &
- & l - 1) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l))
- nR_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, &
- & l)*(flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, &
- & l - 1) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l))
- nR2_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, &
- & l)*(flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, &
- & l - 1) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l))
+ nb_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, l)*(flux_rsx_vf(j, k, l - 1, &
+ & eqn_idx%bub%beg + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + (i - 1)*nmom))
+ nR_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, l)*(flux_rsx_vf(j, k, l - 1, &
+ & eqn_idx%bub%beg + 1 + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + 1 + (i - 1)*nmom))
+ nR2_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, l)*(flux_rsx_vf(j, k, l - 1, &
+ & eqn_idx%bub%beg + 3 + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + 3 + (i - 1)*nmom))
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, &
& i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, &
& q, i))
else
- nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, &
- & l - 1) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l)
- nR_dot = flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, &
- & l - 1) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)
- nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, &
- & l - 1) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)
+ nb_dot = flux_rsx_vf(j, k, l - 1, eqn_idx%bub%beg + (i - 1)*nmom) - flux_rsx_vf(j, k, l, &
+ & eqn_idx%bub%beg + (i - 1)*nmom)
+ nR_dot = flux_rsx_vf(j, k, l - 1, eqn_idx%bub%beg + 1 + (i - 1)*nmom) - flux_rsx_vf(j, k, &
+ & l, eqn_idx%bub%beg + 1 + (i - 1)*nmom)
+ nR2_dot = flux_rsx_vf(j, k, l - 1, eqn_idx%bub%beg + 3 + (i - 1)*nmom) - flux_rsx_vf(j, &
+ & k, l, eqn_idx%bub%beg + 3 + (i - 1)*nmom)
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, &
& i) - 3._wp*gam/(dz(l)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
end if
diff --git a/src/simulation/m_rank_timing.fpp b/src/simulation/m_rank_timing.fpp
new file mode 100644
index 0000000000..d05514ff49
--- /dev/null
+++ b/src/simulation/m_rank_timing.fpp
@@ -0,0 +1,84 @@
+!>
+!!@file
+!!@brief Contains module m_rank_timing
+
+#:include 'macros.fpp'
+
+!> @brief Per-rank compute-time (RHS + phase-change relaxation) imbalance diagnostic.
+module m_rank_timing
+
+ use m_derived_types
+ use m_global_parameters
+ use m_mpi_common
+
+ implicit none
+
+ private
+ public :: s_rank_time_tic, s_rank_time_toc, s_report_rank_time
+
+ !> accumulated per-rank wall time over the timed regions this report interval (rank-local)
+ real(wp) :: t_rank_compute = 0._wp
+ !> system_clock tick captured at the most recent tic
+ integer(8) :: tic_count
+ !> tic/toc nesting depth: only the outermost pair measures, so the AMR fine advance can bracket its compute segments while the
+ !! inner s_compute_rhs pair becomes a no-op (no double counting)
+ integer :: tic_depth = 0
+
+contains
+
+ !> Start a per-rank wall-clock timing region. The device sync first drains any prior GPU work, so the interval that follows
+ !! measures only the timed region.
+ impure subroutine s_rank_time_tic
+
+ if (.not. rank_time_wrt) return
+ tic_depth = tic_depth + 1
+ if (tic_depth > 1) return
+ $:GPU_WAIT()
+ call system_clock(tic_count)
+
+ end subroutine s_rank_time_tic
+
+ !> End a per-rank wall-clock timing region and accumulate its wall duration. The device sync first drains the timed GPU kernels,
+ !! so the wall interval reflects real compute time (cpu_time would capture only host-side launch overhead on the GPU backend).
+ impure subroutine s_rank_time_toc
+
+ integer(8) :: toc_count, rate
+
+ if (.not. rank_time_wrt) return
+ ! unmatched toc (caller bug): clamp instead of underflowing into an uninitialized tic_count
+ if (tic_depth <= 0) then
+ tic_depth = 0
+ return
+ end if
+ tic_depth = tic_depth - 1
+ if (tic_depth > 0) return
+ $:GPU_WAIT()
+ call system_clock(toc_count, rate)
+ t_rank_compute = t_rank_compute + real(toc_count - tic_count, wp)/real(rate, wp)
+
+ end subroutine s_rank_time_toc
+
+ !> Reduce per-rank accumulated compute time to a max/mean imbalance, print on rank 0, then reset the accumulator for the next
+ !! interval.
+ impure subroutine s_report_rank_time
+
+ real(wp) :: t_max, t_sum, t_mean, imb
+ integer :: ierr
+
+ if (.not. rank_time_wrt) return
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(t_rank_compute, t_max, 1, mpi_p, MPI_MAX, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(t_rank_compute, t_sum, 1, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+ t_mean = t_sum/real(num_procs, wp)
+#else
+ t_max = t_rank_compute; t_mean = t_rank_compute
+#endif
+ imb = t_max/max(t_mean, tiny(1._wp))
+ if (proc_rank == 0) then
+ print '(A,F8.3,A,ES12.5,A,ES12.5)', '[rank_time] imbalance(max/mean)= ', imb, ' t_max= ', t_max, ' t_mean= ', t_mean
+ end if
+ t_rank_compute = 0._wp
+
+ end subroutine s_report_rank_time
+
+end module m_rank_timing
diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp
index 504f0c02c3..84ac550398 100644
--- a/src/simulation/m_rhs.fpp
+++ b/src/simulation/m_rhs.fpp
@@ -11,6 +11,7 @@ module m_rhs
use m_derived_types
use m_global_parameters
+ use m_rank_timing, only: s_rank_time_tic, s_rank_time_toc
use m_mpi_proxy
use m_variables_conversion
use m_weno
@@ -18,6 +19,7 @@ module m_rhs
& recon_type_muscl
use m_muscl
use m_riemann_solvers
+ use m_riemann_state, only: flux_rsx_vf, flux_src_rsx_vf, flux_gsrc_rsx_vf
use m_cbc
use m_bubbles_EE
use m_bubbles_EL
@@ -27,6 +29,7 @@ module m_rhs
use m_viscous
use m_ibm
use m_nvtx
+ use m_phase_timing
use m_boundary_common
use m_helper
use m_surface_tension
@@ -36,10 +39,12 @@ module m_rhs
use m_igr
use m_thinc
use m_pressure_relaxation
+ use m_active_box, only: ab_x, ab_y, ab_z, ab_active
+ use m_amr_registers, only: s_amr_capture_boundary_flux
implicit none
- private; public :: s_initialize_rhs_module, s_compute_rhs, s_finalize_rhs_module
+ private; public :: s_initialize_rhs_module, s_compute_rhs, s_finalize_rhs_module, q_prim_qp
type(vector_field) :: q_cons_qp !< WENO-reconstructed cell-average conservative variables at quadrature points
$:GPU_DECLARE(create='[q_cons_qp]')
@@ -109,6 +114,10 @@ module m_rhs
type(int_bounds_info) :: is1, is2, is3
!> @}
+
+ type(int_bounds_info) :: ab_int(1:3) !< Active-box interior bounds for convert call (device-resident)
+ $:GPU_DECLARE(create='[ab_int]')
+ logical :: ab_prim_seeded = .false. !< Active-box: whether q_prim_qp's frozen exterior has been seeded once (host-only)
$:GPU_DECLARE(create='[is1, is2, is3]')
!> @name Saved fluxes for testing
@@ -148,24 +157,24 @@ contains
if (.not. igr) then
do l = 1, sys_size
- @:ALLOCATE(q_cons_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(q_cons_qp%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
do l = eqn_idx%mom%beg, eqn_idx%E
- @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
end if
if (surface_tension) then
do l = eqn_idx%adv%end + 1, eqn_idx%c - 1
- @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
else
do l = eqn_idx%adv%end + 1, sys_size
- @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
end if
@@ -175,8 +184,8 @@ contains
do l = 1, eqn_idx%cont%end
if (relativity) then
! Cons and Prim densities are different for relativity
- @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
else
q_prim_qp%vf(l)%sf => q_cons_qp%vf(l)%sf
$:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(l)%sf]')
@@ -203,7 +212,7 @@ contains
$:GPU_ENTER_DATA(attach='[q_prim_qp%vf(eqn_idx%psi)%sf]')
end if
- if (.not. igr) then
+ if (hypo_nc_mode == hypo_nc_mode_dual_pass) then
@:ALLOCATE(flux_n(1:num_dims))
@:ALLOCATE(flux_src_n(1:num_dims))
@:ALLOCATE(flux_gsrc_n(1:num_dims))
@@ -307,22 +316,30 @@ contains
@:ALLOCATE(dqR_prim_dy_n(1:num_dims))
@:ALLOCATE(dqR_prim_dz_n(1:num_dims))
+ ! qL_prim/qR_prim stage the reconstructed MOMENTUM components for the viscous path only: s_get_viscous fills them
+ ! (called under `viscous .and. .not. igr`), s_compute_viscous_source_flux reads them (under `viscous .and.
+ ! weno_Re_flux`), and the weno_Re_flux branches of s_reconstruct_cell_boundary_values copy them into qL_rsx_vf.
+ ! Every other reconstruction path writes qL_rsx_vf directly and never touches these. So an inviscid run was carrying
+ ! 2 x num_dims x num_vels FULL-DOMAIN arrays it can never reach - 1.24 GiB/rank at 400^3 np=8. The vf containers stay
+ ! allocated (and ACC_SETUP'd) so the dummies remain valid; only the payload is conditional.
do i = 1, num_dims
@:ALLOCATE(qL_prim(i)%vf(1:sys_size))
@:ALLOCATE(qR_prim(i)%vf(1:sys_size))
- do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(qL_prim(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
- @:ALLOCATE(qR_prim(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
- end do
+ if (viscous) then
+ do l = eqn_idx%mom%beg, eqn_idx%mom%end
+ @:ALLOCATE(qL_prim(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ @:ALLOCATE(qR_prim(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ end do
+ end if
@:ACC_SETUP_VFs(qL_prim(i), qR_prim(i))
end do
- @:ALLOCATE(qL_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, &
- & 1:sys_size))
- @:ALLOCATE(qR_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, &
- & 1:sys_size))
+ @:ALLOCATE(qL_rsx_vf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end, 1:sys_size))
+ @:ALLOCATE(qR_rsx_vf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end, 1:sys_size))
if (.not. viscous) then
do i = 1, num_dims
@@ -349,12 +366,12 @@ contains
if (viscous) then
@:ALLOCATE(tau_Re_vf(1:sys_size))
do i = 1, num_dims
- @:ALLOCATE(tau_Re_vf(eqn_idx%cont%end + i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(tau_Re_vf(eqn_idx%cont%end + i)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(tau_Re_vf(eqn_idx%cont%end + i))
end do
- @:ALLOCATE(tau_Re_vf(eqn_idx%E)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(tau_Re_vf(eqn_idx%E)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(tau_Re_vf(eqn_idx%E))
@:ALLOCATE(dq_prim_dx_qp(1)%vf(1:sys_size))
@@ -362,24 +379,24 @@ contains
@:ALLOCATE(dq_prim_dz_qp(1)%vf(1:sys_size))
do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
@:ACC_SETUP_VFs(dq_prim_dx_qp(1))
if (n > 0) then
do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(dq_prim_dy_qp(1)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(dq_prim_dy_qp(1)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
@:ACC_SETUP_VFs(dq_prim_dy_qp(1))
if (p > 0) then
do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
@:ACC_SETUP_VFs(dq_prim_dz_qp(1))
end if
@@ -396,27 +413,27 @@ contains
do i = 1, num_dims
do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(dqL_prim_dx_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
- @:ALLOCATE(dqR_prim_dx_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(dqL_prim_dx_n(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ @:ALLOCATE(dqR_prim_dx_n(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
if (n > 0) then
do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
- @:ALLOCATE(dqR_prim_dy_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ @:ALLOCATE(dqR_prim_dy_n(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
end if
if (p > 0) then
do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:ALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
- @:ALLOCATE(dqR_prim_dz_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ @:ALLOCATE(dqR_prim_dz_n(i)%vf(l)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end do
end if
@@ -425,10 +442,10 @@ contains
end do
if (weno_Re_flux) then
- @:ALLOCATE(dqL_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end))
- @:ALLOCATE(dqR_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end))
+ @:ALLOCATE(dqL_rsx_vf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end))
+ @:ALLOCATE(dqR_rsx_vf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end))
end if
else
@:ALLOCATE(dq_prim_dx_qp(1)%vf(1:sys_size))
@@ -448,20 +465,6 @@ contains
end if
end do
end if
-
- $:GPU_PARALLEL_LOOP(private='[i, j, k, l, id]', collapse=4)
- do id = 1, num_dims
- do i = 1, sys_size
- do l = idwbuff(3)%beg, idwbuff(3)%end
- do k = idwbuff(2)%beg, idwbuff(2)%end
- do j = idwbuff(1)%beg, idwbuff(1)%end
- flux_gsrc_n(id)%vf(i)%sf(j, k, l) = 0._wp
- end do
- end do
- end do
- end do
- end do
- $:END_GPU_PARALLEL_LOOP()
end if
if (qbmm) then
@@ -470,22 +473,23 @@ contains
do i = 0, 2
do j = 0, 2
do k = 1, nb
- @:ALLOCATE(mom_3d(i, j, k)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(mom_3d(i, j, k)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, &
+ & idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(mom_3d(i, j, k))
end do
end do
end do
do i = 1, nmomsp
- @:ALLOCATE(mom_sp(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(mom_sp(i)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(mom_sp(i))
end do
end if
if (mpp_lim .and. bubbles_euler) then
- @:ALLOCATE(alf_sum%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(alf_sum%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end if
if (use_nc_iface_vel) then
@:ALLOCATE(nc_iface_vel_n(1:num_dims))
@@ -523,8 +527,8 @@ contains
end if
if (alt_soundspeed) then
- @:ALLOCATE(blkmod1(0:m, 0:n, 0:p), blkmod2(0:m, 0:n, 0:p), alpha1(0:m, 0:n, 0:p), alpha2(0:m, 0:n, 0:p), Kterm(0:m, &
- & 0:n, 0:p))
+ @:ALLOCATE(blkmod1(0:m_alloc, 0:n_alloc, 0:p_alloc), blkmod2(0:m_alloc, 0:n_alloc, 0:p_alloc), &
+ & alpha1(0:m_alloc, 0:n_alloc, 0:p_alloc), alpha2(0:m_alloc, 0:n_alloc, 0:p_alloc), Kterm(0:m_alloc, 0:n_alloc, 0:p_alloc))
end if
if (hypo_nc_mode == hypo_nc_mode_dual_pass) then
@@ -550,15 +554,17 @@ contains
if (bf_spatial_support) then
if (n > 0) then
if (p > 0) then
- @:ALLOCATE(spbf_source_x(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))
- @:ALLOCATE(spbf_source_y(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))
+ @:ALLOCATE(spbf_source_x(-buff_size:buff_size + m_alloc, -buff_size:buff_size + n_alloc, &
+ & -buff_size:buff_size + p_alloc))
+ @:ALLOCATE(spbf_source_y(-buff_size:buff_size + m_alloc, -buff_size:buff_size + n_alloc, &
+ & -buff_size:buff_size + p_alloc))
else
- @:ALLOCATE(spbf_source_x(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))
- @:ALLOCATE(spbf_source_y(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))
+ @:ALLOCATE(spbf_source_x(-buff_size:buff_size + m_alloc, -buff_size:buff_size + n_alloc, 0:0))
+ @:ALLOCATE(spbf_source_y(-buff_size:buff_size + m_alloc, -buff_size:buff_size + n_alloc, 0:0))
end if
else
- @:ALLOCATE(spbf_source_x(-buff_size:buff_size + m, 0:0, 0:0))
- @:ALLOCATE(spbf_source_y(-buff_size:buff_size + m, 0:0, 0:0))
+ @:ALLOCATE(spbf_source_x(-buff_size:buff_size + m_alloc, 0:0, 0:0))
+ @:ALLOCATE(spbf_source_y(-buff_size:buff_size + m_alloc, 0:0, 0:0))
end if
@:PREFER_GPU(spbf_source_x)
@:PREFER_GPU(spbf_source_y)
@@ -587,19 +593,58 @@ contains
integer, intent(in) :: t_step
integer, intent(in) :: stage
integer :: id
- integer(kind=8) :: i, j, k, l, q !< Generic loop iterators
+ integer(kind=8) :: i, j, k, l, q !< Generic loop iterators
+ integer :: cbjlo, cbjhi, cbklo, cbkhi, cbllo, cblhi !< Active-box + halo copy bounds
! RHS: halo exchange -> reconstruct -> Riemann solve -> flux difference -> source terms
+ ! AMR NOTE: when amr_in_fine_advance is true, the grid globals (m/n/p, idwint/idwbuff, x_cb..dz) are SWAPPED to a fine
+ ! block's values (s_amr_swap_to_fine). Code reading a module-level array precomputed against the COARSE grid must guard on
+ ! .not. amr_in_fine_advance or read the swapped/refreshed state - see the ab_int GPU_UPDATE below and the swap contract in
+ ! m_amr.fpp. A physics hook here that indexes coarse-baked state is the ab_int/acoustic-source hazard.
+
call nvtxStartRange("COMPUTE-RHS")
+ if (ab_active .and. ab_prim_seeded) then
+ cbjlo = max(idwbuff(1)%beg, ab_x%beg - buff_size)
+ cbjhi = min(idwbuff(1)%end, ab_x%end + buff_size)
+ cbklo = max(idwbuff(2)%beg, ab_y%beg - buff_size)
+ cbkhi = min(idwbuff(2)%end, ab_y%end + buff_size)
+ cbllo = max(idwbuff(3)%beg, ab_z%beg - buff_size)
+ cblhi = min(idwbuff(3)%end, ab_z%end + buff_size)
+ ! Convert over the same footprint as the copy (clamped to interior) so q_prim_qp
+ ! is valid for reconstruction stencils at the box boundary.
+ ab_int(1)%beg = max(0, ab_x%beg - buff_size); ab_int(1)%end = min(m, ab_x%end + buff_size)
+ ab_int(2)%beg = max(0, ab_y%beg - buff_size); ab_int(2)%end = min(n, ab_y%end + buff_size)
+ ab_int(3)%beg = max(0, ab_z%beg - buff_size); ab_int(3)%end = min(p, ab_z%end + buff_size)
+ else
+ ! Full-domain window: every non-active_box run, plus the ONE-TIME seeding pass on the first
+ ! active_box RHS call. active_box narrows the cons->prim producer to the box, but full-domain
+ ! consumers (ICFL/vCFL monitor, probes, IB) still read 0:m,0:n,0:p; an unconverted exterior
+ ! is uninitialized memory -> NaN (fatal on Cray, silently finite on some compilers). Seeding
+ ! q_prim_qp over the full domain once fills the frozen ambient exterior with valid primitives
+ ! that subsequent narrowed passes never overwrite.
+ cbjlo = idwbuff(1)%beg; cbjhi = idwbuff(1)%end
+ cbklo = idwbuff(2)%beg; cbkhi = idwbuff(2)%end
+ cbllo = idwbuff(3)%beg; cblhi = idwbuff(3)%end
+ ab_int = idwint
+ end if
+ if (ab_active) ab_prim_seeded = .true.
+
+ ! ab_int must be refreshed on device EVERY call: the AMR fine advance swaps idwint to the fine-block
+ ! bounds, and CCE OpenACC resolves the convert kernel's loop bounds through the present device copy of
+ ! this module variable - a seed-once guard left stale COARSE bounds on the swapped fine grid, giving
+ ! out-of-range device accesses and a spurious wave at every fine-block edge (CCE-acc only; NVHPC and
+ ! CCE-omp evaluate the bounds host-side and never saw it).
+ $:GPU_UPDATE(device='[ab_int]')
+
if (.not. igr) then
! Association/Population of Working Variables
$:GPU_PARALLEL_LOOP(private='[i, j, k, l]', collapse=4)
do i = 1, sys_size
- do l = idwbuff(3)%beg, idwbuff(3)%end
- do k = idwbuff(2)%beg, idwbuff(2)%end
- do j = idwbuff(1)%beg, idwbuff(1)%end
+ do l = cbllo, cblhi
+ do k = cbklo, cbkhi
+ do j = cbjlo, cbjhi
q_cons_qp%vf(i)%sf(j, k, l) = q_cons_vf(i)%sf(j, k, l)
end do
end do
@@ -633,16 +678,25 @@ contains
if (igr) then
call nvtxStartRange("RHS-COMMUNICATION")
+ call s_phase_tic(PH_BHALO)
call s_populate_variables_buffers(bc_type, q_cons_vf, pb_in, mv_in, q_T_sf)
+ call s_phase_toc(PH_BHALO)
call nvtxEndRange
end if
if (.not. igr) then
call nvtxStartRange("RHS-CONVERT")
- call s_convert_conservative_to_primitive_variables(q_cons_qp%vf, q_T_sf, q_prim_qp%vf, idwint)
+ ! 2a: the AMR fine advance may have preloaded this block's computed prim vars from the batched
+ ! conversion (s_amr_convert_prim_batch, pinned to this kernel); the per-block conversion is then
+ ! skipped bit-identically. The aliased prim vars (cont, adv, c, psi) ride the cons copy-in above.
+ if (.not. amr_prim_preloaded) then
+ call s_convert_conservative_to_primitive_variables(q_cons_qp%vf, q_T_sf, q_prim_qp%vf, ab_int)
+ end if
call nvtxEndRange
call nvtxStartRange("RHS-COMMUNICATION")
+ call s_phase_tic(PH_BHALO)
call s_populate_variables_buffers(bc_type, q_prim_qp%vf, pb_in, mv_in, q_T_sf)
+ call s_phase_toc(PH_BHALO)
call nvtxEndRange
end if
@@ -652,6 +706,11 @@ contains
if (t_step == t_step_stop) return
end if
+ ! Per-rank compute timing starts here: AFTER the halo exchange (s_populate_variables_buffers)
+ ! and the early-return guards, so it captures only the local compute (reconstruct/Riemann/
+ ! flux/source) and excludes the cross-rank halo wait that would otherwise mask compute imbalance.
+ if (rank_time_wrt) call s_rank_time_tic()
+
if (qbmm) call s_mom_inv(q_cons_qp%vf, q_prim_qp%vf, mom_sp, mom_3d, pb_in, rhs_pb, mv_in, rhs_mv, idwbuff(1), &
& idwbuff(2), idwbuff(3))
@@ -718,18 +777,26 @@ contains
call nvtxEndRange
end if
- ! RHS for diffusion
+ ! RHS for chemistry species diffusion: writes species (and, when not viscous, energy) face
+ ! fluxes into flux_src_rsx_vf. Runs before the AMR capture below so refluxing sees the total
+ ! advection+diffusion flux, mirroring the viscous flux_src the Riemann solver wrote.
if (chemistry .and. chem_params%diffusion) then
call nvtxStartRange("RHS-CHEM-DIFFUSION")
- call s_compute_chemistry_diffusion_flux(id, q_prim_qp%vf, flux_src_n(id)%vf, irx, iry, irz, q_T_sf)
+ call s_compute_chemistry_diffusion_flux(id, q_prim_qp%vf, flux_src_rsx_vf, irx, iry, irz, q_T_sf)
call nvtxEndRange
end if
+ ! AMR refluxing: record the c/f boundary-face fluxes exactly as the assembly above used
+ ! them (after s_cbc may have modified flux_rsx_vf in the advection source call, and after
+ ! all flux_src contributions - viscous and species diffusion - are in place); must run
+ ! before the next direction's sweep overwrites flux_rsx_vf, which all directions share.
+ if (amr) call s_amr_capture_boundary_flux(id, stage)
+
! Viscous stress contribution to RHS
if (viscous .or. surface_tension .or. chem_params%diffusion) then
call nvtxStartRange("RHS-ADD-PHYSICS")
- call s_compute_additional_physics_rhs(id, q_prim_qp%vf, rhs_vf, flux_src_n(id)%vf, dq_prim_dx_qp(1)%vf, &
- & dq_prim_dy_qp(1)%vf, dq_prim_dz_qp(1)%vf)
+ call s_compute_additional_physics_rhs(id, q_prim_qp%vf, rhs_vf, dq_prim_dx_qp(1)%vf, dq_prim_dy_qp(1)%vf, &
+ & dq_prim_dz_qp(1)%vf)
call nvtxEndRange
end if
@@ -743,7 +810,7 @@ contains
! RHS additions for qbmm bubbles
if (qbmm) then
call nvtxStartRange("RHS-QBMM")
- call s_compute_qbmm_rhs(id, q_cons_qp%vf, q_prim_qp%vf, rhs_vf, flux_n(id)%vf, pb_in, rhs_pb)
+ call s_compute_qbmm_rhs(id, q_cons_qp%vf, q_prim_qp%vf, rhs_vf, pb_in, rhs_pb)
call nvtxEndRange
end if
! END: Additional physics and source terms
@@ -781,7 +848,7 @@ contains
end if
call nvtxEndRange
call nvtxStartRange("RHS-ADVECTION-SRC")
- call s_compute_advection_source_term(id, rhs_hatR_vf, q_cons_qp, q_prim_qp, flux_src_n(id), .false.)
+ call s_compute_advection_source_term(id, rhs_hatR_vf, q_cons_qp, q_prim_qp, .false.)
call nvtxEndRange
end do
@@ -849,7 +916,10 @@ contains
call s_compute_ptilde(q_cons_qp%vf(1:sys_size), q_prim_qp%vf(1:sys_size))
end if
- if (bubbles_lagrange) then
+ ! Lagrangian bubbles couple on the coarse grid only (the cloud is excluded from fine blocks):
+ ! the EL hooks are skipped during the fine advance - a bubble's position would map to wrong
+ ! cell indices on the swapped block grid.
+ if (bubbles_lagrange .and. .not. amr_in_fine_advance) then
if (.not. adap_dt) then
call nvtxStartRange("RHS-EL-BUBBLES-DYN")
call s_compute_bubble_EL_dynamics(q_prim_qp%vf(1:sys_size), bc_type, stage)
@@ -897,6 +967,10 @@ contains
end if
end if
+ ! Per-rank compute timing ends here (brackets only the local compute above; excludes
+ ! the halo exchange near the top of the routine).
+ if (rank_time_wrt) call s_rank_time_toc()
+
call nvtxEndRange
end subroutine s_compute_rhs
@@ -1026,11 +1100,36 @@ contains
end if
irx%end = m; iry%end = n; irz%end = p
+ ! Restrict the Riemann face window to the active box: [box%beg, box%end] on the
+ ! transverse directions, [box%beg-1, box%end] on the normal direction (face j needs
+ ! cells j and j+1). s_riemann_solver pushes these to the device.
+ if (ab_active) then
+ irx%beg = ab_x%beg; iry%beg = ab_y%beg; irz%beg = ab_z%beg
+ irx%end = ab_x%end; iry%end = ab_y%end; irz%end = ab_z%end
+ if (id == 1) then
+ irx%beg = ab_x%beg - 1
+ else if (id == 2) then
+ iry%beg = ab_y%beg - 1
+ else
+ irz%beg = ab_z%beg - 1
+ end if
+ end if
+
! Computing Riemann Solver Flux and Source Flux
call nvtxStartRange("RHS-RIEMANN-SOLVER")
- call s_riemann_solver(qR_rsx_vf, dqR_prim_dx_n(id)%vf, dqR_prim_dy_n(id)%vf, dqR_prim_dz_n(id)%vf, qR_prim(id)%vf, &
- & qL_rsx_vf, dqL_prim_dx_n(id)%vf, dqL_prim_dy_n(id)%vf, dqL_prim_dz_n(id)%vf, qL_prim(id)%vf, &
- & q_prim_qp%vf, flux_n(id)%vf, flux_src_n(id)%vf, flux_gsrc_n(id)%vf, id, irx, iry, irz)
+ if (hypo_nc_mode == hypo_nc_mode_dual_pass) then
+ ! Fused dual-pass: one call computes BOTH anchored flux sets (hat_L -> flux_n via the
+ ! solver's own finalize; hat_R into the flux_hatR_rs* buffers, finalized separately via
+ ! s_finalize_riemann_solver_hatR between the two RHS assemblies).
+ call s_hypo_hlld_riemann_solver(qR_rsx_vf, dqR_prim_dx_n(id)%vf, dqR_prim_dy_n(id)%vf, dqR_prim_dz_n(id)%vf, &
+ & qR_prim(id)%vf, qL_rsx_vf, dqL_prim_dx_n(id)%vf, dqL_prim_dy_n(id)%vf, &
+ & dqL_prim_dz_n(id)%vf, qL_prim(id)%vf, q_prim_qp%vf, flux_n(id)%vf, &
+ & flux_src_n(id)%vf, flux_gsrc_n(id)%vf, id, irx, iry, irz)
+ else
+ call s_riemann_solver(qR_rsx_vf, dqR_prim_dx_n(id)%vf, dqR_prim_dy_n(id)%vf, dqR_prim_dz_n(id)%vf, qR_prim(id)%vf, &
+ & qL_rsx_vf, dqL_prim_dx_n(id)%vf, dqL_prim_dy_n(id)%vf, dqL_prim_dz_n(id)%vf, qL_prim(id)%vf, &
+ & q_prim_qp%vf, id, irx, iry, irz)
+ end if
call nvtxEndRange
if (use_nc_iface_vel) then
@@ -1039,23 +1138,23 @@ contains
! Additional physics and source terms RHS addition for advection source
call nvtxStartRange("RHS-ADVECTION-SRC")
- call s_compute_advection_source_term(id, rhs_vf, q_cons_qp, q_prim_qp, flux_src_n(id), is_hat_L)
+ call s_compute_advection_source_term(id, rhs_vf, q_cons_qp, q_prim_qp, is_hat_L)
call nvtxEndRange
end subroutine s_compute_directional_rhs
!> Accumulate advection source contributions from a given coordinate direction into the RHS
- subroutine s_compute_advection_source_term(idir, rhs_vf, q_cons_vf, q_prim_vf, flux_src_n_vf, is_hat_L)
+ subroutine s_compute_advection_source_term(idir, rhs_vf, q_cons_vf, q_prim_vf, is_hat_L)
integer, intent(in) :: idir
type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
type(vector_field), intent(inout) :: q_cons_vf
type(vector_field), intent(inout) :: q_prim_vf
- type(vector_field), intent(inout) :: flux_src_n_vf
logical, intent(in) :: is_hat_L
- integer :: j, k, l, q !< Loop iterators from original, meaning varies
- integer :: k_loop, l_loop, q_loop !< Standardized spatial loop iterators 0:m, 0:n, 0:p
+ integer :: j, k, l, q !< Loop iterators from original, meaning varies
+ integer :: k_loop, l_loop, q_loop !< Standardized spatial loop iterators 0:m, 0:n, 0:p
integer :: i_fluid_loop
+ integer :: abx_lo, abx_hi, aby_lo, aby_hi, abz_lo, abz_hi !< Active-box flux-difference bounds
real(wp) :: inv_ds, flux_face1, flux_face2
real(wp) :: advected_qty_val, pressure_val, velocity_val
real(wp) :: G1_eff, G2_eff
@@ -1067,6 +1166,17 @@ contains
G2_eff = fluid_pp(2)%G
end if
+ ! Only the box cells have a valid RHS divergence; restrict the flux-difference loops to the
+ ! box when engaged (in every loop here 0:p is z, 0:n is y, 0:m is x).
+
+ if (ab_active) then
+ abx_lo = ab_x%beg; abx_hi = ab_x%end
+ aby_lo = ab_y%beg; aby_hi = ab_y%end
+ abz_lo = ab_z%beg; abz_hi = ab_z%end
+ else
+ abx_lo = 0; abx_hi = m; aby_lo = 0; aby_hi = n; abz_lo = 0; abz_hi = p
+ end if
+
if (alt_soundspeed) then
$:GPU_PARALLEL_LOOP(private='[k_loop, l_loop, q_loop]', collapse=3)
do q_loop = 0, p
@@ -1097,21 +1207,21 @@ contains
select case (idir)
case (1) ! x-direction
if (bc_x%beg <= BC_CHAR_SLIP_WALL .and. bc_x%beg >= BC_CHAR_SUP_OUTFLOW) then
- call s_cbc(q_prim_vf%vf, flux_n(idir)%vf, flux_src_n_vf%vf, idir, -1, irx, iry, irz)
+ call s_cbc(q_prim_vf%vf, idir, -1, irx, iry, irz)
end if
if (bc_x%end <= BC_CHAR_SLIP_WALL .and. bc_x%end >= BC_CHAR_SUP_OUTFLOW) then
- call s_cbc(q_prim_vf%vf, flux_n(idir)%vf, flux_src_n_vf%vf, idir, 1, irx, iry, irz)
+ call s_cbc(q_prim_vf%vf, idir, 1, irx, iry, irz)
end if
if (hypo_nc_mode /= hypo_nc_mode_dual_pass) then
$:GPU_PARALLEL_LOOP(collapse=4,private='[j, k_loop, l_loop, q_loop, inv_ds, flux_face1, flux_face2]')
do j = 1, sys_size
- do q_loop = 0, p
- do l_loop = 0, n
- do k_loop = 0, m
+ do q_loop = abz_lo, abz_hi
+ do l_loop = aby_lo, aby_hi
+ do k_loop = abx_lo, abx_hi
inv_ds = 1._wp/dx(k_loop)
- flux_face1 = flux_n(1)%vf(j)%sf(k_loop - 1, l_loop, q_loop)
- flux_face2 = flux_n(1)%vf(j)%sf(k_loop, l_loop, q_loop)
+ flux_face1 = flux_rsx_vf(k_loop - 1, l_loop, q_loop, j)
+ flux_face2 = flux_rsx_vf(k_loop, l_loop, q_loop, j)
rhs_vf(j)%sf(k_loop, l_loop, q_loop) = inv_ds*(flux_face1 - flux_face2)
end do
end do
@@ -1158,8 +1268,8 @@ contains
inv_ds = 1._wp/dx(k_loop)
advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(k_loop, l_loop, q_loop)
pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(k_loop, l_loop, q_loop)
- flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(k_loop, l_loop, q_loop)
- flux_face2 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(k_loop - 1, l_loop, q_loop)
+ flux_face1 = flux_src_rsx_vf(k_loop, l_loop, q_loop, eqn_idx%adv%beg)
+ flux_face2 = flux_src_rsx_vf(k_loop - 1, l_loop, q_loop, eqn_idx%adv%beg)
rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(k_loop, l_loop, &
& q_loop) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(k_loop, l_loop, &
& q_loop) - inv_ds*advected_qty_val*pressure_val*(flux_face1 - flux_face2)
@@ -1170,24 +1280,24 @@ contains
$:END_GPU_PARALLEL_LOOP()
end if
- call s_add_directional_advection_source_terms(idir, rhs_vf, q_cons_vf, q_prim_vf, flux_src_n_vf, Kterm)
+ call s_add_directional_advection_source_terms(idir, rhs_vf, q_cons_vf, q_prim_vf, Kterm)
case (2) ! y-direction
if (bc_y%beg <= BC_CHAR_SLIP_WALL .and. bc_y%beg >= BC_CHAR_SUP_OUTFLOW) then
- call s_cbc(q_prim_vf%vf, flux_n(idir)%vf, flux_src_n_vf%vf, idir, -1, irx, iry, irz)
+ call s_cbc(q_prim_vf%vf, idir, -1, irx, iry, irz)
end if
if (bc_y%end <= BC_CHAR_SLIP_WALL .and. bc_y%end >= BC_CHAR_SUP_OUTFLOW) then
- call s_cbc(q_prim_vf%vf, flux_n(idir)%vf, flux_src_n_vf%vf, idir, 1, irx, iry, irz)
+ call s_cbc(q_prim_vf%vf, idir, 1, irx, iry, irz)
end if
if (hypo_nc_mode /= hypo_nc_mode_dual_pass) then
$:GPU_PARALLEL_LOOP(collapse=4,private='[j, k, l, q, inv_ds, flux_face1, flux_face2]')
do j = 1, sys_size
- do l = 0, p
- do k = 0, n
- do q = 0, m
+ do l = abz_lo, abz_hi
+ do k = aby_lo, aby_hi
+ do q = abx_lo, abx_hi
inv_ds = 1._wp/dy(k)
- flux_face1 = flux_n(2)%vf(j)%sf(q, k - 1, l)
- flux_face2 = flux_n(2)%vf(j)%sf(q, k, l)
+ flux_face1 = flux_rsx_vf(q, k - 1, l, j)
+ flux_face2 = flux_rsx_vf(q, k, l, j)
rhs_vf(j)%sf(q, k, l) = rhs_vf(j)%sf(q, k, l) + inv_ds*(flux_face1 - flux_face2)
end do
end do
@@ -1234,8 +1344,8 @@ contains
inv_ds = 1._wp/dy(k)
advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(q, k, l)
pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(q, k, l)
- flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(q, k, l)
- flux_face2 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(q, k - 1, l)
+ flux_face1 = flux_src_rsx_vf(q, k, l, eqn_idx%adv%beg)
+ flux_face2 = flux_src_rsx_vf(q, k - 1, l, eqn_idx%adv%beg)
rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, &
& l) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, &
& l) - inv_ds*advected_qty_val*pressure_val*(flux_face1 - flux_face2)
@@ -1291,8 +1401,8 @@ contains
do l = 0, p
do k = 0, n
do q = 0, m
- flux_face1 = flux_gsrc_n(2)%vf(j)%sf(q, k - 1, l)
- flux_face2 = flux_gsrc_n(2)%vf(j)%sf(q, k, l)
+ flux_face1 = flux_gsrc_rsx_vf(q, k - 1, l, j)
+ flux_face2 = flux_gsrc_rsx_vf(q, k, l, j)
rhs_vf(j)%sf(q, k, l) = rhs_vf(j)%sf(q, k, l) - 5.e-1_wp/y_cc(k)*(flux_face1 + flux_face2)
end do
end do
@@ -1302,13 +1412,13 @@ contains
end if
end if
- call s_add_directional_advection_source_terms(idir, rhs_vf, q_cons_vf, q_prim_vf, flux_src_n_vf, Kterm)
+ call s_add_directional_advection_source_terms(idir, rhs_vf, q_cons_vf, q_prim_vf, Kterm)
case (3) ! z-direction
if (bc_z%beg <= BC_CHAR_SLIP_WALL .and. bc_z%beg >= BC_CHAR_SUP_OUTFLOW) then
- call s_cbc(q_prim_vf%vf, flux_n(idir)%vf, flux_src_n_vf%vf, idir, -1, irx, iry, irz)
+ call s_cbc(q_prim_vf%vf, idir, -1, irx, iry, irz)
end if
if (bc_z%end <= BC_CHAR_SLIP_WALL .and. bc_z%end >= BC_CHAR_SUP_OUTFLOW) then
- call s_cbc(q_prim_vf%vf, flux_n(idir)%vf, flux_src_n_vf%vf, idir, 1, irx, iry, irz)
+ call s_cbc(q_prim_vf%vf, idir, 1, irx, iry, irz)
end if
if (grid_geometry == 3) then ! Cylindrical Coordinates
@@ -1319,8 +1429,8 @@ contains
do l = 0, m
inv_ds = 1._wp/(dz(k)*y_cc(q))
velocity_val = q_prim_vf%vf(eqn_idx%cont%end + idir)%sf(l, q, k)
- flux_face1 = flux_n(3)%vf(j)%sf(l, q, k - 1)
- flux_face2 = flux_n(3)%vf(j)%sf(l, q, k)
+ flux_face1 = flux_rsx_vf(l, q, k - 1, j)
+ flux_face2 = flux_rsx_vf(l, q, k, j)
rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) + inv_ds*velocity_val*(flux_face1 - flux_face2)
end do
end do
@@ -1332,8 +1442,8 @@ contains
do k = 0, p
do q = 0, n
do l = 0, m
- flux_face1 = flux_gsrc_n(3)%vf(j)%sf(l, q, k - 1)
- flux_face2 = flux_gsrc_n(3)%vf(j)%sf(l, q, k)
+ flux_face1 = flux_gsrc_rsx_vf(l, q, k - 1, j)
+ flux_face2 = flux_gsrc_rsx_vf(l, q, k, j)
rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) - 5.e-1_wp/y_cc(q)*(flux_face1 + flux_face2)
end do
end do
@@ -1344,12 +1454,12 @@ contains
if (hypo_nc_mode /= hypo_nc_mode_dual_pass) then
$:GPU_PARALLEL_LOOP(collapse=4,private='[j, k, l, q, inv_ds, flux_face1, flux_face2]')
do j = 1, sys_size
- do k = 0, p
- do q = 0, n
- do l = 0, m
+ do k = abz_lo, abz_hi
+ do q = aby_lo, aby_hi
+ do l = abx_lo, abx_hi
inv_ds = 1._wp/dz(k)
- flux_face1 = flux_n(3)%vf(j)%sf(l, q, k - 1)
- flux_face2 = flux_n(3)%vf(j)%sf(l, q, k)
+ flux_face1 = flux_rsx_vf(l, q, k - 1, j)
+ flux_face2 = flux_rsx_vf(l, q, k, j)
rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) + inv_ds*(flux_face1 - flux_face2)
end do
end do
@@ -1397,8 +1507,8 @@ contains
inv_ds = 1._wp/dz(k)
advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(l, q, k)
pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(l, q, k)
- flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(l, q, k)
- flux_face2 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(l, q, k - 1)
+ flux_face1 = flux_src_rsx_vf(l, q, k, eqn_idx%adv%beg)
+ flux_face2 = flux_src_rsx_vf(l, q, k - 1, eqn_idx%adv%beg)
rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(l, q, &
& k) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(l, q, &
& k) - inv_ds*advected_qty_val*pressure_val*(flux_face1 - flux_face2)
@@ -1409,19 +1519,18 @@ contains
$:END_GPU_PARALLEL_LOOP()
end if
- call s_add_directional_advection_source_terms(idir, rhs_vf, q_cons_vf, q_prim_vf, flux_src_n_vf, Kterm)
+ call s_add_directional_advection_source_terms(idir, rhs_vf, q_cons_vf, q_prim_vf, Kterm)
end select
contains
!> Add the advection source flux-difference terms for a single coordinate direction to the RHS
- subroutine s_add_directional_advection_source_terms(current_idir, rhs_vf_arg, q_cons_vf_arg, q_prim_vf_arg, &
- & flux_src_n_vf_arg, Kterm_arg)
+ subroutine s_add_directional_advection_source_terms(current_idir, rhs_vf_arg, q_cons_vf_arg, q_prim_vf_arg, Kterm_arg)
+
integer, intent(in) :: current_idir
type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf_arg
type(vector_field), intent(in) :: q_cons_vf_arg
type(vector_field), intent(in) :: q_prim_vf_arg
- type(vector_field), intent(in) :: flux_src_n_vf_arg
real(wp), allocatable, dimension(:,:,:), intent(in) :: Kterm_arg
integer :: j_adv, k_idx, l_idx, q_idx
real(wp) :: local_inv_ds, local_term_coeff, local_flux1, local_flux2
@@ -1447,8 +1556,8 @@ contains
do k_idx = 0, m ! x_extent
local_inv_ds = 1._wp/dx(k_idx)
local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(k_idx, l_idx, q_idx)
- local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx - 1, l_idx, q_idx)
- local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx)
+ local_flux1 = flux_src_rsx_vf(k_idx - 1, l_idx, q_idx, j_adv)
+ local_flux2 = flux_src_rsx_vf(k_idx, l_idx, q_idx, j_adv)
rhs_vf_arg(j_adv)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(j_adv)%sf(k_idx, l_idx, &
& q_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do
@@ -1476,11 +1585,11 @@ contains
$:GPU_PARALLEL_LOOP(collapse=4, private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, &
& local_flux1, local_flux2]')
do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end
- do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m
+ do q_idx = abz_lo, abz_hi; do l_idx = aby_lo, aby_hi; do k_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dx(k_idx)
local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx - 1, l_idx, q_idx)
+ local_flux1 = flux_src_rsx_vf(k_idx, l_idx, q_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(k_idx - 1, l_idx, q_idx, eqn_idx%adv%beg)
rhs_vf_arg(j_adv)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(j_adv)%sf(k_idx, l_idx, &
& q_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do; end do; end do
@@ -1489,11 +1598,11 @@ contains
if (alt_soundspeed) then ! K*div(u) correction
$:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_k_term_val, &
& local_flux1, local_flux2]')
- do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m
+ do q_idx = abz_lo, abz_hi; do l_idx = aby_lo, aby_hi; do k_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dx(k_idx)
local_k_term_val = Kterm_arg(k_idx, l_idx, q_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx - 1, l_idx, q_idx)
+ local_flux1 = flux_src_rsx_vf(k_idx, l_idx, q_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(k_idx - 1, l_idx, q_idx, eqn_idx%adv%beg)
rhs_vf_arg(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(k_idx, l_idx, &
& q_idx) + local_k_term_val*local_inv_ds*(local_flux1 - local_flux2)
rhs_vf_arg(eqn_idx%adv%end)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(k_idx, l_idx, &
@@ -1513,8 +1622,8 @@ contains
do q_idx = 0, m ! x_extent
local_inv_ds = 1._wp/dy(k_idx)
local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(q_idx, k_idx, l_idx)
- local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx - 1, l_idx)
- local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx)
+ local_flux1 = flux_src_rsx_vf(q_idx, k_idx - 1, l_idx, j_adv)
+ local_flux2 = flux_src_rsx_vf(q_idx, k_idx, l_idx, j_adv)
rhs_vf_arg(j_adv)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(j_adv)%sf(q_idx, k_idx, &
& l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do
@@ -1555,11 +1664,11 @@ contains
$:GPU_PARALLEL_LOOP(collapse=4, private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, &
& local_flux1, local_flux2]')
do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end
- do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m
+ do l_idx = abz_lo, abz_hi; do k_idx = aby_lo, aby_hi; do q_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dy(k_idx)
local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx - 1, l_idx)
+ local_flux1 = flux_src_rsx_vf(q_idx, k_idx, l_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(q_idx, k_idx - 1, l_idx, eqn_idx%adv%beg)
rhs_vf_arg(j_adv)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(j_adv)%sf(q_idx, k_idx, &
& l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do; end do; end do
@@ -1568,11 +1677,11 @@ contains
if (alt_soundspeed) then ! K*div(u) correction
$:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_k_term_val, &
& local_flux1, local_flux2]')
- do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m
+ do l_idx = abz_lo, abz_hi; do k_idx = aby_lo, aby_hi; do q_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dy(k_idx)
local_k_term_val = Kterm_arg(q_idx, k_idx, l_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx - 1, l_idx)
+ local_flux1 = flux_src_rsx_vf(q_idx, k_idx, l_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(q_idx, k_idx - 1, l_idx, eqn_idx%adv%beg)
rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, k_idx, &
& l_idx) + local_k_term_val*local_inv_ds*(local_flux1 - local_flux2)
rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, k_idx, &
@@ -1584,8 +1693,8 @@ contains
& private='[k_idx, l_idx, q_idx, local_k_term_val, local_flux1, local_flux2]')
do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m
local_k_term_val = Kterm_arg(q_idx, k_idx, l_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx - 1, l_idx)
+ local_flux1 = flux_src_rsx_vf(q_idx, k_idx, l_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(q_idx, k_idx - 1, l_idx, eqn_idx%adv%beg)
rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, &
& k_idx, l_idx) + (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2)
rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, &
@@ -1606,8 +1715,8 @@ contains
do l_idx = 0, m ! x_extent
local_inv_ds = 1._wp/dz(k_idx)
local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(l_idx, q_idx, k_idx)
- local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx - 1)
- local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx)
+ local_flux1 = flux_src_rsx_vf(l_idx, q_idx, k_idx - 1, j_adv)
+ local_flux2 = flux_src_rsx_vf(l_idx, q_idx, k_idx, j_adv)
rhs_vf_arg(j_adv)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(j_adv)%sf(l_idx, q_idx, &
& k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do
@@ -1635,11 +1744,11 @@ contains
$:GPU_PARALLEL_LOOP(collapse=4, private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, &
& local_flux1, local_flux2]')
do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end
- do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m
+ do k_idx = abz_lo, abz_hi; do q_idx = aby_lo, aby_hi; do l_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dz(k_idx)
local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx - 1)
+ local_flux1 = flux_src_rsx_vf(l_idx, q_idx, k_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(l_idx, q_idx, k_idx - 1, eqn_idx%adv%beg)
rhs_vf_arg(j_adv)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(j_adv)%sf(l_idx, q_idx, &
& k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do; end do; end do
@@ -1651,8 +1760,8 @@ contains
do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m
local_inv_ds = 1._wp/dz(k_idx)
local_k_term_val = Kterm_arg(l_idx, q_idx, k_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx - 1)
+ local_flux1 = flux_src_rsx_vf(l_idx, q_idx, k_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(l_idx, q_idx, k_idx - 1, eqn_idx%adv%beg)
rhs_vf_arg(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(l_idx, &
& q_idx, k_idx) + local_k_term_val*local_inv_ds*(local_flux1 - local_flux2)
rhs_vf_arg(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(l_idx, &
@@ -1672,8 +1781,8 @@ contains
do l_idx = 0, m ! x_extent
local_inv_ds = 1._wp/dz(k_idx)
local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(l_idx, q_idx, k_idx)
- local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx - 1)
- local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx)
+ local_flux1 = flux_src_rsx_vf(l_idx, q_idx, k_idx - 1, j_adv)
+ local_flux2 = flux_src_rsx_vf(l_idx, q_idx, k_idx, j_adv)
rhs_vf_arg(j_adv)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(j_adv)%sf(l_idx, q_idx, &
& k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do
@@ -1701,11 +1810,11 @@ contains
$:GPU_PARALLEL_LOOP(collapse=4, private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, &
& local_flux1, local_flux2]')
do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end
- do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m
+ do k_idx = abz_lo, abz_hi; do q_idx = aby_lo, aby_hi; do l_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dz(k_idx)
local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx - 1)
+ local_flux1 = flux_src_rsx_vf(l_idx, q_idx, k_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(l_idx, q_idx, k_idx - 1, eqn_idx%adv%beg)
rhs_vf_arg(j_adv)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(j_adv)%sf(l_idx, q_idx, &
& k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2)
end do; end do; end do
@@ -1714,11 +1823,11 @@ contains
if (alt_soundspeed) then ! K*div(u) correction
$:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_k_term_val, &
& local_flux1, local_flux2]')
- do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m
+ do k_idx = abz_lo, abz_hi; do q_idx = aby_lo, aby_hi; do l_idx = abx_lo, abx_hi
local_inv_ds = 1._wp/dz(k_idx)
local_k_term_val = Kterm_arg(l_idx, q_idx, k_idx)
- local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx)
- local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx - 1)
+ local_flux1 = flux_src_rsx_vf(l_idx, q_idx, k_idx, eqn_idx%adv%beg)
+ local_flux2 = flux_src_rsx_vf(l_idx, q_idx, k_idx - 1, eqn_idx%adv%beg)
rhs_vf_arg(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(l_idx, &
& q_idx, k_idx) + local_k_term_val*local_inv_ds*(local_flux1 - local_flux2)
rhs_vf_arg(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(l_idx, &
@@ -1735,12 +1844,11 @@ contains
end subroutine s_compute_advection_source_term
!> Add viscous, surface-tension, and species-diffusion source flux contributions to the RHS for a given direction
- subroutine s_compute_additional_physics_rhs(idir, q_prim_vf, rhs_vf, flux_src_n_in, dq_prim_dx_vf, dq_prim_dy_vf, dq_prim_dz_vf)
+ subroutine s_compute_additional_physics_rhs(idir, q_prim_vf, rhs_vf, dq_prim_dx_vf, dq_prim_dy_vf, dq_prim_dz_vf)
integer, intent(in) :: idir
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
- type(scalar_field), dimension(sys_size), intent(in) :: flux_src_n_in
type(scalar_field), dimension(sys_size), intent(in) :: dq_prim_dx_vf, dq_prim_dy_vf, dq_prim_dz_vf
integer :: i, j, k, l
@@ -1751,8 +1859,8 @@ contains
do k = 0, n
do j = 0, m
rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, &
- & l) + 1._wp/dx(j)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, &
- & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j - 1, k, l))
+ & l) + 1._wp/dx(j)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%adv%beg) - flux_src_rsx_vf(j - 1, k, l, eqn_idx%adv%beg))
end do
end do
end do
@@ -1767,22 +1875,22 @@ contains
if (surface_tension .or. viscous) then
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%mom%beg, eqn_idx%E
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_n_in(i)%sf(j - 1, k, &
- & l) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_rsx_vf(j - 1, k, l, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
end if
if (chem_params%diffusion) then
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%species%beg, eqn_idx%species%end
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_n_in(i)%sf(j - 1, k, &
- & l) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_rsx_vf(j - 1, k, l, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
if (.not. viscous) then
rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, &
- & l) + 1._wp/dx(j)*(flux_src_n_in(eqn_idx%E)%sf(j - 1, k, &
- & l) - flux_src_n_in(eqn_idx%E)%sf(j, k, l))
+ & l) + 1._wp/dx(j)*(flux_src_rsx_vf(j - 1, k, l, eqn_idx%E) - flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E))
end if
end if
end do
@@ -1797,15 +1905,18 @@ contains
do k = 0, n
do j = 0, m
rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, &
- & l) + 1._wp/dy(k)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, &
- & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k - 1, l))
+ & l) + 1._wp/dy(k)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%adv%beg) - flux_src_rsx_vf(j, k - 1, l, eqn_idx%adv%beg))
end do
end do
end do
$:END_GPU_PARALLEL_LOOP()
end if
- if (cyl_coord .and. ((bc_y%beg == -2) .or. (bc_y%beg == -14))) then
+ ! the axis-singularity stress treatment belongs to the PHYSICAL axis only: bc_y is not
+ ! swapped by the AMR fine advance, so without the guard a fine block would apply axis
+ ! handling at its own (interior) lower-y edge - the coarse pass owns the real axis
+ if (cyl_coord .and. (.not. amr_in_fine_advance) .and. ((bc_y%beg == -2) .or. (bc_y%beg == -14))) then
if (viscous) then
if (p > 0) then
call s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, &
@@ -1836,8 +1947,8 @@ contains
do j = 0, m
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%mom%beg, eqn_idx%E
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, k - 1, &
- & l) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_rsx_vf(j, k - 1, l, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
end do
end do
@@ -1852,21 +1963,21 @@ contains
if (surface_tension .or. viscous) then
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%mom%beg, eqn_idx%E
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, &
- & k - 1, l) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_rsx_vf(j, k - 1, l, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
end if
if (chem_params%diffusion) then
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%species%beg, eqn_idx%species%end
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, &
- & k - 1, l) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_rsx_vf(j, k - 1, l, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
if (.not. viscous) then
rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, &
- & l) + 1._wp/dy(k)*(flux_src_n_in(eqn_idx%E)%sf(j, k - 1, &
- & l) - flux_src_n_in(eqn_idx%E)%sf(j, k, l))
+ & l) + 1._wp/dy(k)*(flux_src_rsx_vf(j, k - 1, l, eqn_idx%E) - flux_src_rsx_vf(j, &
+ & k, l, eqn_idx%E))
end if
end if
end do
@@ -1885,8 +1996,8 @@ contains
do j = 0, m
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%mom%beg, eqn_idx%E
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_n_in(i)%sf(j, &
- & k - 1, l) + flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_rsx_vf(j, k - 1, &
+ & l, i) + flux_src_rsx_vf(j, k, l, i))
end do
end do
end do
@@ -1912,8 +2023,8 @@ contains
do j = 0, m
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%mom%beg, eqn_idx%E
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_n_in(i)%sf(j, &
- & k - 1, l) + flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_rsx_vf(j, k - 1, &
+ & l, i) + flux_src_rsx_vf(j, k, l, i))
end do
end do
end do
@@ -1928,8 +2039,8 @@ contains
do k = 0, n
do j = 0, m
rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, &
- & l) + 1._wp/dz(l)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, &
- & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, l - 1))
+ & l) + 1._wp/dz(l)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%adv%beg) - flux_src_rsx_vf(j, k, l - 1, eqn_idx%adv%beg))
end do
end do
end do
@@ -1944,21 +2055,21 @@ contains
if (surface_tension .or. viscous) then
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%mom%beg, eqn_idx%E
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_n_in(i)%sf(j, k, &
- & l - 1) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_rsx_vf(j, k, l - 1, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
end if
if (chem_params%diffusion) then
$:GPU_LOOP(parallelism='[seq]')
do i = eqn_idx%species%beg, eqn_idx%species%end
- rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_n_in(i)%sf(j, k, &
- & l - 1) - flux_src_n_in(i)%sf(j, k, l))
+ rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_rsx_vf(j, k, l - 1, &
+ & i) - flux_src_rsx_vf(j, k, l, i))
end do
if (.not. viscous) then
rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, &
- & l) + 1._wp/dz(l)*(flux_src_n_in(eqn_idx%E)%sf(j, k, &
- & l - 1) - flux_src_n_in(eqn_idx%E)%sf(j, k, l))
+ & l) + 1._wp/dz(l)*(flux_src_rsx_vf(j, k, l - 1, eqn_idx%E) - flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E))
end if
end if
end do
@@ -1973,12 +2084,12 @@ contains
do k = 0, n
do j = 0, m
rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) + 5.e-1_wp*(flux_src_n_in(eqn_idx%mom%end)%sf(j, k, &
- & l - 1) + flux_src_n_in(eqn_idx%mom%end)%sf(j, k, l))
+ & l) + 5.e-1_wp*(flux_src_rsx_vf(j, k, l - 1, eqn_idx%mom%end) + flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%end))
rhs_vf(eqn_idx%mom%end)%sf(j, k, l) = rhs_vf(eqn_idx%mom%end)%sf(j, k, &
- & l) - 5.e-1_wp*(flux_src_n_in(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l - 1) + flux_src_n_in(eqn_idx%mom%beg + 1)%sf(j, k, l))
+ & l) - 5.e-1_wp*(flux_src_rsx_vf(j, k, l - 1, eqn_idx%mom%beg + 1) + flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1))
end do
end do
end do
@@ -2015,6 +2126,27 @@ contains
is1%end = is1%end - ${SCHEME}$_polyn
end if
+ ! Restrict the reconstruction compute-window to the active box (arrays stay allocated
+ ! full-size). The normal direction (is1) extends buff_size beyond the box so
+ ! boundary-cell stencils read valid ambient neighbours; the transverse directions
+ ! (is2, is3) cover the box, intersected with the allocation-derived window above.
+ ! s_${SCHEME}$ pushes this window to the device.
+ if (ab_active) then
+ if (norm_dir == 1) then
+ is1%beg = max(is1%beg, ab_x%beg - buff_size); is1%end = min(is1%end, ab_x%end + buff_size)
+ is2%beg = max(is2%beg, ab_y%beg); is2%end = min(is2%end, ab_y%end)
+ is3%beg = max(is3%beg, ab_z%beg); is3%end = min(is3%end, ab_z%end)
+ else if (norm_dir == 2) then
+ is1%beg = max(is1%beg, ab_y%beg - buff_size); is1%end = min(is1%end, ab_y%end + buff_size)
+ is2%beg = max(is2%beg, ab_x%beg); is2%end = min(is2%end, ab_x%end)
+ is3%beg = max(is3%beg, ab_z%beg); is3%end = min(is3%end, ab_z%end)
+ else
+ is1%beg = max(is1%beg, ab_z%beg - buff_size); is1%end = min(is1%end, ab_z%end + buff_size)
+ is2%beg = max(is2%beg, ab_y%beg); is2%end = min(is2%end, ab_y%end)
+ is3%beg = max(is3%beg, ab_x%beg); is3%end = min(is3%end, ab_x%end)
+ end if
+ end if
+
call s_${SCHEME}$ (v_vf(iv%beg:iv%end), vL_x(:,:,:,iv%beg:iv%end), vR_x(:,:,:,iv%beg:iv%end), recon_dir, is1, &
& is2, is3)
end if
@@ -2196,7 +2328,7 @@ contains
@:DEALLOCATE(alf_sum%sf)
end if
- if (.not. igr) then
+ if (hypo_nc_mode == hypo_nc_mode_dual_pass) then
do i = num_dims, 1, -1
if (i /= 1) then
do l = 1, sys_size
@@ -2237,11 +2369,15 @@ contains
end do
@:DEALLOCATE(flux_n, flux_src_n, flux_gsrc_n)
+ end if
+ if (.not. igr) then
do i = 1, num_dims
- do l = eqn_idx%mom%beg, eqn_idx%mom%end
- @:DEALLOCATE(qL_prim(i)%vf(l)%sf)
- @:DEALLOCATE(qR_prim(i)%vf(l)%sf)
- end do
+ if (viscous) then
+ do l = eqn_idx%mom%beg, eqn_idx%mom%end
+ @:DEALLOCATE(qL_prim(i)%vf(l)%sf)
+ @:DEALLOCATE(qR_prim(i)%vf(l)%sf)
+ end do
+ end if
@:DEALLOCATE(qL_prim(i)%vf, qR_prim(i)%vf)
end do
@:DEALLOCATE(qL_prim, qR_prim)
diff --git a/src/simulation/m_riemann_solver_hll.fpp b/src/simulation/m_riemann_solver_hll.fpp
index 28c0db1073..d9768807fd 100644
--- a/src/simulation/m_riemann_solver_hll.fpp
+++ b/src/simulation/m_riemann_solver_hll.fpp
@@ -26,8 +26,7 @@ contains
!> HLL approximate Riemann solver, Harten et al. SIAM Review (1983)
subroutine s_hll_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, &
- & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
- & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
+ & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, norm_dir, ix, iy, iz)
real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
@@ -36,10 +35,9 @@ contains
& dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
! Intercell fluxes
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
- real(wp) :: flux_tau_L, flux_tau_R
- integer, intent(in) :: norm_dir
- type(int_bounds_info), intent(in) :: ix, iy, iz
+ real(wp) :: flux_tau_L, flux_tau_R
+ integer, intent(in) :: norm_dir
+ type(int_bounds_info), intent(in) :: ix, iy, iz
#:if not MFC_CASE_OPTIMIZATION and USING_AMD
real(wp), dimension(3) :: alpha_rho_L, alpha_rho_R
@@ -103,7 +101,7 @@ contains
& qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, norm_dir, ix, iy, iz)
! Reshaping inputted data based on dimensional splitting direction
- call s_initialize_riemann_solver(flux_src_vf, norm_dir)
+ call s_initialize_riemann_solver(norm_dir)
Re_size_loc1 = Re_size(1); Re_size_loc2 = Re_size(2)
#:for NORM_DIR, XYZ, STENCIL_VAR, COORDS, X_BND, Y_BND, Z_BND in &
[(1, 'x', 'j', '{STENCIL_IDX}, k, l', 'is1', 'is2', 'is3'), &
@@ -684,8 +682,8 @@ contains
& qR_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
- & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
- & norm_dir, ix, iy, iz)
+ & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), q_prim_vf, norm_dir, ix, &
+ & iy, iz)
else
call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqL_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
@@ -694,13 +692,11 @@ contains
& q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
- & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
- & norm_dir, ix, iy, iz)
+ & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), q_prim_vf, norm_dir, ix, &
+ & iy, iz)
end if
end if
- call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
-
end subroutine s_hll_riemann_solver
end module m_riemann_solver_hll
diff --git a/src/simulation/m_riemann_solver_hllc.fpp b/src/simulation/m_riemann_solver_hllc.fpp
index e760f5874e..20d6782c1e 100644
--- a/src/simulation/m_riemann_solver_hllc.fpp
+++ b/src/simulation/m_riemann_solver_hllc.fpp
@@ -29,8 +29,7 @@ contains
!> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, &
- & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
- & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
+ & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, norm_dir, ix, iy, iz)
real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
@@ -39,9 +38,8 @@ contains
& dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
! Intercell fluxes
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
- integer, intent(in) :: norm_dir
- type(int_bounds_info), intent(in) :: ix, iy, iz
+ integer, intent(in) :: norm_dir
+ type(int_bounds_info), intent(in) :: ix, iy, iz
#:if not MFC_CASE_OPTIMIZATION and USING_AMD
real(wp), dimension(3) :: alpha_rho_L, alpha_rho_R
@@ -164,7 +162,7 @@ contains
! Reshaping inputted data based on dimensional splitting direction
- call s_initialize_riemann_solver(flux_src_vf, norm_dir)
+ call s_initialize_riemann_solver(norm_dir)
Re_size_loc1 = Re_size(1); Re_size_loc2 = Re_size(2)
@@ -870,10 +868,10 @@ contains
! give two line numbers. Do not merge them back into one.
#:if HYPO
$:GPU_PARALLEL_LOOP(collapse=3, private=_hllc_priv, copyin='[is1, is2, is3]', &
- & firstprivate='[Re_size_loc1, Re_size_loc2]')
+ & firstprivate='[Re_size_loc1, Re_size_loc2]', extraOmpArgs='map(alloc: vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)')
#:else
$:GPU_PARALLEL_LOOP(collapse=3, private=_hllc_priv, copyin='[is1, is2, is3]', &
- & firstprivate='[Re_size_loc1, Re_size_loc2]')
+ & firstprivate='[Re_size_loc1, Re_size_loc2]', extraOmpArgs='map(alloc: vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)')
#:endif
do l = ${Z_BND}$%beg, ${Z_BND}$%end
do k = ${Y_BND}$%beg, ${Y_BND}$%end
@@ -1554,8 +1552,8 @@ contains
& qR_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
- & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
- & norm_dir, ix, iy, iz)
+ & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), q_prim_vf, norm_dir, ix, &
+ & iy, iz)
else
call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqL_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
@@ -1564,17 +1562,15 @@ contains
& q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
& dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
- & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
- & norm_dir, ix, iy, iz)
+ & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), q_prim_vf, norm_dir, ix, &
+ & iy, iz)
end if
end if
if (surface_tension) then
- call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
+ call s_compute_capillary_source_flux(vel_src_rsx_vf, norm_dir, isx, isy, isz)
end if
- call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
-
end subroutine s_hllc_riemann_solver
end module m_riemann_solver_hllc
diff --git a/src/simulation/m_riemann_solver_hlld.fpp b/src/simulation/m_riemann_solver_hlld.fpp
index c49992bedb..a575dff141 100644
--- a/src/simulation/m_riemann_solver_hlld.fpp
+++ b/src/simulation/m_riemann_solver_hlld.fpp
@@ -19,8 +19,7 @@ contains
!> HLLD Riemann solver for MHD, Miyoshi & Kusano JCP (2005)
subroutine s_hlld_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, &
- & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
- & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
+ & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, norm_dir, ix, iy, iz)
real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
@@ -28,7 +27,6 @@ contains
type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
integer, intent(in) :: norm_dir
type(int_bounds_info), intent(in) :: ix, iy, iz
@@ -64,7 +62,7 @@ contains
call s_populate_riemann_states_variables_buffers(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
& qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, norm_dir, ix, iy, iz)
- call s_initialize_riemann_solver(flux_src_vf, norm_dir)
+ call s_initialize_riemann_solver(norm_dir)
#:for NORM_DIR, XYZ, STENCIL_VAR, COORDS, X_BND, Y_BND, Z_BND in &
[(1, 'x', 'j', '{STENCIL_IDX}, k, l', 'is1', 'is2', 'is3'), &
@@ -267,8 +265,6 @@ contains
end if
#:endfor
- call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
-
end subroutine s_hlld_riemann_solver
end module m_riemann_solver_hlld
diff --git a/src/simulation/m_riemann_solver_hypo_hlld.fpp b/src/simulation/m_riemann_solver_hypo_hlld.fpp
index 52316daa24..ee04f51875 100644
--- a/src/simulation/m_riemann_solver_hypo_hlld.fpp
+++ b/src/simulation/m_riemann_solver_hypo_hlld.fpp
@@ -163,7 +163,7 @@ contains
call s_populate_riemann_states_variables_buffers(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
& qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, norm_dir, ix, iy, iz)
- call s_initialize_riemann_solver(flux_src_vf, norm_dir)
+ call s_initialize_riemann_solver(norm_dir)
#:for NORM_DIR, XYZ, STENCIL_VAR, COORDS, X_BND, Y_BND, Z_BND in &
[(1, 'x', 'j', '{STENCIL_IDX}, k, l', 'is1', 'is2', 'is3'), &
diff --git a/src/simulation/m_riemann_solver_lf.fpp b/src/simulation/m_riemann_solver_lf.fpp
index 1ea7ffa12d..984a91c700 100644
--- a/src/simulation/m_riemann_solver_lf.fpp
+++ b/src/simulation/m_riemann_solver_lf.fpp
@@ -23,8 +23,7 @@ contains
!> Lax-Friedrichs (Rusanov) approximate Riemann solver
subroutine s_lf_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, &
- & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, &
- & flux_gsrc_vf, norm_dir, ix, iy, iz)
+ & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, norm_dir, ix, iy, iz)
real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
@@ -33,9 +32,8 @@ contains
& dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
! Intercell fluxes
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
- integer, intent(in) :: norm_dir
- type(int_bounds_info), intent(in) :: ix, iy, iz
+ integer, intent(in) :: norm_dir
+ type(int_bounds_info), intent(in) :: ix, iy, iz
#:if not MFC_CASE_OPTIMIZATION and USING_AMD
real(wp), dimension(3) :: alpha_rho_L, alpha_rho_R
@@ -93,7 +91,7 @@ contains
& qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, norm_dir, ix, iy, iz)
! Reshaping inputted data based on dimensional splitting direction
- call s_initialize_riemann_solver(flux_src_vf, norm_dir)
+ call s_initialize_riemann_solver(norm_dir)
Re_size_loc1 = Re_size(1); Re_size_loc2 = Re_size(2)
#:for NORM_DIR, XYZ, STENCIL_VAR, COORDS, X_BND, Y_BND, Z_BND in &
[(1, 'x', 'j', '{STENCIL_IDX}, k, l', 'is1', 'is2', 'is3'), &
@@ -430,110 +428,124 @@ contains
end do
if (norm_dir == 1) then
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(1) + vel_grad_R(1, 1)*vel_R(1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(1) + vel_grad_R(1, &
+ & 1)*vel_R(1))
#:if not MFC_CASE_OPTIMIZATION or num_dims > 1
if (num_dims > 1) then
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2)*vel_L(1) + vel_grad_R(2, &
- & 2)*vel_R(1))
-
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 2) + vel_grad_R(1, 2)) - 0.5_wp*(vel_grad_L(2, &
- & 1) + vel_grad_R(2, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 2)*vel_L(2) + vel_grad_R(1, &
- & 2)*vel_R(2)) - 0.5_wp*(vel_grad_L(2, 1)*vel_L(2) + vel_grad_R(2, 1)*vel_R(2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, &
+ & 2) + vel_grad_R(2, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, &
+ & 2)*vel_L(1) + vel_grad_R(2, 2)*vel_R(1))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - 0.5_wp*(vel_grad_L(1, 2) + vel_grad_R(1, &
+ & 2)) - 0.5_wp*(vel_grad_L(2, 1) + vel_grad_R(2, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(1, 2)*vel_L(2) + vel_grad_R(1, &
+ & 2)*vel_R(2)) - 0.5_wp*(vel_grad_L(2, 1)*vel_L(2) + vel_grad_R(2, &
+ & 1)*vel_R(2))
#:if not MFC_CASE_OPTIMIZATION or num_dims > 2
if (num_dims > 2) then
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
- & 3)*vel_L(1) + vel_grad_R(3, 3)*vel_R(1))
-
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 3) + vel_grad_R(1, &
- & 3)) - 0.5_wp*(vel_grad_L(3, 1) + vel_grad_R(3, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 3)*vel_L(3) + vel_grad_R(1, &
- & 3)*vel_R(3)) - 0.5_wp*(vel_grad_L(3, 1)*vel_L(3) + vel_grad_R(3, &
- & 1)*vel_R(3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
+ & 3) + vel_grad_R(3, 3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
+ & 3)*vel_L(1) + vel_grad_R(3, 3)*vel_R(1))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - 0.5_wp*(vel_grad_L(1, 3) + vel_grad_R(1, &
+ & 3)) - 0.5_wp*(vel_grad_L(3, 1) + vel_grad_R(3, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(1, 3)*vel_L(3) + vel_grad_R(1, &
+ & 3)*vel_R(3)) - 0.5_wp*(vel_grad_L(3, &
+ & 1)*vel_L(3) + vel_grad_R(3, 1)*vel_R(3))
end if
#:endif
end if
#:endif
else if (norm_dir == 2) then
#:if not MFC_CASE_OPTIMIZATION or num_dims > 1
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2))
-
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2))
-
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 2) + vel_grad_R(1, 2)) - 0.5_wp*(vel_grad_L(2, &
- & 1) + vel_grad_R(2, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 2)*vel_L(1) + vel_grad_R(1, &
- & 2)*vel_R(1)) - 0.5_wp*(vel_grad_L(2, 1)*vel_L(1) + vel_grad_R(2, 1)*vel_R(1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, &
+ & 1) + vel_grad_R(1, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, &
+ & 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, &
+ & 2) + vel_grad_R(2, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, &
+ & 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - 0.5_wp*(vel_grad_L(1, 2) + vel_grad_R(1, &
+ & 2)) - 0.5_wp*(vel_grad_L(2, 1) + vel_grad_R(2, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(1, 2)*vel_L(1) + vel_grad_R(1, &
+ & 2)*vel_R(1)) - 0.5_wp*(vel_grad_L(2, 1)*vel_L(1) + vel_grad_R(2, 1)*vel_R(1))
#:if not MFC_CASE_OPTIMIZATION or num_dims > 2
if (num_dims > 2) then
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
- & k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3)*vel_L(2) + vel_grad_R(3, &
- & 3)*vel_R(2))
-
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, &
- & k, l) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, &
- & 3)) - 0.5_wp*(vel_grad_L(3, 2) + vel_grad_R(3, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 3)*vel_L(3) + vel_grad_R(2, &
- & 3)*vel_R(3)) - 0.5_wp*(vel_grad_L(3, 2)*vel_L(3) + vel_grad_R(3, &
- & 2)*vel_R(3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
+ & 3) + vel_grad_R(3, 3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
+ & 3)*vel_L(2) + vel_grad_R(3, 3)*vel_R(2))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, &
+ & 3)) - 0.5_wp*(vel_grad_L(3, 2) + vel_grad_R(3, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(2, 3)*vel_L(3) + vel_grad_R(2, &
+ & 3)*vel_R(3)) - 0.5_wp*(vel_grad_L(3, 2)*vel_L(3) + vel_grad_R(3, &
+ & 2)*vel_R(3))
end if
#:endif
#:endif
else
#:if not MFC_CASE_OPTIMIZATION or num_dims > 2
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3))
-
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3))
-
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 3) + vel_grad_R(1, 3)) - 0.5_wp*(vel_grad_L(3, &
- & 1) + vel_grad_R(3, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 3)*vel_L(1) + vel_grad_R(1, &
- & 3)*vel_R(1)) - 0.5_wp*(vel_grad_L(3, 1)*vel_L(1) + vel_grad_R(3, 1)*vel_R(1))
-
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3))
-
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, 3)) - 0.5_wp*(vel_grad_L(3, &
- & 2) + vel_grad_R(3, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 3)*vel_L(2) + vel_grad_R(2, &
- & 3)*vel_R(2)) - 0.5_wp*(vel_grad_L(3, 2)*vel_L(2) + vel_grad_R(3, 2)*vel_R(2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, &
+ & 1) + vel_grad_R(1, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, &
+ & 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, &
+ & 2) + vel_grad_R(2, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, &
+ & 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - 0.5_wp*(vel_grad_L(1, 3) + vel_grad_R(1, &
+ & 3)) - 0.5_wp*(vel_grad_L(3, 1) + vel_grad_R(3, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(1, 3)*vel_L(1) + vel_grad_R(1, &
+ & 3)*vel_R(1)) - 0.5_wp*(vel_grad_L(3, 1)*vel_L(1) + vel_grad_R(3, 1)*vel_R(1))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
+ & 3) + vel_grad_R(3, 3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, &
+ & 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, &
+ & 3)) - 0.5_wp*(vel_grad_L(3, 2) + vel_grad_R(3, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(2, 3)*vel_L(2) + vel_grad_R(2, &
+ & 3)*vel_R(2)) - 0.5_wp*(vel_grad_L(3, 2)*vel_L(2) + vel_grad_R(3, 2)*vel_R(2))
#:endif
end if
end if
@@ -561,64 +573,67 @@ contains
end do
if (norm_dir == 1) then
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, &
- & 1)*vel_L(1) + vel_grad_R(1, 1)*vel_R(1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, eqn_idx%E) - 0.5_wp*(vel_grad_L(1, &
+ & 1)*vel_L(1) + vel_grad_R(1, 1)*vel_R(1))
#:if not MFC_CASE_OPTIMIZATION or num_dims > 1
if (num_dims > 1) then
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(1) + vel_grad_R(2, 2)*vel_R(1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(1) + vel_grad_R(2, &
+ & 2)*vel_R(1))
#:if not MFC_CASE_OPTIMIZATION or num_dims > 2
if (num_dims > 2) then
- flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(1) + vel_grad_R(3, 3)*vel_R(1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(1) + vel_grad_R(3, &
+ & 3)*vel_R(1))
end if
#:endif
end if
#:endif
else if (norm_dir == 2) then
#:if not MFC_CASE_OPTIMIZATION or num_dims > 1
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(1, 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2))
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2))
#:if not MFC_CASE_OPTIMIZATION or num_dims > 2
if (num_dims > 2) then
- flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
- & k, l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(2) + vel_grad_R(3, 3)*vel_R(2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 1) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(2) + vel_grad_R(3, &
+ & 3)*vel_R(2))
end if
#:endif
#:endif
else
#:if not MFC_CASE_OPTIMIZATION or num_dims > 2
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(1, 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3))
-
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3))
-
- flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(1, 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3))
+
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + 2) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + 2) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3))
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3))
#:endif
end if
end if
@@ -628,8 +643,6 @@ contains
$:END_GPU_PARALLEL_LOOP()
end if
- call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
-
end subroutine s_lf_riemann_solver
end module m_riemann_solver_lf
diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp
index 9ee91ecccc..a0353bd44d 100644
--- a/src/simulation/m_riemann_solvers.fpp
+++ b/src/simulation/m_riemann_solvers.fpp
@@ -29,8 +29,7 @@ contains
!> Dispatch to the subroutines that are utilized to compute the Riemann problem solution. For additional information please
!! reference: 1) s_hll_riemann_solver 2) s_hllc_riemann_solver 3) s_lf_riemann_solver 4) s_hlld_riemann_solver
subroutine s_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, &
- & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, &
- & flux_gsrc_vf, norm_dir, ix, iy, iz)
+ & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, norm_dir, ix, iy, iz)
real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
@@ -38,34 +37,24 @@ contains
type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
& dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
- integer, intent(in) :: norm_dir
- type(int_bounds_info), intent(in) :: ix, iy, iz
+ integer, intent(in) :: norm_dir
+ type(int_bounds_info), intent(in) :: ix, iy, iz
! Hypoelasticity enters the Riemann layer in THREE distinct code shapes:
! 1. HLLC - inline "if (hypoelasticity)" branches inside s_hllc_riemann_solver
! 2. HLL - inline "if (hypoelasticity)" branches inside s_hll_riemann_solver
- ! 3. HLLD - a separate module (m_riemann_solver_hypo_hlld), reached by the hypo_nc_mode_dual_pass path below
+ ! 3. HLLD - a separate module (m_riemann_solver_hypo_hlld), called directly from m_rhs (s_compute_directional_rhs)
+ ! under hypo_nc_mode_dual_pass
! HLLD needs its own path because its anchored dual pass produces BOTH the hat_L and hat_R anchored flux
! sets in one fused solve, whose partial RHS are then summed in m_rhs; HLLC/HLL instead add their
! non-conservative contribution within a single-pass solve. See
! misc/dev_notes/Riemann_and_RHS_source_terms_explanations.md (S5.3).
- if (hypo_nc_mode == hypo_nc_mode_dual_pass) then
- ! Fused dual-pass: one call computes BOTH anchored flux sets (hat_L -> flux_vf via the regular finalize; hat_R into
- ! flux_hatR_rs*, finalized separately via s_finalize_riemann_solver_hatR between the two RHS assemblies).
- call s_hypo_hlld_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, &
- & qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, &
- & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
-
- return
- end if
-
#:for NAME, NUM in [('hll', 1), ('hllc', 2), ('hlld', 4), ('lf', 5)]
if (riemann_solver == ${NUM}$) then
call s_${NAME}$_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, &
& qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, &
- & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
+ & q_prim_vf, norm_dir, ix, iy, iz)
end if
#:endfor
@@ -76,7 +65,7 @@ contains
! Allocating the variables that will be utilized to formulate the left, right, and average states of the Riemann problem, as
! well the Riemann problem solution
- integer :: i, j
+ integer :: i, j, k, l, src_lo
@:ALLOCATE(Gs_rs(1:num_fluids))
@@ -103,29 +92,80 @@ contains
is1%beg = -1; is2%beg = 0; is3%beg = 0
is1%end = m; is2%end = n; is3%end = p
- @:ALLOCATE(flux_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
- @:ALLOCATE(flux_gsrc_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
- @:ALLOCATE(flux_src_rsx_vf(-1:m, -1:n, -1:p, eqn_idx%adv%beg:sys_size))
- @:ALLOCATE(vel_src_rsx_vf(-1:m, -1:n, -1:p, 1:num_vels))
+ @:ALLOCATE(flux_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:sys_size))
+ @:ALLOCATE(vel_src_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:num_vels))
+
+ ! Size the source-flux buffer to the band that is actually written. These are FULL-DOMAIN arrays, so each unused component
+ ! costs (m_alloc+2)(n_alloc+2)(p_alloc+2) reals per rank - 0.37 GB/rank of waste at 400^3 for the five components an
+ ! inviscid Cartesian run never touches.
+ ! chemistry diffusion : from 1, because m_chemistry lives in src/common, cannot use m_riemann_state, and so takes a flat
+ ! dummy declared `dimension(-1:, -1:, -1:, 1:)` - the lower bounds must agree or every species
+ ! index silently shifts. It is only ever passed this array when diffusion is on.
+ ! viscous / surf.tens.: from mom%beg (the viscous stress and work fluxes occupy mom..E)
+ ! otherwise : from adv%beg (the advection source band alone)
+ if (chemistry .and. chem_params%diffusion) then
+ src_lo = 1
+ else if (viscous .or. surface_tension) then
+ src_lo = eqn_idx%mom%beg
+ else
+ src_lo = eqn_idx%adv%beg
+ end if
+ @:ALLOCATE(flux_src_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, src_lo:sys_size))
+
+ ! The geometric source flux exists only on the cylindrical/axisymmetric paths - every write in the four solvers and both
+ ! reads in m_rhs sit under `cyl_coord` or `grid_geometry == 3`, and grid_geometry == 3 implies cyl_coord
+ ! (m_global_parameters). A Cartesian run therefore never touches it, so do not pay 6 full-domain arrays for it. It is
+ ! zeroed on allocation because the solvers write only the components they touch while m_rhs reads the whole band.
+ if (cyl_coord) then
+ @:ALLOCATE(flux_gsrc_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:sys_size))
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = -1, p_alloc
+ do k = -1, n_alloc
+ do j = -1, m_alloc
+ flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
+ end if
+
if (qbmm) then
- @:ALLOCATE(mom_sp_rsx_vf(-1:m+1, -1:n+1, -1:p+1, 1:4))
+ @:ALLOCATE(mom_sp_rsx_vf(-1:m_alloc+1, -1:n_alloc+1, -1:p_alloc+1, 1:4))
end if
if (viscous) then
- @:ALLOCATE(Re_avg_rsx_vf(-1:m, -1:n, -1:p, 1:2))
+ @:ALLOCATE(Re_avg_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:2))
end if
+ ! _alloc bounds like every rs sibling above: the AMR fine advance swaps m/n/p to fine-block
+ ! extents that can exceed the coarse subdomain when amr_max_grid_size pins a larger block
if (use_nc_iface_vel) then
- @:ALLOCATE(nc_iface_vel_rsx_vf(-1:m, -1:n, -1:p, 1:num_dims))
+ @:ALLOCATE(nc_iface_vel_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:num_dims))
end if
if (hypo_nc_mode == hypo_nc_mode_dual_pass) then
- @:ALLOCATE(flux_hatR_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
+ @:ALLOCATE(flux_hatR_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:sys_size))
if (use_nc_iface_vel) then
- @:ALLOCATE(nc_iface_vel_hatR_rsx_vf(-1:m, -1:n, -1:p, 1:num_dims))
+ @:ALLOCATE(nc_iface_vel_hatR_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:num_dims))
end if
if (cyl_coord) then
- @:ALLOCATE(flux_gsrc_hatR_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
+ @:ALLOCATE(flux_gsrc_hatR_rsx_vf(-1:m_alloc, -1:n_alloc, -1:p_alloc, 1:sys_size))
+ ! zeroed for the same reason as flux_gsrc_rsx_vf above: nothing in the tree WRITES this array, but
+ ! s_finalize_riemann_solver_hatR copies all of 1:sys_size out of it into flux_gsrc_n(id), which m_rhs
+ ! folds into the RHS. Without this it fed uninitialized memory into the solution under cyl_coord.
+ $:GPU_PARALLEL_LOOP(collapse=4)
+ do i = 1, sys_size
+ do l = -1, p_alloc
+ do k = -1, n_alloc
+ do j = -1, m_alloc
+ flux_gsrc_hatR_rsx_vf(j, k, l, i) = 0._wp
+ end do
+ end do
+ end do
+ end do
+ $:END_GPU_PARALLEL_LOOP()
end if
end if
@@ -141,7 +181,9 @@ contains
@:DEALLOCATE(vel_src_rsx_vf)
@:DEALLOCATE(flux_rsx_vf)
@:DEALLOCATE(flux_src_rsx_vf)
- @:DEALLOCATE(flux_gsrc_rsx_vf)
+ if (cyl_coord) then
+ @:DEALLOCATE(flux_gsrc_rsx_vf)
+ end if
@:DEALLOCATE(Gs_rs)
if (use_nc_iface_vel) then
@:DEALLOCATE(nc_iface_vel_rsx_vf)
diff --git a/src/simulation/m_riemann_state.fpp b/src/simulation/m_riemann_state.fpp
index abb1733b70..db0d7959c4 100644
--- a/src/simulation/m_riemann_state.fpp
+++ b/src/simulation/m_riemann_state.fpp
@@ -11,7 +11,7 @@ module m_riemann_state
use m_derived_types
use m_global_parameters
- use m_constants, only: riemann_solver_hll, riemann_solver_hlld, verysmall
+ use m_constants, only: verysmall
use m_hb_function
implicit none
@@ -77,22 +77,21 @@ contains
!! geometries. For more information please refer to: 1) s_compute_cartesian_viscous_source_flux 2)
!! s_compute_cylindrical_viscous_source_flux
subroutine s_compute_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, dvelR_dy_vf, &
- & dvelR_dz_vf, flux_src_vf, q_prim_vf, norm_dir, ix, iy, iz)
+ & dvelR_dz_vf, q_prim_vf, norm_dir, ix, iy, iz)
type(scalar_field), dimension(num_vels), intent(in) :: velL_vf, velR_vf, dvelL_dx_vf, dvelR_dx_vf, dvelL_dy_vf, &
& dvelR_dy_vf, dvelL_dz_vf, dvelR_dz_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
- type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
- integer, intent(in) :: norm_dir
- type(int_bounds_info), intent(in) :: ix, iy, iz
+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
+ integer, intent(in) :: norm_dir
+ type(int_bounds_info), intent(in) :: ix, iy, iz
if (grid_geometry == 3) then
call s_compute_cylindrical_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, &
- & dvelR_dy_vf, dvelR_dz_vf, flux_src_vf, q_prim_vf, norm_dir, ix, iy, iz)
+ & dvelR_dy_vf, dvelR_dz_vf, q_prim_vf, norm_dir, ix, iy, iz)
else
call s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, dvelR_dx_vf, dvelR_dy_vf, &
- & dvelR_dz_vf, flux_src_vf, q_prim_vf, norm_dir)
+ & dvelR_dz_vf, q_prim_vf, norm_dir)
end if
end subroutine s_compute_viscous_source_flux
@@ -431,11 +430,10 @@ contains
end subroutine s_populate_riemann_states_variables_buffers
!> Set up the chosen Riemann solver algorithm for the current direction
- subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
+ subroutine s_initialize_riemann_solver(norm_dir)
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
- integer, intent(in) :: norm_dir
- integer :: i, j, k, l !< Generic loop iterators
+ integer, intent(in) :: norm_dir
+ integer :: i, j, k, l !< Generic loop iterators
! Reshaping Inputted Data in x-direction
@@ -446,7 +444,7 @@ contains
do l = is3%beg, is3%end
do k = is2%beg, is2%end
do j = is1%beg, is1%end
- flux_src_vf(i)%sf(j, k, l) = 0._wp
+ flux_src_rsx_vf(j, k, l, i) = 0._wp
end do
end do
end do
@@ -461,7 +459,7 @@ contains
do k = is2%beg, is2%end
do j = is1%beg, is1%end
if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
- flux_src_vf(i)%sf(j, k, l) = 0._wp
+ flux_src_rsx_vf(j, k, l, i) = 0._wp
end if
end do
end do
@@ -492,7 +490,7 @@ contains
do l = is3%beg, is3%end
do j = is1%beg, is1%end
do k = is2%beg, is2%end
- flux_src_vf(i)%sf(k, j, l) = 0._wp
+ flux_src_rsx_vf(k, j, l, i) = 0._wp
end do
end do
end do
@@ -507,7 +505,7 @@ contains
do j = is1%beg, is1%end
do k = is2%beg, is2%end
if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
- flux_src_vf(i)%sf(k, j, l) = 0._wp
+ flux_src_rsx_vf(k, j, l, i) = 0._wp
end if
end do
end do
@@ -538,7 +536,7 @@ contains
do j = is1%beg, is1%end
do k = is2%beg, is2%end
do l = is3%beg, is3%end
- flux_src_vf(i)%sf(l, k, j) = 0._wp
+ flux_src_rsx_vf(l, k, j, i) = 0._wp
end do
end do
end do
@@ -553,7 +551,7 @@ contains
do k = is2%beg, is2%end
do l = is3%beg, is3%end
if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
- flux_src_vf(i)%sf(l, k, j) = 0._wp
+ flux_src_rsx_vf(l, k, j, i) = 0._wp
end if
end do
end do
@@ -581,16 +579,15 @@ contains
!> Compute cylindrical viscous source flux contributions for momentum and energy
subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, &
- & dvelR_dy_vf, dvelR_dz_vf, flux_src_vf, q_prim_vf, norm_dir, ix, iy, iz)
+ & dvelR_dy_vf, dvelR_dz_vf, q_prim_vf, norm_dir, ix, iy, iz)
- type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
- type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
- type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
- type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
- type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
- integer, intent(in) :: norm_dir
- type(int_bounds_info), intent(in) :: ix, iy, iz
+ type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
+ type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
+ type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
+ type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
+ integer, intent(in) :: norm_dir
+ type(int_bounds_info), intent(in) :: ix, iy, iz
! Local variables
@@ -779,20 +776,20 @@ contains
$:GPU_LOOP(parallelism='[seq]')
do i_vel = 1, num_dims
- flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, &
- & k, l) - stress_vector_shear(i_vel)
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + i_vel - 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + i_vel - 1) - stress_vector_shear(i_vel)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
end do
end if
if (bulk_stress) then
stress_normal_bulk = divergence_cyl/Re_b
- flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, &
- & l) = flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) - vel_src_int(norm_dir)*stress_normal_bulk
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + norm_dir - 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + norm_dir - 1) - stress_normal_bulk
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) - vel_src_int(norm_dir)*stress_normal_bulk
end if
end do
end do
@@ -803,15 +800,14 @@ contains
!> Compute Cartesian viscous source flux contributions for momentum and energy
subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, dvelR_dx_vf, dvelR_dy_vf, &
- & dvelR_dz_vf, flux_src_vf, q_prim_vf, norm_dir)
+ & dvelR_dz_vf, q_prim_vf, norm_dir)
! Arguments
- type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
- type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
- type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
- type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
- integer, intent(in) :: norm_dir
+ type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
+ type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
+ type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
+ integer, intent(in) :: norm_dir
! Local variables
@@ -945,12 +941,11 @@ contains
call s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, current_tau_shear)
do i_dim = 1, num_dims
- flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
- & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
- & l_loop) - current_tau_shear(norm_dir, i_dim)
+ flux_src_rsx_vf(j_loop, k_loop, l_loop, eqn_idx%mom%beg + i_dim - 1) = flux_src_rsx_vf(j_loop, &
+ & k_loop, l_loop, eqn_idx%mom%beg + i_dim - 1) - current_tau_shear(norm_dir, i_dim)
- flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
- & l_loop) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
+ flux_src_rsx_vf(j_loop, k_loop, l_loop, eqn_idx%E) = flux_src_rsx_vf(j_loop, k_loop, l_loop, &
+ & eqn_idx%E) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
end do
end if
@@ -959,12 +954,11 @@ contains
call s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, current_tau_bulk)
do i_dim = 1, num_dims
- flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
- & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
- & l_loop) - current_tau_bulk(norm_dir, i_dim)
+ flux_src_rsx_vf(j_loop, k_loop, l_loop, eqn_idx%mom%beg + i_dim - 1) = flux_src_rsx_vf(j_loop, &
+ & k_loop, l_loop, eqn_idx%mom%beg + i_dim - 1) - current_tau_bulk(norm_dir, i_dim)
- flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
- & l_loop) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
+ flux_src_rsx_vf(j_loop, k_loop, l_loop, eqn_idx%E) = flux_src_rsx_vf(j_loop, k_loop, l_loop, &
+ & eqn_idx%E) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
end do
end if
end do
@@ -1100,13 +1094,14 @@ contains
$:GPU_ROUTINE(function_name='s_compute_hypoelastic_interface_energy', parallelism='[seq]', cray_inline=True)
- integer, intent(in) :: nf !< Number of fluids to mix the shear modulus over
- real(wp), dimension(nf), intent(in) :: alpha_L, alpha_R !< Left and right volume fractions
- real(wp), intent(in) :: damage_L, damage_R !< Continuum damage states (referenced only when cont_damage)
- real(wp), dimension(6), intent(in) :: tau_e_L, tau_e_R !< Left and right elastic shear stresses
- real(wp), intent(out) :: G_L, G_R !< Left and right mixture shear moduli
- real(wp), intent(inout) :: E_L, E_R !< Left and right state energies
- integer :: i !< Loop iterator
+ integer, intent(in) :: nf !< Number of fluids to mix the shear modulus over
+ real(wp), dimension(nf), intent(in) :: alpha_L, alpha_R !< Left and right volume fractions
+ real(wp), intent(in) :: damage_L, damage_R !< Continuum damage states (referenced only when cont_damage)
+ real(wp), dimension(6), intent(in) :: tau_e_L, tau_e_R !< Left and right elastic shear stresses
+ real(wp), intent(out) :: G_L, G_R !< Left and right mixture shear moduli
+ real(wp), intent(inout) :: E_L, E_R !< Left and right state energies
+ integer :: i !< Loop iterator
+ logical :: elastic_L, elastic_R !< Side retains elastic energy (not damage-collapsed)
G_L = 0._wp; G_R = 0._wp
@@ -1121,17 +1116,29 @@ contains
G_R = G_R*max((1._wp - damage_R), 0._wp)
end if
+ ! Under continuum damage a heavily-damaged interface can drive G -> 0 while the reconstructed stress does
+ ! not relax with it, so tau^2/(4G) blows up. It stays finite (and negligible) on most backends but goes
+ ! NaN under macOS gfortran's libm. Gate on the damage variable itself - skip the elastic energy only
+ ! where damage has collapsed the modulus (the blow-up mechanism), treating > 99.9% damaged as failed.
+ ! Dimensionless, so soft/nondimensionalized materials (G <= O(1e3)) keep their energy term; pristine
+ ! states keep master's verysmall gate regardless of material stiffness.
+ elastic_L = .true.; elastic_R = .true.
+ if (cont_damage) then
+ elastic_L = (1._wp - damage_L > damage_energy_cutoff)
+ elastic_R = (1._wp - damage_R > damage_energy_cutoff)
+ end if
+
$:GPU_LOOP(parallelism='[seq]')
do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
! Elastic contribution to energy if G large enough
- if (G_L > verysmall) then
+ if ((G_L > verysmall) .and. elastic_L) then
E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L)
! Double for shear stresses
if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L)
end if
end if
- if (G_R > verysmall) then
+ if ((G_R > verysmall) .and. elastic_R) then
E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R)
! Double for shear stresses
if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
diff --git a/src/simulation/m_sfc_partition.fpp b/src/simulation/m_sfc_partition.fpp
new file mode 100644
index 0000000000..620db6b7e3
--- /dev/null
+++ b/src/simulation/m_sfc_partition.fpp
@@ -0,0 +1,218 @@
+!>
+!!@file
+!!@brief Contains module m_sfc_partition
+
+#:include 'macros.fpp'
+
+!> @brief Analysis-only weighted space-filling-curve partitioner.
+module m_sfc_partition
+
+ use m_derived_types
+ use m_global_parameters
+ use m_mpi_proxy
+ use m_mpi_common
+ use m_load_weight, only: load_weight
+ use m_box, only: f_morton
+
+ implicit none
+
+ private
+ public :: s_initialize_sfc_partition_module, s_finalize_sfc_partition_module, s_compute_sfc_partition, s_report_sfc_partition
+
+ integer :: n_tiles_x, n_tiles_y, n_tiles_z, n_tiles
+ real(wp), allocatable :: tile_weight(:) !< global per-tile aggregated cost (linear index)
+ integer, allocatable :: tile_rank(:) !< proposed owning rank per tile
+ integer, allocatable :: sfc_order(:) !< tile linear indices in Morton order
+ real(wp) :: cur_w_max !< current static per-rank max weight (existing decomposition)
+
+contains
+
+ impure subroutine s_initialize_sfc_partition_module
+
+ if (.not. sfc_partition_wrt) return
+ n_tiles_x = (m_glb + 1 + partition_tile_size - 1)/partition_tile_size
+ n_tiles_y = (n_glb + 1 + partition_tile_size - 1)/partition_tile_size
+ n_tiles_z = (p_glb + 1 + partition_tile_size - 1)/partition_tile_size
+ n_tiles = n_tiles_x*n_tiles_y*n_tiles_z
+ @:ALLOCATE(tile_weight(0:n_tiles - 1))
+ @:ALLOCATE(tile_rank(0:n_tiles - 1))
+ @:ALLOCATE(sfc_order(1:n_tiles))
+
+ end subroutine s_initialize_sfc_partition_module
+
+ impure subroutine s_finalize_sfc_partition_module
+
+ if (.not. sfc_partition_wrt) return
+ @:DEALLOCATE(tile_weight)
+ @:DEALLOCATE(tile_rank)
+ @:DEALLOCATE(sfc_order)
+
+ end subroutine s_finalize_sfc_partition_module
+
+ !> Aggregate per-cell load weights (computed by the caller) into global per-tile weights via MPI_ALLREDUCE.
+ impure subroutine s_compute_sfc_partition()
+
+ real(wp), allocatable :: tile_local(:)
+ integer :: j, k, l, gx, gy, gz, tx, ty, tz, t, ierr
+ real(wp) :: my_w
+ integer :: sfc_start(3) !< bounds-safe copy of start_idx (0 for inactive dims)
+
+ if (.not. sfc_partition_wrt) return
+
+ ! 3-element start offset safe to access regardless of num_dims (start_idx is allocated
+ ! (1:num_dims) only; higher dims are always 0).
+ sfc_start = 0
+ sfc_start(1) = start_idx(1)
+ if (num_dims >= 2) sfc_start(2) = start_idx(2)
+ if (num_dims >= 3) sfc_start(3) = start_idx(3)
+
+ allocate (tile_local(0:n_tiles - 1)); tile_local = 0._wp
+ do l = 0, p
+ do k = 0, n
+ do j = 0, m
+ gx = sfc_start(1) + j
+ gy = sfc_start(2) + k
+ gz = sfc_start(3) + l
+ tx = gx/partition_tile_size; ty = gy/partition_tile_size; tz = gz/partition_tile_size
+ t = (tz*n_tiles_y + ty)*n_tiles_x + tx
+ tile_local(t) = tile_local(t) + real(load_weight%sf(j, k, l), wp)
+ end do
+ end do
+ end do
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(tile_local, tile_weight, n_tiles, mpi_p, MPI_SUM, MPI_COMM_WORLD, ierr)
+#else
+ tile_weight = tile_local
+#endif
+ my_w = sum(tile_local)
+#ifdef MFC_MPI
+ call MPI_ALLREDUCE(my_w, cur_w_max, 1, mpi_p, MPI_MAX, MPI_COMM_WORLD, ierr)
+#else
+ cur_w_max = my_w
+#endif
+ deallocate (tile_local)
+
+ call s_build_sfc_order(sfc_order)
+
+ block
+ real(wp), allocatable :: wsfc(:)
+ real(wp) :: lo, hi, mid, acc
+ integer :: i, r, it
+ allocate (wsfc(n_tiles))
+ do i = 1, n_tiles; wsfc(i) = tile_weight(sfc_order(i)); end do
+ ! binary search the smallest feasible max-load bound
+ lo = maxval(wsfc); hi = sum(wsfc)
+ do it = 1, 200
+ if (hi - lo <= 1.e-12_wp*max(hi, 1._wp)) exit
+ mid = 0.5_wp*(lo + hi)
+ if (f_segments_needed(wsfc, mid) <= num_procs) then; hi = mid; else; lo = mid; end if
+ end do
+ ! assign ranks greedily with bound=hi, capping at num_procs-1 for the tail
+ r = 0; acc = 0._wp
+ do i = 1, n_tiles
+ if (acc + wsfc(i) > hi .and. acc > 0._wp .and. r < num_procs - 1) then
+ r = r + 1; acc = wsfc(i)
+ else
+ acc = acc + wsfc(i)
+ end if
+ tile_rank(sfc_order(i)) = r
+ end do
+ deallocate (wsfc)
+ end block
+
+ end subroutine s_compute_sfc_partition
+
+ !> Greedy count of contiguous segments (each <= bound) over SFC-ordered weights.
+ pure integer function f_segments_needed(wsfc, bound) result(nseg)
+
+ real(wp), intent(in) :: wsfc(:)
+ real(wp), intent(in) :: bound
+ real(wp) :: acc; integer :: i
+
+ nseg = 1; acc = 0._wp
+ do i = 1, size(wsfc)
+ if (acc + wsfc(i) > bound .and. acc > 0._wp) then
+ nseg = nseg + 1; acc = wsfc(i)
+ else
+ acc = acc + wsfc(i)
+ end if
+ end do
+
+ end function f_segments_needed
+
+ !> Fills order(1:n_tiles) with tile linear indices sorted by Morton code.
+ impure subroutine s_build_sfc_order(order)
+
+ integer, intent(out) :: order(:)
+ integer(kind=8), allocatable :: code(:)
+ integer :: tx, ty, tz, t, i
+ integer :: width, lo_r, mid_r, hi_r, ia, ib_m, iw
+ integer, allocatable :: work(:)
+
+ allocate (code(0:n_tiles - 1))
+ do tz = 0, n_tiles_z - 1
+ do ty = 0, n_tiles_y - 1
+ do tx = 0, n_tiles_x - 1
+ t = (tz*n_tiles_y + ty)*n_tiles_x + tx
+ code(t) = f_morton(tx, ty, tz)
+ end do
+ end do
+ end do
+ ! Index sort by Morton code: bottom-up mergesort, O(n_tiles log n_tiles). A selection loop is
+ ! prohibitive at fine tile sizes (n_tiles reaches 1e6+ on large 3D grids). Codes are unique
+ ! (one per tile), so the order is deterministic on every rank.
+ do i = 1, n_tiles
+ order(i) = i - 1
+ end do
+ allocate (work(1:n_tiles))
+ width = 1
+ do while (width < n_tiles)
+ do lo_r = 1, n_tiles, 2*width
+ mid_r = min(lo_r + width - 1, n_tiles)
+ hi_r = min(lo_r + 2*width - 1, n_tiles)
+ if (mid_r >= hi_r) cycle
+ ia = lo_r; ib_m = mid_r + 1; iw = lo_r
+ do while (ia <= mid_r .and. ib_m <= hi_r)
+ if (code(order(ia)) <= code(order(ib_m))) then
+ work(iw) = order(ia); ia = ia + 1
+ else
+ work(iw) = order(ib_m); ib_m = ib_m + 1
+ end if
+ iw = iw + 1
+ end do
+ do while (ia <= mid_r); work(iw) = order(ia); ia = ia + 1; iw = iw + 1; end do
+ do while (ib_m <= hi_r); work(iw) = order(ib_m); ib_m = ib_m + 1; iw = iw + 1; end do
+ order(lo_r:hi_r) = work(lo_r:hi_r)
+ end do
+ width = 2*width
+ end do
+ deallocate (work)
+ deallocate (code)
+
+ end subroutine s_build_sfc_order
+
+ !> Print current static imbalance, predicted post-balance imbalance, and gain ratio.
+ impure subroutine s_report_sfc_partition
+
+ real(wp), allocatable :: rank_w(:)
+ real(wp) :: w_sum, w_max, w_mean, imb_new, imb_cur, gain
+ integer :: t
+
+ if (.not. sfc_partition_wrt) return
+ allocate (rank_w(0:num_procs - 1)); rank_w = 0._wp
+ do t = 0, n_tiles - 1
+ rank_w(tile_rank(t)) = rank_w(tile_rank(t)) + tile_weight(t)
+ end do
+ w_sum = sum(rank_w); w_max = maxval(rank_w); w_mean = w_sum/real(num_procs, wp)
+ imb_new = w_max/max(w_mean, tiny(1._wp))
+ imb_cur = cur_w_max/max(w_mean, tiny(1._wp))
+ gain = imb_cur/max(imb_new, tiny(1._wp))
+ if (proc_rank == 0) then
+ print '(A,F8.3,A,F8.3,A,F8.3,A,I0,A,I0,A)', '[sfc_partition] imbalance current=', imb_cur, ' predicted=', imb_new, &
+ & ' gain=', gain, ' (', n_tiles, ' tiles over ', num_procs, ' ranks)'
+ end if
+ deallocate (rank_w)
+
+ end subroutine s_report_sfc_partition
+
+end module m_sfc_partition
diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp
index 4d10417ed5..610e453c57 100644
--- a/src/simulation/m_start_up.fpp
+++ b/src/simulation/m_start_up.fpp
@@ -8,6 +8,7 @@
!> @brief Reads input files, loads initial conditions and grid data, and orchestrates solver initialization and finalization
module m_start_up
+ use m_phase_timing, only: s_phase_tic, s_phase_toc, PH_REGRID
use m_derived_types
use m_global_parameters
use m_mpi_proxy
@@ -25,6 +26,7 @@ module m_start_up
use m_chemistry
use m_data_output
use m_time_steppers
+ use m_rank_timing, only: s_rank_time_tic, s_rank_time_toc
use m_qbmm
use m_derived_variables
use m_hypoelastic
@@ -51,6 +53,15 @@ module m_start_up
use m_body_forces
use m_sim_helpers
use m_igr
+ use m_active_box
+ use m_load_weight
+ use m_load_balance, only: s_load_balance_rebalance
+ use m_sfc_partition
+ use m_amr, only: amr_maxc_fit, s_initialize_amr_module, s_populate_amr_fine, s_finalize_amr_module, s_amr_setup_ib, &
+ & s_l0_tiles_init, s_l0_tiles_finalize, s_l0_scatter_tiles_to_coarse
+ use m_amr_regrid, only: s_amr_regrid, s_amr_check_active_box_containment
+ use m_amr_restart, only: s_write_amr_restart, s_read_amr_restart
+ use m_amr_registers, only: s_initialize_amr_registers, s_finalize_amr_registers
use m_constants, only: model_eqns_6eq, time_stepper_rk1, time_stepper_rk2, time_stepper_rk3, recon_type_weno, recon_type_muscl
implicit none
@@ -61,6 +72,7 @@ module m_start_up
type(scalar_field), allocatable, dimension(:) :: q_cons_temp
real(wp) :: dt_init
+ real(wp) :: ph_wall_total = 0._wp !< TEMP: accumulated step-loop wall for the phase budget
contains
@@ -569,7 +581,9 @@ contains
real(wp), intent(inout) :: time_avg
integer :: i, eta_hh, eta_mm, eta_ss
real(wp) :: eta_sec
+ integer(8) :: ph_c0, ph_c1, ph_rate
+ call system_clock(ph_c0)
if (cfl_dt) then
if (cfl_const_dt .and. t_step == 0) call s_compute_dt()
@@ -634,11 +648,31 @@ contains
! Advance time after RK so source terms see current-step time
mytime = mytime + dt
- if (relax) call s_infinite_relaxation_k(q_cons_ts(1)%vf)
+ if (relax) then
+ if (rank_time_wrt) call s_rank_time_tic()
+ call s_infinite_relaxation_k(q_cons_ts(1)%vf)
+ if (rank_time_wrt) call s_rank_time_toc()
+ end if
! Time-stepping loop controls
t_step = t_step + 1
+ if (amr .and. amr_regrid_int > 0) then
+ if (mod(t_step, amr_regrid_int) == 0) then
+ ! Coexist: tiles own the state, and the stage loop refreshes L0 only at the TOP of each stage - so here L0 holds
+ ! the second-to-last stage's tile interiors (plus fine-restricted covered cells), one stage stale. s_amr_regrid
+ ! BOTH tags off L0 and prolongs each new block's seed from it, so a stale L0 moves the boxes and seeds them wrong.
+ ! Same just-in-time refresh s_save_data does before it consumes L0; no-op without tiles.
+ if (l0_ntile > 0) call s_l0_scatter_tiles_to_coarse(q_cons_ts(1)%vf)
+ call s_phase_tic(PH_REGRID)
+ call s_amr_regrid(q_cons_ts(1)%vf)
+ call s_phase_toc(PH_REGRID)
+ end if
+ end if
+
+ call system_clock(ph_c1, ph_rate)
+ ph_wall_total = ph_wall_total + real(ph_c1 - ph_c0, wp)/real(ph_rate, wp)
+
end subroutine s_perform_time_step
!> Collect per-process wall-clock times and write aggregate performance metrics to file
@@ -711,6 +745,11 @@ contains
integer :: stor
integer :: save_count
+ ! beta: tiles own the state; refresh the L0 I/O staging buffer from them just-in-time for output (MPI-aware for migrated
+ ! tiles). Safe: s_save_data always runs after >=1 s_perform_time_step, so tiles are seeded + advanced by now.
+
+ if (l0_ntile > 0) call s_l0_scatter_tiles_to_coarse(q_cons_ts(1)%vf)
+
if (down_sample) then
call s_populate_variables_buffers(bc_type, q_cons_ts(1)%vf)
end if
@@ -782,6 +821,9 @@ contains
! Write IB kinematic state for restart
if (ib) call s_write_ib_state_file(save_count)
+ ! Fine-level AMR restart file (current box + intersection-local fine state) alongside the level-0 restart
+ if (amr) call s_write_amr_restart(save_count)
+
call nvtxEndRange
call cpu_time(finish)
if (cfl_dt) then
@@ -803,6 +845,7 @@ contains
integer :: m_ds, n_ds, p_ds
integer :: i
+ logical :: amr_restored
call s_initialize_global_parameters_module()
#:if USING_AMD
@@ -818,7 +861,9 @@ contains
if (bubbles_euler .or. bubbles_lagrange) then
call s_initialize_bubbles_model()
end if
- call s_initialize_mpi_common_module(exchange_all_chemistry_temperatures_in=.false., use_rdma_transport_in=rdma_mpi)
+ ! AMR needs the temperature ghost as the cons->prim Newton guess when a fine block's conversion
+ ! widens over the ghost shell at a rank seam (else an uninitialized guess -> NaN).
+ call s_initialize_mpi_common_module(exchange_all_chemistry_temperatures_in=amr, use_rdma_transport_in=rdma_mpi)
call s_initialize_mpi_proxy_module()
call s_initialize_variables_conversion_module(enforce_density_floor=.true., preserve_qbmm_number=.true.)
if (grid_geometry == 3) call s_initialize_fftw_module()
@@ -839,9 +884,21 @@ contains
call s_initialize_rhs_module()
+ if (active_box) call s_initialize_active_box_module()
+ call s_initialize_load_weight_module()
+ call s_initialize_sfc_partition_module()
+
if (surface_tension) call s_initialize_surface_tension_module()
- if (relax) call s_initialize_phasechange_module()
+ if (relax) then
+ ! the load-weight field is computed for load_weight_wrt AND for sfc_partition_wrt: allocate under the
+ ! same condition, else the sfc-only path reads unallocated (or never-written) iteration counts
+ if (load_weight_wrt .or. sfc_partition_wrt) then
+ call s_initialize_phasechange_module([m_alloc, n_alloc, p_alloc])
+ else
+ call s_initialize_phasechange_module([-1, -1, -1])
+ end if
+ end if
call s_initialize_data_output_module()
call s_initialize_derived_variables_module()
@@ -895,6 +952,13 @@ contains
if (n > 0) dy_min = minval(dy)
if (p > 0) dz_min = minval(dz)
+ call s_initialize_amr_module()
+ call s_l0_tiles_init() ! L0-as-blocks spike (l0_ntile > 0); no-op otherwise
+ call s_initialize_amr_registers(amr_maxc_fit)
+ ! restarts restore the saved (possibly regridded) box and fine state; otherwise prolong from coarse
+ call s_read_amr_restart(amr_restored)
+ if (.not. amr_restored) call s_populate_amr_fine(q_cons_ts(1)%vf)
+
if (model_eqns == model_eqns_6eq) call s_initialize_internal_energy_equations(q_cons_ts(1)%vf)
if (ib) then
block
@@ -920,6 +984,8 @@ contains
deallocate (particle_cloud_ibs)
end block
call s_ibm_setup()
+ ! per-block fine-grid IB state (static-body AMR): resolve the body on each fine block from the geometry
+ if (amr) call s_amr_setup_ib()
if (t_step_start == 0 .or. (cfl_dt .and. n_start == 0)) then
call s_write_ib_data_file(0)
call s_write_ib_state_file(0)
@@ -951,6 +1017,10 @@ contains
if (hypoelasticity) call s_initialize_hypoelastic_module()
+ if (active_box) call s_initialize_active_box(q_cons_ts(1)%vf)
+ ! AMR blocks must sit strictly inside the active window (named abort otherwise)
+ if (active_box .and. amr) call s_amr_check_active_box_containment()
+
end subroutine s_initialize_modules
!> Set up the MPI execution environment, bind GPUs, and decompose the computational domain
@@ -1026,6 +1096,11 @@ contains
call s_mpi_decompose_computational_domain(write_silo_ghost_offsets=.false., adjust_local_domains=.false.)
+ ! Weighted static decomposition: probe one field from the restart file at the equal
+ ! layout and re-split axes toward the load concentration. Must run here, before
+ ! s_initialize_modules allocates extent-dependent arrays at the equal layout.
+ call s_load_balance_rebalance()
+
bc = bc_xyz_info(bc_x, bc_y, bc_z)
end subroutine s_initialize_mpi_domain
@@ -1105,11 +1180,21 @@ contains
!> Finalize and deallocate all simulation sub-modules in reverse initialization order
impure subroutine s_finalize_modules
+ call s_finalize_amr_registers()
+ call s_finalize_amr_module()
+ call s_l0_tiles_finalize() ! L0-as-blocks spike; no-op otherwise
+ block
+ use m_phase_timing, only: s_phase_report
+ call s_phase_report(ph_wall_total)
+ end block
call s_finalize_time_steppers_module()
if (hypoelasticity) call s_finalize_hypoelastic_module()
call s_finalize_derived_variables_module()
call s_finalize_data_output_module()
call s_finalize_rhs_module()
+ if (active_box) call s_finalize_active_box_module()
+ call s_finalize_load_weight_module()
+ call s_finalize_sfc_partition_module()
if (igr) then
call s_finalize_igr_module()
else
diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp
index 0b7caf7a47..e014935420 100644
--- a/src/simulation/m_surface_tension.fpp
+++ b/src/simulation/m_surface_tension.fpp
@@ -17,6 +17,7 @@ module m_surface_tension
use m_muscl
use m_helper
use m_boundary_common
+ use m_riemann_state, only: flux_src_rsx_vf
implicit none
@@ -48,22 +49,24 @@ contains
@:ALLOCATE(c_divs(1:num_dims + 1))
do j = 1, num_dims + 1
- @:ALLOCATE(c_divs(j)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(c_divs(j)%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(c_divs(j))
end do
- @:ALLOCATE(gL_x(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, num_dims + 1))
- @:ALLOCATE(gR_x(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, num_dims + 1))
+ @:ALLOCATE(gL_x(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end, num_dims + 1))
+ @:ALLOCATE(gR_x(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end, num_dims + 1))
end subroutine s_initialize_surface_tension_module
!> Compute the capillary source flux from reconstructed color-gradient fields
- subroutine s_compute_capillary_source_flux(vSrc_rsx_vf, flux_src_vf, id, isx, isy, isz)
+ subroutine s_compute_capillary_source_flux(vSrc_rsx_vf, id, isx, isy, isz)
- real(wp), dimension(-1:,-1:,-1:,1:), intent(in) :: vSrc_rsx_vf
- type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
- integer, intent(in) :: id
- type(int_bounds_info), intent(in) :: isx, isy, isz
+ real(wp), dimension(-1:,-1:,-1:,1:), intent(in) :: vSrc_rsx_vf
+ integer, intent(in) :: id
+ type(int_bounds_info), intent(in) :: isx, isy, isz
#:if not MFC_CASE_OPTIMIZATION and USING_AMD
real(wp), dimension(3, 3) :: Omega
@@ -101,16 +104,16 @@ contains
@:compute_capillary_stress_tensor()
do i = 1, num_dims
- flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, &
- & l) + Omega(1, i)
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + i - 1) + Omega(1, i)
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(1, &
- & i)*vSrc_rsx_vf(j, k, l, i)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, eqn_idx%E) + Omega(1, &
+ & i)*vSrc_rsx_vf(j, k, l, i)
end do
! Continuum surface force capillary stress, Schmidmayer et al. JCP (2017)
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 1)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 1)
end if
end do
end do
@@ -144,15 +147,15 @@ contains
@:compute_capillary_stress_tensor()
do i = 1, num_dims
- flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, &
- & k, l) + Omega(2, i)
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + i - 1) + Omega(2, i)
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(2, &
- & i)*vSrc_rsx_vf(j, k, l, i)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, eqn_idx%E) + Omega(2, &
+ & i)*vSrc_rsx_vf(j, k, l, i)
end do
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 2)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 2)
end if
end do
end do
@@ -187,15 +190,15 @@ contains
@:compute_capillary_stress_tensor()
do i = 1, num_dims
- flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, &
- & k, l) + Omega(3, i)
+ flux_src_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%mom%beg + i - 1) + Omega(3, i)
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(3, &
- & i)*vSrc_rsx_vf(j, k, l, i)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, eqn_idx%E) + Omega(3, &
+ & i)*vSrc_rsx_vf(j, k, l, i)
end do
- flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
- & l) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 3)
+ flux_src_rsx_vf(j, k, l, eqn_idx%E) = flux_src_rsx_vf(j, k, l, &
+ & eqn_idx%E) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 3)
end if
end do
end do
diff --git a/src/simulation/m_thinc.fpp b/src/simulation/m_thinc.fpp
index 5f9d1c7d54..de4849920d 100644
--- a/src/simulation/m_thinc.fpp
+++ b/src/simulation/m_thinc.fpp
@@ -196,9 +196,10 @@ contains
subroutine s_initialize_thinc_module()
if (int_comp == int_comp_mthinc) then
- @:ALLOCATE(mthinc_nhat(1:3, idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, &
- & idwbuff(3)%beg:idwbuff(3)%end))
- @:ALLOCATE(mthinc_d(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ @:ALLOCATE(mthinc_nhat(1:3, idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
+ @:ALLOCATE(mthinc_d(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
end if
end subroutine s_initialize_thinc_module
diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp
index daf1c2a734..29e26db2b4 100644
--- a/src/simulation/m_time_steppers.fpp
+++ b/src/simulation/m_time_steppers.fpp
@@ -8,6 +8,7 @@
!> @brief Total-variation-diminishing (TVD) Runge--Kutta time integrators (1st-, 2nd-, and 3rd-order SSP)
module m_time_steppers
+ use m_phase_timing
use m_derived_types
use m_global_parameters
use m_rhs
@@ -27,6 +28,14 @@ module m_time_steppers
use m_body_forces
use m_derived_variables
use m_constants, only: model_eqns_6eq, time_stepper_rk1, time_stepper_rk2, time_stepper_rk3
+ use m_active_box, only: s_grow_active_box, s_check_active_box_envelope, ab_x, ab_y, ab_z, ab_active
+ use m_amr, only: amr_xchg_coarse_ghosts, s_amr_exchange_coarse_cons_halo, s_amr_stage_fill_wave, s_amr_parent_fill_wave, &
+ & s_amr_fine_stage_advance, s_amr_fine_fine_halo, s_amr_advance_fine_subcycle_all, s_restrict_fine_to_coarse, &
+ & s_amr_relax_fine, s_amr_p2p_reflux_faces, s_amr_reflux_faces_wave, s_amr_freg_wave, s_amr_restrict_wave, &
+ & s_amr_convert_prim_batch, amr_prim_batch, s_amr_reflux_to_parent, s_l0_advance_stage, s_l0_advance_stage_rhs, &
+ & s_l0_advance_stage_rk, s_l0_add_reflux_to_tiles, s_l0_restrict_to_tiles, s_l0_copy_coarse_to_tiles, s_l0_forced_remap, &
+ & s_l0_rebalance, s_l0_scatter_tiles_to_coarse, s_l0_fill_tiles_from_coarse
+ use m_amr_registers, only: s_amr_apply_reflux, s_amr_apply_reflux_state
implicit none
@@ -290,7 +299,12 @@ contains
@:ACC_SETUP_SFs(q_prim_vf(i))
end do
- @:ALLOCATE(q_T_sf%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end))
+ ! allocation bounds, not runtime bounds: q_T_sf is the one array here that crosses into the AMR fine advance (it is
+ ! passed through s_amr_fine_stage_advance to s_compute_rhs), so it must hold a refined block as well as the coarse
+ ! subdomain. Every other array in this module is coarse-only - the fine advance works through the flat store and
+ ! the pooled q_prim/rhs scratch (m_amr).
+ @:ALLOCATE(q_T_sf%sf(idwbuff_alloc(1)%beg:idwbuff_alloc(1)%end, idwbuff_alloc(2)%beg:idwbuff_alloc(2)%end, &
+ & idwbuff_alloc(3)%beg:idwbuff_alloc(3)%end))
@:ACC_SETUP_SFs(q_T_sf)
end if
end if
@@ -444,21 +458,85 @@ contains
real(wp), intent(inout) :: time_avg
integer, intent(in) :: nstage
integer :: i, j, k, l, q, s !< Generic loop iterator
- real(wp) :: start, finish
- integer(kind=8) :: stage_t0, stage_t1, clock_rate, clock_max
- real(wp) :: stage_time
- integer, parameter :: n_warmup = 2 !< time steps excluded before the timing floor (warmup/JIT/first-touch)
+ !> block-slot loop variable (s_amr_select_slot sets global amr_cur, so amr_cur must not be the active DO variable)
+ integer :: islot, ilev
+ integer :: jlo, jhi, klo, khi, llo, lhi !< Active-box loop bounds for RK update
+ real(wp) :: start, finish
+ integer(kind=8) :: stage_t0, stage_t1, clock_rate, clock_max
+ real(wp) :: stage_time
+ integer, parameter :: n_warmup = 2 !<