ocean_obc_apply_baroclinic Subroutine

public subroutine ocean_obc_apply_baroclinic(grid, bc, bt_work, ms, dt)

Set per-layer normal velocity at open-ish faces after apply_bt_correction. Scheme via bc%radiation_scheme: RAD_ANOMALY (0, default): Flather mean + zero-gradient anomaly. RAD_ORLANSKI (1): per-layer implicit-upwind radiation (Orlanski 1976), running-mean phase speed rx; u_prev snapshot refreshed at END so cold-start (u_prev=0) sees rx=0 for a quiescent IC. Optional nudging (Marchesiello et al. 2001) composes AFTER either scheme when the selected tau > 0, toward the edge clamped_u/v: tau_in when incoming (dhdt·dhdx ≤ 0 Orlanski; outward vel ≤ 0 anomaly), else tau_out. CLAMPED: u_layer(wall) = clamped_u, all layers. No-op when no edge is open-ish.

Arguments

Type IntentOptional Attributes Name
type(hgrid_t), intent(in) :: grid
type(ocean_bc_state_t), intent(inout) :: bc
type(barotropic_workstate_t), intent(in) :: bt_work
type(multilayer_state_t), intent(inout) :: ms
real(kind=wp), intent(in) :: dt

Outer baroclinic timestep (seconds). Needed for nudging and Orlanski rx.

Calls

proc~~ocean_obc_apply_baroclinic~~CallsGraph proc~ocean_obc_apply_baroclinic ocean_obc_apply_baroclinic proc~apply_clamped_meridional_north apply_clamped_meridional_north proc~ocean_obc_apply_baroclinic->proc~apply_clamped_meridional_north proc~apply_clamped_meridional_south apply_clamped_meridional_south proc~ocean_obc_apply_baroclinic->proc~apply_clamped_meridional_south proc~apply_clamped_zonal_east apply_clamped_zonal_east proc~ocean_obc_apply_baroclinic->proc~apply_clamped_zonal_east proc~apply_clamped_zonal_west apply_clamped_zonal_west proc~ocean_obc_apply_baroclinic->proc~apply_clamped_zonal_west proc~apply_meridional_baroclinic apply_meridional_baroclinic proc~ocean_obc_apply_baroclinic->proc~apply_meridional_baroclinic proc~apply_nudge_meridional_north apply_nudge_meridional_north proc~ocean_obc_apply_baroclinic->proc~apply_nudge_meridional_north proc~apply_nudge_meridional_south apply_nudge_meridional_south proc~ocean_obc_apply_baroclinic->proc~apply_nudge_meridional_south proc~apply_nudge_zonal_east apply_nudge_zonal_east proc~ocean_obc_apply_baroclinic->proc~apply_nudge_zonal_east proc~apply_nudge_zonal_west apply_nudge_zonal_west proc~ocean_obc_apply_baroclinic->proc~apply_nudge_zonal_west proc~apply_orlanski_east apply_orlanski_east proc~ocean_obc_apply_baroclinic->proc~apply_orlanski_east proc~apply_orlanski_north apply_orlanski_north proc~ocean_obc_apply_baroclinic->proc~apply_orlanski_north proc~apply_orlanski_south apply_orlanski_south proc~ocean_obc_apply_baroclinic->proc~apply_orlanski_south proc~apply_orlanski_west apply_orlanski_west proc~ocean_obc_apply_baroclinic->proc~apply_orlanski_west proc~apply_zonal_baroclinic apply_zonal_baroclinic proc~ocean_obc_apply_baroclinic->proc~apply_zonal_baroclinic proc~fill_uv_layer_ghosts fill_uv_layer_ghosts proc~ocean_obc_apply_baroclinic->proc~fill_uv_layer_ghosts proc~is_open_ish is_open_ish proc~ocean_obc_apply_baroclinic->proc~is_open_ish proc~is_radiating is_radiating proc~ocean_obc_apply_baroclinic->proc~is_radiating proc~snapshot_u_prev_east snapshot_u_prev_east proc~ocean_obc_apply_baroclinic->proc~snapshot_u_prev_east proc~snapshot_u_prev_west snapshot_u_prev_west proc~ocean_obc_apply_baroclinic->proc~snapshot_u_prev_west proc~snapshot_v_prev_north snapshot_v_prev_north proc~ocean_obc_apply_baroclinic->proc~snapshot_v_prev_north proc~snapshot_v_prev_south snapshot_v_prev_south proc~ocean_obc_apply_baroclinic->proc~snapshot_v_prev_south proc~apply_meridional_baroclinic->proc~is_radiating local local proc~apply_meridional_baroclinic->local proc~apply_nudge_meridional_north->local proc~apply_nudge_meridional_south->local proc~apply_nudge_zonal_east->local proc~apply_nudge_zonal_west->local proc~apply_orlanski_east->local proc~apply_orlanski_north->local proc~apply_orlanski_south->local proc~apply_orlanski_west->local proc~apply_zonal_baroclinic->proc~is_radiating proc~apply_zonal_baroclinic->local proc~open_ghost_fill_edge open_ghost_fill_edge proc~fill_uv_layer_ghosts->proc~open_ghost_fill_edge

