apply_geothermal_src_impl Subroutine

private pure subroutine apply_geothermal_src_impl(hTr, budget, wet_mask, h_layer, k_bot, src, nz, h_min)

Stamp src * wet_mask(i,j) onto the lowest massive layer of a tracer’s hTr array (first k with h_layer > h_min, scanning k = k_bot(i,j)..nz from the first live layer up), mirror into the matching budget contributor. Flat-impl over plain allocatables — the outer subroutine reaches ms%tracers(idx)%hTr on the host before calling this.

Arguments

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

Calls

proc~~apply_geothermal_src_impl~~CallsGraph proc~apply_geothermal_src_impl apply_geothermal_src_impl local local proc~apply_geothermal_src_impl->local

Called by

proc~~apply_geothermal_src_impl~~CalledByGraph proc~apply_geothermal_src_impl apply_geothermal_src_impl proc~ocean_geothermal_apply_tracers ocean_geothermal_apply_tracers proc~ocean_geothermal_apply_tracers->proc~apply_geothermal_src_impl proc~run_stage run_stage proc~run_stage->proc~ocean_geothermal_apply_tracers proc~run_stage_split run_stage_split proc~run_stage_split->proc~ocean_geothermal_apply_tracers 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
real(kind=wp), private :: cell
integer, private :: i
integer, private :: j
integer, private :: k
integer, private :: k_dep
integer, private :: nx
integer, private :: ny

Source Code

   pure subroutine apply_geothermal_src_impl(hTr, budget, wet_mask, h_layer, k_bot, src, nz, h_min)
      !! Stamp `src * wet_mask(i,j)` onto the lowest *massive* layer of
      !! a tracer's hTr array (first `k` with `h_layer > h_min`,
      !! scanning `k = k_bot(i,j)..nz` from the first live layer up), mirror into the matching
      !! budget contributor.  Flat-impl over plain allocatables — the
      !! outer subroutine reaches `ms%tracers(idx)%hTr` on the host
      !! before calling this.
      ! assumed-shape-ok: tracer registry outer-shim — caller host-dereferences
      ! ms%tracers(idx)%hTr before passing; size varies per tracer slot;
      ! called once per tracer per thermo step (per CLAUDE.md outer-shim pattern).
      real(wp), intent(inout) :: hTr(:, :, :)
      real(wp), intent(inout) :: budget(:, :, :)  ! assumed-shape-ok: tracer registry outer-shim; thermo cadence
      real(wp), intent(in)    :: wet_mask(:, :)  ! assumed-shape-ok: tracer registry outer-shim; thermo cadence
      real(wp), intent(in)    :: h_layer(:, :, :)  ! assumed-shape-ok: tracer registry outer-shim; thermo cadence
      integer, intent(in)     :: k_bot(:, :)  ! assumed-shape-ok: shaped like wet_mask (same caller); thermo cadence
      real(wp), intent(in)    :: src
      integer, intent(in)    :: nz
      real(wp), intent(in)    :: h_min
      integer :: i, j, nx, ny, k, k_dep
      real(wp) :: cell
      nx = size(hTr, 1)
      ny = size(hTr, 2)
      do concurrent(j=1:ny, i=1:nx) local(cell, k, k_dep)
         ! Lowest massive layer: scan from the first LIVE layer `k_bot`
         ! (the bed, k=1, off z_fixed) up.  In the common case
         ! h_layer(i,j,k_bot) > h_min and k_dep = k_bot.  Falls back
         ! to nz if every layer is below the floor (deposits at the
         ! surface rather than dropping the energy).
         k_dep = nz
         do k = k_bot(i, j), nz
            if (h_layer(i, j, k) > h_min) then
               k_dep = k
               exit
            end if
         end do
         cell = src*wet_mask(i, j)
         hTr(i, j, k_dep) = hTr(i, j, k_dep) + cell
         budget(i, j, k_dep) = budget(i, j, k_dep) + cell
      end do
   end subroutine apply_geothermal_src_impl