Pressure-force variant, the reference densities (rho0 / rho_ref,
both from the single configured ρ₀ — &ocean_ic_nml rho_0 via
eos%rho0), the reduced-gravity (gprime / gfs_scale) knobs, the
bathymetry copy into the PGF slot, and the matching barotropic
fast-loop gravity g_bt for the gprime / FV_MOM6-reduced-GFS paths.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(config_t), | intent(in) | :: | cfg | |||
| type(ocean_state_t), | intent(inout) | :: | ocean_state | |||
| integer, | intent(in) | :: | compute_rank |
Unused (no rank-0 logging in this helper); kept for a uniform configure_ocean_* signature. |
||
| integer, | intent(out), | optional | :: | ierr |
Non-zero on a PGF/EOS configuration conflict when present;
absent behaves as today ( |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| integer, | private | :: | local_ierr |
subroutine configure_ocean_pgf(cfg, ocean_state, compute_rank, ierr) !! Pressure-force variant, the reference densities (`rho0` / `rho_ref`, !! both from the single configured ρ₀ — `&ocean_ic_nml rho_0` via !! `eos%rho0`), the reduced-gravity (gprime / gfs_scale) knobs, the !! bathymetry copy into the PGF slot, and the matching barotropic !! fast-loop gravity g_bt for the gprime / FV_MOM6-reduced-GFS paths. type(config_t), intent(in) :: cfg type(ocean_state_t), intent(inout) :: ocean_state integer, intent(in) :: compute_rank !! Unused (no rank-0 logging in this helper); kept for a uniform !! configure_ocean_* signature. integer, intent(out), optional :: ierr !! Non-zero on a PGF/EOS configuration conflict when present; !! absent behaves as today (`error stop`). integer :: local_ierr ! ALLOCATION-GATE CONSISTENCY GUARD. When `scratch_gated` is on, the ! PGF slot allocated only the buffers reachable from the `variant` / ! `reconstruct_for_pressure` latched by `ocean_state_init_from_config` ! BEFORE `init(grid)`. Both are re-derived here from the same cfg ! fields, so they must agree. If a future edit ever lets them ! diverge, the gated-off buffers would be unallocated on a path that ! reaches them — which under `-gpu=mem:separate` is a silent wrong ! answer, not a crash. Fail loud instead. if (ocean_state%pressure_force%scratch_gated) then if (ocean_state%pressure_force%variant /= & parse_opgf_variant(cfg%ocean%pgf%form)) then call fail("configure_ocean_pgf: pgf variant changed between "// & "the pre-init latch and configure — the scratch "// & "allocation gate was decided on the stale value.", ierr, OCEAN_STATUS_ERR_SETUP) return end if if (ocean_state%pressure_force%reconstruct_for_pressure .neqv. & cfg%ocean%pgf%reconstruct_for_pressure) then call fail("configure_ocean_pgf: reconstruct_for_pressure "// & "changed between the pre-init latch and configure — "// & "the recon scratch allocation gate is stale.", ierr, OCEAN_STATUS_ERR_SETUP) return end if end if ocean_state%pressure_force%variant = parse_opgf_variant(cfg%ocean%pgf%form) ! Grounded-layer PGF gate (`&ocean_isopycnal_nml pgf_skip_nonoverlap`). ! The predicate lives in `pgf_nonoverlap_gate_on` because the PGF slot's ! allocation gate had to evaluate it BEFORE `init` (FV_MOM6 allocates ! `z_centre` for this gate and nothing else) — see the pre-init latch in ! `ocean_state_init_from_config`. Re-evaluating it here and ! comparing is what keeps that latch honest. if (ocean_state%pressure_force%scratch_gated .and. & (ocean_state%pressure_force%skip_nonoverlap .neqv. & pgf_nonoverlap_gate_on(cfg, ocean_state%pressure_force%variant))) then call fail("configure_ocean_pgf: pgf_skip_nonoverlap changed between "// & "the pre-init latch and configure — the z_centre allocation "// & "gate is stale.", ierr, OCEAN_STATUS_ERR_SETUP) return end if ocean_state%pressure_force%skip_nonoverlap = & pgf_nonoverlap_gate_on(cfg, ocean_state%pressure_force%variant) ! Grounded = non-overlapping AND vanished on one side: the gate never ! zeroes the PGF of a layer that is massive in both columns. ocean_state%pressure_force%nonoverlap_vanish_tol = & nonoverlap_vanish_tol_for(cfg%ocean%isopycnal%angstrom_h) if (ocean_state%pressure_force%skip_nonoverlap) then if (compute_rank == 0) then call logger%info("Isopycnal PGF: pgf_skip_nonoverlap = ON "// & "(grounded-layer face PGF zeroed where layers do not overlap "// & "and one side is <= "// & to_string(ocean_state%pressure_force%nonoverlap_vanish_tol)//" m)") end if else if (parse_ocean_vcoord_type(cfg%vcoord_type) == VCOORD_LAGRANGIAN .and. & cfg%ocean%isopycnal%pgf_skip_nonoverlap .and. & ocean_state%pressure_force%variant /= OPGF_VARIANT_GPRIME) then ! Asked for, but not available. What is left here is `gprime`: the ! NK=2 reduced-gravity form differences interface positions directly, ! never builds the layer-centre Jacobian the gate corrects and carries ! no `z_centre` buffer — enabling the gate would read unallocated ! memory, a silent wrong answer under `-gpu=mem:separate` rather than ! a crash. Loud, not fatal: the run is legal, it just keeps the ! spurious gradient. if (compute_rank == 0) then call logger%warning("ocean_isopycnal_nml: pgf_skip_nonoverlap has no "// & "effect with ocean_pgf_nml form='"// & trim(cfg%ocean%pgf%form)//"' (the gate covers mont "// & "/ fv_lite / fv_wright / fv_mom6) — a grounded "// & "isopycnal layer can still drive a spurious "// & "pressure gradient at rest") end if end if ! N2: device-callable-variant gate runs POST-config (eos%variant was ! set from the knob in configure_ocean_drag, the first configure call). if (present(ierr)) then call eos_validate(ocean_state%eos, ierr=local_ierr) if (local_ierr /= 0) then ierr = local_ierr return end if else call eos_validate(ocean_state%eos) end if ! FV_WRIGHT re-evaluates the Wright (1997) rational EOS inside its ! Picard pressure sweep, so it cannot honour a non-Wright rho_layer. ! Roquet + FV_WRIGHT is therefore unsupported (FV_LITE / FV_MOM6 / ! gprime read rho_layer generically and are fine). Fail loud — a ! follow-up could add a Roquet column sweep. if (ocean_state%eos%variant == EOS_VARIANT_ROQUET_SPV .and. & ocean_state%pressure_force%variant == OPGF_VARIANT_FV_WRIGHT) then call fail("configure_ocean_pgf: eos='roquet_spv' is "// & "incompatible with pgf form='fv_wright' (the FV_WRIGHT "// & "Picard sweep re-evaluates Wright internally). Use "// & "fv_lite, fv_mom6, or gprime with roquet_spv.", ierr, OCEAN_STATUS_ERR_SETUP) return end if ! Reference densities. BOTH PGF reference densities follow the SINGLE ! configured ρ₀ (`&ocean_ic_nml rho_0`, landed on `eos%rho0` by ! `ocean_state_init_from_config` — the same scalar EPBL, kappa-shear, ! tidal mixing, the `eta_ib` surface-pressure seam, MEKE/GM and the ! isopycnal slopes all take). Without this the PGF slot kept its ! 1035 type default while the EOS followed the namelist, so a run with ! `rho_0 /= 1035` silently integrated an EOS and a pressure gradient on ! two different reference densities. ! ! `rho0` (Boussinesq divisor, `du/dt = −(1/ρ₀)∂p/∂x`) and `rho_ref` ! (the baseline subtracted from layer densities when building the ! FV_MOM6 `pa` anomaly stack, and the `g·ρ_ref/ρ₀` surface value in ! `compute_pbce`) stay SEPARATE MEMBERS — the roles differ and ! interchanging them is a known MOM6 bug class — but roundabout has no ! separate anomaly-reference knob, so both take the one configured ρ₀. ! ! Plain host scalars: every consumer reads them host-side (into a local ! `inv_rho0`, or by value into a `*_impl`), so no `!$acc update device` ! is owed here — and this runs well before `ocean_state_enter_data` in ! any case. ocean_state%pressure_force%rho0 = ocean_state%eos%rho0 ocean_state%pressure_force%rho_ref = ocean_state%eos%rho0 ocean_state%pressure_force%gprime_gfs = cfg%ocean%pgf%gprime_gfs ocean_state%pressure_force%gprime_gint = cfg%ocean%pgf%gprime_gint ocean_state%pressure_force%gfs_scale = cfg%ocean%pgf%gfs_scale ocean_state%pressure_force%mass_weight = cfg%ocean%pgf%mass_weight ocean_state%pressure_force%reconstruct_for_pressure = & cfg%ocean%pgf%reconstruct_for_pressure ocean_state%pressure_force%insitu_density = cfg%ocean%pgf%insitu_density ocean_state%pressure_force%recon_scheme = cfg%ocean%pgf%recon_scheme ocean_state%pressure_force%p_top_in_bc = cfg%ocean%pgf%p_top_in_bc ! The top-of-column load enters the `pa` stack's surface boundary ! condition, which only the FV_MOM6 family builds. Mirrors the ! `validate_config` refusal so an in-memory namelist / API caller ! that bypasses validation still fails loud instead of running a ! silently inert knob. if (cfg%ocean%pgf%p_top_in_bc .and. & ocean_state%pressure_force%variant /= OPGF_VARIANT_FV_MOM6) then call fail("configure_ocean_pgf: p_top_in_bc=.true. requires "// & "form='fv_mom6'. Other PGF variants build no pa(nz+1) "// & "pressure-stack boundary condition for the load to enter.", & ierr, OCEAN_STATUS_ERR_SETUP) return end if ! The bc-PGF retro-correction reads `pgf%e_face`, which only FV_MOM6 ! fills. Mirrors the `validate_config` refusal so an in-memory / ! API caller fails at configure, not with an `error stop` in step 1. if (cfg%ocean%bt%correction_bc_pgf .and. & ocean_state%pressure_force%variant /= OPGF_VARIANT_FV_MOM6) then call fail("configure_ocean_pgf: &ocean_bt_nml correction_bc_pgf=.true. "// & "requires form='fv_mom6'. compute_pbce builds the per-layer "// & "pressure response from the FV_MOM6 interface-height stack "// & "(pgf%e_face), which no other PGF form fills.", & ierr, OCEAN_STATUS_ERR_SETUP) return end if ! In-layer T/S reconstruction wires into the FV_MOM6 layer-integrated ! form only (it carries e_face / pa / intz_dpa). Fail loud if the ! knob is on with any other PGF form. if (cfg%ocean%pgf%reconstruct_for_pressure .and. & ocean_state%pressure_force%variant /= OPGF_VARIANT_FV_MOM6) then call fail("configure_ocean_pgf: reconstruct_for_pressure=.true. "// & "requires form='fv_mom6' (the layer-integrated FV path). "// & "Other PGF variants do not carry the e_face/pa/intz_dpa "// & "stack the reconstruction replaces.", ierr, OCEAN_STATUS_ERR_SETUP) return end if ! The PGF's bathymetry copy (gprime recovers ∇η = ∇(Σh) - ∇b, FV-MOM6 ! places the bottom interface from it) is NOT taken here: `engine_setup` ! takes it after the init-time periodic/fold wrap + halo exchange of ! `b`, so the seam ghosts it copies are the right ones. ! gprime: run the BT fast loop at the reduced free-surface gravity g_FS, ! else the BT correction cancels the gprime reduced-gravity tendency. if (ocean_state%pressure_force%variant == OPGF_VARIANT_GPRIME) then ocean_state%dyn%bt_work%g_bt = ocean_state%pressure_force%gprime_gfs end if ! BEBT projection (MOM6 BT_PROJECT_VELOCITY); 0 = pure forward-backward. ocean_state%dyn%bt_work%bebt = cfg%ocean%bt%bebt ! FV_MOM6: BT gravity is ALWAYS gfs_scale*GRAVITY (the Pass-5 ! Montgomery correction supplies the complementary share when ! gfs_scale < 1). Gate must NOT condition on nz_layers (NK=1 SSH ! bug, 2026-05-26). ! ! UNCONDITIONAL on gfs_scale (fixed 2026-09-28, was gated on ! `gfs_scale < 1.0 - 1e-12`): `pgf_free_surface_gravity` builds the ! slow PGF's shed free-surface term as ! `gfs_scale*GRAVITY*rho_ref/rho0` unconditionally (GRAVITY = ! 9.80665, `rdb_constants`), but with the old gate `g_bt` stayed at ! `barotropic_workstate_t`'s struct-default literal `9.81_wp` ! whenever `gfs_scale >= 1` (the common default) -- a ~3.4e-4 ! relative mismatch between the two gravities. `set_fast_forcing_eta_pf` ! subtracts `g_pf*grad(eta)` from the depth-mean slow PGF so the ! fast loop's own live `-g_bt*grad(eta)` can re-supply exactly that ! term; with `g_pf /= g_bt` the two do not cancel and the fast loop ! carries a real leftover forcing `(g_bt - g_pf)*grad(eta)`. ! Invisible in an ordinary run (eta gradients are generated by real ! dynamics, and the bias is a tiny wave-speed error), but exposed ! bit-for-bit whenever `eta` starts with a real static gradient at ! rest -- exactly what `&ocean_cavity_dyn_nml trim_ic_for_p_surf` ! seeds under a sloping ice draft. Root cause of the ! `vcm_lid_slope_sigma_unstrat` rest-state blip (peak En 9.997e-13); ! see `tests/test_ocean_cavity_load.F90::test_trim_uniform_rho_rest` ! (the end-to-end regression; the raw PGF face force was ALREADY ! round-off before this fix -- see the sibling ! `test_trim_balances_pfu_uniform_rho`). if (ocean_state%pressure_force%variant == OPGF_VARIANT_FV_MOM6) then ocean_state%dyn%bt_work%g_bt = ocean_state%pressure_force%gfs_scale*GRAVITY end if if (present(ierr)) ierr = OCEAN_STATUS_OK end subroutine configure_ocean_pgf