ice_frazil_uptake_impl Subroutine

private pure subroutine ice_frazil_uptake_impl(hTr_T, hTr_S, h_layer, wet_mask, eos, frazil_heat, m_ice, m_snow, enth_ice, sal_ice, m_frozen_diag, salt_flux_diag, dt_therm, nghost, ncat, nk, nz, nx, ny)

Device kernel over PHYSICAL cells (ghosts excluded — same physical-cells-only contract as ice_frazil_accumulate_impl and ice_thermo_columns). Per wet, non-vanished, banked cell: sample SST/SSS at k = nz, compute the seawater freezing point, spend the WHOLE bank on category-1’s column via ice_frazil_uptake_column, and reset frazil_heat to 0 (fully spent). The per-cell diags (m_frozen_diag, salt_flux_diag) are zeroed UNCONDITIONALLY first, then overwritten under the gate — an unbanked/dry/land/vanished cell reports zero, not a stale value from a prior window.

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

Bank on dry/vanished columns is NOT zeroed here — it stays banked (conserved) until the column is wet+intact enough to spend it, matching the “never discard a bank” contract of rdb_ice_frazil.

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)
type(eos_t), intent(in) :: eos
real(kind=wp), intent(inout) :: frazil_heat(nx,ny)
real(kind=wp), intent(inout) :: m_ice(nx,ny,ncat)
real(kind=wp), intent(inout) :: m_snow(nx,ny,ncat)
real(kind=wp), intent(inout) :: enth_ice(nx,ny,ncat,nk)
real(kind=wp), intent(inout) :: sal_ice(nx,ny,ncat,nk)
real(kind=wp), intent(inout) :: m_frozen_diag(nx,ny)
real(kind=wp), intent(inout) :: salt_flux_diag(nx,ny)
real(kind=wp), intent(in) :: dt_therm
integer, intent(in) :: nghost
integer, intent(in) :: ncat
integer, intent(in) :: nk
integer, intent(in) :: nz
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ice_frazil_uptake_impl~~CallsGraph proc~ice_frazil_uptake_impl ice_frazil_uptake_impl local local proc~ice_frazil_uptake_impl->local proc~eos_freezing_point eos_freezing_point proc~ice_frazil_uptake_impl->proc~eos_freezing_point proc~ice_frazil_uptake_column ice_frazil_uptake_column proc~ice_frazil_uptake_impl->proc~ice_frazil_uptake_column proc~ice_enth_from_ts ice_enth_from_ts proc~ice_frazil_uptake_column->proc~ice_enth_from_ts proc~ice_enthalpy_liquid ice_enthalpy_liquid proc~ice_frazil_uptake_column->proc~ice_enthalpy_liquid proc~ice_rebalance_layers ice_rebalance_layers proc~ice_frazil_uptake_column->proc~ice_rebalance_layers proc~ice_t_freeze ice_t_freeze proc~ice_frazil_uptake_column->proc~ice_t_freeze

Called by

proc~~ice_frazil_uptake_impl~~CalledByGraph proc~ice_frazil_uptake_impl ice_frazil_uptake_impl proc~ice_frazil_uptake ice_frazil_uptake proc~ice_frazil_uptake->proc~ice_frazil_uptake_impl proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_frazil_uptake 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
real(kind=wp), private :: enth_ice_col(ICE_NK_MAX)
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_frozen_pt
real(kind=wp), private :: m_ice_pt
real(kind=wp), private :: m_snow_pt
real(kind=wp), private :: s_surf
real(kind=wp), private :: sal_ice_col(ICE_NK_MAX)
real(kind=wp), private :: salt_to_ice_pt
real(kind=wp), private :: sst
real(kind=wp), private :: tfw

