ocean_surface_flux_apply_sw_penetration Subroutine

public subroutine ocean_surface_flux_apply_sw_penetration(grid, sf, ms, dt, active, cover_frac)

Additive correction that redistributes the penetrating shortwave fraction of Q_heat through the upper water column as a two-band exponential (Paulson & Simpson 1977; Jerlov types), instead of leaving all of it deposited at the surface layer by ocean_surface_flux_apply_tracers.

Penetrating irradiance at downward depth d: I(d) = I0 · [ R·exp(-d/zeta1) + (1-R)·exp(-d/zeta2) ] with I0 = sw_pen_frac · Q_heat(i,j). Per-layer absorbed SW = I(d_top) - I(d_bot); the bed (k = k_bot, the first LIVE layer counting up — 1 off z_fixed) is treated as opaque (I_bot := 0) so the column absorbs all of I0 and energy is conserved exactly (Σ_k absorbed_k = I0).

Additive-correction structure: the surface kernel already deposited the full I0 lump at k = nz; this kernel removes it there (-inv_scale · I0) and adds the distributed profile, so the net column heat change versus the legacy all-at-nz deposition is zero — shortwave only MOVES heat in depth. Both the hTr and heat_budget_surface increments are mirrored, so the total surface heat budget is unchanged (just depth-spread).

Bottom-up convention (k = nz surface, k = 1 bed). No-op unless sf%has_sw .and. sf%has_heat, a temperature tracer is registered, and (optionally) active is true. Default-off (sw_pen_frac = 0 ⇒ has_sw = .false.) leaves the path byte-for-byte unchanged.

Arguments

Type IntentOptional Attributes Name
type(hgrid_t), intent(in) :: grid
type(ocean_surface_flux_t), intent(in), optional :: sf

Optional — absent ⇒ no-op (no forcing configured).
type(multilayer_state_t), intent(inout) :: ms
real(kind=wp), intent(in) :: dt
logical, intent(in), optional :: active

Optional thermo-cadence gate. Present-and-false ⇒ early return; absent ⇒ kernel runs.
real(kind=wp), intent(in), optional :: cover_frac(:,:)

Optional ice-shelf cover fraction (metrics%cover_frac, v1 binary). Present ⇒ the penetrating irradiance is scaled by 1 - cover_frac, so a covered column absorbs NOTHING — no sunlight reaches the ocean through several hundred metres of ice. Needed even on the sw_source="net_heat" branch, where Q_heat is already assembler-masked: this kernel’s job is to MOVE a surface lump down the column, and on a masked column the lump it would remove was never deposited (the same argument &ocean_wetdry_nml makes for a dry column). Absent ⇒ the original kernel, byte-identical.

Calls

proc~~ocean_surface_flux_apply_sw_penetration~~CallsGraph proc~ocean_surface_flux_apply_sw_penetration ocean_surface_flux_apply_sw_penetration proc~apply_sw_penetration_cover_impl apply_sw_penetration_cover_impl proc~ocean_surface_flux_apply_sw_penetration->proc~apply_sw_penetration_cover_impl proc~apply_sw_penetration_impl apply_sw_penetration_impl proc~ocean_surface_flux_apply_sw_penetration->proc~apply_sw_penetration_impl local local proc~apply_sw_penetration_cover_impl->local proc~sw_transmission sw_transmission proc~apply_sw_penetration_cover_impl->proc~sw_transmission proc~apply_sw_penetration_impl->local proc~apply_sw_penetration_impl->proc~sw_transmission

Called by

proc~~ocean_surface_flux_apply_sw_penetration~~CalledByGraph proc~ocean_surface_flux_apply_sw_penetration ocean_surface_flux_apply_sw_penetration proc~apply_sw_and_restore apply_sw_and_restore proc~apply_sw_and_restore->proc~ocean_surface_flux_apply_sw_penetration proc~run_stage run_stage proc~run_stage->proc~apply_sw_and_restore proc~run_stage_split run_stage_split proc~run_stage_split->proc~apply_sw_and_restore proc~ocean_dyn_step ocean_dyn_step proc~ocean_dyn_step->proc~run_stage proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_stage_split proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step proc~engine_step->proc~ocean_dyn_step_split proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step

Variables

Type Visibility Attributes Name Initial
integer, private :: idx_T
logical, private :: masked
integer, private :: nx
integer, private :: ny
integer, private :: nz

