epbl_compute Subroutine

public pure subroutine epbl_compute(grid, this, ms, ss, dt, sf)

Run EPBL over the domain: fill this%kd_int (interface diffusivity) and this%mld. Call at thermo cadence with the thermo dt. Outer shim: dereferences the tracer-registry hTr arrays + the 2D Q_heat/Q_salt forcing fields on the host (array-of-DT and allocatable indirection blocks NVHPC device codegen), then forwards to the column kernel which reads q_T_kin(i,j) / q_S_kin(i,j) per column inside the DC.

sf (surface-flux slot) is REQUIRED — EPBL computes B_0 from the per-column kinematic fluxes. The dispatch in vmix_apply_in_stage already errors before reaching here when sf is absent and EPBL is active.

Arguments

Type IntentOptional Attributes Name
type(hgrid_t), intent(in) :: grid
type(ocean_epbl_t), intent(inout) :: this
type(multilayer_state_t), intent(in) :: ms
type(ocean_surface_stress_t), intent(in) :: ss
real(kind=wp), intent(in) :: dt
type(ocean_surface_flux_t), intent(in) :: sf

Calls

proc~~epbl_compute~~CallsGraph proc~epbl_compute epbl_compute proc~epbl_column_kernel epbl_column_kernel proc~epbl_compute->proc~epbl_column_kernel local local proc~epbl_column_kernel->local proc~eos_specvol_derivs eos_specvol_derivs proc~epbl_column_kernel->proc~eos_specvol_derivs proc~epbl_find_mstar epbl_find_mstar proc~epbl_column_kernel->proc~epbl_find_mstar proc~epbl_lf17_la epbl_lf17_la proc~epbl_column_kernel->proc~epbl_lf17_la proc~epbl_lf17_wave_state epbl_lf17_wave_state proc~epbl_column_kernel->proc~epbl_lf17_wave_state proc~epbl_lt_enhance epbl_lt_enhance proc~epbl_column_kernel->proc~epbl_lt_enhance proc~epbl_mixlen_shape epbl_mixlen_shape proc~epbl_column_kernel->proc~epbl_mixlen_shape proc~sw_pe_cost_shape sw_pe_cost_shape proc~epbl_column_kernel->proc~sw_pe_cost_shape proc~roquet_spv_point roquet_spv_point proc~eos_specvol_derivs->proc~roquet_spv_point proc~one_m_exp_x one_m_exp_x proc~epbl_lf17_la->proc~one_m_exp_x

Called by

proc~~epbl_compute~~CalledByGraph proc~epbl_compute epbl_compute proc~vmix_apply_in_stage vmix_apply_in_stage proc~vmix_apply_in_stage->proc~epbl_compute proc~run_stage run_stage proc~run_stage->proc~vmix_apply_in_stage proc~run_stage_split run_stage_split proc~run_stage_split->proc~vmix_apply_in_stage 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 :: nx
integer, private :: ny
logical, private :: sw_ctke_active

Source Code

   pure subroutine epbl_compute(grid, this, ms, ss, dt, sf)
      !! Run EPBL over the domain: fill `this%kd_int` (interface
      !! diffusivity) and `this%mld`.  Call at thermo cadence with
      !! the thermo dt.  Outer shim: dereferences the tracer-registry
      !! hTr arrays + the 2D Q_heat/Q_salt forcing fields on the host
      !! (array-of-DT and allocatable indirection blocks NVHPC device
      !! codegen), then forwards to the column kernel which reads
      !! q_T_kin(i,j) / q_S_kin(i,j) per column inside the DC.
      !!
      !! `sf` (surface-flux slot) is REQUIRED — EPBL computes B_0 from
      !! the per-column kinematic fluxes.  The dispatch in
      !! `vmix_apply_in_stage` already errors before reaching here when
      !! `sf` is absent and EPBL is active.
      type(hgrid_t), intent(in) :: grid
      type(ocean_epbl_t), intent(inout) :: this
      type(multilayer_state_t), intent(in) :: ms
      type(ocean_surface_stress_t), intent(in) :: ss
      real(wp), intent(in) :: dt
      type(ocean_surface_flux_t), intent(in) :: sf

      integer :: nx, ny
      logical :: sw_ctke_active

      if (ms%idx_temperature <= 0 .or. ms%idx_salinity <= 0) return

      nx = grid%nx_total
      ny = grid%ny_total

      ! Kinematic scale factors (column-invariant multipliers):
      !   q_T_kin(i,j) = Q_heat(i,j) / (rho0 · cp)  [degC·m/s]
      !   q_S_kin(i,j) = Q_salt(i,j) / rho0           [PSU·m/s]
      ! The column kernel reads these at (i,j) inside the DC so that
      ! spatially-varying forcing (Area-A3/A4) is handled correctly.
      !
      ! (PR-21) Penetrating-SW TKE ledger: active only when the ledger is
      ! enabled AND penetrating SW is on.  The irradiance source is
      ! selected HOST-SIDE (`sf%sw_from_qsw`); the conditionally-allocated
      ! `q_sw` is passed only on the guarded branch (validate_config
      ! forces enable_components when sw_source="q_sw", making it total).
      ! When inactive, the source array is irrelevant (kernel never reads
      ! it), so the legacy `Q_heat` argument is passed on both branches.
      sw_ctke_active = this%epbl_sw_ctke .and. sf%has_sw
      if (sw_ctke_active .and. sf%sw_from_qsw) then
         call epbl_column_kernel(grid, this, ms, &
                                 ms%tracers(ms%idx_temperature)%hTr, &
                                 ms%tracers(ms%idx_salinity)%hTr, &
                                 ss, dt, &
                                 sf%Q_heat, 1.0_wp/(this%rho0*sf%cp), &
                                 sf%Q_salt, 1.0_wp/this%rho0, &
                                 sf%q_sw, sw_ctke_active, sf%sw_pen_frac, &
                                 sf%sw_band_ratio, sf%sw_zeta1, sf%sw_zeta2, &
                                 ms%wet_mask, this%in_eos, nx, ny)
      else
         call epbl_column_kernel(grid, this, ms, &
                                 ms%tracers(ms%idx_temperature)%hTr, &
                                 ms%tracers(ms%idx_salinity)%hTr, &
                                 ss, dt, &
                                 sf%Q_heat, 1.0_wp/(this%rho0*sf%cp), &
                                 sf%Q_salt, 1.0_wp/this%rho0, &
                                 sf%Q_heat, sw_ctke_active, sf%sw_pen_frac, &
                                 sf%sw_band_ratio, sf%sw_zeta1, sf%sw_zeta2, &
                                 ms%wet_mask, this%in_eos, nx, ny)
      end if
   end subroutine epbl_compute