seed_baroclinic_jet_ic Subroutine

public subroutine seed_baroclinic_jet_ic(state, grid, cfg, ierr)

Two-layer reduced-gravity baroclinic-instability IC — a geostrophically-balanced tanh jet in the upper (surface) layer of a spherical re-entrant channel, plus a front-localised sech² meander seed that the instability grows. Reproduces the bc_inst spec (SIM_DETAILS.md §5), mapped to Roundabout’s bottom-up layer convention (k=1 bed, k=nz surface). The spec’s layers FLIP:

  • spec upper layer 1 (the jet) → Roundabout k=2 (surface)
  • spec lower layer 2 (at rest) → Roundabout k=1 (bed)

With y = R·(φ − φ₀) (m) about the jet centre and xm = R·cosφ₀·(λ − λ_west) (m):

ξ(x,y) = Δξ·tanh(y/L) + A_pert·sech²(y/L)·cos(k_x·xm) η(y) = −(g’/g_FS)·ξ (free-surface signature) h_layer(:,:,1) = H_bed + ξ (lower, k=1) h_layer(:,:,2) = H_surf + (η − ξ) (upper, k=2) u_face_x_layer(:,:,2) = (g’/f)·(Δξ/L)·sech²(y/L) (base tanh only) u_face_x_layer(:,:,1) = 0 ; v_face_y_layer = 0

g' and g_FS are read from the SAME reduced-gravity parameters the gprime PGF consumes (cfg%ocean%pgf%gprime_gint / gprime_gfs), so the IC balance and the PGF that maintains it use one source of truth. f = 2Ω·sin(φ) is the full variable Coriolis at the u-face (T-row) latitude — NOT the scalar coriolis_f. The geostrophic jet uses the BASE tanh only; the perturbation is an unbalanced interface displacement the instability feeds on.

Requires nz_layers == 2, &ocean_pgf_nml form="gprime", and a spherical grid. Fills the FULL arrays incl. ghost rows: φ/λ are continued analytically past the physical cells, which for a periodic-x channel wraps exactly because k_x·L_x = 2π·pert_nx (integer pert_nx), so the x-ghost columns match the physical ones. Wall-y ghosts continue the smooth tanh/sech² profile.

Host-compute (deterministic, RNG-free): plain host loops writing state%multilayer BEFORE enter_data, per the setup-code convention (a do concurrent here would round-trip unmapped arrays through the device).

Arguments

Type IntentOptional Attributes Name
type(ocean_state_t), intent(inout) :: state
type(hgrid_t), intent(in) :: grid
type(config_t), intent(in) :: cfg
integer, intent(out), optional :: ierr

Non-zero on a baroclinic-jet IC configuration conflict when present; absent behaves as today (error stop).

MPI: the global physical-index offsets and the global domain extents come off grid (i_offset_global / j_offset_global, nx_global / ny_global). All four are load-bearing: the jet-centre latitude, the perturbation wavenumber AND both index→coordinate maps must describe the WHOLE domain, or every rank reproduces the entire jet inside its own tile (with pert_nx = 3, three wavelengths per TILE instead of three per DOMAIN). On a single rank the offsets are 0 and global == local, so the seed is byte-identical.


Calls

proc~~seed_baroclinic_jet_ic~~CallsGraph proc~seed_baroclinic_jet_ic seed_baroclinic_jet_ic info info proc~seed_baroclinic_jet_ic->info proc~comm_env_rank comm_env_rank proc~seed_baroclinic_jet_ic->proc~comm_env_rank proc~fail fail proc~seed_baroclinic_jet_ic->proc~fail proc~seed_tracer_uniform_impl seed_tracer_uniform_impl proc~seed_baroclinic_jet_ic->proc~seed_tracer_uniform_impl to_string to_string proc~seed_baroclinic_jet_ic->to_string error error proc~fail->error proc~error_ring_push error_ring_push proc~fail->proc~error_ring_push

Called by

