ocean_surfstress_cover_impl Subroutine

private pure subroutine ocean_surfstress_cover_impl(tau_x, tau_y, cover_frac, nx, ny)

Flat do concurrent kernel behind ocean_surface_stress_apply_cover — explicit-shape dummies, integer dims first (decl-order, ifx

8586).

THIS IS top_drag_fill_face_cover_impl‘S RULE, APPLIED IN PLACE. The face projection is stated once, in rdb_ocean_top_drag’s module docstring (§ The FACE cover rule), and there are two implementations of it only because one fills face ARRAYS the drag kernel reads per step and the other multiplies tau in place at configure — materialising two more face arrays here, in a slot that exists whether or not there is a cavity, to then throw them away, is the worse trade. They are kept identical by a TEST (cavity_cover_face_rule_matches_top_drag), which is the same way mirror_of_bottom_drag keeps the top and bottom drag one closure rather than two. Both halves of the rule matter:

  • interior faces take the OR, max(cover(i-1,j), cover(i,j)), so the CALVING-FRONT face is closed to the wind exactly where it is opened to the drag;
  • RIM faces (i = 1, i = nx+1, j = 1, j = ny+1) are left UNTOUCHED, because they have only one neighbour in range. Inventing a one-sided cover there would (a) disagree with the drag’s cover_u = 0 and (b) clobber a periodic tau ghost that the halo seam had already wrapped — this routine runs AFTER ocean_seam_refresh_surface_stress. Those faces carry no prognostic velocity, so leaving them alone is not an approximation.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(inout) :: tau_x(nx+1,ny)
real(kind=wp), intent(inout) :: tau_y(nx,ny+1)
real(kind=wp), intent(in) :: cover_frac(nx,ny)
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ocean_surfstress_cover_impl~~CallsGraph proc~ocean_surfstress_cover_impl ocean_surfstress_cover_impl local local proc~ocean_surfstress_cover_impl->local

Called by

proc~~ocean_surfstress_cover_impl~~CalledByGraph proc~ocean_surfstress_cover_impl ocean_surfstress_cover_impl proc~ocean_surface_stress_apply_cover ocean_surface_stress_apply_cover proc~ocean_surface_stress_apply_cover->proc~ocean_surfstress_cover_impl 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~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 engine_step proc~engine_step->proc~ocean_data_forcing_apply proc~engine_step_ice engine_step_ice 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

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: cov
integer, private :: i
integer, private :: j

Source Code

   pure subroutine ocean_surfstress_cover_impl(tau_x, tau_y, cover_frac, nx, ny)
      !! Flat `do concurrent` kernel behind `ocean_surface_stress_apply_cover`
      !! — explicit-shape dummies, integer dims first (decl-order, ifx
      !! #8586).
      !!
      !! THIS IS `top_drag_fill_face_cover_impl`'S RULE, APPLIED IN PLACE.
      !! The face projection is stated once, in `rdb_ocean_top_drag`'s
      !! module docstring (§ The FACE cover rule), and there are two
      !! implementations of it only because one fills face ARRAYS the drag
      !! kernel reads per step and the other multiplies `tau` in place at
      !! configure — materialising two more face arrays here, in a slot
      !! that exists whether or not there is a cavity, to then throw them
      !! away, is the worse trade.  They are kept identical by a TEST
      !! (`cavity_cover_face_rule_matches_top_drag`), which is the same
      !! way `mirror_of_bottom_drag` keeps the top and bottom drag one
      !! closure rather than two.  Both halves of the rule matter:
      !!
      !!   * interior faces take the OR, `max(cover(i-1,j), cover(i,j))`,
      !!     so the CALVING-FRONT face is closed to the wind exactly where
      !!     it is opened to the drag;
      !!   * RIM faces (`i = 1`, `i = nx+1`, `j = 1`, `j = ny+1`) are left
      !!     UNTOUCHED, because they have only one neighbour in range.
      !!     Inventing a one-sided cover there would (a) disagree with the
      !!     drag's `cover_u = 0` and (b) clobber a periodic `tau` ghost
      !!     that the halo seam had already wrapped — this routine runs
      !!     AFTER `ocean_seam_refresh_surface_stress`.  Those faces carry
      !!     no prognostic velocity, so leaving them alone is not an
      !!     approximation.
      integer, intent(in)    :: nx, ny
      real(wp), intent(inout) :: tau_x(nx + 1, ny), tau_y(nx, ny + 1)
      real(wp), intent(in)    :: cover_frac(nx, ny)
      integer :: i, j
      real(wp) :: cov
      do concurrent(j=1:ny, i=2:nx) local(cov)
         cov = max(cover_frac(i - 1, j), cover_frac(i, j))
         tau_x(i, j) = tau_x(i, j)*(1.0_wp - cov)
      end do
      do concurrent(j=2:ny, i=1:nx) local(cov)
         cov = max(cover_frac(i, j - 1), cover_frac(i, j))
         tau_y(i, j) = tau_y(i, j)*(1.0_wp - cov)
      end do
   end subroutine ocean_surfstress_cover_impl