apply_sw_penetration_impl Subroutine

private pure subroutine apply_sw_penetration_impl(hTr, budget, h_layer, k_bot, wet_mask, sw_src, inv_scale, sw_pen_frac, R, zeta1, zeta2, nz, nx, ny)

Per-column two-band shortwave redistribution. Explicit-shape dummies so NVHPC stdpar compiles device kernels against static bounds. Difference form (I(d_top) - I(d_bot)) — no division by h, so a vanishing layer (h → 0 ⇒ d_top == d_bot) absorbs zero automatically with no guard. The transmission T(d) is the shared sw_transmission (same-module ⇒ inlined by NVHPC), so the deposition and the boundary-layer coupling cannot diverge.

inv_scale = dt/(rho0·cp); R/zeta1/zeta2 are the two-band parameters; sw_pen_frac scales sw_src to the penetrating irradiance I0. sw_src is the caller-selected source (Q_heat for the legacy net-heat path, q_sw for the PR-12 component path); the additive-correction conservation identity -I0 + Σ_k I0·(T_top - T_bot) = 0 holds for ANY sw_src, so the source swap cannot break conservation. At k = nz the legacy I0 lump is subtracted before adding the surface band, keeping the net column change against the all-at-nz baseline at zero.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(inout) :: hTr(nx,ny,nz)
real(kind=wp), intent(inout) :: budget(nx,ny,nz)
real(kind=wp), intent(in) :: h_layer(nx,ny,nz)
integer, intent(in) :: k_bot(nx,ny)

ms%k_bot — the first LIVE layer counting up from the bed. The opaque-bed residual lands HERE, not on k = 1: under z_fixed the layers below are inert fillers (1 elsewhere ⇒ unchanged).
real(kind=wp), intent(in) :: wet_mask(nx,ny)
real(kind=wp), intent(in) :: sw_src(nx,ny)
real(kind=wp), intent(in) :: inv_scale
real(kind=wp), intent(in) :: sw_pen_frac
real(kind=wp), intent(in) :: R
real(kind=wp), intent(in) :: zeta1
real(kind=wp), intent(in) :: zeta2
integer, intent(in) :: nz
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

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

Called by

proc~~apply_sw_penetration_impl~~CalledByGraph proc~apply_sw_penetration_impl apply_sw_penetration_impl proc~ocean_surface_flux_apply_sw_penetration ocean_surface_flux_apply_sw_penetration proc~ocean_surface_flux_apply_sw_penetration->proc~apply_sw_penetration_impl 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

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: absorbed
real(kind=wp), private :: add
real(kind=wp), private :: d_bot
real(kind=wp), private :: d_top
integer, private :: i
real(kind=wp), private :: i0col
integer, private :: j
integer, private :: k
real(kind=wp), private :: trans_bot
real(kind=wp), private :: trans_top

Source Code

   pure subroutine apply_sw_penetration_impl(hTr, budget, h_layer, k_bot, wet_mask, &
                                             sw_src, inv_scale, sw_pen_frac, R, &
                                             zeta1, zeta2, nz, nx, ny)
      !! Per-column two-band shortwave redistribution.  Explicit-shape
      !! dummies so NVHPC stdpar compiles device kernels against static
      !! bounds.  Difference form (`I(d_top) - I(d_bot)`) — no division
      !! by `h`, so a vanishing layer (`h → 0 ⇒ d_top == d_bot`) absorbs
      !! zero automatically with no guard.  The transmission `T(d)` is
      !! the shared `sw_transmission` (same-module ⇒ inlined by NVHPC),
      !! so the deposition and the boundary-layer coupling cannot diverge.
      !!
      !! `inv_scale` = dt/(rho0·cp); `R`/`zeta1`/`zeta2` are the two-band
      !! parameters; `sw_pen_frac` scales `sw_src` to the penetrating
      !! irradiance `I0`.  `sw_src` is the caller-selected source
      !! (`Q_heat` for the legacy net-heat path, `q_sw` for the PR-12
      !! component path); the additive-correction conservation identity
      !! `-I0 + Σ_k I0·(T_top - T_bot) = 0` holds for ANY `sw_src`, so the
      !! source swap cannot break conservation.  At `k = nz` the legacy
      !! `I0` lump is subtracted before adding the surface band, keeping
      !! the net column change against the all-at-`nz` baseline at zero.
      integer, intent(in)    :: nz, nx, ny
      real(wp), intent(inout) :: hTr(nx, ny, nz)
      real(wp), intent(inout) :: budget(nx, ny, nz)
      real(wp), intent(in)    :: h_layer(nx, ny, nz)
      integer, intent(in)     :: k_bot(nx, ny)
         !! `ms%k_bot` — the first LIVE layer counting up from the bed.  The
         !! opaque-bed residual lands HERE, not on `k = 1`: under `z_fixed`
         !! the layers below are inert fillers (`1` elsewhere ⇒ unchanged).
      real(wp), intent(in)    :: wet_mask(nx, ny)
      real(wp), intent(in)    :: sw_src(nx, ny)
      real(wp), intent(in)    :: inv_scale, sw_pen_frac, R, zeta1, zeta2
      integer :: i, j, k
      real(wp) :: i0col, d_top, d_bot, trans_top, trans_bot, absorbed, add

      do concurrent(j=1:ny, i=1:nx) local(i0col, d_top, d_bot, trans_top, &
                                          trans_bot, absorbed, add, k)
         i0col = sw_pen_frac*sw_src(i, j)*wet_mask(i, j)
         d_top = 0.0_wp
         do k = nz, k_bot(i, j), -1
            d_bot = d_top + h_layer(i, j, k)
            trans_top = sw_transmission(d_top, R, zeta1, zeta2)
            if (k > k_bot(i, j)) then
               trans_bot = sw_transmission(d_bot, R, zeta1, zeta2)
            else
               trans_bot = 0.0_wp   ! bed opaque: column absorbs all of I0
            end if
            absorbed = i0col*(trans_top - trans_bot)
            add = inv_scale*absorbed
            if (k == nz) add = add - inv_scale*i0col   ! remove the surface lump
            hTr(i, j, k) = hTr(i, j, k) + add
            budget(i, j, k) = budget(i, j, k) + add
            d_top = d_bot
         end do
      end do
   end subroutine apply_sw_penetration_impl