Source Code

   pure subroutine ice_frazil_uptake_impl(hTr_T, hTr_S, h_layer, wet_mask, eos, &
                                          frazil_heat, m_ice, m_snow, enth_ice, sal_ice, &
                                          m_frozen_diag, salt_flux_diag, &
                                          dt_therm, nghost, ncat, nk, nz, nx, ny)
      !! Device kernel over PHYSICAL cells (ghosts excluded — same
      !! physical-cells-only contract as `ice_frazil_accumulate_impl` and
      !! `ice_thermo_columns`). Per wet, non-vanished, banked cell:
      !! sample SST/SSS at `k = nz`, compute the seawater freezing point,
      !! spend the WHOLE bank on category-1's column via
      !! `ice_frazil_uptake_column`, and reset `frazil_heat` to 0 (fully
      !! spent). The per-cell diags (`m_frozen_diag`, `salt_flux_diag`)
      !! are zeroed UNCONDITIONALLY first, then overwritten under the
      !! gate — an unbanked/dry/land/vanished cell reports zero, not a
      !! stale value from a prior window.
      !!
      !! Decl-order: all integer dims declared before the explicit-shape
      !! arrays that use them. Inner `if` gate only (never a masked
      !! `do concurrent` header, per the dc-to-omp constraint).
      !!
      !! Bank on dry/vanished columns is NOT zeroed here — it stays
      !! banked (conserved) until the column is wet+intact enough to
      !! spend it, matching the "never discard a bank" contract of
      !! `rdb_ice_frazil`.
      integer, intent(in) :: nghost, ncat, nk, 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)
      type(eos_t), intent(in) :: eos
      real(wp), intent(inout) :: frazil_heat(nx, ny)
      real(wp), intent(inout) :: m_ice(nx, ny, ncat)
      real(wp), intent(inout) :: m_snow(nx, ny, ncat)
      real(wp), intent(inout) :: enth_ice(nx, ny, ncat, nk)
      real(wp), intent(inout) :: sal_ice(nx, ny, ncat, nk)
      real(wp), intent(inout) :: m_frozen_diag(nx, ny)
      real(wp), intent(inout) :: salt_flux_diag(nx, ny)
      real(wp), intent(in) :: dt_therm

      integer :: i, j, i_lo, i_hi, j_lo, j_hi
      real(wp) :: h, sst, s_surf, tfw
      real(wp) :: m_snow_pt, m_ice_pt, m_frozen_pt, salt_to_ice_pt
      real(wp) :: enth_ice_col(ICE_NK_MAX), sal_ice_col(ICE_NK_MAX)

      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, &
                                                    m_snow_pt, m_ice_pt, m_frozen_pt, &
                                                    salt_to_ice_pt, enth_ice_col, sal_ice_col)
         m_frozen_diag(i, j) = 0.0_wp
         salt_flux_diag(i, j) = 0.0_wp
         h = h_layer(i, j, nz)
         if (wet_mask(i, j) > 0.5_wp .and. h > H_VANISHED .and. frazil_heat(i, j) > 0.0_wp) 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)

            m_snow_pt = m_snow(i, j, 1)
            m_ice_pt = m_ice(i, j, 1)
            enth_ice_col(1:nk) = enth_ice(i, j, 1, 1:nk)
            sal_ice_col(1:nk) = sal_ice(i, j, 1, 1:nk)

            call ice_frazil_uptake_column(nk, frazil_heat(i, j), tfw, sst, s_surf, &
                                          m_snow_pt, m_ice_pt, enth_ice_col(1:nk), &
                                          sal_ice_col(1:nk), m_frozen_pt, salt_to_ice_pt)

            m_ice(i, j, 1) = m_ice_pt
            enth_ice(i, j, 1, 1:nk) = enth_ice_col(1:nk)
            sal_ice(i, j, 1, 1:nk) = sal_ice_col(1:nk)
            m_frozen_diag(i, j) = m_frozen_pt
            salt_flux_diag(i, j) = (m_frozen_pt*s_surf - salt_to_ice_pt)/dt_therm
            frazil_heat(i, j) = 0.0_wp
         end if
      end do
   end subroutine ice_frazil_uptake_impl