ocean_surface_stress_apply_cover Subroutine

public pure subroutine ocean_surface_stress_apply_cover(ss, cover_frac)

Zero the wind-stress pair on every C-grid face that touches an ice-covered cell, then refresh stress_mag from the masked pair. The two halves are ONE call on purpose: a masked tau with a stale stress_mag would leave KPP/EPBL mixing on a wind that no longer reaches the water.

FACE RULE — see the module docstring. open_face = min(1 - cover_left, 1 - cover_right), i.e. a face is closed if EITHER neighbour is covered, so no wind acts on a covered cell. A rim face (i = 1 / i = nx+1, j = 1 / j = ny+1) has only one neighbour in range and takes that cell’s cover.

Idempotent (multiplies by 0 or 1), so the configure-time call and the per-bracket data-forcing seam can both run it.

Runs where the data lives — a plain do concurrent, so it is a host loop before enter_data and a device kernel after, exactly like ocean_surface_stress_refresh_mag.

Arguments

Type IntentOptional Attributes Name
type(ocean_surface_stress_t), intent(inout) :: ss
real(kind=wp), intent(in) :: cover_frac(:,:)

Ice-cover fraction at cell centres (metrics%cover_frac, v1 binary 0/1), shape (nx_total, ny_total).

Calls

proc~~ocean_surface_stress_apply_cover~~CallsGraph proc~ocean_surface_stress_apply_cover ocean_surface_stress_apply_cover proc~ocean_surface_stress_refresh_mag ocean_surface_stress_refresh_mag proc~ocean_surface_stress_apply_cover->proc~ocean_surface_stress_refresh_mag proc~ocean_surfstress_cover_impl ocean_surfstress_cover_impl proc~ocean_surface_stress_apply_cover->proc~ocean_surfstress_cover_impl proc~ocean_surfstress_derived_impl ocean_surfstress_derived_impl proc~ocean_surface_stress_refresh_mag->proc~ocean_surfstress_derived_impl local local proc~ocean_surfstress_cover_impl->local proc~ocean_surfstress_derived_impl->local

Called by

proc~~ocean_surface_stress_apply_cover~~CalledByGraph proc~ocean_surface_stress_apply_cover ocean_surface_stress_apply_cover proc~configure_ocean_cavity configure_ocean_cavity proc~configure_ocean_cavity->proc~ocean_surface_stress_apply_cover proc~ocean_surface_stress_set_derived ocean_surface_stress_set_derived proc~ocean_surface_stress_set_derived->proc~ocean_surface_stress_apply_cover proc~engine_setup engine_setup proc~engine_setup->proc~configure_ocean_cavity proc~configure_ocean_forcing configure_ocean_forcing proc~engine_setup->proc~configure_ocean_forcing proc~ocean_data_forcing_configure ocean_data_forcing_configure proc~engine_setup->proc~ocean_data_forcing_configure proc~ocean_seam_refresh_surface_stress ocean_seam_refresh_surface_stress proc~ocean_seam_refresh_surface_stress->proc~ocean_surface_stress_set_derived proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup proc~configure_ocean_forcing->proc~ocean_seam_refresh_surface_stress proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_setup proc~engine_step engine_step proc~driver_run_ocean->proc~engine_step proc~engine_step_ice engine_step_ice proc~driver_run_ocean->proc~engine_step_ice proc~driver_validate driver_validate proc~driver_validate->proc~engine_setup proc~ice_ocean_stress_flux ice_ocean_stress_flux proc~ice_ocean_stress_flux->proc~ocean_seam_refresh_surface_stress proc~ocean_data_forcing_apply ocean_data_forcing_apply proc~ocean_data_forcing_apply->proc~ocean_seam_refresh_surface_stress proc~ocean_data_forcing_configure->proc~ocean_seam_refresh_surface_stress proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean proc~engine_step->proc~ocean_data_forcing_apply proc~engine_step_ice->proc~ice_ocean_stress_flux proc~rdb_ocean_create_finalize rdb_ocean_create_finalize proc~rdb_ocean_create_finalize->proc~complete_ocean_create proc~rdb_ocean_create_from_string rdb_ocean_create_from_string proc~rdb_ocean_create_from_string->proc~complete_ocean_create proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step proc~rdb_ocean_step->proc~engine_step_ice

Variables

Type Visibility Attributes Name Initial
integer, private :: nx
integer, private :: ny

Source Code

   pure subroutine ocean_surface_stress_apply_cover(ss, cover_frac)
      !! Zero the wind-stress pair on every C-grid face that touches an
      !! ice-covered cell, then refresh `stress_mag` from the masked
      !! pair.  The two halves are ONE call on purpose: a masked `tau`
      !! with a stale `stress_mag` would leave KPP/EPBL mixing on a wind
      !! that no longer reaches the water.
      !!
      !! FACE RULE — see the module docstring.  `open_face =
      !! min(1 - cover_left, 1 - cover_right)`, i.e. a face is closed if
      !! EITHER neighbour is covered, so no wind acts on a covered cell.
      !! A rim face (`i = 1` / `i = nx+1`, `j = 1` / `j = ny+1`) has only
      !! one neighbour in range and takes that cell's cover.
      !!
      !! Idempotent (multiplies by 0 or 1), so the configure-time call
      !! and the per-bracket data-forcing seam can both run it.
      !!
      !! **Runs where the data lives** — a plain `do concurrent`, so it
      !! is a host loop before `enter_data` and a device kernel after,
      !! exactly like `ocean_surface_stress_refresh_mag`.
      type(ocean_surface_stress_t), intent(inout) :: ss
      real(wp), intent(in) :: cover_frac(:, :)
         !! Ice-cover fraction at cell centres (`metrics%cover_frac`,
         !! v1 binary 0/1), shape `(nx_total, ny_total)`.
      ! assumed-shape-ok: configure-time / per-forcing-bracket cadence,
      ! forwarded to an explicit-shape `_impl` before any device loop.
      integer :: nx, ny

      if (.not. allocated(ss%tau_x) .or. .not. allocated(ss%tau_y)) return
      nx = size(ss%tau_x, 1) - 1
      ny = size(ss%tau_x, 2)
      ! A placeholder-sized cover (the `use_cavity = .false.` (1,1)
      ! allocation) is not a mask — refuse it rather than mask a corner.
      if (size(cover_frac, 1) /= nx .or. size(cover_frac, 2) /= ny) return
      call ocean_surfstress_cover_impl(ss%tau_x, ss%tau_y, cover_frac, nx, ny)
      call ocean_surface_stress_refresh_mag(ss)
   end subroutine ocean_surface_stress_apply_cover