Source Code

   subroutine ocean_surface_flux_apply_sw_penetration(grid, sf, ms, dt, active, cover_frac)
      !! Additive correction that redistributes the penetrating
      !! shortwave fraction of `Q_heat` through the upper water column
      !! as a two-band exponential (Paulson & Simpson 1977; Jerlov
      !! types), instead of leaving all of it deposited at the surface
      !! layer by `ocean_surface_flux_apply_tracers`.
      !!
      !! Penetrating irradiance at downward depth `d`:
      !!   I(d) = I0 · [ R·exp(-d/zeta1) + (1-R)·exp(-d/zeta2) ]
      !! with `I0 = sw_pen_frac · Q_heat(i,j)`.  Per-layer absorbed SW =
      !! `I(d_top) - I(d_bot)`; the bed (`k = k_bot`, the first LIVE layer
      !! counting up — `1` off `z_fixed`) is treated as opaque
      !! (`I_bot := 0`) so the column absorbs all of `I0` and energy is
      !! conserved exactly (Σ_k absorbed_k = I0).
      !!
      !! Additive-correction structure: the surface kernel already
      !! deposited the full `I0` lump at `k = nz`; this kernel removes it
      !! there (`-inv_scale · I0`) and adds the distributed profile, so
      !! the net column heat change versus the legacy all-at-`nz`
      !! deposition is zero — shortwave only MOVES heat in depth.  Both
      !! the `hTr` and `heat_budget_surface` increments are mirrored, so
      !! the total surface heat budget is unchanged (just depth-spread).
      !!
      !! Bottom-up convention (`k = nz` surface, `k = 1` bed).  No-op
      !! unless `sf%has_sw .and. sf%has_heat`, a temperature tracer is
      !! registered, and (optionally) `active` is true.  Default-off
      !! (`sw_pen_frac = 0` ⇒ `has_sw = .false.`) leaves the path
      !! byte-for-byte unchanged.
      type(hgrid_t), intent(in) :: grid
      type(ocean_surface_flux_t), intent(in), optional :: sf
         !! Optional — absent ⇒ no-op (no forcing configured).
      type(multilayer_state_t), intent(inout) :: ms
      real(wp), intent(in) :: dt
      logical, intent(in), optional :: active
         !! Optional thermo-cadence gate.  Present-and-false ⇒ early
         !! return; absent ⇒ kernel runs.
      real(wp), intent(in), optional :: cover_frac(:, :)
         !! Optional ice-shelf cover fraction (`metrics%cover_frac`,
         !! v1 binary).  Present ⇒ the penetrating irradiance is scaled
         !! by `1 - cover_frac`, so a covered column absorbs NOTHING —
         !! no sunlight reaches the ocean through several hundred metres
         !! of ice.  Needed even on the `sw_source="net_heat"` branch,
         !! where `Q_heat` is already assembler-masked: this kernel's
         !! job is to MOVE a surface lump down the column, and on a
         !! masked column the lump it would remove was never deposited
         !! (the same argument `&ocean_wetdry_nml` makes for a dry
         !! column).  Absent ⇒ the original kernel, byte-identical.
      ! assumed-shape-ok: thermo-cadence shim, forwarded to an
      ! explicit-shape `_impl` before the device loop.

      integer :: nx, ny, nz, idx_T
      logical :: masked

      if (present(active)) then
         if (.not. active) return
      end if
      if (.not. present(sf)) return
      if (.not. (sf%has_sw .and. sf%has_heat)) return
      if (.not. allocated(ms%tracers)) return

      idx_T = ms%idx_temperature
      if (idx_T <= 0) return

      nx = grid%nx_total
      ny = grid%ny_total
      nz = ms%nz_ml

      ! Shim+_impl split: keep the `tracers(idx_T)%hTr` registry deref on
      ! the host (array-of-DT indirection blocks NVHPC device codegen).
      ! The irradiance source is selected HOST-SIDE (`sw_from_qsw`): the
      ! PR-12 `q_sw` component is allocated only under `use_components`,
      ! so passing it as an actual argument is only legal on the branch
      ! guarded by the host flag (validate_config forces
      ! enable_components when sw_source="q_sw", making this total).  The
      ! additive-correction identity `-I0 + Σ_k I0·(T_top - T_bot) = 0`
      ! holds for ANY I0, so the source swap cannot break conservation.
      masked = .false.
      if (present(cover_frac)) then
         masked = (size(cover_frac, 1) == nx .and. size(cover_frac, 2) == ny)
      end if
      if (masked) then
         if (sf%sw_from_qsw) then
            call apply_sw_penetration_cover_impl(ms%tracers(idx_T)%hTr, &
                                                 ms%heat_budget_surface, &
                                                 ms%h_layer, ms%k_bot, ms%wet_mask, cover_frac, sf%q_sw, &
                                                 dt/(sf%rho0*sf%cp), sf%sw_pen_frac, &
                                                 sf%sw_band_ratio, sf%sw_zeta1, sf%sw_zeta2, &
                                                 nz, nx, ny)
         else
            call apply_sw_penetration_cover_impl(ms%tracers(idx_T)%hTr, &
                                                 ms%heat_budget_surface, &
                                                 ms%h_layer, ms%k_bot, ms%wet_mask, cover_frac, sf%Q_heat, &
                                                 dt/(sf%rho0*sf%cp), sf%sw_pen_frac, &
                                                 sf%sw_band_ratio, sf%sw_zeta1, sf%sw_zeta2, &
                                                 nz, nx, ny)
         end if
         return
      end if
      if (sf%sw_from_qsw) then
         call apply_sw_penetration_impl(ms%tracers(idx_T)%hTr, &
                                        ms%heat_budget_surface, &
                                        ms%h_layer, ms%k_bot, ms%wet_mask, sf%q_sw, &
                                        dt/(sf%rho0*sf%cp), sf%sw_pen_frac, &
                                        sf%sw_band_ratio, sf%sw_zeta1, sf%sw_zeta2, &
                                        nz, nx, ny)
      else
         call apply_sw_penetration_impl(ms%tracers(idx_T)%hTr, &
                                        ms%heat_budget_surface, &
                                        ms%h_layer, ms%k_bot, ms%wet_mask, sf%Q_heat, &
                                        dt/(sf%rho0*sf%cp), sf%sw_pen_frac, &
                                        sf%sw_band_ratio, sf%sw_zeta1, sf%sw_zeta2, &
                                        nz, nx, ny)
      end if
   end subroutine ocean_surface_flux_apply_sw_penetration