proc~~seed_baroclinic_jet_ic~~CalledByGraph proc~seed_baroclinic_jet_ic seed_baroclinic_jet_ic proc~ocean_state_seed_from_cfg ocean_state_seed_from_cfg proc~ocean_state_seed_from_cfg->proc~seed_baroclinic_jet_ic proc~engine_setup engine_setup proc~engine_setup->proc~ocean_state_seed_from_cfg proc~complete_ocean_create complete_ocean_create proc~complete_ocean_create->proc~engine_setup 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~driver_run driver_run proc~driver_run->proc~driver_run_ocean 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 :: H_bed
real(kind=wp), private :: H_surf
real(kind=wp), private :: H_total
real(kind=wp), private :: Lx
real(kind=wp), private :: a_pert
real(kind=wp), private :: cos_phi0
real(kind=wp), private :: dlat
real(kind=wp), private :: dlon
real(kind=wp), private :: dxi
real(kind=wp), private :: eta_local
real(kind=wp), private :: f_u
real(kind=wp), private :: g_fs
real(kind=wp), private :: gprime
integer, private :: i
integer, private :: idx_S
integer, private :: idx_T
integer, private :: ioff
integer, private :: j
real(kind=wp), private :: jet_L
integer, private :: joff
integer, private :: k
real(kind=wp), private :: kx
real(kind=wp), private :: lam_deg
real(kind=wp), private :: lat_south
real(kind=wp), private :: lon_west
integer, private :: ng
integer, private :: nx_total
integer, private :: nxg
integer, private :: ny_total
integer, private :: nyg
integer, private :: nz_ml
real(kind=wp), private :: omega
real(kind=wp), private :: phi
real(kind=wp), private :: phi0
real(kind=wp), private :: rad_earth
real(kind=wp), private :: sech2
real(kind=wp), private :: tanh_y
real(kind=wp), private :: u_jet
real(kind=wp), private :: xi_full
real(kind=wp), private :: xm
real(kind=wp), private :: y_arg

