apply_sw_penetration_cover_impl Subroutine

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

Ice-shelf-cover twin of apply_sw_penetration_impl: the open-water factor 1 - cover_frac composes multiplicatively with wet_mask into the column irradiance I0, so a fully covered column neither removes the surface lump nor deposits a profile — it is left EXACTLY untouched. Separate _impl, not an in-loop present() test (house idiom, see apply_surface_src_2d_dyn_impl) — the cover-off path keeps the original kernel byte-identical.

The additive-correction conservation identity -I0 + Σ_k I0·(T_top - T_bot) = 0 holds for ANY I0, and I0 = 0 is the degenerate case of it, so scaling the source cannot break column heat conservation.

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) :: cover_frac(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_cover_impl~~CallsGraph proc~apply_sw_penetration_cover_impl apply_sw_penetration_cover_impl local local proc~apply_sw_penetration_cover_impl->local proc~sw_transmission sw_transmission proc~apply_sw_penetration_cover_impl->proc~sw_transmission

Called by

proc~~apply_sw_penetration_cover_impl~~CalledByGraph proc~apply_sw_penetration_cover_impl apply_sw_penetration_cover_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_cover_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_cover_impl(hTr, budget, h_layer, k_bot, wet_mask, &
                                                   cover_frac, sw_src, inv_scale, &
                                                   sw_pen_frac, R, zeta1, zeta2, nz, nx, ny)
      !! Ice-shelf-cover twin of `apply_sw_penetration_impl`: the
      !! open-water factor `1 - cover_frac` composes multiplicatively
      !! with `wet_mask` into the column irradiance `I0`, so a fully
      !! covered column neither removes the surface lump nor deposits a
      !! profile — it is left EXACTLY untouched.  Separate `_impl`, not
      !! an in-loop `present()` test (house idiom, see
      !! `apply_surface_src_2d_dyn_impl`) — the cover-off path keeps the
      !! original kernel byte-identical.
      !!
      !! The additive-correction conservation identity
      !! `-I0 + Σ_k I0·(T_top - T_bot) = 0` holds for ANY `I0`, and
      !! `I0 = 0` is the degenerate case of it, so scaling the source
      !! cannot break column heat conservation.
      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)    :: cover_frac(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)*(1.0_wp - cover_frac(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_cover_impl