Called by

proc~~ocean_obc_apply_baroclinic~~CalledByGraph proc~ocean_obc_apply_baroclinic ocean_obc_apply_baroclinic proc~run_stage_split run_stage_split proc~run_stage_split->proc~ocean_obc_apply_baroclinic proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_stage_split proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
logical, private :: any_open
integer, private :: bc_e
integer, private :: bc_n
integer, private :: bc_s
integer, private :: bc_w
integer, private :: i_e
integer, private :: i_w
integer, private :: j_n
integer, private :: j_s
integer, private :: nx
integer, private :: nxt
integer, private :: ny
integer, private :: nyt
integer, private :: nz
integer, private :: rad_scheme

Source Code

   subroutine ocean_obc_apply_baroclinic(grid, bc, bt_work, ms, dt)
      !! Set per-layer normal velocity at open-ish faces after
      !! `apply_bt_correction`.  Scheme via `bc%radiation_scheme`:
      !!   RAD_ANOMALY (0, default): Flather mean + zero-gradient anomaly.
      !!   RAD_ORLANSKI (1): per-layer implicit-upwind radiation (Orlanski 1976),
      !!     running-mean phase speed `rx`; `u_prev` snapshot refreshed at END
      !!     so cold-start (u_prev=0) sees rx=0 for a quiescent IC.
      !! Optional nudging (Marchesiello et al. 2001) composes AFTER either
      !! scheme when the selected tau > 0, toward the edge `clamped_u/v`:
      !! tau_in when incoming (dhdt·dhdx ≤ 0 Orlanski; outward vel ≤ 0 anomaly),
      !! else tau_out.  CLAMPED: u_layer(wall) = clamped_u, all layers.
      !! No-op when no edge is open-ish.
      type(hgrid_t), intent(in) :: grid
      type(ocean_bc_state_t), intent(inout) :: bc
      type(barotropic_workstate_t), intent(in) :: bt_work
      type(multilayer_state_t), intent(inout) :: ms
      real(wp), intent(in) :: dt
         !! Outer baroclinic timestep (seconds).  Needed for nudging and Orlanski rx.

      integer :: bc_w, bc_e, bc_s, bc_n
      logical :: any_open
      integer :: i_w, i_e, j_s, j_n
      integer :: nz, nx, ny, nxt, nyt
      integer :: rad_scheme

      bc_w = bc%west%bc_type
      bc_e = bc%east%bc_type
      bc_s = bc%south%bc_type
      bc_n = bc%north%bc_type
      ! MPI-seam neutralisation (O0): a seam edge carries no physical BC.
      ! WALL is a no-op throughout this routine (verified: all dispatch is
      ! guarded by is_open_ish/is_radiating, neither of which includes
      ! OBC_WALL), so remapping the cached tag makes every per-edge block
      ! skip the seam.
      if (.not. bc%has_west) bc_w = OBC_WALL
      if (.not. bc%has_east) bc_e = OBC_WALL
      if (.not. bc%has_south) bc_s = OBC_WALL
      if (.not. bc%has_north) bc_n = OBC_WALL

      any_open = is_open_ish(bc_w) .or. is_open_ish(bc_e) .or. &
                 is_open_ish(bc_s) .or. is_open_ish(bc_n)
      if (.not. any_open) return

      nz = ms%nz_ml
      nxt = grid%nx_total
      nyt = grid%ny_total
      nx = grid%nx_phys
      ny = grid%ny_phys
      rad_scheme = bc%radiation_scheme

      ! Physical wall-face indices (u_face_x is nx_total+1 wide).
      i_w = grid%nghost + 1
      i_e = grid%nghost + nx + 1
      j_s = grid%nghost + 1
      j_n = grid%nghost + ny + 1

      if (rad_scheme == RAD_ORLANSKI) then
         ! ---- Orlanski per-layer radiation ----
         ! Zonal edges
         if (is_radiating(bc_w) .and. allocated(bc%rx_west)) then
            call apply_orlanski_west(ms%u_face_x_layer, &
                                     bc%rx_west, bc%u_prev_west, &
                                     nxt, nyt, nz, i_w, j_s, j_n, &
                                     bc%orlanski_rx_max, bc%orlanski_gamma, &
                                     bc%nudge_tau_in, bc%nudge_tau_out, &
                                     dt, bc%west%clamped_u)
         else if (bc_w == OBC_CLAMPED) then
            call apply_clamped_zonal_west(ms%u_face_x_layer, nxt, nyt, nz, i_w, j_s, j_n, &
                                          bc%west%clamped_u)
         end if
         if (is_radiating(bc_e) .and. allocated(bc%rx_east)) then
            call apply_orlanski_east(ms%u_face_x_layer, &
                                     bc%rx_east, bc%u_prev_east, &
                                     nxt, nyt, nz, i_e, j_s, j_n, &
                                     bc%orlanski_rx_max, bc%orlanski_gamma, &
                                     bc%nudge_tau_in, bc%nudge_tau_out, &
                                     dt, bc%east%clamped_u)
         else if (bc_e == OBC_CLAMPED) then
            call apply_clamped_zonal_east(ms%u_face_x_layer, nxt, nyt, nz, i_e, j_s, j_n, &
                                          bc%east%clamped_u)
         end if
         ! Meridional edges
         if (is_radiating(bc_s) .and. allocated(bc%rx_south)) then
            call apply_orlanski_south(ms%v_face_y_layer, &
                                      bc%rx_south, bc%u_prev_south, &
                                      nxt, nyt, nz, j_s, i_w, i_e - 1, &
                                      bc%orlanski_rx_max, bc%orlanski_gamma, &
                                      bc%nudge_tau_in, bc%nudge_tau_out, &
                                      dt, bc%south%clamped_v)
         else if (bc_s == OBC_CLAMPED) then
            call apply_clamped_meridional_south(ms%v_face_y_layer, nxt, nyt, nz, j_s, i_w, i_e - 1, &
                                                bc%south%clamped_v)
         end if
         if (is_radiating(bc_n) .and. allocated(bc%rx_north)) then
            call apply_orlanski_north(ms%v_face_y_layer, &
                                      bc%rx_north, bc%u_prev_north, &
                                      nxt, nyt, nz, j_n, i_w, i_e - 1, &
                                      bc%orlanski_rx_max, bc%orlanski_gamma, &
                                      bc%nudge_tau_in, bc%nudge_tau_out, &
                                      dt, bc%north%clamped_v)
         else if (bc_n == OBC_CLAMPED) then
            call apply_clamped_meridional_north(ms%v_face_y_layer, nxt, nyt, nz, j_n, i_w, i_e - 1, &
                                                bc%north%clamped_v)
         end if

         ! Refresh u_prev snapshots (first-interior-face normal velocity).
         ! Done AFTER all four edge updates so the current call's u_new is
         ! consistent with what the next call will see.
         if (allocated(bc%u_prev_west)) then
            call snapshot_u_prev_west(ms%u_face_x_layer, bc%u_prev_west, &
                                      nxt, nyt, nz, i_w, j_s, j_n)
         end if
         if (allocated(bc%u_prev_east)) then
            call snapshot_u_prev_east(ms%u_face_x_layer, bc%u_prev_east, &
                                      nxt, nyt, nz, i_e, j_s, j_n)
         end if
         if (allocated(bc%u_prev_south)) then
            call snapshot_v_prev_south(ms%v_face_y_layer, bc%u_prev_south, &
                                       nxt, nyt, nz, j_s, i_w, i_e - 1)
         end if
         if (allocated(bc%u_prev_north)) then
            call snapshot_v_prev_north(ms%v_face_y_layer, bc%u_prev_north, &
                                       nxt, nyt, nz, j_n, i_w, i_e - 1)
         end if

      else
         ! ---- Anomaly scheme (default) ----
         ! ---- Zonal open faces (west / east) ----
         if (is_open_ish(bc_w) .or. is_open_ish(bc_e)) then
            call apply_zonal_baroclinic(ms%u_face_x_layer, &
                                        ms%h_layer, &
                                        bt_work%bt_ubt_end, &
                                        nxt, nyt, nz, &
                                        i_w, i_e, j_s, j_n, &
                                        bc_w, bc_e, &
                                        bc%west%clamped_u, bc%east%clamped_u)
         end if

         ! ---- Meridional open faces (south / north) ----
         if (is_open_ish(bc_s) .or. is_open_ish(bc_n)) then
            call apply_meridional_baroclinic(ms%v_face_y_layer, &
                                             ms%h_layer, &
                                             bt_work%bt_vbt_end, &
                                             nxt, nyt, nz, &
                                             i_w, i_e - 1, j_s, j_n, &
                                             bc_s, bc_n, &
                                             bc%south%clamped_v, bc%north%clamped_v)
         end if

         ! ---- Anomaly-scheme nudging (Marchesiello et al. 2001) ----
         ! Applied when either tau > 0.  Sign convention for "incoming":
         ! anomaly scheme uses the outward velocity sign:
         !   west  inflow: u_wall(i_w) > 0  → incoming
         !   east  inflow: u_wall(i_e) < 0  → incoming
         !   south inflow: v_wall(j_s) > 0  → incoming
         !   north inflow: v_wall(j_n) < 0  → incoming
         if (bc%nudge_tau_in > 0.0_wp .or. bc%nudge_tau_out > 0.0_wp) then
            if (is_radiating(bc_w)) then
               call apply_nudge_zonal_west(ms%u_face_x_layer, &
                                           nxt, nyt, nz, i_w, j_s, j_n, &
                                           bc%nudge_tau_in, bc%nudge_tau_out, &
                                           dt, bc%west%clamped_u)
            end if
            if (is_radiating(bc_e)) then
               call apply_nudge_zonal_east(ms%u_face_x_layer, &
                                           nxt, nyt, nz, i_e, j_s, j_n, &
                                           bc%nudge_tau_in, bc%nudge_tau_out, &
                                           dt, bc%east%clamped_u)
            end if
            if (is_radiating(bc_s)) then
               call apply_nudge_meridional_south(ms%v_face_y_layer, &
                                                 nxt, nyt, nz, j_s, i_w, i_e - 1, &
                                                 bc%nudge_tau_in, bc%nudge_tau_out, &
                                                 dt, bc%south%clamped_v)
            end if
            if (is_radiating(bc_n)) then
               call apply_nudge_meridional_north(ms%v_face_y_layer, &
                                                 nxt, nyt, nz, j_n, i_w, i_e - 1, &
                                                 bc%nudge_tau_in, bc%nudge_tau_out, &
                                                 dt, bc%north%clamped_v)
            end if
         end if
      end if

      ! Zero-gradient fill of the per-layer VELOCITY ghosts incl. ghost×ghost
      ! corners: the corner-adjacent C-grid Coriolis/KE/vorticity stencil reads
      ! the diagonal corner ghost, so unfilled corner garbage blows up (open-edge
      ! NaN).  x-then-y; cross-axis range clipped to physical span unless the
      ! adjacent edge is also open, keeping WALL/PERIODIC ghosts untouched.
      call fill_uv_layer_ghosts(ms%u_face_x_layer, ms%v_face_y_layer, &
                                nxt, nyt, nz, grid%nghost, nx, ny, &
                                bc_w, bc_e, bc_s, bc_n)
   end subroutine ocean_obc_apply_baroclinic