ice_compute_basal_flux_impl Subroutine

private pure subroutine ice_compute_basal_flux_impl(hTr_T, hTr_S, h_layer, wet_mask, m_ice, eos, fb, sst_seam, ssurf_seam, tfw_seam, dt_therm, nghost, ncat, nz, nx, ny)

Device kernel over PHYSICAL cells (ghosts excluded — same physical-cells-only contract as ice_frazil_accumulate_impl). fb/sst_seam/ssurf_seam/tfw_seam are zeroed unconditionally first. The SAMPLE seam (sst_seam/ssurf_seam/tfw_seam) is filled on every wet, non-vanished cell (harmless — the column reads it only where it has ice). But fb is filled ONLY where BOTH the cell is wet+non-vanished AND it carries ice (sum_cat m_ice > ICE_RHO_ICE*H_VANISHED, exactly ice_thermo_columns’ own per-cat ice threshold, summed): no ice base ⇒ no basal flux. This keeps the coupler and the column in lockstep on which cells exchange, so an ice-free warm ocean cell (SST > T_f, the normal open-ocean state) reports fb = 0 and the melt-side reduce kernel’s -fb term is a harmless subtraction of zero (rather than a spurious ocean-cooling Q_heat = -fb).

Decl-order: all integer dims declared before the explicit-shape arrays that use them. Inner if gate only (never a masked do concurrent header).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: hTr_T(nx,ny,nz)
real(kind=wp), intent(in) :: hTr_S(nx,ny,nz)
real(kind=wp), intent(in) :: h_layer(nx,ny,nz)
real(kind=wp), intent(in) :: wet_mask(nx,ny)
real(kind=wp), intent(in) :: m_ice(nx,ny,ncat)
type(eos_t), intent(in) :: eos
real(kind=wp), intent(inout) :: fb(nx,ny)
real(kind=wp), intent(inout) :: sst_seam(nx,ny)
real(kind=wp), intent(inout) :: ssurf_seam(nx,ny)
real(kind=wp), intent(inout) :: tfw_seam(nx,ny)
real(kind=wp), intent(in) :: dt_therm
integer, intent(in) :: nghost
integer, intent(in) :: ncat
integer, intent(in) :: nz
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ice_compute_basal_flux_impl~~CallsGraph proc~ice_compute_basal_flux_impl ice_compute_basal_flux_impl local local proc~ice_compute_basal_flux_impl->local proc~eos_freezing_point eos_freezing_point proc~ice_compute_basal_flux_impl->proc~eos_freezing_point

Called by

proc~~ice_compute_basal_flux_impl~~CalledByGraph proc~ice_compute_basal_flux_impl ice_compute_basal_flux_impl proc~ice_compute_basal_flux ice_compute_basal_flux proc~ice_compute_basal_flux->proc~ice_compute_basal_flux_impl proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_compute_basal_flux proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step_ice proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step_ice proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
integer, private :: cat
real(kind=wp), private :: h
integer, private :: i
integer, private :: i_hi
integer, private :: i_lo
integer, private :: j
integer, private :: j_hi
integer, private :: j_lo
real(kind=wp), private :: m_ice_tot
real(kind=wp), private :: s_surf
real(kind=wp), private :: sst
real(kind=wp), private :: tfw

Source Code

   pure subroutine ice_compute_basal_flux_impl(hTr_T, hTr_S, h_layer, wet_mask, m_ice, eos, &
                                               fb, sst_seam, ssurf_seam, tfw_seam, &
                                               dt_therm, nghost, ncat, nz, nx, ny)
      !! Device kernel over PHYSICAL cells (ghosts excluded — same
      !! physical-cells-only contract as `ice_frazil_accumulate_impl`).
      !! `fb`/`sst_seam`/`ssurf_seam`/`tfw_seam` are zeroed unconditionally
      !! first. The SAMPLE seam (sst_seam/ssurf_seam/tfw_seam) is filled on
      !! every wet, non-vanished cell (harmless — the column reads it only
      !! where it has ice). But `fb` is filled ONLY where BOTH the cell is
      !! wet+non-vanished AND it carries ice (`sum_cat m_ice >
      !! ICE_RHO_ICE*H_VANISHED`, exactly ice_thermo_columns' own per-cat
      !! ice threshold, summed): no ice base ⇒ no basal flux. This keeps the
      !! coupler and the column in lockstep on which cells exchange, so an
      !! ice-free warm ocean cell (SST > T_f, the normal open-ocean state)
      !! reports fb = 0 and the melt-side reduce kernel's `-fb` term is a
      !! harmless subtraction of zero (rather than a spurious ocean-cooling
      !! Q_heat = -fb).
      !!
      !! Decl-order: all integer dims declared before the explicit-shape
      !! arrays that use them. Inner `if` gate only (never a masked
      !! `do concurrent` header).
      integer, intent(in) :: nghost, ncat, nz, nx, ny
      real(wp), intent(in) :: hTr_T(nx, ny, nz)
      real(wp), intent(in) :: hTr_S(nx, ny, nz)
      real(wp), intent(in) :: h_layer(nx, ny, nz)
      real(wp), intent(in) :: wet_mask(nx, ny)
      real(wp), intent(in) :: m_ice(nx, ny, ncat)
      type(eos_t), intent(in) :: eos
      real(wp), intent(inout) :: fb(nx, ny)
      real(wp), intent(inout) :: sst_seam(nx, ny)
      real(wp), intent(inout) :: ssurf_seam(nx, ny)
      real(wp), intent(inout) :: tfw_seam(nx, ny)
      real(wp), intent(in) :: dt_therm

      integer :: i, j, cat, i_lo, i_hi, j_lo, j_hi
      real(wp) :: h, sst, s_surf, tfw, m_ice_tot

      i_lo = nghost + 1
      i_hi = nx - nghost
      j_lo = nghost + 1
      j_hi = ny - nghost

      do concurrent(j=j_lo:j_hi, i=i_lo:i_hi) local(h, sst, s_surf, tfw, cat, m_ice_tot)
         fb(i, j) = 0.0_wp
         sst_seam(i, j) = 0.0_wp
         ssurf_seam(i, j) = 0.0_wp
         tfw_seam(i, j) = 0.0_wp
         h = h_layer(i, j, nz)
         if (wet_mask(i, j) > 0.5_wp .and. h > H_VANISHED) then
            sst = hTr_T(i, j, nz)/h
            s_surf = hTr_S(i, j, nz)/h
            tfw = eos_freezing_point(eos, s_surf, 0.0_wp)
            sst_seam(i, j) = sst
            ssurf_seam(i, j) = s_surf
            tfw_seam(i, j) = tfw
            m_ice_tot = 0.0_wp
            do cat = 1, ncat
               m_ice_tot = m_ice_tot + m_ice(i, j, cat)
            end do
            if (m_ice_tot > ICE_RHO_ICE*H_VANISHED) then
               fb(i, j) = RHO_WATER*SEAWATER_CP*max(0.0_wp, sst - tfw)*h/dt_therm
            end if
         end if
      end do
   end subroutine ice_compute_basal_flux_impl