ocean_surfflux_assemble_cover_impl Subroutine

   pure subroutine ocean_surfflux_assemble_cover_impl(heat_content_massin, &
                                                      heat_content_massout, &
                                                      Q_heat, Q_salt, &
                                                      q_sw, q_lw, q_lat, q_sens, heat_added, &
                                                      heat_cavity, &
                                                      heat_content_lprec, heat_content_fprec, &
                                                      heat_content_vprec, heat_content_lrunoff, &
                                                      heat_content_frunoff, heat_content_seaice_melt, &
                                                      evap, salt_flux, salt_cavity, &
                                                      hTr_T, h_layer, wet_mask, cover_frac, &
                                                      Q_heat_const, Q_salt_const, cp, h_min, &
                                                      nz, nx, ny)
      !! Ice-shelf-cover twin of `ocean_surfflux_assemble_impl`: the
      !! open-water factor `open_f = 1 - cover_frac` multiplies the
      !! ATMOSPHERIC group and NOT the cavity group.  Grouping, spelt
      !! out because it is the whole point of this kernel:
      !!
      !!   masked   — `Q_heat_const`, `q_sw`, `q_lw`, `q_lat`, `q_sens`,
      !!              `heat_added`, `heat_content_massin` (the six
      !!              mass-enthalpy companions), `heat_content_massout`
      !!              (`cp·SST·evap`), `Q_salt_const`, `salt_flux`;
      !!   UNmasked — `heat_cavity`, `salt_cavity`.
      !!
      !! The two `heat_content_mass*` OUTPUTS carry the factor too: they
      !! are diagnostics of atmospheric mass exchange, which under a
      !! shelf is zero, and reporting the unmasked value next to a
      !! masked `Q_heat` would make the ledger not add up.
      !!
      !! Separate `_impl`, not an in-loop `present()` test (house
      !! idiom) — the cover-off path keeps the production assembler
      !! byte-identical.
      integer, intent(in)    :: nz, nx, ny
      real(wp), intent(inout) :: heat_content_massin(nx, ny), heat_content_massout(nx, ny)
      real(wp), intent(inout) :: Q_heat(nx, ny), Q_salt(nx, ny)
      real(wp), intent(in)    :: q_sw(nx, ny), q_lw(nx, ny), q_lat(nx, ny), q_sens(nx, ny)
      real(wp), intent(in)    :: heat_added(nx, ny), heat_cavity(nx, ny)
      real(wp), intent(in)    :: heat_content_lprec(nx, ny), heat_content_fprec(nx, ny)
      real(wp), intent(in)    :: heat_content_vprec(nx, ny), heat_content_lrunoff(nx, ny)
      real(wp), intent(in)    :: heat_content_frunoff(nx, ny), heat_content_seaice_melt(nx, ny)
      real(wp), intent(in)    :: evap(nx, ny), salt_flux(nx, ny), salt_cavity(nx, ny)
      real(wp), intent(in)    :: hTr_T(nx, ny, nz), h_layer(nx, ny, nz), wet_mask(nx, ny)
      real(wp), intent(in)    :: cover_frac(nx, ny)
      real(wp), intent(in)    :: Q_heat_const, Q_salt_const, cp, h_min
      integer :: i, j
      real(wp) :: sst, massin, massout, open_f

      do concurrent(j=1:ny, i=1:nx) local(sst, massin, massout, open_f)
         open_f = 1.0_wp - cover_frac(i, j)
         massin = open_f*(heat_content_lprec(i, j) + heat_content_fprec(i, j) &
                          + heat_content_vprec(i, j) + heat_content_lrunoff(i, j) &
                          + heat_content_frunoff(i, j) + heat_content_seaice_melt(i, j))
         ! vanished-ok: same caller-supplied `h_min` floor — the SST carrying the
         ! evaporative heat content must stay a temperature.
         sst = hTr_T(i, j, nz)/max(h_layer(i, j, nz), h_min)
         massout = open_f*cp*sst*evap(i, j)
         heat_content_massin(i, j) = wet_mask(i, j)*massin
         heat_content_massout(i, j) = wet_mask(i, j)*massout
         Q_heat(i, j) = wet_mask(i, j)* &
                        (open_f*(Q_heat_const + q_sw(i, j) + q_lw(i, j) + q_lat(i, j) + &
                                 q_sens(i, j) + heat_added(i, j)) + &
                         heat_cavity(i, j) + massin + massout)
         Q_salt(i, j) = wet_mask(i, j)*(open_f*(Q_salt_const + salt_flux(i, j)) + &
                                        salt_cavity(i, j))
      end do
   end subroutine ocean_surfflux_assemble_cover_impl