Source Code

   subroutine seed_baroclinic_jet_ic(state, grid, cfg, ierr)
      !! Two-layer reduced-gravity baroclinic-instability IC — a
      !! geostrophically-balanced tanh jet in the upper (surface) layer of
      !! a spherical re-entrant channel, plus a front-localised sech²
      !! meander seed that the instability grows.  Reproduces the `bc_inst`
      !! spec (SIM_DETAILS.md §5), mapped to Roundabout's bottom-up layer
      !! convention (k=1 bed, k=nz surface).  The spec's layers FLIP:
      !!
      !!   * spec upper layer 1 (the jet) → Roundabout k=2 (surface)
      !!   * spec lower layer 2 (at rest) → Roundabout k=1 (bed)
      !!
      !! With `y = R·(φ − φ₀)` (m) about the jet centre and
      !! `xm = R·cosφ₀·(λ − λ_west)` (m):
      !!
      !!   ξ(x,y) = Δξ·tanh(y/L) + A_pert·sech²(y/L)·cos(k_x·xm)
      !!   η(y)   = −(g'/g_FS)·ξ                       (free-surface signature)
      !!   h_layer(:,:,1) = H_bed  + ξ                 (lower, k=1)
      !!   h_layer(:,:,2) = H_surf + (η − ξ)           (upper, k=2)
      !!   u_face_x_layer(:,:,2) = (g'/f)·(Δξ/L)·sech²(y/L)  (base tanh only)
      !!   u_face_x_layer(:,:,1) = 0 ;  v_face_y_layer = 0
      !!
      !! `g'` and `g_FS` are read from the SAME reduced-gravity parameters
      !! the gprime PGF consumes (`cfg%ocean%pgf%gprime_gint` /
      !! `gprime_gfs`), so the IC balance and the PGF that maintains it use
      !! one source of truth.  `f = 2Ω·sin(φ)` is the full variable
      !! Coriolis at the u-face (T-row) latitude — NOT the scalar
      !! `coriolis_f`.  The geostrophic jet uses the BASE tanh only; the
      !! perturbation is an unbalanced interface displacement the
      !! instability feeds on.
      !!
      !! Requires `nz_layers == 2`, `&ocean_pgf_nml form="gprime"`, and a
      !! spherical grid.  Fills the FULL arrays incl. ghost rows: φ/λ are
      !! continued analytically past the physical cells, which for a
      !! periodic-x channel wraps exactly because `k_x·L_x = 2π·pert_nx`
      !! (integer `pert_nx`), so the x-ghost columns match the physical
      !! ones.  Wall-y ghosts continue the smooth tanh/sech² profile.
      !!
      !! Host-compute (deterministic, RNG-free): plain host loops writing
      !! `state%multilayer` BEFORE `enter_data`, per the setup-code
      !! convention (a `do concurrent` here would round-trip unmapped
      !! arrays through the device).
      type(ocean_state_t), intent(inout) :: state
      type(hgrid_t), intent(in) :: grid
      type(config_t), intent(in) :: cfg
      integer, intent(out), optional :: ierr
         !! Non-zero on a baroclinic-jet IC configuration conflict when
         !! present; absent behaves as today (`error stop`).
      !!
      !! MPI: the global physical-index offsets and the global domain
      !! extents come off `grid` (`i_offset_global` / `j_offset_global`,
      !! `nx_global` / `ny_global`).  All four are load-bearing: the
      !! jet-centre latitude, the perturbation wavenumber AND both
      !! index→coordinate maps must describe the WHOLE domain, or every
      !! rank reproduces the entire jet inside its own tile (with
      !! `pert_nx = 3`, three wavelengths per TILE instead of three per
      !! DOMAIN).  On a single rank the offsets are 0 and global == local,
      !! so the seed is byte-identical.

      integer :: i, j, k, nx_total, ny_total, nz_ml, ng
      integer :: idx_S, idx_T
      integer :: ioff, joff, nxg, nyg
      real(wp) :: gprime, g_fs, H_total, H_surf, H_bed
      real(wp) :: jet_L, dxi, a_pert, kx, phi0, cos_phi0, Lx
      real(wp) :: rad_earth, omega, lon_west, lat_south, dlon, dlat
      real(wp) :: phi, y_arg, tanh_y, sech2, f_u, u_jet
      real(wp) :: lam_deg, xm, xi_full, eta_local

      nz_ml = state%multilayer%nz_ml
      if (nz_ml /= 2) then
         call fail("seed_baroclinic_jet_ic: requires nz_layers == 2 "// &
                   "(two-layer reduced gravity); got "//to_string(nz_ml), ierr, OCEAN_STATUS_ERR_IC_SEED)
         return
      end if
      if (trim(cfg%ocean%pgf%form) /= "gprime") then
         call fail("seed_baroclinic_jet_ic: requires &ocean_pgf_nml "// &
                   "form='gprime'; got '"//trim(cfg%ocean%pgf%form)//"'", ierr, OCEAN_STATUS_ERR_IC_SEED)
         return
      end if
      if (trim(cfg%ocean%grid%grid_config) /= "spherical") then
         call fail("seed_baroclinic_jet_ic: requires &ocean_grid_nml "// &
                   "grid_config='spherical'; got '"// &
                   trim(cfg%ocean%grid%grid_config)//"'", ierr, OCEAN_STATUS_ERR_IC_SEED)
         return
      end if
      if (cfg%ocean%grid%omega <= 0.0_wp) then
         call fail("seed_baroclinic_jet_ic: requires &ocean_grid_nml "// &
                   "omega > 0 (planetary Coriolis f = 2*Omega*sin(phi))", ierr, OCEAN_STATUS_ERR_IC_SEED)
         return
      end if

      nx_total = grid%nx_total
      ny_total = grid%ny_total
      ng = grid%nghost

      ! Reduced-gravity parameters — read from the gprime PGF's own config
      ! (single source of truth for g' and the free-surface gravity g_FS).
      gprime = cfg%ocean%pgf%gprime_gint
      g_fs = cfg%ocean%pgf%gprime_gfs

      ! Rest layer split: upper (surface, k=2) H_surf; lower (bed, k=1) H_bed.
      H_total = cfg%ocean%topo%max_depth
      H_surf = cfg%ocean%ic%upper_layer_rest
      H_bed = H_total - H_surf
      if (H_surf <= 0.0_wp .or. H_bed <= 0.0_wp) then
         call fail("seed_baroclinic_jet_ic: upper_layer_rest ("// &
                   to_string(H_surf)//" m) must lie in (0, max_depth="// &
                   to_string(H_total)//" m)", ierr, OCEAN_STATUS_ERR_IC_SEED)
         return
      end if

      ioff = grid%i_offset_global
      joff = grid%j_offset_global
      nxg = grid%nx_global
      nyg = grid%ny_global

      jet_L = cfg%ocean%ic%jet_half_width
      dxi = cfg%ocean%ic%interface_amp
      a_pert = cfg%ocean%ic%pert_amp_frac*dxi

      ! Spherical geometry.  dx/dy are dlon/dlat in DEGREES for spherical.
      rad_earth = cfg%ocean%grid%rad_earth
      omega = cfg%ocean%grid%omega
      lon_west = cfg%ocean%grid%lon_west
      lat_south = cfg%ocean%grid%lat_south
      dlon = grid%dx
      dlat = grid%dy
      ! Jet-centre latitude = domain centre; φ = (lat_south + ny/2·dlat).
      phi0 = (lat_south + 0.5_wp*real(nyg, wp)*dlat)*DEG2RAD
      cos_phi0 = cos(phi0)

      ! Zonal perturbation wavenumber.  L_x = R·cosφ₀·(lon span, rad);
      ! integer pert_nx ⇒ k_x·L_x = 2π·pert_nx makes the x-continuation
      ! periodic (ghost columns match the physical wrap).
      Lx = rad_earth*cos_phi0*(real(nxg, wp)*dlon*DEG2RAD)
      kx = TWO_PI*real(cfg%ocean%ic%pert_nx, wp)/Lx

      ! ---- h_layer (cell centres), full array incl. ghosts ----
      do j = 1, ny_total
         phi = (lat_south + (real(j - ng + joff, wp) - 0.5_wp)*dlat)*DEG2RAD
         y_arg = rad_earth*(phi - phi0)/jet_L
         tanh_y = tanh(y_arg)
         sech2 = 1.0_wp/cosh(y_arg)**2
         do i = 1, nx_total
            lam_deg = lon_west + (real(i - ng + ioff, wp) - 0.5_wp)*dlon
            xm = rad_earth*cos_phi0*((lam_deg - lon_west)*DEG2RAD)
            xi_full = dxi*tanh_y + a_pert*sech2*cos(kx*xm)
            eta_local = -(gprime/g_fs)*xi_full
            state%multilayer%h_layer(i, j, 1) = H_bed + xi_full            ! lower (bed)
            state%multilayer%h_layer(i, j, 2) = H_surf + (eta_local - xi_full)  ! upper (surface)
         end do
      end do

      ! ---- balanced zonal jet on the upper-layer u-faces (row-only) ----
      ! u depends on the T-row latitude only (base tanh; NOT the pert).  The
      ! u-face shares its T-row's latitude, so f = 2Ω·sin(φ_row).  Lower
      ! layer + all v-faces stay at rest.
      state%multilayer%u_face_x_layer = 0.0_wp
      state%multilayer%v_face_y_layer = 0.0_wp
      do j = 1, ny_total
         phi = (lat_south + (real(j - ng + joff, wp) - 0.5_wp)*dlat)*DEG2RAD
         y_arg = rad_earth*(phi - phi0)/jet_L
         sech2 = 1.0_wp/cosh(y_arg)**2
         f_u = 2.0_wp*omega*sin(phi)
         u_jet = (gprime/f_u)*(dxi/jet_L)*sech2
         do i = 1, nx_total + 1
            state%multilayer%u_face_x_layer(i, j, 2) = u_jet
         end do
      end do

      ! ---- hu on x-faces: u · face-interpolated h (mirror seed_eady_ic) ----
      ! u_face/h_layer are staggered (nx+1 faces vs nx cells); end faces take
      ! the adjacent cell.  Lower layer u=0 ⇒ hu=0.  hv stays zero (v=0).
      state%multilayer%hv_face_y_layer = 0.0_wp
      do k = 1, nz_ml
         associate (uf => state%multilayer%u_face_x_layer, &
                    hl => state%multilayer%h_layer, &
                    huf => state%multilayer%hu_face_x_layer)
            huf(1, :, k) = uf(1, :, k)*hl(1, :, k)
            huf(2:nx_total, :, k) = uf(2:nx_total, :, k) &
                                    *0.5_wp*(hl(1:nx_total - 1, :, k) + hl(2:nx_total, :, k))
            huf(nx_total + 1, :, k) = uf(nx_total + 1, :, k)*hl(nx_total, :, k)
         end associate
      end do

      ! ---- re-seed S/T uniform against the new h_layer ----
      ! The default seed set hTr = const·h_layer against the OLD uniform
      ! split; refresh so hTr/h_layer stays at the configured scalars.
      idx_S = state%multilayer%idx_salinity
      idx_T = state%multilayer%idx_temperature
      if (idx_S > 0) then
         call seed_tracer_uniform_impl( &
            state%multilayer%tracers(idx_S)%hTr, &
            state%multilayer%h_layer, cfg%initial_salinity, nz_ml)
      end if
      if (idx_T > 0) then
         call seed_tracer_uniform_impl( &
            state%multilayer%tracers(idx_T)%hTr, &
            state%multilayer%h_layer, cfg%initial_temperature, nz_ml)
      end if

      if (comm_env_rank() == 0) then
         call logger%info("seed_baroclinic_jet_ic: 2-layer reduced-gravity jet — "// &
                          "L="//to_string(jet_L)//" m, dxi="//to_string(dxi)// &
                          " m, g'="//to_string(gprime)//" m/s^2, H_surf="// &
                          to_string(H_surf)//" m, H_bed="//to_string(H_bed)// &
                          " m, n_x="//to_string(cfg%ocean%ic%pert_nx))
      end if
      if (present(ierr)) ierr = OCEAN_STATUS_OK
   end subroutine seed_baroclinic_jet_ic