fill_ice_conc_thick_impl Subroutine

private pure subroutine fill_ice_conc_thick_impl(ncat, nx, ny, wet_T, part_size, m_ice, emit_thick, buf)

Shared conc/thick device kernel. Inlines the two-mode gather of ice_cell_concentration_impl (rdb_ice_state — convention of record; test_ocean_ice_diags pins the copies equal): ncat==1 legacy lumped (per-CELL m_ice, ci = 0/1), ncat>1 SIS2 ITD (ci = min(1, Σ part_size), mice = Σ part_size·m_ice). emit_thick=.false. ⇒ buf = ci; .true. ⇒ buf = mice/ICE_RHO_ICE (grid-mean thickness, m). Scalar flag branch is constant-folded on the device — one kernel, no scratch companion.

Land AND ghost cells (wet_T <= 0.5) write the IEEE NaN missing-data sentinel, matching fill_tracer_impl’s convention — this used to write a plain 0.0, which is a LEGAL concentration/ thickness value, so diag_field_stats’s finite-cell mean counted the whole ghost ring as “0% ice” ocean and diluted the mean (e.g. 1200/1496 = 0.802139 on a 40x30/nghost=2 domain that is 100% ice-covered everywhere wet). test_fill_ice_conc_thick_nan_ghost pins the fix.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: ncat
integer, intent(in) :: nx
integer, intent(in) :: ny
real(kind=wp), intent(in) :: wet_T(nx,ny)
real(kind=wp), intent(in) :: part_size(nx,ny,0:ncat)
real(kind=wp), intent(in) :: m_ice(nx,ny,ncat)
logical, intent(in) :: emit_thick
real(kind=wp), intent(inout) :: buf(:,:,:)

Calls

proc~~fill_ice_conc_thick_impl~~CallsGraph proc~fill_ice_conc_thick_impl fill_ice_conc_thick_impl local local proc~fill_ice_conc_thick_impl->local

Called by

proc~~fill_ice_conc_thick_impl~~CalledByGraph proc~fill_ice_conc_thick_impl fill_ice_conc_thick_impl proc~fill_ice_conc fill_ice_conc proc~fill_ice_conc->proc~fill_ice_conc_thick_impl proc~fill_ice_thick fill_ice_thick proc~fill_ice_thick->proc~fill_ice_conc_thick_impl

Variables

Type Visibility Attributes Name Initial
integer, private :: c
real(kind=wp), private :: ci_sum
real(kind=wp), private :: ci_val
integer, private :: i
integer, private :: j
real(kind=wp), private :: mice_val
integer, private :: nxl
integer, private :: nyl
real(kind=wp), private :: qnan

Source Code

   pure subroutine fill_ice_conc_thick_impl(ncat, nx, ny, wet_T, part_size, &
                                            m_ice, emit_thick, buf)
      !! Shared conc/thick device kernel.  Inlines the two-mode gather of
      !! `ice_cell_concentration_impl` (`rdb_ice_state` — convention of
      !! record; `test_ocean_ice_diags` pins the copies equal): ncat==1
      !! legacy lumped (per-CELL m_ice, ci = 0/1), ncat>1 SIS2 ITD
      !! (ci = min(1, Σ part_size), mice = Σ part_size·m_ice).
      !! `emit_thick=.false.` ⇒ buf = ci; `.true.` ⇒ buf = mice/ICE_RHO_ICE
      !! (grid-mean thickness, m).  Scalar flag branch is constant-folded on
      !! the device — one kernel, no scratch companion.
      !!
      !! Land AND ghost cells (`wet_T <= 0.5`) write the IEEE NaN
      !! missing-data sentinel, matching `fill_tracer_impl`'s convention —
      !! this used to write a plain 0.0, which is a LEGAL concentration/
      !! thickness value, so `diag_field_stats`'s finite-cell mean counted
      !! the whole ghost ring as "0% ice" ocean and diluted the mean (e.g.
      !! 1200/1496 = 0.802139 on a 40x30/nghost=2 domain that is 100%
      !! ice-covered everywhere wet). `test_fill_ice_conc_thick_nan_ghost`
      !! pins the fix.
      integer, intent(in) :: ncat, nx, ny
      real(wp), intent(in) :: wet_T(nx, ny)
      real(wp), intent(in) :: part_size(nx, ny, 0:ncat)
      real(wp), intent(in) :: m_ice(nx, ny, ncat)
      logical, intent(in) :: emit_thick
      real(wp), intent(inout) :: buf(:, :, :)  ! assumed-shape-ok: diag fill — cadence-bounded
      integer :: i, j, c, nxl, nyl
      real(wp) :: mice_val, ci_val, ci_sum, qnan

      nxl = min(nx, size(buf, 1))
      nyl = min(ny, size(buf, 2))
      qnan = ieee_value(0.0_wp, ieee_quiet_nan)

      if (ncat == 1) then
         do concurrent(j=1:nyl, i=1:nxl) local(mice_val, ci_val)
            if (wet_T(i, j) > 0.5_wp) then
               if (m_ice(i, j, 1) > 0.0_wp) then
                  mice_val = m_ice(i, j, 1)
                  ci_val = 1.0_wp
               else
                  mice_val = 0.0_wp
                  ci_val = 0.0_wp
               end if
               buf(i, j, 1) = merge(mice_val/ICE_RHO_ICE, ci_val, emit_thick)
            else
               buf(i, j, 1) = qnan
            end if
         end do
      else
         do concurrent(j=1:nyl, i=1:nxl) local(c, mice_val, ci_val, ci_sum)
            if (wet_T(i, j) > 0.5_wp) then
               mice_val = 0.0_wp
               ci_sum = 0.0_wp
               do c = 1, ncat
                  mice_val = mice_val + part_size(i, j, c)*m_ice(i, j, c)
                  ci_sum = ci_sum + part_size(i, j, c)
               end do
               ci_val = min(1.0_wp, ci_sum)
               buf(i, j, 1) = merge(mice_val/ICE_RHO_ICE, ci_val, emit_thick)
            else
               buf(i, j, 1) = qnan
            end if
         end do
      end if
   end subroutine fill_ice_conc_thick_impl