MOM_barotropic.F90

!> Baropotric solver
module mom_barotropic
 
! This file is part of MOM6. See LICENSE.md for the license.
 
use mom_debugging, only : hchksum, uvchksum
use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
use mom_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
use mom_diag_mediator, only : safe_alloc_ptr, diag_ctrl, enable_averaging
use mom_domains, only : min_across_pes, clone_mom_domain, pass_vector
use mom_domains, only : to_all, scalar_pair, agrid, corner, mom_domain_type
use mom_domains, only : create_group_pass, do_group_pass, group_pass_type
use mom_domains, only : start_group_pass, complete_group_pass, pass_var
use mom_error_handler, only : mom_error, mom_mesg, fatal, warning, is_root_pe
use mom_file_parser, only : get_param, log_param, log_version, param_file_type
use mom_forcing_type, only : mech_forcing
use mom_grid, only : ocean_grid_type
use mom_hor_index, only : hor_index_type
use mom_io, only : vardesc, var_desc, mom_read_data, slasher
use mom_open_boundary, only : ocean_obc_type, obc_simple, obc_none, open_boundary_query
use mom_open_boundary, only : obc_direction_e, obc_direction_w
use mom_open_boundary, only : obc_direction_n, obc_direction_s, obc_segment_type
use mom_restart, only : register_restart_field, query_initialized, mom_restart_cs
use mom_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_cs
use mom_time_manager, only : time_type, real_to_time, operator(+), operator(-)
use mom_unit_scaling, only : unit_scale_type
use mom_variables, only : bt_cont_type, alloc_bt_cont_type
use mom_verticalgrid, only : verticalgrid_type
 
implicit none ; private
 
#include <MOM_memory.h>
#ifdef STATIC_MEMORY_
#  ifndef BTHALO_
#    define BTHALO_ 0
#  endif
#  define WHALOI_ MAX(BTHALO_-NIHALO_,0)
#  define WHALOJ_ MAX(BTHALO_-NJHALO_,0)
#  define NIMEMW_   1-WHALOI_:NIMEM_+WHALOI_
#  define NJMEMW_   1-WHALOJ_:NJMEM_+WHALOJ_
#  define NIMEMBW_  -WHALOI_:NIMEM_+WHALOI_
#  define NJMEMBW_  -WHALOJ_:NJMEM_+WHALOJ_
#  define SZIW_(G)  NIMEMW_
#  define SZJW_(G)  NJMEMW_
#  define SZIBW_(G) NIMEMBW_
#  define SZJBW_(G) NJMEMBW_
#else
#  define NIMEMW_   :
#  define NJMEMW_   :
#  define NIMEMBW_  :
#  define NJMEMBW_  :
#  define SZIW_(G)  G%isdw:G%iedw
#  define SZJW_(G)  G%jsdw:G%jedw
#  define SZIBW_(G) G%isdw-1:G%iedw
#  define SZJBW_(G) G%jsdw-1:G%jedw
#endif
 
public btcalc, bt_mass_source, btstep, barotropic_init, barotropic_end
public register_barotropic_restarts, set_dtbt, barotropic_get_tav
 
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]".  If the units
! vary with the Boussinesq approximation, the Boussinesq variant is given first.
 
!> The barotropic stepping open boundary condition type
type, private :: bt_obc_type
  real, dimension(:,:), pointer :: cg_u => null()  !< The external wave speed at u-points [L T-1 ~> m s-1].
  real, dimension(:,:), pointer :: cg_v => null()  !< The external wave speed at u-points [L T-1 ~> m s-1].
  real, dimension(:,:), pointer :: h_u => null()   !< The total thickness at the u-points [H ~> m or kg m-2].
  real, dimension(:,:), pointer :: h_v => null()   !< The total thickness at the v-points [H ~> m or kg m-2].
  real, dimension(:,:), pointer :: uhbt => null()  !< The zonal barotropic thickness fluxes specified
                                     !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(:,:), pointer :: vhbt => null()  !< The meridional barotropic thickness fluxes specified
                                     !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(:,:), pointer :: ubt_outer => null() !< The zonal velocities just outside the domain,
                                     !! as set by the open boundary conditions [L T-1 ~> m s-1].
  real, dimension(:,:), pointer :: vbt_outer => null() !< The meridional velocities just outside the domain,
                                     !! as set by the open boundary conditions [L T-1 ~> m s-1].
  real, dimension(:,:), pointer :: eta_outer_u => null() !< The surface height outside of the domain
                                     !! at a u-point with an open boundary condition [H ~> m or kg m-2].
  real, dimension(:,:), pointer :: eta_outer_v => null() !< The surface height outside of the domain
                                     !! at a v-point with an open boundary condition [H ~> m or kg m-2].
  logical :: apply_u_obcs !< True if this PE has an open boundary at a u-point.
  logical :: apply_v_obcs !< True if this PE has an open boundary at a v-point.
  !>@{ Index ranges for the open boundary conditions
  integer :: is_u_obc, ie_u_obc, js_u_obc, je_u_obc
  integer :: is_v_obc, ie_v_obc, js_v_obc, je_v_obc
  !!@}
  logical :: is_alloced = .false. !< True if BT_OBC is in use and has been allocated
 
  type(group_pass_type) :: pass_uv   !< Structure for group halo pass
  type(group_pass_type) :: pass_uhvh !< Structure for group halo pass
  type(group_pass_type) :: pass_h    !< Structure for group halo pass
  type(group_pass_type) :: pass_cg   !< Structure for group halo pass
  type(group_pass_type) :: pass_eta_outer  !< Structure for group halo pass
end type bt_obc_type
 
!> The barotropic stepping control stucture
type, public :: barotropic_cs ; private
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu
          !< The fraction of the total column thickness interpolated to u grid points in each layer [nondim].
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv
          !< The fraction of the total column thickness interpolated to v grid points in each layer [nondim].
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_) :: idatu
          !< Inverse of the basin depth at u grid points [Z-1 ~> m-1].
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u
          !< A spatially varying linear drag coefficient acting on the zonal barotropic flow
          !! [H T-1 ~> m s-1 or kg m-2 s-1].
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_ic
          !< The barotropic solvers estimate of the zonal transport as the initial condition for
          !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg s-1].
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_ic
          !< The barotropic solvers estimate of the zonal velocity that will be the initial
          !! condition for the next call to btstep [L T-1 ~> m s-1].
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav
          !< The barotropic zonal velocity averaged over the baroclinic time step [L T-1 ~> m s-1].
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_) :: idatv
          !< Inverse of the basin depth at v grid points [Z-1 ~> m-1].
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v
          !< A spatially varying linear drag coefficient acting on the zonal barotropic flow
          !! [H T-1 ~> m s-1 or kg m-2 s-1].
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_ic
          !< The barotropic solvers estimate of the zonal transport as the initial condition for
          !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg s-1].
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_ic
          !< The barotropic solvers estimate of the zonal velocity that will be the initial
          !! condition for the next call to btstep [L T-1 ~> m s-1].
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav
          !< The barotropic meridional velocity averaged over the  baroclinic time step [L T-1 ~> m s-1].
  real allocable_, dimension(NIMEM_,NJMEM_) :: eta_cor
          !< The difference between the free surface height from the barotropic calculation and the sum
          !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic
          !! calculation over a baroclinic timestep [H ~> m or kg m-2].
  real allocable_, dimension(NIMEM_,NJMEM_) :: eta_cor_bound
          !< A limit on the rate at which eta_cor can be applied while avoiding instability
          !! [H T-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true.
  real allocable_, dimension(NIMEMW_,NJMEMW_) :: &
    ua_polarity, &  !< Test vector components for checking grid polarity.
    va_polarity, &  !< Test vector components for checking grid polarity.
    bathyt          !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m]
  real allocable_, dimension(NIMEMW_,NJMEMW_) :: iareat
                    !<   This is a copy of G%IareaT with wide halos, but will
                    !! still utilize the macro IareaT when referenced, [L-2 ~> m-2].
  real allocable_, dimension(NIMEMBW_,NJMEMW_) :: &
    d_u_cor, &      !<   A simply averaged depth at u points [Z ~> m].
    dy_cu, &        !<   A copy of G%dy_Cu with wide halos [L ~> m].
    idxcu           !<   A copy of G%IdxCu with wide halos [L-1 ~> m-1].
  real allocable_, dimension(NIMEMW_,NJMEMBW_) :: &
    d_v_cor, &      !<   A simply averaged depth at v points [Z ~> m].
    dx_cv, &        !<   A copy of G%dx_Cv with wide halos [L ~> m].
    idycv           !<   A copy of G%IdyCv with wide halos [L-1 ~> m-1].
  real allocable_, dimension(NIMEMBW_,NJMEMBW_) :: &
    q_d             !< f / D at PV points [Z-1 T-1 ~> m-1 s-1].
 
  real, dimension(:,:,:), pointer :: frhatu1 => null() !< Predictor step values of frhatu stored for diagnostics.
  real, dimension(:,:,:), pointer :: frhatv1 => null() !< Predictor step values of frhatv stored for diagnostics.
 
  type(bt_obc_type) :: bt_obc !< A structure with all of this modules fields
                              !! for applying open boundary conditions.
 
  real    :: rho0            !< The density used in the Boussinesq approximation [kg m-3].
  real    :: dtbt            !< The barotropic time step [s].
  real    :: dtbt_fraction   !<   The fraction of the maximum time-step that
                             !! should used.  The default is 0.98.
  real    :: dtbt_max        !<   The maximum stable barotropic time step [s].
  real    :: dt_bt_filter    !<   The time-scale over which the barotropic mode solutions are
                             !! filtered [T ~> s] if positive, or as a fraction of DT if
                             !! negative [nondim].  This can never be taken to be longer than 2*dt.
                             !! Set this to 0 to apply no filtering.
  integer :: nstep_last = 0  !< The number of barotropic timesteps per baroclinic
                             !! time step the last time btstep was called.
  real    :: bebt            !< A nondimensional number, from 0 to 1, that
                             !! determines the gravity wave time stepping scheme.
                             !! 0.0 gives a forward-backward scheme, while 1.0
                             !! give backward Euler. In practice, bebt should be
                             !! of order 0.2 or greater.
  logical :: split           !< If true, use the split time stepping scheme.
  logical :: bound_bt_corr   !< If true, the magnitude of the fake mass source
                             !! in the barotropic equation that drives the two
                             !! estimates of the free surface height toward each
                             !! other is bounded to avoid driving corrective
                             !! velocities that exceed MAXCFL_BT_CONT.
  logical :: gradual_bt_ics  !< If true, adjust the initial conditions for the
                             !! barotropic solver to the values from the layered
                             !! solution over a whole timestep instead of
                             !! instantly.  This is a decent approximation to the
                             !! inclusion of sum(u dh_dt) while also correcting
                             !! for truncation errors.
  logical :: sadourny        !< If true, the Coriolis terms are discretized
                             !! with Sadourny's energy conserving scheme,
                             !! otherwise the Arakawa & Hsu scheme is used.  If
                             !! the deformation radius is not resolved Sadourny's
                             !! scheme should probably be used.
  logical :: nonlinear_continuity !< If true, the barotropic continuity equation
                             !! uses the full ocean thickness for transport.
  integer :: nonlin_cont_update_period !< The number of barotropic time steps
                             !! between updates to the face area, or 0 only to
                             !! update at the start of a call to btstep.  The
                             !! default is 1.
  logical :: bt_project_velocity !< If true, step the barotropic velocity first
                             !! and project out the velocity tendency by 1+BEBT
                             !! when calculating the transport.  The default
                             !! (false) is to use a predictor continuity step to
                             !! find the pressure field, and then do a corrector
                             !! continuity step using a weighted average of the
                             !! old and new velocities, with weights of (1-BEBT)
                             !! and BEBT.
  logical :: dynamic_psurf   !< If true, add a dynamic pressure due to a viscous
                             !! ice shelf, for instance.
  real    :: dmin_dyn_psurf  !< The minimum depth to use in limiting the size
                             !! of the dynamic surface pressure for stability [Z ~> m].
  real    :: ice_strength_length  !< The length scale at which the damping rate
                             !! due to the ice strength should be the same as if
                             !! a Laplacian were applied [L ~> m].
  real    :: const_dyn_psurf !< The constant that scales the dynamic surface
                             !! pressure [nondim].  Stable values are < ~1.0.
                             !! The default is 0.9.
  logical :: tides           !< If true, apply tidal momentum forcing.
  real    :: g_extra         !< A nondimensional factor by which gtot is enhanced.
  integer :: hvel_scheme     !< An integer indicating how the thicknesses at
                             !! velocity points are calculated. Valid values are
                             !! given by the parameters defined below:
                             !!   HARMONIC, ARITHMETIC, HYBRID, and FROM_BT_CONT
  logical :: strong_drag     !< If true, use a stronger estimate of the retarding
                             !! effects of strong bottom drag.
  logical :: linear_wave_drag  !< If true, apply a linear drag to the barotropic
                             !! velocities, using rates set by lin_drag_u & _v
                             !! divided by the depth of the ocean.
  logical :: linearized_bt_pv  !< If true, the PV and interface thicknesses used
                             !! in the barotropic Coriolis calculation is time
                             !! invariant and linearized.
  logical :: use_wide_halos  !< If true, use wide halos and march in during the
                             !! barotropic time stepping for efficiency.
  logical :: clip_velocity   !< If true, limit any velocity components that are
                             !! are large enough for a CFL number to exceed
                             !! CFL_trunc.  This should only be used as a
                             !! desperate debugging measure.
  logical :: debug           !< If true, write verbose checksums for debugging purposes.
  logical :: debug_bt        !< If true, write verbose checksums for debugging purposes.
  real    :: vel_underflow   !< Velocity components smaller than vel_underflow
                             !! are set to 0 [L T-1 ~> m s-1].
  real    :: maxvel          !< Velocity components greater than maxvel are
                             !! truncated to maxvel [m s-1].
  real    :: cfl_trunc       !< If clip_velocity is true, velocity components will
                             !! be truncated when they are large enough that the
                             !! corresponding CFL number exceeds this value, nondim.
  real    :: maxcfl_bt_cont  !< The maximum permitted CFL number associated with the
                             !! barotropic accelerations from the summed velocities
                             !! times the time-derivatives of thicknesses.  The
                             !! default is 0.1, and there will probably be real
                             !! problems if this were set close to 1.
  logical :: bt_cont_bounds  !< If true, use the BT_cont_type variables to set
                             !! limits on the magnitude of the corrective mass
                             !! fluxes.
  logical :: visc_rem_u_uh0  !< If true, use the viscous remnants when estimating
                             !! the barotropic velocities that were used to
                             !! calculate uh0 and vh0.  False is probably the
                             !! better choice.
  logical :: adjust_bt_cont  !< If true, adjust the curve fit to the BT_cont type
                             !! that is used by the barotropic solver to match the
                             !! transport about which the flow is being linearized.
  logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations
                             !! that is not bitwise rotationally symmetric in the
                             !! meridional Coriolis term of the barotropic solver.
  type(time_type), pointer :: time  => null() !< A pointer to the ocean models clock.
  type(diag_ctrl), pointer :: diag => null()  !< A structure that is used to regulate
                             !! the timing of diagnostic output.
  type(mom_domain_type), pointer :: bt_domain => null()
  type(hor_index_type), pointer :: debug_bt_hi => null() !< debugging copy of horizontal index_type
  type(tidal_forcing_cs), pointer :: tides_csp => null()
  logical :: module_is_initialized = .false.
 
  integer :: isdw !< The lower i-memory limit for the wide halo arrays.
  integer :: iedw !< The upper i-memory limit for the wide halo arrays.
  integer :: jsdw !< The lower j-memory limit for the wide halo arrays.
  integer :: jedw !< The upper j-memory limit for the wide halo arrays.
 
  type(group_pass_type) :: pass_q_dcor !< Handle for a group halo pass
  type(group_pass_type) :: pass_gtot !< Handle for a group halo pass
  type(group_pass_type) :: pass_tmp_uv !< Handle for a group halo pass
  type(group_pass_type) :: pass_eta_bt_rem !< Handle for a group halo pass
  type(group_pass_type) :: pass_force_hbt0_cor_ref !< Handle for a group halo pass
  type(group_pass_type) :: pass_dat_uv !< Handle for a group halo pass
  type(group_pass_type) :: pass_eta_ubt !< Handle for a group halo pass
  type(group_pass_type) :: pass_etaav !< Handle for a group halo pass
  type(group_pass_type) :: pass_ubt_cor !< Handle for a group halo pass
  type(group_pass_type) :: pass_ubta_uhbta !< Handle for a group halo pass
  type(group_pass_type) :: pass_e_anom !< Handle for a group halo pass
 
  !>@{ Diagnostic IDs
  integer :: id_pfu_bt = -1, id_pfv_bt = -1, id_coru_bt = -1, id_corv_bt = -1
  integer :: id_ubtforce = -1, id_vbtforce = -1, id_uaccel = -1, id_vaccel = -1
  integer :: id_visc_rem_u = -1, id_visc_rem_v = -1, id_eta_cor = -1
  integer :: id_ubt = -1, id_vbt = -1, id_eta_bt = -1, id_ubtav = -1, id_vbtav = -1
  integer :: id_ubt_st = -1, id_vbt_st = -1, id_eta_st = -1
  integer :: id_ubt_hifreq = -1, id_vbt_hifreq = -1, id_eta_hifreq = -1
  integer :: id_uhbt_hifreq = -1, id_vhbt_hifreq = -1, id_eta_pred_hifreq = -1
  integer :: id_gtotn = -1, id_gtots = -1, id_gtote = -1, id_gtotw = -1
  integer :: id_uhbt = -1, id_frhatu = -1, id_vhbt = -1, id_frhatv = -1
  integer :: id_frhatu1 = -1, id_frhatv1 = -1
 
  integer :: id_btc_fa_u_ee = -1, id_btc_fa_u_e0 = -1, id_btc_fa_u_w0 = -1, id_btc_fa_u_ww = -1
  integer :: id_btc_ubt_ee = -1, id_btc_ubt_ww = -1
  integer :: id_btc_fa_v_nn = -1, id_btc_fa_v_n0 = -1, id_btc_fa_v_s0 = -1, id_btc_fa_v_ss = -1
  integer :: id_btc_vbt_nn = -1, id_btc_vbt_ss = -1
  integer :: id_uhbt0 = -1, id_vhbt0 = -1
  !!@}
 
end type barotropic_cs
 
!> A desciption of the functional dependence of transport at a u-point
type, private :: local_bt_cont_u_type
  real :: fa_u_ee !< The effective open face area for zonal barotropic transport
                  !! drawing from locations far to the east [H L ~> m2 or kg m-1].
  real :: fa_u_e0 !< The effective open face area for zonal barotropic transport
                  !! drawing from nearby to the east [H L ~> m2 or kg m-1].
  real :: fa_u_w0 !< The effective open face area for zonal barotropic transport
                  !! drawing from nearby to the west [H L ~> m2 or kg m-1].
  real :: fa_u_ww !< The effective open face area for zonal barotropic transport
                  !! drawing from locations far to the west [H L ~> m2 or kg m-1].
  real :: ubt_ww  !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal
                  !! open face area is FA_u_WW.  uBT_WW must be non-negative.
  real :: ubt_ee  !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal
                  !! open face area is FA_u_EE. uBT_EE must be non-positive.
  real :: uh_crvw !< The curvature of face area with velocity for flow from the west [H T2 L-1 ~> s2 or kg s2 m-3].
  real :: uh_crve !< The curvature of face area with velocity for flow from the east [H T2 L-1 ~> s2 or kg s2 m-3].
  real :: uh_ww   !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1].
  real :: uh_ee   !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg s-1].
end type local_bt_cont_u_type
!> A desciption of the functional dependence of transport at a v-point
type, private :: local_bt_cont_v_type
  real :: fa_v_nn !< The effective open face area for meridional barotropic transport
                  !! drawing from locations far to the north [H m ~> m2 or kg m-1].
  real :: fa_v_n0 !< The effective open face area for meridional barotropic transport
                  !! drawing from nearby to the north [H m ~> m2 or kg m-1].
  real :: fa_v_s0 !< The effective open face area for meridional barotropic transport
                  !! drawing from nearby to the south [H m ~> m2 or kg m-1].
  real :: fa_v_ss !< The effective open face area for meridional barotropic transport
                  !! drawing from locations far to the south [H m ~> m2 or kg m-1].
  real :: vbt_ss  !< vBT_SS is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal
                  !! open face area is FA_v_SS. vBT_SS must be non-negative.
  real :: vbt_nn  !< vBT_NN is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal
                  !! open face area is FA_v_NN.  vBT_NN must be non-positive.
  real :: vh_crvs !< The curvature of face area with velocity for flow from the south [H T2 L-1 ~> s2 or kg s2 m-3].
  real :: vh_crvn !< The curvature of face area with velocity for flow from the north [H T2 L-1 ~> s2 or kg s2 m-3].
  real :: vh_ss   !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1].
  real :: vh_nn   !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1].
end type local_bt_cont_v_type
 
!> A container for passing around active tracer point memory limits
type, private :: memory_size_type
  !>@{ Currently active memory limits
  integer :: isdw, iedw, jsdw, jedw ! The memory limits of the wide halo arrays.
  !!@}
end type memory_size_type
 
!>@{ CPU time clock IDs
integer :: id_clock_sync=-1, id_clock_calc=-1
integer :: id_clock_calc_pre=-1, id_clock_calc_post=-1
integer :: id_clock_pass_step=-1, id_clock_pass_pre=-1, id_clock_pass_post=-1
!!@}
 
!>@{ Enumeration values for various schemes
integer, parameter :: harmonic        = 1
integer, parameter :: arithmetic      = 2
integer, parameter :: hybrid          = 3
integer, parameter :: from_bt_cont    = 4
integer, parameter :: hybrid_bt_cont  = 5
character*(20), parameter :: hybrid_string = "HYBRID"
character*(20), parameter :: harmonic_string = "HARMONIC"
character*(20), parameter :: arithmetic_string = "ARITHMETIC"
character*(20), parameter :: bt_cont_string = "FROM_BT_CONT"
!!@}
 
contains
 
!> This subroutine time steps the barotropic equations explicitly.
!! For gravity waves, anything between a forwards-backwards scheme
!! and a simulated backwards Euler scheme is used, with bebt between
!! 0.0 and 1.0 determining the scheme.  In practice, bebt must be of
!! order 0.2 or greater.  A forwards-backwards treatment of the
!! Coriolis terms is always used.
subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, &
                  eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, &
                  eta_out, uhbtav, vhbtav, G, GV, US, CS, &
                  visc_rem_u, visc_rem_v, etaav, OBC, &
                  BT_cont, eta_PF_start, &
                  taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0)
  type(ocean_grid_type),                   intent(inout) :: g       !< The ocean's grid structure.
  type(verticalgrid_type),                   intent(in)  :: gv      !< The ocean's vertical grid structure.
  type(unit_scale_type),                     intent(in)  :: us      !< A dimensional unit scaling type
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: u_in    !< The initial (3-D) zonal velocity [m s-1].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: v_in    !< The initial (3-D) meridional velocity [m s-1].
  real, dimension(SZI_(G),SZJ_(G)),          intent(in)  :: eta_in  !< The initial barotropic free surface height
                                                         !! anomaly or column mass anomaly [H ~> m or kg m-2].
  real,                                      intent(in)  :: dt      !< The time increment to integrate over.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: bc_accel_u !< The zonal baroclinic accelerations [m s-2].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: bc_accel_v !< The meridional baroclinic accelerations,
                                                                       !! [m s-2].
  type(mech_forcing),                        intent(in)  :: forces     !< A structure with the driving mechanical forces
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)),  intent(in)  :: pbce       !< The baroclinic pressure anomaly in each layer
                                                         !! due to free surface height anomalies
                                                         !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
  real, dimension(SZI_(G),SZJ_(G)),          intent(in)  :: eta_pf_in  !< The 2-D eta field (either SSH anomaly or
                                                         !! column mass anomaly) that was used to calculate the input
                                                         !! pressure gradient accelerations (or its final value if
                                                         !! eta_PF_start is provided [H ~> m or kg m-2].
                                                         !! Note: eta_in, pbce, and eta_PF_in must have up-to-date
                                                         !! values in the first point of their halos.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: u_cor      !< The (3-D) zonal-velocities used to
                                                         !! calculate the Coriolis terms in bc_accel_u [m s-1].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: v_cor      !< Ditto for meridonal bc_accel_v.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due
                                                         !! to the barotropic calculation [m s-2].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer
                                                         !! due to the barotropic calculation [m s-2].
  real, dimension(SZI_(G),SZJ_(G)),          intent(out) :: eta_out       !< The final barotropic free surface
                                                         !! height anomaly or column mass anomaly [H ~> m or kg m-2].
  real, dimension(SZIB_(G),SZJ_(G)),         intent(out) :: uhbtav        !< the barotropic zonal volume or mass
                                                         !! fluxes averaged through the barotropic steps
                                                         !! [H m2 s-1 ~> m3 or kg s-1].
  real, dimension(SZI_(G),SZJB_(G)),         intent(out) :: vhbtav        !< the barotropic meridional volume or mass
                                                         !! fluxes averaged through the barotropic steps
                                                         !! [H m2 s-1 ~> m3 or kg s-1].
  type(barotropic_cs),                       pointer     :: cs            !< The control structure returned by a
                                                         !! previous call to barotropic_init.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: visc_rem_u    !< Both the fraction of the momentum
                                                         !! originally in a layer that remains after a time-step of
                                                         !! viscosity, and the fraction of a time-step's worth of a
                                                         !! barotropic acceleration that a layer experiences after
                                                         !! viscosity is applied, in the zonal direction. Nondimensional
                                                         !! between 0 (at the bottom) and 1 (far above the bottom).
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: visc_rem_v    !< Ditto for meridional direction [nondim].
  real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav        !< The free surface height or column mass
                                                         !! averaged over the barotropic integration [H ~> m or kg m-2].
  type(ocean_obc_type),                optional, pointer :: obc          !< The open boundary condition structure.
  type(bt_cont_type),                  optional, pointer :: bt_cont      !< A structure with elements that describe
                                                         !! the effective open face areas as a function of barotropic
                                                         !! flow.
  real, dimension(:,:),                optional, pointer :: eta_pf_start !< The eta field consistent with the pressure
                                                         !! gradient at the start of the barotropic stepping
                                                         !! [H ~> m or kg m-2].
  real, dimension(:,:),                optional, pointer :: taux_bot     !< The zonal bottom frictional stress from
                                                         !! ocean to the seafloor [Pa].
  real, dimension(:,:),                optional, pointer :: tauy_bot     !< The meridional bottom frictional stress
                                                         !! from ocean to the seafloor [Pa].
  real, dimension(:,:,:),              optional, pointer :: uh0     !< The zonal layer transports at reference
                                                                    !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1].
  real, dimension(:,:,:),              optional, pointer :: u_uh0   !< The velocities used to calculate uh0 [m s-1]
  real, dimension(:,:,:),              optional, pointer :: vh0     !< The zonal layer transports at reference
                                                                    !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1].
  real, dimension(:,:,:),              optional, pointer :: v_vh0   !< The velocities used to calculate vh0 [m s-1]
 
  ! Local variables
  real :: ubt_cor(szib_(g),szj_(g)) ! The barotropic velocities that had been
  real :: vbt_cor(szi_(g),szjb_(g)) ! used to calculate the input Coriolis
                                    ! terms [L T-1 ~> m s-1].
  real :: wt_u(szib_(g),szj_(g),szk_(g)) ! wt_u and wt_v are the
  real :: wt_v(szi_(g),szjb_(g),szk_(g)) ! normalized weights to
                ! be used in calculating barotropic velocities, possibly with
                ! sums less than one due to viscous losses.  Nondimensional.
  real, dimension(SZIB_(G),SZJ_(G)) :: &
    av_rem_u, &   ! The weighted average of visc_rem_u, nondimensional.
    tmp_u         ! A temporary array at u points.
  real, dimension(SZI_(G),SZJB_(G)) :: &
    av_rem_v, &   ! The weighted average of visc_rem_v, nondimensional.
    tmp_v         ! A temporary array at v points.
  real, dimension(SZI_(G),SZJ_(G)) :: &
    e_anom        ! The anomaly in the sea surface height or column mass
                  ! averaged between the beginning and end of the time step,
                  ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
 
  ! These are always allocated with symmetric memory and wide halos.
  real :: q(szibw_(cs),szjbw_(cs))  ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1].
  real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
    ubt, &        ! The zonal barotropic velocity [L T-1 ~> m s-1].
    bt_rem_u, &   ! The fraction of the barotropic zonal velocity that remains
                  ! after a time step, the remainder being lost to bottom drag.
                  ! bt_rem_u is a nondimensional number between 0 and 1.
    bt_force_u, & ! The vertical average of all of the u-accelerations that are
                  ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
    u_accel_bt, & ! The difference between the zonal acceleration from the
                  ! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
    uhbt, &       ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1].
    uhbt0, &      ! The difference between the sum of the layer zonal thickness
                  ! fluxes and the barotropic thickness flux using the same
                  ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
    ubt_old, &    ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1].
    ubt_first, &  ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
    ubt_sum, &    ! The sum of ubt over the time steps [L T-1 ~> m s-1].
    uhbt_sum, &   ! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
    ubt_wtd, &    ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].
    ubt_trans, &  ! The latest value of ubt used for a transport [L T-1 ~> m s-1].
    azon, bzon, & ! _zon & _mer are the values of the Coriolis force which
    czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav,
    amer, bmer, & ! respectively to get the barotropic inertial rotation
    cmer, dmer, & ! [T-1 ~> s-1].
    cor_u, &      ! The zonal Coriolis acceleration [L T-2 ~> m s-2].
    cor_ref_u, &  ! The zonal barotropic Coriolis acceleration due
                  ! to the reference velocities [L T-2 ~> m s-2].
    pfu, &        ! The zonal pressure force acceleration [L T-2 ~> m s-2].
    rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1].
    pfu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2].
    coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
    dcor_u, &     ! A simply averaged depth at u points [Z ~> m].
    datu          ! Basin depth at u-velocity grid points times the y-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
    vbt, &        ! The meridional barotropic velocity [L T-1 ~> m s-1].
    bt_rem_v, &   ! The fraction of the barotropic meridional velocity that
                  ! remains after a time step, the rest being lost to bottom
                  ! drag.  bt_rem_v is a nondimensional number between 0 and 1.
    bt_force_v, & ! The vertical average of all of the v-accelerations that are
                  ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
    v_accel_bt, & ! The difference between the meridional acceleration from the
                  ! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
    vhbt, &       ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1].
    vhbt0, &      ! The difference between the sum of the layer meridional
                  ! thickness fluxes and the barotropic thickness flux using
                  ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
    vbt_old, &    ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1].
    vbt_first, &  ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
    vbt_sum, &    ! The sum of vbt over the time steps [L T-1 ~> m s-1].
    vhbt_sum, &   ! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
    vbt_wtd, &    ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].
    vbt_trans, &  ! The latest value of vbt used for a transport [L T-1 ~> m s-1].
    cor_v, &      ! The meridional Coriolis acceleration [L T-2 ~> m s-2].
    cor_ref_v, &  ! The meridional barotropic Coriolis acceleration due
                  ! to the reference velocities [L T-2 ~> m s-2].
    pfv, &        ! The meridional pressure force acceleration [L T-2 ~> m s-2].
    rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1].
    pfv_bt_sum, & ! The summed meridional barotropic pressure gradient force,
                  ! [L T-2 ~> m s-2].
    corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration,
                  ! [L T-2 ~> m s-2].
    dcor_v, &     ! A simply averaged depth at v points [Z ~> m].
    datv          ! Basin depth at v-velocity grid points times the x-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
    eta, &        ! The barotropic free surface height anomaly or column mass
                  ! anomaly [H ~> m or kg m-2]
    eta_pred      ! A predictor value of eta [H ~> m or kg m-2] like eta.
  real, dimension(:,:), pointer :: &
    eta_pf_bt     ! A pointer to the eta array (either eta or eta_pred) that
                  ! determines the barotropic pressure force [H ~> m or kg m-2]
  real, dimension(SZIW_(CS),SZJW_(CS)) :: &
    eta_sum, &    ! eta summed across the timesteps [H ~> m or kg m-2].
    eta_wtd, &    ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2].
    eta_pf, &     ! A local copy of the 2-D eta field (either SSH anomaly or
                  ! column mass anomaly) that was used to calculate the input
                  ! pressure gradient accelerations [H ~> m or kg m-2].
    eta_pf_1, &   ! The initial value of eta_PF, when interp_eta_PF is
                  ! true [H ~> m or kg m-2].
    d_eta_pf, &   ! The change in eta_PF over the barotropic time stepping when
                  ! interp_eta_PF is true [H ~> m or kg m-2].
    gtot_e, &     ! gtot_X is the effective total reduced gravity used to relate
    gtot_w, &     ! free surface height deviations to pressure forces (including
    gtot_n, &     ! GFS and baroclinic  contributions) in the barotropic momentum
    gtot_s, &     ! equations half a grid-point in the X-direction (X is N, S, E, or W)
                  ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
                  ! (See Hallberg, J Comp Phys 1997 for a discussion.)
    eta_src, &    ! The source of eta per barotropic timestep [H ~> m or kg m-2].
    dyn_coef_eta, & ! The coefficient relating the changes in eta to the
                  ! dynamic surface pressure under rigid ice
                  ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
    p_surf_dyn    ! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].
  type(local_bt_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: &
    btcl_u        ! A repackaged version of the u-point information in BT_cont.
  type(local_bt_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: &
    btcl_v        ! A repackaged version of the v-point information in BT_cont.
  ! End of wide-sized variables.
 
  real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
    ubt_prev, uhbt_prev, ubt_sum_prev, uhbt_sum_prev, ubt_wtd_prev  ! for OBC
  real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
    vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev  ! for OBC
 
  real :: mass_to_z   ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1].
  real :: visc_rem    ! A work variable that may equal visc_rem_[uv].  Nondim.
  real :: vel_prev    ! The previous velocity [L T-1 ~> m s-1].
  real :: dtbt        ! The barotropic time step [T ~> s].
  real :: dt_in_t     ! The baroclinic time step [T ~> s].
  real :: bebt        ! A copy of CS%bebt [nondim].
  real :: be_proj     ! The fractional amount by which velocities are projected
                      ! when project_velocity is true. For now be_proj is set
                      ! to equal bebt, as they have similar roles and meanings.
  real :: idt         ! The inverse of dt [T-1 ~> s-1].
  real :: det_de      ! The partial derivative due to self-attraction and loading
                      ! of the reference geopotential with the sea surface height.
                      ! This is typically ~0.09 or less.
  real :: dgeo_de     ! The constant of proportionality between geopotential and
                      ! sea surface height.  It is a nondimensional number of
                      ! order 1.  For stability, this may be made larger
                      ! than physical problem would suggest.
  real :: instep      ! The inverse of the number of barotropic time steps
                      ! to take.
  real :: wt_end      ! The weighting of the final value of eta_PF [nondim]
  integer :: nstep    ! The number of barotropic time steps to take.
  type(time_type) :: &
    time_bt_start, &  ! The starting time of the barotropic steps.
    time_step_end, &  ! The end time of a barotropic step.
    time_end_in       ! The end time for diagnostics when this routine started.
  real :: time_int_in ! The diagnostics' time interval when this routine started.
  logical :: do_hifreq_output  ! If true, output occurs every barotropic step.
  logical :: use_bt_cont, do_ave, find_etaav, find_pf, find_cor
  logical :: ice_is_rigid, nonblock_setup, interp_eta_pf
  logical :: project_velocity, add_uh0
 
  real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta
                      ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
  real :: ice_strength = 0.0  ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].
  real :: idt_max2    ! The squared inverse of the local maximum stable
                      ! barotropic time step [T-2 ~> s-2].
  real :: h_min_dyn   ! The minimum depth to use in limiting the size of the
                      ! dynamic surface pressure for stability [H ~> m or kg m-2].
  real :: h_eff_dx2   ! The effective total thickness divided by the grid spacing
                      ! squared [H L-2 ~> m-1 or kg m-4].
  real :: vel_tmp     ! A temporary velocity [m s-1].
  real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1].
  real :: htot        ! The total thickness [H ~> m or kg m-2].
  real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2].
  real :: accel_underflow ! An acceleration that is so small it should be zeroed out.
 
  real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2
  real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans
  real :: i_sum_wt_vel, i_sum_wt_eta, i_sum_wt_accel, i_sum_wt_trans
  real :: dt_filt     ! The half-width of the barotropic filter [T ~> s].
  real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans
  integer :: nfilter
 
  logical :: apply_obcs, apply_obc_flather, apply_obc_open
  type(memory_size_type) :: ms
  character(len=200) :: mesg
  integer :: isv, iev, jsv, jev ! The valid array size at the end of a step.
  integer :: stencil  ! The stencil size of the algorithm, often 1 or 2.
  integer :: isvf, ievf, jsvf, jevf, num_cycles
  integer :: i, j, k, n
  integer :: is, ie, js, je, nz, isq, ieq, jsq, jeq
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
  integer :: ioff, joff
 
  if (.not.associated(cs)) call mom_error(fatal, &
      "btstep: Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  ms%isdw = cs%isdw ; ms%iedw = cs%iedw ; ms%jsdw = cs%jsdw ; ms%jedw = cs%jedw
  dt_in_t = us%s_to_T*dt
  idt = 1.0 / dt_in_t
  accel_underflow = us%L_T_to_m_s*cs%vel_underflow * us%s_to_T*idt
 
  use_bt_cont = .false.
  if (present(bt_cont)) use_bt_cont = (associated(bt_cont))
 
  interp_eta_pf = .false.
  if (present(eta_pf_start)) interp_eta_pf = (associated(eta_pf_start))
 
  project_velocity = cs%BT_project_velocity
 
  ! Figure out the fullest arrays that could be updated.
  stencil = 1
  if ((.not.use_bt_cont) .and. cs%Nonlinear_continuity .and. &
      (cs%Nonlin_cont_update_period > 0)) stencil = 2
 
  do_ave = query_averaging_enabled(cs%diag)
  find_etaav = present(etaav)
  find_pf = (do_ave .and. ((cs%id_PFu_bt > 0) .or. (cs%id_PFv_bt > 0)))
  find_cor = (do_ave .and. ((cs%id_Coru_bt > 0) .or. (cs%id_Corv_bt > 0)))
 
  add_uh0 = .false.
  if (present(uh0)) add_uh0 = associated(uh0)
  if (add_uh0 .and. .not.(present(vh0) .and. present(u_uh0) .and. &
                          present(v_vh0))) call mom_error(fatal, &
      "btstep: vh0, u_uh0, and v_vh0 must be present if uh0 is used.")
  if (add_uh0 .and. .not.(associated(vh0) .and. associated(u_uh0) .and. &
                          associated(v_vh0))) call mom_error(fatal, &
      "btstep: vh0, u_uh0, and v_vh0 must be associated if uh0 is used.")
 
  ! This can be changed to try to optimize the performance.
  nonblock_setup = g%nonblocking_updates
 
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
  apply_obcs = .false. ; cs%BT_OBC%apply_u_OBCs = .false. ; cs%BT_OBC%apply_v_OBCs = .false.
  apply_obc_open = .false.
  apply_obc_flather = .false.
  if (present(obc)) then ; if (associated(obc)) then
    cs%BT_OBC%apply_u_OBCs = obc%open_u_BCs_exist_globally .or. obc%specified_u_BCs_exist_globally
    cs%BT_OBC%apply_v_OBCs = obc%open_v_BCs_exist_globally .or. obc%specified_v_BCs_exist_globally
    apply_obc_flather = open_boundary_query(obc, apply_flather_obc=.true.)
    apply_obc_open = open_boundary_query(obc, apply_open_obc=.true.)
    apply_obcs = open_boundary_query(obc, apply_specified_obc=.true.) .or. &
           apply_obc_flather .or. apply_obc_open
 
    if (apply_obc_flather .and. .not.gv%Boussinesq) call mom_error(fatal, &
      "btstep: Flather open boundary conditions have not yet been "// &
      "implemented for a non-Boussinesq model.")
  endif ; endif
 
  num_cycles = 1
  if (cs%use_wide_halos) &
    num_cycles = min((is-cs%isdw) / stencil, (js-cs%jsdw) / stencil)
  isvf = is - (num_cycles-1)*stencil ; ievf = ie + (num_cycles-1)*stencil
  jsvf = js - (num_cycles-1)*stencil ; jevf = je + (num_cycles-1)*stencil
 
  nstep = ceiling(dt/cs%dtbt - 0.0001)
  if (is_root_pe() .and. (nstep /= cs%nstep_last)) then
    write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, &
               & " seconds, max ", ES12.6, ".")') (dt/nstep), cs%dtbt_max
    call mom_mesg(mesg, 3)
  endif
  cs%nstep_last = nstep
 
  ! Set the actual barotropic time step.
  instep = 1.0 / real(nstep)
  dtbt = dt_in_t * instep
  bebt = cs%bebt
  be_proj = cs%bebt
  mass_to_z = us%m_to_L*us%T_to_s**2 * us%m_to_Z / gv%Rho0
 
  !--- setup the weight when computing vbt_trans and ubt_trans
  if (project_velocity) then
    trans_wt1 = (1.0 + be_proj); trans_wt2 = -be_proj
  else
    trans_wt1 = bebt ;           trans_wt2 = (1.0-bebt)
  endif
 
  do_hifreq_output = .false.
  if ((cs%id_ubt_hifreq > 0) .or. (cs%id_vbt_hifreq > 0) .or. &
      (cs%id_eta_hifreq > 0) .or. (cs%id_eta_pred_hifreq > 0) .or. &
      (cs%id_uhbt_hifreq > 0) .or. (cs%id_vhbt_hifreq > 0)) then
    do_hifreq_output = query_averaging_enabled(cs%diag, time_int_in, time_end_in)
    if (do_hifreq_output) &
      time_bt_start = time_end_in - real_to_time(dt)
  endif
 
!--- begin setup for group halo update
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
  if (.not. cs%linearized_BT_PV) then
    call create_group_pass(cs%pass_q_DCor, q, cs%BT_Domain, to_all, position=corner)
    call create_group_pass(cs%pass_q_DCor, dcor_u, dcor_v, cs%BT_Domain, &
         to_all+scalar_pair)
  endif
  if ((isq > is-1) .or. (jsq > js-1)) &
    call create_group_pass(cs%pass_tmp_uv, tmp_u, tmp_v, g%Domain)
  call create_group_pass(cs%pass_gtot, gtot_e, gtot_n, cs%BT_Domain, &
       to_all+scalar_pair, agrid)
  call create_group_pass(cs%pass_gtot, gtot_w, gtot_s, cs%BT_Domain, &
       to_all+scalar_pair, agrid)
 
  if (cs%dynamic_psurf) &
    call create_group_pass(cs%pass_eta_bt_rem, dyn_coef_eta, cs%BT_Domain)
  if (interp_eta_pf) then
    call create_group_pass(cs%pass_eta_bt_rem, eta_pf_1, cs%BT_Domain)
    call create_group_pass(cs%pass_eta_bt_rem, d_eta_pf, cs%BT_Domain)
  else
    call create_group_pass(cs%pass_eta_bt_rem, eta_pf, cs%BT_Domain)
  endif
  call create_group_pass(cs%pass_eta_bt_rem, eta_src, cs%BT_Domain)
  ! The following halo updates are not needed without wide halos.  RWH
  ! We do need them after all.
! if (ievf > ie) then
    call create_group_pass(cs%pass_eta_bt_rem, bt_rem_u, bt_rem_v, &
                      cs%BT_Domain, to_all+scalar_pair)
    if (cs%linear_wave_drag) &
      call create_group_pass(cs%pass_eta_bt_rem, rayleigh_u, rayleigh_v, &
                      cs%BT_Domain, to_all+scalar_pair)
! endif
  ! The following halo update is not needed without wide halos.  RWH
  if (((g%isd > cs%isdw) .or. (g%jsd > cs%jsdw)) .or. (isq <= is-1) .or. (jsq <= js-1)) &
    call create_group_pass(cs%pass_force_hbt0_Cor_ref, bt_force_u, bt_force_v, cs%BT_Domain)
  if (add_uh0) call create_group_pass(cs%pass_force_hbt0_Cor_ref, uhbt0, vhbt0, cs%BT_Domain)
  call create_group_pass(cs%pass_force_hbt0_Cor_ref, cor_ref_u, cor_ref_v, cs%BT_Domain)
  if (.not. use_bt_cont) then
    call create_group_pass(cs%pass_Dat_uv, datu, datv, cs%BT_Domain, to_all+scalar_pair)
  endif
  call create_group_pass(cs%pass_eta_ubt, eta, cs%BT_Domain)
  call create_group_pass(cs%pass_eta_ubt, ubt, vbt, cs%BT_Domain)
 
  call create_group_pass(cs%pass_ubt_Cor, ubt_cor, vbt_cor, g%Domain)
  ! These passes occur at the end of the routine, as data is being readied to
  ! share with the main part of the MOM6 code.
  if (find_etaav) then
    call create_group_pass(cs%pass_etaav, etaav, g%Domain)
  endif
  call create_group_pass(cs%pass_e_anom, e_anom, g%Domain)
  call create_group_pass(cs%pass_ubta_uhbta, cs%ubtav, cs%vbtav, g%Domain)
  call create_group_pass(cs%pass_ubta_uhbta, uhbtav, vhbtav, g%Domain)
 
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
!--- end setup for group halo update
 
!   Calculate the constant coefficients for the Coriolis force terms in the
! barotropic momentum equations.  This has to be done quite early to start
! the halo update that needs to be completed before the next calculations.
  if (cs%linearized_BT_PV) then
    !$OMP parallel do default(shared)
    do j=jsvf-2,jevf+1 ; do i=isvf-2,ievf+1
      q(i,j) = cs%q_D(i,j)
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=jsvf-1,jevf+1 ; do i=isvf-2,ievf+1
      dcor_u(i,j) = cs%D_u_Cor(i,j)
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=jsvf-2,jevf+1 ; do i=isvf-1,ievf+1
      dcor_v(i,j) = cs%D_v_Cor(i,j)
    enddo ; enddo
  else
    q(:,:) = 0.0 ; dcor_u(:,:) = 0.0 ; dcor_v(:,:) = 0.0
    !  This option has not yet been written properly.
    !  ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous).
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie
      dcor_u(i,j) = 0.5 * (g%bathyT(i+1,j) + g%bathyT(i,j))
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie
      dcor_v(i,j) = 0.5 * (g%bathyT(i,j+1) + g%bathyT(i,j))
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is-1,ie
      q(i,j) = 0.25 * g%CoriolisBu(i,j) * &
           ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / &
           ((g%areaT(i,j) * g%bathyT(i,j) + g%areaT(i+1,j+1) * g%bathyT(i+1,j+1)) + &
            (g%areaT(i+1,j) * g%bathyT(i+1,j) + g%areaT(i,j+1) * g%bathyT(i,j+1)) )
    enddo ; enddo
 
    ! With very wide halos, q and D need to be calculated on the available data
    ! domain and then updated onto the full computational domain.
    ! These calculations can be done almost immediately, but the halo updates
    ! must be done before the [abcd]mer and [abcd]zon are calculated.
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (nonblock_setup) then
      call start_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
    else
      call do_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
    endif
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  ! Zero out various wide-halo arrays.
  !$OMP parallel do default(shared)
  do j=cs%jsdw,cs%jedw ; do i=cs%isdw,cs%iedw
    gtot_e(i,j) = 0.0 ; gtot_w(i,j) = 0.0
    gtot_n(i,j) = 0.0 ; gtot_s(i,j) = 0.0
    eta(i,j) = 0.0
    eta_pf(i,j) = 0.0
    if (interp_eta_pf) then
      eta_pf_1(i,j) = 0.0 ; d_eta_pf(i,j) = 0.0
    endif
    p_surf_dyn(i,j) = 0.0
    if (cs%dynamic_psurf) dyn_coef_eta(i,j) = 0.0
  enddo ; enddo
  !   The halo regions of various arrays need to be initialized to
  ! non-NaNs in case the neighboring domains are not part of the ocean.
  ! Otherwise a halo update later on fills in the correct values.
  !$OMP parallel do default(shared)
  do j=cs%jsdw,cs%jedw ; do i=cs%isdw-1,cs%iedw
    cor_ref_u(i,j) = 0.0 ; bt_force_u(i,j) = 0.0 ; ubt(i,j) = 0.0
    datu(i,j) = 0.0 ; bt_rem_u(i,j) = 0.0 ; uhbt0(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=cs%jsdw-1,cs%jedw ; do i=cs%isdw,cs%iedw
    cor_ref_v(i,j) = 0.0 ; bt_force_v(i,j) = 0.0 ; vbt(i,j) = 0.0
    datv(i,j) = 0.0 ; bt_rem_v(i,j) = 0.0 ; vhbt0(i,j) = 0.0
  enddo ; enddo
 
  ! Copy input arrays into their wide-halo counterparts.
  if (interp_eta_pf) then
    !$OMP parallel do default(shared)
    do j=g%jsd,g%jed ; do i=g%isd,g%ied ! Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?
      eta(i,j) = eta_in(i,j)
      eta_pf_1(i,j) = eta_pf_start(i,j)
      d_eta_pf(i,j) = eta_pf_in(i,j) - eta_pf_start(i,j)
    enddo ; enddo
  else
    !$OMP parallel do default(shared)
    do j=g%jsd,g%jed ; do i=g%isd,g%ied !: Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?
      eta(i,j) = eta_in(i,j)
      eta_pf(i,j) = eta_pf_in(i,j)
    enddo ; enddo
  endif
 
  !$OMP parallel do default(shared) private(visc_rem)
  do k=1,nz ; do j=js,je ; do i=is-1,ie
    ! rem needs greater than visc_rem_u and 1-Instep/visc_rem_u.
    ! The 0.5 below is just for safety.
    if (visc_rem_u(i,j,k) <= 0.0) then ; visc_rem = 0.0
    elseif (visc_rem_u(i,j,k) >= 1.0) then ; visc_rem = 1.0
    elseif (visc_rem_u(i,j,k)**2 > visc_rem_u(i,j,k) - 0.5*instep) then
      visc_rem = visc_rem_u(i,j,k)
    else ; visc_rem = 1.0 - 0.5*instep/visc_rem_u(i,j,k) ; endif
    wt_u(i,j,k) = cs%frhatu(i,j,k) * visc_rem
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared) private(visc_rem)
  do k=1,nz ; do j=js-1,je ; do i=is,ie
    ! rem needs greater than visc_rem_v and 1-Instep/visc_rem_v.
    if (visc_rem_v(i,j,k) <= 0.0) then ; visc_rem = 0.0
    elseif (visc_rem_v(i,j,k) >= 1.0) then ; visc_rem = 1.0
    elseif (visc_rem_v(i,j,k)**2 > visc_rem_v(i,j,k) - 0.5*instep) then
      visc_rem = visc_rem_v(i,j,k)
    else ; visc_rem = 1.0 - 0.5*instep/visc_rem_v(i,j,k) ; endif
    wt_v(i,j,k) = cs%frhatv(i,j,k) * visc_rem
  enddo ; enddo ; enddo
 
  !   Use u_Cor and v_Cor as the reference values for the Coriolis terms,
  ! including the viscous remnant.
  !$OMP parallel do default(shared)
  do j=js-1,je+1 ; do i=is-1,ie ; ubt_cor(i,j) = 0.0 ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is-1,ie+1 ; vbt_cor(i,j) = 0.0 ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js,je ; do k=1,nz ; do i=is-1,ie
    ubt_cor(i,j) = ubt_cor(i,j) + wt_u(i,j,k) * us%m_s_to_L_T*u_cor(i,j,k)
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do k=1,nz ; do i=is,ie
    vbt_cor(i,j) = vbt_cor(i,j) + wt_v(i,j,k) * us%m_s_to_L_T*v_cor(i,j,k)
  enddo ; enddo ; enddo
 
  ! The gtot arrays are the effective layer-weighted reduced gravities for
  ! accelerations across the various faces, with names for the relative
  ! locations of the faces to the pressure point.  They will have their halos
  ! updated later on.
  !$OMP parallel do default(shared)
  do j=js,je
    do k=1,nz ; do i=is-1,ie
      gtot_e(i,j)   = gtot_e(i,j)   + pbce(i,j,k)   * wt_u(i,j,k)
      gtot_w(i+1,j) = gtot_w(i+1,j) + pbce(i+1,j,k) * wt_u(i,j,k)
    enddo ; enddo
  enddo
  !$OMP parallel do default(shared)
  do j=js-1,je
     do k=1,nz ; do i=is,ie
      gtot_n(i,j)   = gtot_n(i,j)   + pbce(i,j,k)   * wt_v(i,j,k)
      gtot_s(i,j+1) = gtot_s(i,j+1) + pbce(i,j+1,k) * wt_v(i,j,k)
    enddo ; enddo
  enddo
 
  if (cs%tides) then
    call tidal_forcing_sensitivity(g, cs%tides_CSp, det_de)
    dgeo_de = 1.0 + det_de + cs%G_extra
  else
    dgeo_de = 1.0 + cs%G_extra
  endif
 
  if (nonblock_setup .and. .not.cs%linearized_BT_PV) then
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    call complete_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  ! Calculate the open areas at the velocity points.
  ! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor.
  if (use_bt_cont) then
    call set_local_bt_cont_types(bt_cont, btcl_u, btcl_v, g, us, ms, cs%BT_Domain, 1+ievf-ie)
  else
    if (cs%Nonlinear_continuity) then
      call find_face_areas(datu, datv, g, gv, us, cs, ms, eta, 1)
    else
      call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=1)
    endif
  endif
 
  ! Set up fields related to the open boundary conditions.
  if (apply_obcs) then
    call set_up_bt_obc(obc, eta, cs%BT_OBC, cs%BT_Domain, g, gv, us, ms, ievf-ie, use_bt_cont, &
                       datu, datv, btcl_u, btcl_v)
  endif
 
!   Here the vertical average accelerations due to the Coriolis, advective,
! pressure gradient and horizontal viscous terms in the layer momentum
! equations are calculated.  These will be used to determine the difference
! between the accelerations due to the average of the layer equations and the
! barotropic calculation.
 
  !$OMP parallel do default(shared)
  do j=js,je ; do i=is-1,ie
    ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
    ! ### although with BT_cont_types IDatu should be replaced by
    ! ###   CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds).
    bt_force_u(i,j) = forces%taux(i,j) * mass_to_z * cs%IDatu(i,j)*visc_rem_u(i,j,1)
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is,ie
    ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
    ! ### although with BT_cont_types IDatv should be replaced by
    ! ###   CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds).
    bt_force_v(i,j) = forces%tauy(i,j) * mass_to_z * cs%IDatv(i,j)*visc_rem_v(i,j,1)
  enddo ; enddo
  if (present(taux_bot) .and. present(tauy_bot)) then
    if (associated(taux_bot) .and. associated(tauy_bot)) then
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        bt_force_u(i,j) = bt_force_u(i,j) - taux_bot(i,j) * mass_to_z  * cs%IDatu(i,j)
      enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        bt_force_v(i,j) = bt_force_v(i,j) - tauy_bot(i,j) * mass_to_z  * cs%IDatv(i,j)
      enddo ; enddo
    endif
  endif
 
  ! bc_accel_u & bc_accel_v are only available on the potentially
  ! non-symmetric computational domain.
  !$OMP parallel do default(shared)
  do j=js,je ; do k=1,nz ; do i=isq,ieq
    bt_force_u(i,j) = bt_force_u(i,j) + wt_u(i,j,k) * us%m_to_L*us%T_to_s**2*bc_accel_u(i,j,k)
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=jsq,jeq ; do k=1,nz ; do i=is,ie
    bt_force_v(i,j) = bt_force_v(i,j) + wt_v(i,j,k) * us%m_to_L*us%T_to_s**2*bc_accel_v(i,j,k)
  enddo ; enddo ; enddo
 
  ! Determine the difference between the sum of the layer fluxes and the
  ! barotropic fluxes found from the same input velocities.
  if (add_uh0) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie ; uhbt(i,j) = 0.0 ; ubt(i,j) = 0.0 ; enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie ; vhbt(i,j) = 0.0 ; vbt(i,j) = 0.0 ; enddo ; enddo
    if (cs%visc_rem_u_uh0) then
      !$OMP parallel do default(shared)
      do j=js,je ; do k=1,nz ; do i=is-1,ie
        uhbt(i,j) = uhbt(i,j) + us%T_to_s*us%m_to_L**2*uh0(i,j,k)
        ubt(i,j) = ubt(i,j) + wt_u(i,j,k) * us%m_s_to_L_T*u_uh0(i,j,k)
      enddo ; enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do k=1,nz ; do i=is,ie
        vhbt(i,j) = vhbt(i,j) + us%T_to_s*us%m_to_L**2*vh0(i,j,k)
        vbt(i,j) = vbt(i,j) + wt_v(i,j,k) * us%m_s_to_L_T*v_vh0(i,j,k)
      enddo ; enddo ; enddo
    else
      !$OMP parallel do default(shared)
      do j=js,je ; do k=1,nz ; do i=is-1,ie
        uhbt(i,j) = uhbt(i,j) + us%T_to_s*us%m_to_L**2*uh0(i,j,k)
        ubt(i,j) = ubt(i,j) + cs%frhatu(i,j,k) * us%m_s_to_L_T*u_uh0(i,j,k)
      enddo ; enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do k=1,nz ; do i=is,ie
        vhbt(i,j) = vhbt(i,j) + us%T_to_s*us%m_to_L**2*vh0(i,j,k)
        vbt(i,j) = vbt(i,j) + cs%frhatv(i,j,k) * us%m_s_to_L_T*v_vh0(i,j,k)
      enddo ; enddo ; enddo
    endif
    if (use_bt_cont) then
      if (cs%adjust_BT_cont) then
        ! Use the additional input transports to broaden the fits
        ! over which the bt_cont_type applies.
 
        ! Fill in the halo data for ubt, vbt, uhbt, and vhbt.
        if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
        if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
        call pass_vector(ubt, vbt, cs%BT_Domain, complete=.false., halo=1+ievf-ie)
        call pass_vector(uhbt, vhbt, cs%BT_Domain, complete=.true., halo=1+ievf-ie)
        if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
        if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
        call adjust_local_bt_cont_types(ubt, uhbt, vbt, vhbt, btcl_u, btcl_v, &
                                        g, us, ms, 1+ievf-ie)
      endif
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        uhbt0(i,j) = uhbt(i,j) - find_uhbt(ubt(i,j), btcl_u(i,j), us)
      enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        vhbt0(i,j) = vhbt(i,j) - find_vhbt(vbt(i,j), btcl_v(i,j), us)
      enddo ; enddo
    else
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        uhbt0(i,j) = uhbt(i,j) - datu(i,j)*ubt(i,j)
      enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        vhbt0(i,j) = vhbt(i,j) - datv(i,j)*vbt(i,j)
      enddo ; enddo
    endif
    if (cs%BT_OBC%apply_u_OBCs) then  ! zero out pressure force across boundary
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
        uhbt0(i,j) = 0.0
      endif ; enddo ; enddo
    endif
    if (cs%BT_OBC%apply_v_OBCs) then  ! zero out PF across boundary
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
        vhbt0(i,j) = 0.0
      endif ; enddo ; enddo
    endif
  endif
 
! Calculate the initial barotropic velocities from the layer's velocities.
  !$OMP parallel do default(shared)
  do j=jsvf-1,jevf+1 ; do i=isvf-2,ievf+1
    ubt(i,j) = 0.0 ; uhbt(i,j) = 0.0 ; u_accel_bt(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=jsvf-2,jevf+1 ; do i=isvf-1,ievf+1
    vbt(i,j) = 0.0 ; vhbt(i,j) = 0.0 ; v_accel_bt(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js,je ; do k=1,nz ; do i=is-1,ie
    ubt(i,j) = ubt(i,j) + wt_u(i,j,k) * us%m_s_to_L_T*u_in(i,j,k)
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do k=1,nz ; do i=is,ie
    vbt(i,j) = vbt(i,j) + wt_v(i,j,k) * us%m_s_to_L_T*v_in(i,j,k)
  enddo ; enddo ;  enddo
  !$OMP parallel do default(shared)
  do j=js,je ; do i=is-1,ie
    if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is,ie
    if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
  enddo ; enddo
 
  if (apply_obcs) then
    ubt_first(:,:) = ubt(:,:) ; vbt_first(:,:) = vbt(:,:)
  endif
 
  if (cs%gradual_BT_ICs) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie
      bt_force_u(i,j) = bt_force_u(i,j) + (ubt(i,j) - cs%ubt_IC(i,j)) * idt
      ubt(i,j) = cs%ubt_IC(i,j)
      if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie
      bt_force_v(i,j) = bt_force_v(i,j) + (vbt(i,j) - cs%vbt_IC(i,j)) * idt
      vbt(i,j) = cs%vbt_IC(i,j)
      if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
    enddo ; enddo
  endif
 
  if ((isq > is-1) .or. (jsq > js-1)) then
    ! Non-symmetric memory is being used, so the edge values need to be
    ! filled in with a halo update of a non-symmetric array.
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
    tmp_u(:,:) = 0.0 ; tmp_v(:,:) = 0.0
    do j=js,je ; do i=isq,ieq ; tmp_u(i,j) = bt_force_u(i,j) ; enddo ; enddo
    do j=jsq,jeq ; do i=is,ie ; tmp_v(i,j) = bt_force_v(i,j) ; enddo ; enddo
    if (nonblock_setup) then
      call start_group_pass(cs%pass_tmp_uv, g%Domain)
    else
      call do_group_pass(cs%pass_tmp_uv, g%Domain)
      do j=jsd,jed ; do i=isdb,iedb ; bt_force_u(i,j) = tmp_u(i,j) ; enddo ; enddo
      do j=jsdb,jedb ; do i=isd,ied ; bt_force_v(i,j) = tmp_v(i,j) ; enddo ; enddo
    endif
    if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  if (nonblock_setup) then
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
    call start_group_pass(cs%pass_gtot, cs%BT_Domain)
    call start_group_pass(cs%pass_ubt_Cor, g%Domain)
    if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  ! Determine the weighted Coriolis parameters for the neighboring velocities.
  !$OMP parallel do default(shared)
  do j=jsvf-1,jevf ; do i=isvf-1,ievf+1
    if (cs%Sadourny) then
      amer(i-1,j) = dcor_u(i-1,j) * q(i-1,j)
      bmer(i,j) = dcor_u(i,j) * q(i,j)
      cmer(i,j+1) = dcor_u(i,j+1) * q(i,j)
      dmer(i-1,j+1) = dcor_u(i-1,j+1) * q(i-1,j)
    else
      amer(i-1,j) = dcor_u(i-1,j) * &
                    ((q(i,j) + q(i-1,j-1)) + q(i-1,j)) / 3.0
      bmer(i,j) = dcor_u(i,j) * &
                  (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0
      cmer(i,j+1) = dcor_u(i,j+1) * &
                    (q(i,j) + (q(i-1,j) + q(i,j+1))) / 3.0
      dmer(i-1,j+1) = dcor_u(i-1,j+1) * &
                      ((q(i,j) + q(i-1,j+1)) + q(i-1,j)) / 3.0
    endif
  enddo ; enddo
 
  !$OMP parallel do default(shared)
  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf
    if (cs%Sadourny) then
      azon(i,j) = dcor_v(i+1,j) * q(i,j)
      bzon(i,j) = dcor_v(i,j) * q(i,j)
      czon(i,j) = dcor_v(i,j-1) * q(i,j-1)
      dzon(i,j) = dcor_v(i+1,j-1) * q(i,j-1)
    else
      azon(i,j) = dcor_v(i+1,j) * &
                  (q(i,j) + (q(i+1,j) + q(i,j-1))) / 3.0
      bzon(i,j) = dcor_v(i,j) * &
                  (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0
      czon(i,j) = dcor_v(i,j-1) * &
                  ((q(i,j) + q(i-1,j-1)) + q(i,j-1)) / 3.0
      dzon(i,j) = dcor_v(i+1,j-1) * &
                  ((q(i,j) + q(i+1,j-1)) + q(i,j-1)) / 3.0
    endif
  enddo ; enddo
 
! Complete the previously initiated message passing.
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
  if (nonblock_setup) then
    if ((isq > is-1) .or. (jsq > js-1)) then
      call complete_group_pass(cs%pass_tmp_uv, g%Domain)
      do j=jsd,jed ; do i=isdb,iedb ; bt_force_u(i,j) = tmp_u(i,j) ; enddo ; enddo
      do j=jsdb,jedb ; do i=isd,ied ; bt_force_v(i,j) = tmp_v(i,j) ; enddo ; enddo
    endif
    call complete_group_pass(cs%pass_gtot, cs%BT_Domain)
    call complete_group_pass(cs%pass_ubt_Cor, g%Domain)
  else
    call do_group_pass(cs%pass_gtot, cs%BT_Domain)
    call do_group_pass(cs%pass_ubt_Cor, g%Domain)
  endif
  ! The various elements of gtot are positive definite but directional, so use
  ! the polarity arrays to sort out when the directions have shifted.
  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
    if (cs%ua_polarity(i,j) < 0.0) call swap(gtot_e(i,j), gtot_w(i,j))
    if (cs%va_polarity(i,j) < 0.0) call swap(gtot_n(i,j), gtot_s(i,j))
  enddo ; enddo
 
  !$OMP parallel do default(shared)
  do j=js,je ; do i=is-1,ie
    cor_ref_u(i,j) =  &
        ((azon(i,j) * vbt_cor(i+1,j) + czon(i,j) * vbt_cor(i  ,j-1)) + &
         (bzon(i,j) * vbt_cor(i  ,j) + dzon(i,j) * vbt_cor(i+1,j-1)))
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is,ie
    cor_ref_v(i,j) = -1.0 * &
        ((amer(i-1,j) * ubt_cor(i-1,j) + cmer(i  ,j+1) * ubt_cor(i  ,j+1)) + &
         (bmer(i  ,j) * ubt_cor(i  ,j) + dmer(i-1,j+1) * ubt_cor(i-1,j+1)))
  enddo ; enddo
 
  ! Now start new halo updates.
  if (nonblock_setup) then
    if (.not.use_bt_cont) &
      call start_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
 
    ! The following halo update is not needed without wide halos.  RWH
    call start_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
  endif
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
!$OMP parallel default(none) shared(is,ie,js,je,nz,av_rem_u,av_rem_v,CS,visc_rem_u, &
!$OMP                               visc_rem_v,bt_rem_u,G,GV,nstep,bt_rem_v,Instep, &
!$OMP                               find_etaav,jsvf,jevf,isvf,ievf,eta_sum,eta_wtd, &
!$OMP                               ubt_sum,uhbt_sum,PFu_bt_sum,Coru_bt_sum,ubt_wtd,&
!$OMP                               ubt_trans,vbt_sum,vhbt_sum,PFv_bt_sum,          &
!$OMP                               Corv_bt_sum,vbt_wtd,vbt_trans,eta_src,dt,dtbt,  &
!$OMP                               Rayleigh_u, Rayleigh_v,                         &
!$OMP                               use_BT_Cont,BTCL_u,uhbt0,BTCL_v,vhbt0,eta,Idt)  &
!$OMP                       private(u_max_cor,v_max_cor,eta_cor_max,Htot)
  !$OMP do
  do j=js-1,je+1 ; do i=is-1,ie ; av_rem_u(i,j) = 0.0 ; enddo ; enddo
  !$OMP do
  do j=js-1,je ; do i=is-1,ie+1 ; av_rem_v(i,j) = 0.0 ; enddo ; enddo
  !$OMP do
  do j=js,je ; do k=1,nz ; do i=is-1,ie
    av_rem_u(i,j) = av_rem_u(i,j) + cs%frhatu(i,j,k) * visc_rem_u(i,j,k)
  enddo ; enddo ; enddo
  !$OMP do
  do j=js-1,je ; do k=1,nz ; do i=is,ie
    av_rem_v(i,j) = av_rem_v(i,j) + cs%frhatv(i,j,k) * visc_rem_v(i,j,k)
  enddo ; enddo ; enddo
  if (cs%strong_drag) then
    !$OMP do
    do j=js,je ; do i=is-1,ie
      bt_rem_u(i,j) = g%mask2dCu(i,j) * &
         ((nstep * av_rem_u(i,j)) / (1.0 + (nstep-1)*av_rem_u(i,j)))
    enddo ; enddo
    !$OMP do
    do j=js-1,je ; do i=is,ie
      bt_rem_v(i,j) = g%mask2dCv(i,j) * &
         ((nstep * av_rem_v(i,j)) / (1.0 + (nstep-1)*av_rem_v(i,j)))
    enddo ; enddo
  else
    !$OMP do
    do j=js,je ; do i=is-1,ie
      bt_rem_u(i,j) = 0.0
      if (g%mask2dCu(i,j) * av_rem_u(i,j) > 0.0) &
        bt_rem_u(i,j) = g%mask2dCu(i,j) * (av_rem_u(i,j)**instep)
    enddo ; enddo
    !$OMP do
    do j=js-1,je ; do i=is,ie
      bt_rem_v(i,j) = 0.0
      if (g%mask2dCv(i,j) * av_rem_v(i,j) > 0.0) &
        bt_rem_v(i,j) = g%mask2dCv(i,j) * (av_rem_v(i,j)**instep)
    enddo ; enddo
  endif
  if (cs%linear_wave_drag) then
    !$OMP do
    do j=js,je ; do i=is-1,ie ; if (cs%lin_drag_u(i,j) > 0.0) then
      htot = 0.5 * (eta(i,j) + eta(i+1,j))
      if (gv%Boussinesq) &
        htot = htot + 0.5*gv%Z_to_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j))
      bt_rem_u(i,j) = bt_rem_u(i,j) * (htot / (htot + cs%lin_drag_u(i,j) * dtbt))
 
      rayleigh_u(i,j) = cs%lin_drag_u(i,j) / htot
    endif ; enddo ; enddo
    !$OMP do
    do j=js-1,je ; do i=is,ie ; if (cs%lin_drag_v(i,j) > 0.0) then
      htot = 0.5 * (eta(i,j) + eta(i,j+1))
      if (gv%Boussinesq) &
        htot = htot + 0.5*gv%Z_to_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j+1))
      bt_rem_v(i,j) = bt_rem_v(i,j) * (htot / (htot + cs%lin_drag_v(i,j) * dtbt))
 
      rayleigh_v(i,j) = cs%lin_drag_v(i,j) / htot
    endif ; enddo ; enddo
  endif
 
  ! Zero out the arrays for various time-averaged quantities.
  if (find_etaav) then
    !$OMP do
    do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
      eta_sum(i,j) = 0.0 ; eta_wtd(i,j) = 0.0
    enddo ; enddo
  else
    !$OMP do
    do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
      eta_wtd(i,j) = 0.0
    enddo ; enddo
   endif
  !$OMP do
  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf
    ubt_sum(i,j) = 0.0 ; uhbt_sum(i,j) = 0.0
    pfu_bt_sum(i,j) = 0.0 ; coru_bt_sum(i,j) = 0.0
    ubt_wtd(i,j) = 0.0 ; ubt_trans(i,j) = 0.0
  enddo ; enddo
  !$OMP do
  do j=jsvf-1,jevf ; do i=isvf-1,ievf+1
    vbt_sum(i,j) = 0.0 ; vhbt_sum(i,j) = 0.0
    pfv_bt_sum(i,j) = 0.0 ; corv_bt_sum(i,j) = 0.0
    vbt_wtd(i,j) = 0.0 ; vbt_trans(i,j) = 0.0
  enddo ; enddo
 
  ! Set the mass source, after first initializing the halos to 0.
  !$OMP do
  do j=jsvf-1,jevf+1; do i=isvf-1,ievf+1 ; eta_src(i,j) = 0.0 ; enddo ; enddo
  if (cs%bound_BT_corr) then ; if (use_bt_cont .and. cs%BT_cont_bounds) then
    do j=js,je ; do i=is,ie ; if (g%mask2dT(i,j) > 0.0) then
      if (cs%eta_cor(i,j) > 0.0) then
        !   Limit the source (outward) correction to be a fraction the mass that
        ! can be transported out of the cell by velocities with a CFL number of
        ! CFL_cor.
        u_max_cor = us%m_to_L*g%dxT(i,j) * (cs%maxCFL_BT_cont*idt)
        v_max_cor = us%m_to_L*g%dyT(i,j) * (cs%maxCFL_BT_cont*idt)
        eta_cor_max = dt_in_t * (cs%IareaT(i,j) * &
                   (((find_uhbt(u_max_cor, btcl_u(i,j), us) + uhbt0(i,j)) - &
                     (find_uhbt(-u_max_cor, btcl_u(i-1,j), us) + uhbt0(i-1,j))) + &
                    ((find_vhbt(v_max_cor, btcl_v(i,j), us) + vhbt0(i,j)) - &
                     (find_vhbt(-v_max_cor, btcl_v(i,j-1), us) + vhbt0(i,j-1))) ))
        cs%eta_cor(i,j) = min(cs%eta_cor(i,j), max(0.0, eta_cor_max))
      else
        ! Limit the sink (inward) correction to the amount of mass that is already
        ! inside the cell.
        htot = eta(i,j)
        if (gv%Boussinesq) htot = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j)
 
        cs%eta_cor(i,j) = max(cs%eta_cor(i,j), -max(0.0,htot))
      endif
    endif ; enddo ; enddo
  else ; do j=js,je ; do i=is,ie
    if (abs(cs%eta_cor(i,j)) > dt_in_t*cs%eta_cor_bound(i,j)) &
      cs%eta_cor(i,j) = sign(dt_in_t*cs%eta_cor_bound(i,j), cs%eta_cor(i,j))
  enddo ; enddo ; endif ; endif
  !$OMP do
  do j=js,je ; do i=is,ie
    eta_src(i,j) = g%mask2dT(i,j) * (instep * cs%eta_cor(i,j))
  enddo ; enddo
!$OMP end parallel
 
  if (cs%dynamic_psurf) then
    ice_is_rigid = (associated(forces%rigidity_ice_u) .and. &
                    associated(forces%rigidity_ice_v))
    h_min_dyn = gv%Z_to_H * cs%Dmin_dyn_psurf
    if (ice_is_rigid .and. use_bt_cont) &
      call bt_cont_to_face_areas(bt_cont, datu, datv, g, us, ms, 0, .true.)
    if (ice_is_rigid) then
      !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength)
      do j=js,je ; do i=is,ie
      ! First determine the maximum stable value for dyn_coef_eta.
 
      !   This estimate of the maximum stable time step is pretty accurate for
      ! gravity waves, but it is a conservative estimate since it ignores the
      ! stabilizing effect of the bottom drag.
      idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (us%L_to_m**2*g%IareaT(i,j) * &
            ((gtot_e(i,j) * (datu(i,j)*us%L_to_m*g%IdxCu(i,j)) + &
              gtot_w(i,j) * (datu(i-1,j)*us%L_to_m*g%IdxCu(i-1,j))) + &
             (gtot_n(i,j) * (datv(i,j)*us%L_to_m*g%IdyCv(i,j)) + &
              gtot_s(i,j) * (datv(i,j-1)*us%L_to_m*g%IdyCv(i,j-1)))) + &
            ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
             (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)))
      h_eff_dx2 = max(h_min_dyn * ((us%L_to_m*g%IdxT(i,j))**2 + (us%L_to_m*g%IdyT(i,j))**2), &
                      us%L_to_m**2*g%IareaT(i,j) * &
                        ((datu(i,j)*us%L_to_m*g%IdxCu(i,j) + datu(i-1,j)*us%L_to_m*g%IdxCu(i-1,j)) + &
                         (datv(i,j)*us%L_to_m*g%IdyCv(i,j) + datv(i,j-1)*us%L_to_m*g%IdyCv(i,j-1)) ) )
      dyn_coef_max = cs%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * idt_max2) / &
                     (dtbt**2 * h_eff_dx2)
 
      ! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [m3 s-1].
      ice_strength = us%m_to_L**4*us%Z_to_m*us%T_to_s* &
                     ((forces%rigidity_ice_u(i,j) + forces%rigidity_ice_u(i-1,j)) + &
                      (forces%rigidity_ice_v(i,j) + forces%rigidity_ice_v(i,j-1))) / &
                      (cs%ice_strength_length**2 * dtbt)
 
      ! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]
      dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * gv%H_to_Z)
    enddo ; enddo ; endif
  endif
 
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
  if (nonblock_setup) then
    call start_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
    ! The following halo update is not needed without wide halos.  RWH
  else
    call do_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
    if (.not.use_bt_cont) &
      call do_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
    call do_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
  endif
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
  ! Complete all of the outstanding halo updates.
  if (nonblock_setup) then
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
 
    if (.not.use_bt_cont) &  !### IS THIS OK HERE?
      call complete_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
    call complete_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
    call complete_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
 
    if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  if (cs%debug) then
    call uvchksum("BT [uv]hbt", uhbt, vhbt, cs%debug_BT_HI, haloshift=0, &
                  scale=us%s_to_T*us%L_to_m**2*gv%H_to_m)
    call uvchksum("BT Initial [uv]bt", ubt, vbt, cs%debug_BT_HI, haloshift=0, scale=us%L_T_to_m_s)
    call hchksum(eta, "BT Initial eta", cs%debug_BT_HI, haloshift=0, scale=gv%H_to_m)
    call uvchksum("BT BT_force_[uv]", bt_force_u, bt_force_v, &
                  cs%debug_BT_HI, haloshift=0, scale=us%L_T2_to_m_s2)
    if (interp_eta_pf) then
      call hchksum(eta_pf_1, "BT eta_PF_1",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
      call hchksum(d_eta_pf, "BT d_eta_PF",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
    else
      call hchksum(eta_pf, "BT eta_PF",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
      call hchksum(eta_pf_in, "BT eta_PF_in",g%HI,haloshift=0, scale=gv%H_to_m)
    endif
    call uvchksum("BT Cor_ref_[uv]", cor_ref_u, cor_ref_v, cs%debug_BT_HI, haloshift=0, scale=us%L_T2_to_m_s2)
    call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, cs%debug_BT_HI, haloshift=0, &
                  scale=us%L_to_m**2*us%s_to_T*gv%H_to_m)
    if (.not. use_bt_cont) then
      call uvchksum("BT Dat[uv]", datu, datv, cs%debug_BT_HI, haloshift=1, scale=us%L_to_m*gv%H_to_m)
    endif
    call uvchksum("BT wt_[uv]", wt_u, wt_v, g%HI, 0, .true., .true.)
    call uvchksum("BT frhat[uv]", cs%frhatu, cs%frhatv, g%HI, 0, .true., .true.)
    call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, g%HI, haloshift=0)
    call uvchksum("BT IDat[uv]", cs%IDatu, cs%IDatv, g%HI, haloshift=0, scale=us%m_to_Z)
    call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, g%HI, haloshift=1)
  endif
 
  if (query_averaging_enabled(cs%diag)) then
    if (cs%id_eta_st > 0) call post_data(cs%id_eta_st, eta(isd:ied,jsd:jed), cs%diag)
    if (cs%id_ubt_st > 0) call post_data(cs%id_ubt_st, ubt(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vbt_st > 0) call post_data(cs%id_vbt_st, vbt(isd:ied,jsdb:jedb), cs%diag)
  endif
 
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
 
  if (project_velocity) then ; eta_pf_bt => eta ; else ; eta_pf_bt => eta_pred ; endif
 
  if (cs%dt_bt_filter >= 0.0) then
    dt_filt = 0.5 * max(0.0, min(cs%dt_bt_filter, 2.0*dt_in_t))
  else
    dt_filt = 0.5 * max(0.0, dt_in_t * min(-cs%dt_bt_filter, 2.0))
  endif
  nfilter = ceiling(dt_filt / dtbt)
 
  if (nstep+nfilter==0 ) call mom_error(fatal, &
      "btstep: number of barotropic step (nstep+nfilter) is 0")
 
  ! Set up the normalized weights for the filtered velocity.
  sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
  allocate(wt_vel(nstep+nfilter)) ; allocate(wt_eta(nstep+nfilter))
  allocate(wt_trans(nstep+nfilter+1)) ; allocate(wt_accel(nstep+nfilter+1))
  allocate(wt_accel2(nstep+nfilter+1))
  do n=1,nstep+nfilter
    ! Modify this to use a different filter...
    if ( (n==nstep) .or. (dt_filt - abs(n-nstep)*dtbt >= 0.0)) then
      wt_vel(n) = 1.0  ; wt_eta(n) = 1.0
    elseif (dtbt + dt_filt - abs(n-nstep)*dtbt > 0.0) then
      wt_vel(n) = 1.0 + (dt_filt / dtbt) - abs(n-nstep) ; wt_eta(n) = wt_vel(n)
    else
      wt_vel(n) = 0.0  ; wt_eta(n) = 0.0
    endif
!###    if (n < nstep-nfilter) then ; wt_vel(n) = 0.0 ; else ; wt_vel(n) = 1.0 ; endif
!###    if (n < nstep-nfilter) then ; wt_eta(n) = 0.0 ; else ; wt_eta(n) = 1.0 ; endif
 
    ! The rest should not be changed.
    sum_wt_vel = sum_wt_vel + wt_vel(n) ; sum_wt_eta = sum_wt_eta + wt_eta(n)
  enddo
  wt_trans(nstep+nfilter+1) = 0.0 ; wt_accel(nstep+nfilter+1) = 0.0
  do n=nstep+nfilter,1,-1
    wt_trans(n) = wt_trans(n+1) + wt_eta(n)
    wt_accel(n) = wt_accel(n+1) + wt_vel(n)
    sum_wt_accel = sum_wt_accel + wt_accel(n) ; sum_wt_trans = sum_wt_trans + wt_trans(n)
  enddo
  ! Normalize the weights.
  i_sum_wt_vel = 1.0 / sum_wt_vel ; i_sum_wt_accel = 1.0 / sum_wt_accel
  i_sum_wt_eta = 1.0 / sum_wt_eta ; i_sum_wt_trans = 1.0 / sum_wt_trans
  do n=1,nstep+nfilter
    wt_vel(n) = wt_vel(n) * i_sum_wt_vel
    wt_accel2(n) = wt_accel(n)
    wt_accel(n) = wt_accel(n) * i_sum_wt_accel
    wt_eta(n) = wt_eta(n) * i_sum_wt_eta
!    wt_trans(n) = wt_trans(n) * I_sum_wt_trans
  enddo
 
 
  sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
 
  ! The following loop contains all of the time steps.
  isv=is ; iev=ie ; jsv=js ; jev=je
  do n=1,nstep+nfilter
 
    sum_wt_vel = sum_wt_vel + wt_vel(n)
    sum_wt_eta = sum_wt_eta + wt_eta(n)
    sum_wt_accel = sum_wt_accel + wt_accel2(n)
    sum_wt_trans = sum_wt_trans + wt_trans(n)
 
    if (cs%clip_velocity) then
      do j=jsv,jev ; do i=isv-1,iev
        if ((ubt(i,j) * (dt_in_t * us%m_to_L*g%dy_Cu(i,j))) * us%L_to_m**2*g%IareaT(i+1,j) < -cs%CFL_trunc) then
          ! Add some error reporting later.
          ubt(i,j) = (-0.95*cs%CFL_trunc) * (us%m_to_L**2*g%areaT(i+1,j) / (dt_in_t * us%m_to_L*g%dy_Cu(i,j)))
        elseif ((ubt(i,j) * (dt_in_t * us%m_to_L*g%dy_Cu(i,j))) * us%L_to_m**2*g%IareaT(i,j) > cs%CFL_trunc) then
          ! Add some error reporting later.
          ubt(i,j) = (0.95*cs%CFL_trunc) * (us%m_to_L**2*g%areaT(i,j) / (dt_in_t * us%m_to_L*g%dy_Cu(i,j)))
        endif
      enddo ; enddo
      do j=jsv-1,jev ; do i=isv,iev
        if ((vbt(i,j) * (dt_in_t * us%m_to_L*g%dx_Cv(i,j))) * us%L_to_m**2*g%IareaT(i,j+1) < -cs%CFL_trunc) then
          ! Add some error reporting later.
          vbt(i,j) = (-0.9*cs%CFL_trunc) * (us%m_to_L**2*g%areaT(i,j+1) / (dt_in_t * us%m_to_L*g%dx_Cv(i,j)))
        elseif ((vbt(i,j) * (dt_in_t * us%m_to_L*g%dx_Cv(i,j))) * us%L_to_m**2*g%IareaT(i,j) > cs%CFL_trunc) then
          ! Add some error reporting later.
          vbt(i,j) = (0.9*cs%CFL_trunc) * (us%m_to_L**2*g%areaT(i,j) / (dt_in_t * us%m_to_L*g%dx_Cv(i,j)))
        endif
      enddo ; enddo
    endif
 
    if ((iev - stencil < ie) .or. (jev - stencil < je)) then
      if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
      call do_group_pass(cs%pass_eta_ubt, cs%BT_Domain, clock=id_clock_pass_step)
      isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf
      if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
    else
      isv = isv+stencil ; iev = iev-stencil
      jsv = jsv+stencil ; jev = jev-stencil
    endif
 
    if ((.not.use_bt_cont) .and. cs%Nonlinear_continuity .and. &
        (cs%Nonlin_cont_update_period > 0)) then
      if ((n>1) .and. (mod(n-1,cs%Nonlin_cont_update_period) == 0)) &
        call find_face_areas(datu, datv, g, gv, us, cs, ms, eta, 1+iev-ie)
    endif
 
    !GOMP parallel default(shared)
    if (cs%dynamic_psurf .or. .not.project_velocity) then
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-2,iev+1
          uhbt(i,j) = find_uhbt(ubt(i,j), btcl_u(i,j), us) + uhbt0(i,j)
        enddo ; enddo
        !GOMP do
        do j=jsv-2,jev+1 ; do i=isv-1,iev+1
          vhbt(i,j) = find_vhbt(vbt(i,j), btcl_v(i,j), us) + vhbt0(i,j)
        enddo ; enddo
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev+1
          eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
                     ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j)))
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev+1
          eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
              (((datu(i-1,j)*ubt(i-1,j) + uhbt0(i-1,j)) - &
                (datu(i,j)*ubt(i,j) + uhbt0(i,j))) + &
               ((datv(i,j-1)*vbt(i,j-1) + vhbt0(i,j-1)) - &
                (datv(i,j)*vbt(i,j) + vhbt0(i,j))))
        enddo ; enddo
      endif
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev+1
          p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j))
        enddo ; enddo
      endif
    endif
 
    ! Recall that just outside the do n loop, there is code like...
    !  eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta
 
    if (find_etaav) then
      !GOMP do
      do j=js,je ; do i=is,ie
        eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_pf_bt(i,j)
      enddo ; enddo
    endif
 
    if (interp_eta_pf) then
      wt_end = n*instep  ! This could be (n-0.5)*Instep.
      !GOMP do
      do j=jsv-1,jev+1 ; do i=isv-1,iev+1
        eta_pf(i,j) = eta_pf_1(i,j) + wt_end*d_eta_pf(i,j)
      enddo ; enddo
    endif
 
    if (apply_obc_flather .or. apply_obc_open) then
      !GOMP do
      do j=jsv,jev ; do i=isv-2,iev+1
        ubt_old(i,j) = ubt(i,j)
      enddo ; enddo
      !GOMP do
      do j=jsv-2,jev+1 ; do i=isv,iev
        vbt_old(i,j) = vbt(i,j)
      enddo ; enddo
    endif
    !GOMP end parallel
 
    if (apply_obcs) then
      if (mod(n+g%first_direction,2)==1) then
        ioff = 1; joff = 0
      else
        ioff = 0; joff = 1
      endif
 
      if (cs%BT_OBC%apply_u_OBCs) then  ! save the old value of ubt and uhbt
        !GOMP parallel do default(shared)
        do j=jsv-joff,jev+joff ; do i=isv-1,iev
          ubt_prev(i,j) = ubt(i,j) ; uhbt_prev(i,j) = uhbt(i,j)
          ubt_sum_prev(i,j) = ubt_sum(i,j) ; uhbt_sum_prev(i,j) = uhbt_sum(i,j) ; ubt_wtd_prev(i,j) = ubt_wtd(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! save the old value of vbt and vhbt
        !GOMP parallel do default(shared)
        do j=jsv-1,jev ; do i=isv-ioff,iev+ioff
          vbt_prev(i,j) = vbt(i,j) ; vhbt_prev(i,j) = vhbt(i,j)
          vbt_sum_prev(i,j) = vbt_sum(i,j) ; vhbt_sum_prev(i,j) = vhbt_sum(i,j) ; vbt_wtd_prev(i,j) = vbt_wtd(i,j)
        enddo ; enddo
      endif
    endif
 
    !GOMP parallel default(shared) private(vel_prev)
    if (mod(n+g%first_direction,2)==1) then
      ! On odd-steps, update v first.
      !GOMP do
      do j=jsv-1,jev ; do i=isv-1,iev+1
        cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + &
               (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
        pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
                     (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
                   dgeo_de * cs%IdyCv(i,j)
      enddo ; enddo
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1
          pfv(i,j) = pfv(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * cs%IdyCv(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! zero out PF across boundary
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
          pfv(i,j) = 0.0
        endif ; enddo ; enddo
      endif
      !GOMP do
      do j=jsv-1,jev ; do i=isv-1,iev+1
        vel_prev = vbt(i,j)
        vbt(i,j) = bt_rem_v(i,j) * (vbt(i,j) + &
                    dtbt * ((bt_force_v(i,j) + cor_v(i,j)) + pfv(i,j)))
        vbt_trans(i,j) = trans_wt1*vbt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * &
              ((cor_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh_v(i,j))
        else
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * (cor_v(i,j) + pfv(i,j))
        endif
      enddo ; enddo
 
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1
          vhbt(i,j) = find_vhbt(vbt_trans(i,j), btcl_v(i,j), us) + vhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1
          vhbt(i,j) = datv(i,j)*vbt_trans(i,j) + vhbt0(i,j)
        enddo ; enddo
      endif
      if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
          vbt(i,j) = vbt_prev(i,j) ; vhbt(i,j) = vhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
      ! Now update the zonal velocity.
      !GOMP do
      do j=jsv,jev ; do i=isv-1,iev
        cor_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + &
                      (bzon(i,j) * vbt(i,j) + dzon(i,j) * vbt(i+1,j-1))) - &
                     cor_ref_u(i,j)
        pfu(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_e(i,j) - &
                     (eta_pf_bt(i+1,j)-eta_pf(i+1,j))*gtot_w(i+1,j)) * &
                    dgeo_de * cs%IdxCu(i,j)
      enddo ; enddo
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev
          pfu(i,j) = pfu(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * cs%IdxCu(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_u_OBCs) then  ! zero out pressure force across boundary
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          pfu(i,j) = 0.0
        endif ; enddo ; enddo
      endif
      !GOMP do
      do j=jsv,jev ; do i=isv-1,iev
        vel_prev = ubt(i,j)
        ubt(i,j) = bt_rem_u(i,j) * (ubt(i,j) + &
             dtbt * ((bt_force_u(i,j) + cor_u(i,j)) + pfu(i,j)))
        if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
        ubt_trans(i,j) = trans_wt1*ubt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * &
              ((cor_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh_u(i,j))
        else
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * (cor_u(i,j) + pfu(i,j))
        endif
      enddo ; enddo
 
      if (use_bt_cont) then
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev
          uhbt(i,j) = find_uhbt(ubt_trans(i,j), btcl_u(i,j), us) + uhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev
          uhbt(i,j) = datu(i,j)*ubt_trans(i,j) + uhbt0(i,j)
        enddo ; enddo
      endif
     if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          ubt(i,j) = ubt_prev(i,j); uhbt(i,j) = uhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
    else
      ! On even steps, update u first.
      !GOMP do
      do j=jsv-1,jev+1 ; do i=isv-1,iev
        cor_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + &
                      (bzon(i,j) * vbt(i,j) +  dzon(i,j) * vbt(i+1,j-1))) - &
                     cor_ref_u(i,j)
        pfu(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_e(i,j) - &
                     (eta_pf_bt(i+1,j)-eta_pf(i+1,j))*gtot_w(i+1,j)) * &
                     dgeo_de * cs%IdxCu(i,j)
      enddo ; enddo
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev
          pfu(i,j) = pfu(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * cs%IdxCu(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_u_OBCs) then  ! zero out pressure force across boundary
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          pfu(i,j) = 0.0
        endif ; enddo ; enddo
      endif
 
      !GOMP do
      do j=jsv-1,jev+1 ; do i=isv-1,iev
        vel_prev = ubt(i,j)
        ubt(i,j) = bt_rem_u(i,j) * (ubt(i,j) + &
             dtbt * ((bt_force_u(i,j) + cor_u(i,j)) + pfu(i,j)))
        if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
        ubt_trans(i,j) = trans_wt1*ubt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * &
              ((cor_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh_u(i,j))
        else
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * (cor_u(i,j) + pfu(i,j))
        endif
      enddo ; enddo
 
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev
          uhbt(i,j) = find_uhbt(ubt_trans(i,j), btcl_u(i,j), us) + uhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev
          uhbt(i,j) = datu(i,j)*ubt_trans(i,j) + uhbt0(i,j)
        enddo ; enddo
      endif
      if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          ubt(i,j) = ubt_prev(i,j); uhbt(i,j) = uhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
 
      ! Now update the meridional velocity.
      if (cs%use_old_coriolis_bracket_bug) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + bmer(i,j) * ubt(i,j)) + &
                  (cmer(i,j+1) * ubt(i,j+1) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
          pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
                       (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
                      dgeo_de * cs%IdyCv(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + &
                  (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
          pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
                       (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
                      dgeo_de * cs%IdyCv(i,j)
        enddo ; enddo
      endif
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          pfv(i,j) = pfv(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * cs%IdyCv(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! zero out PF across boundary
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
          pfv(i,j) = 0.0
        endif ; enddo ; enddo
      endif
 
      !GOMP do
      do j=jsv-1,jev ; do i=isv,iev
        vel_prev = vbt(i,j)
        vbt(i,j) = bt_rem_v(i,j) * (vbt(i,j) + &
             dtbt * ((bt_force_v(i,j) + cor_v(i,j)) + pfv(i,j)))
        if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
        vbt_trans(i,j) = trans_wt1*vbt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * &
              ((cor_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh_v(i,j))
        else
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * (cor_v(i,j) + pfv(i,j))
        endif
      enddo ; enddo
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          vhbt(i,j) = find_vhbt(vbt_trans(i,j), btcl_v(i,j), us) + vhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          vhbt(i,j) = datv(i,j)*vbt_trans(i,j) + vhbt0(i,j)
        enddo ; enddo
      endif
      if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev ; if (obc%segnum_v(i,j) /= obc_none) then
          vbt(i,j) = vbt_prev(i,j); vhbt(i,j) = vhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
    endif
    !GOMP end parallel
 
    !GOMP parallel default(shared)
    if (find_pf) then
      !GOMP do
      do j=js,je ; do i=is-1,ie
        pfu_bt_sum(i,j)  = pfu_bt_sum(i,j) + wt_accel2(n) * pfu(i,j)
      enddo ; enddo
      !GOMP do
      do j=js-1,je ; do i=is,ie
        pfv_bt_sum(i,j)  = pfv_bt_sum(i,j) + wt_accel2(n) * pfv(i,j)
      enddo ; enddo
    endif
    if (find_cor) then
      !GOMP do
      do j=js,je ; do i=is-1,ie
        coru_bt_sum(i,j) = coru_bt_sum(i,j) + wt_accel2(n) * cor_u(i,j)
      enddo ; enddo
      !GOMP do
      do j=js-1,je ; do i=is,ie
        corv_bt_sum(i,j) = corv_bt_sum(i,j) + wt_accel2(n) * cor_v(i,j)
      enddo ; enddo
    endif
 
    !GOMP do
    do j=js,je ; do i=is-1,ie
      ubt_sum(i,j) = ubt_sum(i,j) + wt_trans(n) * ubt_trans(i,j)
      uhbt_sum(i,j) = uhbt_sum(i,j) + wt_trans(n) * uhbt(i,j)
      ubt_wtd(i,j) = ubt_wtd(i,j) + wt_vel(n) * ubt(i,j)
    enddo ; enddo
    !GOMP do
    do j=js-1,je ; do i=is,ie
      vbt_sum(i,j) = vbt_sum(i,j) + wt_trans(n) * vbt_trans(i,j)
      vhbt_sum(i,j) = vhbt_sum(i,j) + wt_trans(n) * vhbt(i,j)
      vbt_wtd(i,j) = vbt_wtd(i,j) + wt_vel(n) * vbt(i,j)
    enddo ; enddo
    !GOMP end parallel
 
    if (apply_obcs) then
      if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
        !GOMP parallel do default(shared)
        do j=js,je ; do i=is-1,ie
          if (obc%segnum_u(i,j) /= obc_none) then
            ubt_sum(i,j) = ubt_sum_prev(i,j) ; uhbt_sum(i,j) = uhbt_sum_prev(i,j)
            ubt_wtd(i,j) = ubt_wtd_prev(i,j)
          endif
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
        !GOMP parallel do default(shared)
        do j=js-1,je ; do i=is,ie
          if (obc%segnum_v(i,j) /= obc_none) then
            vbt_sum(i,j) = vbt_sum_prev(i,j) ; vhbt_sum(i,j) = vhbt_sum_prev(i,j)
            vbt_wtd(i,j) = vbt_wtd_prev(i,j)
          endif
        enddo ; enddo
      endif
 
      call apply_velocity_obcs(obc, ubt, vbt, uhbt, vhbt, &
           ubt_trans, vbt_trans, eta, ubt_old, vbt_old, cs%BT_OBC, &
           g, ms, us, iev-ie, dtbt, bebt, use_bt_cont, datu, datv, btcl_u, btcl_v, &
           uhbt0, vhbt0)
      if (cs%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do i=is-1,ie
        if (obc%segnum_u(i,j) /= obc_none) then
          ubt_sum(i,j) = ubt_sum(i,j) + wt_trans(n) * ubt_trans(i,j)
          uhbt_sum(i,j) = uhbt_sum(i,j) + wt_trans(n) * uhbt(i,j)
          ubt_wtd(i,j) = ubt_wtd(i,j) + wt_vel(n) * ubt(i,j)
        endif
      enddo ; enddo ; endif
      if (cs%BT_OBC%apply_v_OBCs) then ; do j=js-1,je ; do i=is,ie
        if (obc%segnum_v(i,j) /= obc_none) then
          vbt_sum(i,j) = vbt_sum(i,j) + wt_trans(n) * vbt_trans(i,j)
          vhbt_sum(i,j) = vhbt_sum(i,j) + wt_trans(n) * vhbt(i,j)
          vbt_wtd(i,j) = vbt_wtd(i,j) + wt_vel(n) * vbt(i,j)
        endif
      enddo ; enddo ; endif
    endif
 
    if (cs%debug_bt) then
      call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, cs%debug_BT_HI, haloshift=iev-ie, &
                    scale=us%s_to_T*us%L_to_m**2*gv%H_to_m)
    endif
 
    !$OMP parallel do default(shared)
    do j=jsv,jev ; do i=isv,iev
      eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
                 ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j)))
      eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n)
      ! Should there be a concern if eta drops below 0 or G%bathyT?
    enddo ; enddo
 
    if (do_hifreq_output) then
      time_step_end = time_bt_start + real_to_time(n*us%T_to_s*dtbt)
      call enable_averaging(us%T_to_s*dtbt, time_step_end, cs%diag)
      if (cs%id_ubt_hifreq > 0) call post_data(cs%id_ubt_hifreq, ubt(isdb:iedb,jsd:jed), cs%diag)
      if (cs%id_vbt_hifreq > 0) call post_data(cs%id_vbt_hifreq, vbt(isd:ied,jsdb:jedb), cs%diag)
      if (cs%id_eta_hifreq > 0) call post_data(cs%id_eta_hifreq, eta(isd:ied,jsd:jed), cs%diag)
      if (cs%id_uhbt_hifreq > 0) call post_data(cs%id_uhbt_hifreq, uhbt(isdb:iedb,jsd:jed), cs%diag)
      if (cs%id_vhbt_hifreq > 0) call post_data(cs%id_vhbt_hifreq, vhbt(isd:ied,jsdb:jedb), cs%diag)
      if (cs%id_eta_pred_hifreq > 0) call post_data(cs%id_eta_pred_hifreq, eta_pf_bt(isd:ied,jsd:jed), cs%diag)
    endif
 
    if (cs%debug_bt) then
      write(mesg,'("BT step ",I4)') n
      call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, cs%debug_BT_HI, haloshift=iev-ie, &
                    scale=us%L_T_to_m_s)
      call hchksum(eta, trim(mesg)//" eta", cs%debug_BT_HI, haloshift=iev-ie, scale=gv%H_to_m)
    endif
 
  enddo ! end of do n=1,ntimestep
  if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
 
  ! Reset the time information in the diag type.
  if (do_hifreq_output) call enable_averaging(time_int_in, time_end_in, cs%diag)
 
  i_sum_wt_vel = 1.0 / sum_wt_vel ; i_sum_wt_eta = 1.0 / sum_wt_eta
  i_sum_wt_accel = 1.0 / sum_wt_accel ; i_sum_wt_trans = 1.0 / sum_wt_trans
 
  if (find_etaav) then ; do j=js,je ; do i=is,ie
    etaav(i,j) = eta_sum(i,j) * i_sum_wt_accel
  enddo ; enddo ; endif
  do j=js-1,je+1 ; do i=is-1,ie+1 ; e_anom(i,j) = 0.0 ; enddo ; enddo
  if (interp_eta_pf) then
    do j=js,je ; do i=is,ie
      e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - &
                               (eta_pf_1(i,j) + 0.5*d_eta_pf(i,j)))
    enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - eta_pf(i,j))
    enddo ; enddo
  endif
  if (apply_obcs) then
    !!! Not safe for wide halos...
    if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
      !GOMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
          e_anom(i+1,j) = e_anom(i,j)
        elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
          e_anom(i,j) = e_anom(i+1,j)
        endif
      enddo ; enddo
    endif
 
    if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
      !GOMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
          e_anom(i,j+1) = e_anom(i,j)
        elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
          e_anom(i,j) = e_anom(i,j+1)
        endif
      enddo ; enddo
    endif
  endif
 
  ! It is possible that eta_out and eta_in are the same.
  do j=js,je ; do i=is,ie
    eta_out(i,j) = eta_wtd(i,j) * i_sum_wt_eta
  enddo ; enddo
 
  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
  if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
  if (g%nonblocking_updates) then
    call start_group_pass(cs%pass_e_anom, g%Domain)
  else
    if (find_etaav) call do_group_pass(cs%pass_etaav, g%Domain)
    call do_group_pass(cs%pass_e_anom, g%Domain)
  endif
  if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
 
  do j=js,je ; do i=is-1,ie
    cs%ubtav(i,j) = ubt_sum(i,j) * i_sum_wt_trans
    uhbtav(i,j) = us%s_to_T*us%L_to_m**2*uhbt_sum(i,j) * i_sum_wt_trans
 ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
 !###   u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel
    ubt_wtd(i,j) = ubt_wtd(i,j) * i_sum_wt_vel
  enddo ; enddo
 
  do j=js-1,je ; do i=is,ie
    cs%vbtav(i,j) = vbt_sum(i,j) * i_sum_wt_trans
    vhbtav(i,j) = us%s_to_T*us%L_to_m**2*vhbt_sum(i,j) * i_sum_wt_trans
 ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
 !###   v_accel_bt(i,J) = v_accel_bt(i,J)  * I_sum_wt_accel
    vbt_wtd(i,j) = vbt_wtd(i,j) * i_sum_wt_vel
  enddo ; enddo
 
  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
  if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
  if (g%nonblocking_updates) then
    call complete_group_pass(cs%pass_e_anom, g%Domain)
    if (find_etaav) call start_group_pass(cs%pass_etaav, g%Domain)
    call start_group_pass(cs%pass_ubta_uhbta, g%DoMain)
  else
    call do_group_pass(cs%pass_ubta_uhbta, g%Domain)
  endif
  if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
 
  ! Now calculate each layer's accelerations.
  !$OMP parallel do default(shared)
  do k=1,nz
    do j=js,je ; do i=is-1,ie
      accel_layer_u(i,j,k) = us%L_T2_to_m_s2 * (u_accel_bt(i,j) - &
           ((pbce(i+1,j,k) - gtot_w(i+1,j)) * e_anom(i+1,j) - &
            (pbce(i,j,k) - gtot_e(i,j)) * e_anom(i,j)) * cs%IdxCu(i,j) )
      if (abs(accel_layer_u(i,j,k)) < accel_underflow) accel_layer_u(i,j,k) = 0.0
    enddo ; enddo
    do j=js-1,je ; do i=is,ie
      accel_layer_v(i,j,k) = us%L_T2_to_m_s2 * (v_accel_bt(i,j) - &
           ((pbce(i,j+1,k) - gtot_s(i,j+1)) * e_anom(i,j+1) - &
            (pbce(i,j,k) - gtot_n(i,j)) * e_anom(i,j)) * cs%IdyCv(i,j) )
      if (abs(accel_layer_v(i,j,k)) < accel_underflow) accel_layer_v(i,j,k) = 0.0
    enddo ; enddo
  enddo
 
  if (apply_obcs) then
    ! Correct the accelerations at OBC velocity points, but only in the
    ! symmetric-memory computational domain, not in the wide halo regions.
    if (cs%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do i=is-1,ie
      if (obc%segnum_u(i,j) /= obc_none) then
        u_accel_bt(i,j) = (ubt_wtd(i,j) - ubt_first(i,j)) / dt_in_t
        do k=1,nz ; accel_layer_u(i,j,k) = us%L_T2_to_m_s2*u_accel_bt(i,j) ; enddo
      endif
    enddo ; enddo ; endif
    if (cs%BT_OBC%apply_v_OBCs) then ; do j=js-1,je ; do i=is,ie
      if (obc%segnum_v(i,j) /= obc_none) then
        v_accel_bt(i,j) = (vbt_wtd(i,j) - vbt_first(i,j)) / dt_in_t
        do k=1,nz ; accel_layer_v(i,j,k) = us%L_T2_to_m_s2*v_accel_bt(i,j) ; enddo
      endif
    enddo ; enddo ; endif
  endif
 
  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
 
  ! Calculate diagnostic quantities.
  if (query_averaging_enabled(cs%diag)) then
 
    do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = ubt_wtd(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = vbt_wtd(i,j) ; enddo ; enddo
    if (use_bt_cont) then
      do j=js,je ; do i=is-1,ie
        cs%uhbt_IC(i,j) = find_uhbt(ubt_wtd(i,j), btcl_u(i,j), us) + uhbt0(i,j)
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        cs%vhbt_IC(i,j) = find_vhbt(vbt_wtd(i,j), btcl_v(i,j), us) + vhbt0(i,j)
      enddo ; enddo
    else
      do j=js,je ; do i=is-1,ie
        cs%uhbt_IC(i,j) = ubt_wtd(i,j) * datu(i,j) + uhbt0(i,j)
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        cs%vhbt_IC(i,j) = vbt_wtd(i,j) * datv(i,j) + vhbt0(i,j)
      enddo ; enddo
    endif
 
!  Offer various barotropic terms for averaging.
    if (cs%id_PFu_bt > 0) then
      do j=js,je ; do i=is-1,ie
        pfu_bt_sum(i,j) = pfu_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_PFu_bt, pfu_bt_sum(isdb:iedb,jsd:jed), cs%diag)
    endif
    if (cs%id_PFv_bt > 0) then
      do j=js-1,je ; do i=is,ie
        pfv_bt_sum(i,j) = pfv_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_PFv_bt, pfv_bt_sum(isd:ied,jsdb:jedb), cs%diag)
    endif
    if (cs%id_Coru_bt > 0) then
      do j=js,je ; do i=is-1,ie
        coru_bt_sum(i,j) = coru_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_Coru_bt, coru_bt_sum(isdb:iedb,jsd:jed), cs%diag)
    endif
    if (cs%id_Corv_bt > 0) then
      do j=js-1,je ; do i=is,ie
        corv_bt_sum(i,j) = corv_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_Corv_bt, corv_bt_sum(isd:ied,jsdb:jedb), cs%diag)
    endif
    if (cs%id_ubtforce > 0) call post_data(cs%id_ubtforce, bt_force_u(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vbtforce > 0) call post_data(cs%id_vbtforce, bt_force_v(isd:ied,jsdb:jedb), cs%diag)
    if (cs%id_uaccel > 0) call post_data(cs%id_uaccel, u_accel_bt(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vaccel > 0) call post_data(cs%id_vaccel, v_accel_bt(isd:ied,jsdb:jedb), cs%diag)
 
    if (cs%id_eta_cor > 0) call post_data(cs%id_eta_cor, cs%eta_cor, cs%diag)
    if (cs%id_eta_bt > 0) call post_data(cs%id_eta_bt, eta_out, cs%diag)
    if (cs%id_gtotn > 0) call post_data(cs%id_gtotn, gtot_n(isd:ied,jsd:jed), cs%diag)
    if (cs%id_gtots > 0) call post_data(cs%id_gtots, gtot_s(isd:ied,jsd:jed), cs%diag)
    if (cs%id_gtote > 0) call post_data(cs%id_gtote, gtot_e(isd:ied,jsd:jed), cs%diag)
    if (cs%id_gtotw > 0) call post_data(cs%id_gtotw, gtot_w(isd:ied,jsd:jed), cs%diag)
    if (cs%id_ubt > 0) call post_data(cs%id_ubt, ubt_wtd(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vbt > 0) call post_data(cs%id_vbt, vbt_wtd(isd:ied,jsdb:jedb), cs%diag)
    if (cs%id_ubtav > 0) call post_data(cs%id_ubtav, cs%ubtav, cs%diag)
    if (cs%id_vbtav > 0) call post_data(cs%id_vbtav, cs%vbtav, cs%diag)
    if (cs%id_visc_rem_u > 0) call post_data(cs%id_visc_rem_u, visc_rem_u, cs%diag)
    if (cs%id_visc_rem_v > 0) call post_data(cs%id_visc_rem_v, visc_rem_v, cs%diag)
 
    if (cs%id_frhatu > 0) call post_data(cs%id_frhatu, cs%frhatu, cs%diag)
    if (cs%id_uhbt > 0) call post_data(cs%id_uhbt, uhbtav, cs%diag)
    if (cs%id_frhatv > 0) call post_data(cs%id_frhatv, cs%frhatv, cs%diag)
    if (cs%id_vhbt > 0) call post_data(cs%id_vhbt, vhbtav, cs%diag)
    if (cs%id_uhbt0 > 0) call post_data(cs%id_uhbt0, uhbt0(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vhbt0 > 0) call post_data(cs%id_vhbt0, vhbt0(isd:ied,jsdb:jedb), cs%diag)
 
    if (cs%id_frhatu1 > 0) call post_data(cs%id_frhatu1, cs%frhatu1, cs%diag)
    if (cs%id_frhatv1 > 0) call post_data(cs%id_frhatv1, cs%frhatv1, cs%diag)
 
    if (use_bt_cont) then
      if (cs%id_BTC_FA_u_EE > 0) call post_data(cs%id_BTC_FA_u_EE, bt_cont%FA_u_EE, cs%diag)
      if (cs%id_BTC_FA_u_E0 > 0) call post_data(cs%id_BTC_FA_u_E0, bt_cont%FA_u_E0, cs%diag)
      if (cs%id_BTC_FA_u_W0 > 0) call post_data(cs%id_BTC_FA_u_W0, bt_cont%FA_u_W0, cs%diag)
      if (cs%id_BTC_FA_u_WW > 0) call post_data(cs%id_BTC_FA_u_WW, bt_cont%FA_u_WW, cs%diag)
      if (cs%id_BTC_uBT_EE > 0) call post_data(cs%id_BTC_uBT_EE, bt_cont%uBT_EE, cs%diag)
      if (cs%id_BTC_uBT_WW > 0) call post_data(cs%id_BTC_uBT_WW, bt_cont%uBT_WW, cs%diag)
      if (cs%id_BTC_FA_v_NN > 0) call post_data(cs%id_BTC_FA_v_NN, bt_cont%FA_v_NN, cs%diag)
      if (cs%id_BTC_FA_v_N0 > 0) call post_data(cs%id_BTC_FA_v_N0, bt_cont%FA_v_N0, cs%diag)
      if (cs%id_BTC_FA_v_S0 > 0) call post_data(cs%id_BTC_FA_v_S0, bt_cont%FA_v_S0, cs%diag)
      if (cs%id_BTC_FA_v_SS > 0) call post_data(cs%id_BTC_FA_v_SS, bt_cont%FA_v_SS, cs%diag)
      if (cs%id_BTC_vBT_NN > 0) call post_data(cs%id_BTC_vBT_NN, bt_cont%vBT_NN, cs%diag)
      if (cs%id_BTC_vBT_SS > 0) call post_data(cs%id_BTC_vBT_SS, bt_cont%vBT_SS, cs%diag)
    endif
  else
    if (cs%id_frhatu1 > 0) cs%frhatu1(:,:,:) = cs%frhatu(:,:,:)
    if (cs%id_frhatv1 > 0) cs%frhatv1(:,:,:) = cs%frhatv(:,:,:)
  endif
 
  if (g%nonblocking_updates) then
    if (find_etaav) call complete_group_pass(cs%pass_etaav, g%Domain)
    call complete_group_pass(cs%pass_ubta_uhbta, g%Domain)
  endif
 
end subroutine btstep
 
!> This subroutine automatically determines an optimal value for dtbt based
!! on some state of the ocean.
subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
  type(ocean_grid_type),        intent(inout) :: g    !< The ocean's grid structure.
  type(verticalgrid_type),      intent(in)    :: gv   !< The ocean's vertical grid structure.
  type(unit_scale_type),        intent(in)    :: us   !< A dimensional unit scaling type
  type(barotropic_cs),          pointer       :: cs   !< Barotropic control structure.
  real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta  !< The barotropic free surface
                                                      !! height anomaly or column mass anomaly [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce  !< The baroclinic pressure
                                                      !! anomaly in each layer due to free surface
                                                      !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
  type(bt_cont_type), optional, pointer       :: bt_cont  !< A structure with elements that describe
                                                      !! the effective open face areas as a
                                                      !! function of barotropic flow.
  real,               optional, intent(in)    :: gtot_est !< An estimate of the total gravitational
                                                      !! acceleration [L2 Z-1 T-2 ~> m s-2].
  real,               optional, intent(in)    :: ssh_add  !< An additional contribution to SSH to
                                                      !! provide a margin of error when
                                                      !! calculating the external wave speed [Z ~> m].
 
  ! Local variables
  real, dimension(SZI_(G),SZJ_(G)) :: &
    gtot_e, &     ! gtot_X is the effective total reduced gravity used to relate
    gtot_w, &     ! free surface height deviations to pressure forces (including
    gtot_n, &     ! GFS and baroclinic  contributions) in the barotropic momentum
    gtot_s        ! equations half a grid-point in the X-direction (X is N, S, E, or W)
                  ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
                  ! (See Hallberg, J Comp Phys 1997 for a discussion.)
  real, dimension(SZIBS_(G),SZJ_(G)) :: &
    datu          ! Basin depth at u-velocity grid points times the y-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real, dimension(SZI_(G),SZJBS_(G)) :: &
    datv          ! Basin depth at v-velocity grid points times the x-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real :: det_de  ! The partial derivative due to self-attraction and loading
                  ! of the reference geopotential with the sea surface height [nondim].
                  ! This is typically ~0.09 or less.
  real :: dgeo_de ! The constant of proportionality between geopotential and
                  ! sea surface height [nondim].  It is a nondimensional number of
                  ! order 1.  For stability, this may be made larger
                  ! than physical problem would suggest.
  real :: add_ssh ! An additional contribution to SSH to provide a margin of error
                  ! when calculating the external wave speed [Z ~> m].
  real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic
                      ! timesteps [T2 ~> s2]
  real :: dtbt_max    ! The maximum barotropic timestep [T ~> s]
  real :: idt_max2    ! The squared inverse of the local maximum stable
                      ! barotropic time step [T-2 ~> s-2].
  logical :: use_bt_cont
  type(memory_size_type) :: ms
 
  character(len=200) :: mesg
  integer :: i, j, k, is, ie, js, je, nz
 
  if (.not.associated(cs)) call mom_error(fatal, &
      "set_dtbt: Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed
 
  if (.not.(present(pbce) .or. present(gtot_est))) call mom_error(fatal, &
      "set_dtbt: Either pbce or gtot_est must be present.")
 
  add_ssh = 0.0 ; if (present(ssh_add)) add_ssh = ssh_add
 
  use_bt_cont = .false.
  if (present(bt_cont)) use_bt_cont = (associated(bt_cont))
 
  if (use_bt_cont) then
    call bt_cont_to_face_areas(bt_cont, datu, datv, g, us, ms, 0, .true.)
  elseif (cs%Nonlinear_continuity .and. present(eta)) then
    call find_face_areas(datu, datv, g, gv, us, cs, ms, eta=eta, halo=0)
  else
    call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=0, add_max=add_ssh)
  endif
 
  det_de = 0.0
  if (cs%tides) call tidal_forcing_sensitivity(g, cs%tides_CSp, det_de)
  dgeo_de = 1.0 + max(0.0, det_de + cs%G_extra)
  if (present(pbce)) then
    do j=js,je ; do i=is,ie
      gtot_e(i,j) = 0.0 ; gtot_w(i,j) = 0.0
      gtot_n(i,j) = 0.0 ; gtot_s(i,j) = 0.0
    enddo ; enddo
    do k=1,nz ; do j=js,je ; do i=is,ie
      gtot_e(i,j) = gtot_e(i,j) + pbce(i,j,k) * cs%frhatu(i,j,k)
      gtot_w(i,j) = gtot_w(i,j) + pbce(i,j,k) * cs%frhatu(i-1,j,k)
      gtot_n(i,j) = gtot_n(i,j) + pbce(i,j,k) * cs%frhatv(i,j,k)
      gtot_s(i,j) = gtot_s(i,j) + pbce(i,j,k) * cs%frhatv(i,j-1,k)
    enddo ; enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      gtot_e(i,j) = gtot_est * gv%H_to_Z ; gtot_w(i,j) = gtot_est * gv%H_to_Z
      gtot_n(i,j) = gtot_est * gv%H_to_Z ; gtot_s(i,j) = gtot_est * gv%H_to_Z
    enddo ; enddo
  endif
 
  min_max_dt2 = 1.0e38*us%s_to_T**2  ! A huge value for the permissible timestep squared.
  do j=js,je ; do i=is,ie
    !   This is pretty accurate for gravity waves, but it is a conservative
    ! estimate since it ignores the stabilizing effect of the bottom drag.
    idt_max2 = 0.5 * (1.0 + 2.0*cs%bebt) * (us%L_to_m**2*g%IareaT(i,j) * &
      ((gtot_e(i,j)*datu(i,j)*us%L_to_m*g%IdxCu(i,j) + gtot_w(i,j)*datu(i-1,j)*us%L_to_m*g%IdxCu(i-1,j)) + &
       (gtot_n(i,j)*datv(i,j)*us%L_to_m*g%IdyCv(i,j) + gtot_s(i,j)*datv(i,j-1)*us%L_to_m*g%IdyCv(i,j-1))) + &
      ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
       (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)))
    if (idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / idt_max2
  enddo ; enddo
  dtbt_max = sqrt(min_max_dt2 / dgeo_de)
  if (id_clock_sync > 0) call cpu_clock_begin(id_clock_sync)
  call min_across_pes(dtbt_max)
  if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync)
 
  cs%dtbt = cs%dtbt_fraction * us%T_to_s * dtbt_max
  cs%dtbt_max = us%T_to_s * dtbt_max
end subroutine set_dtbt
 
!> The following 4 subroutines apply the open boundary conditions.
!! This subroutine applies the open boundary conditions on barotropic
!! velocities and mass transports, as developed by Mehmet Ilicak.
subroutine apply_velocity_obcs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, &
                               eta, ubt_old, vbt_old, BT_OBC, &
                               G, MS, US, halo, dtbt, bebt, use_BT_cont, Datu, Datv, &
                               BTCL_u, BTCL_v, uhbt0, vhbt0)
  type(ocean_obc_type),                  pointer       :: OBC     !< An associated pointer to an OBC type.
  type(ocean_grid_type),                 intent(inout) :: G       !< The ocean's grid structure.
  type(memory_size_type),                intent(in)    :: MS      !< A type that describes the memory sizes of
                                                                  !! the argument arrays.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt     !< the zonal barotropic velocity [m s-1].
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt    !< the zonal barotropic transport
                                                                  !! [H m2 s-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in
                                                                  !! transport [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt     !< the meridional barotropic velocity [m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt    !< the meridional barotropic transport
                                                                  !! [H m2 s-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in
                                                                  !! transports [m s-1].
  real, dimension(SZIW_(MS),SZJW_(MS)),  intent(in)    :: eta     !< The barotropic free surface height anomaly or
                                                                  !! column mass anomaly [H ~> m or kg m-2].
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: ubt_old !< The starting value of ubt in a barotropic
                                                                  !! step [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: vbt_old !< The starting value of vbt in a barotropic
                                                                  !! step [L T-1 ~> m s-1].
  type(bt_obc_type),                     intent(in)    :: BT_OBC  !< A structure with the private barotropic arrays
                                                                  !! related to the open boundary conditions,
                                                                  !! set by set_up_BT_OBC.
  type(unit_scale_type),                 intent(in)    :: US      !< A dimensional unit scaling type
  integer,                               intent(in)    :: halo    !< The extra halo size to use here.
  real,                                  intent(in)    :: dtbt    !< The time step [T ~> s].
  real,                                  intent(in)    :: bebt    !< The fractional weighting of the future velocity
                                                                  !! in determining the transport.
  logical,                               intent(in)    :: use_BT_cont !< If true, use the BT_cont_types to calculate
                                                                  !! transports.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: Datu    !< A fixed estimate of the face areas at u points
                                                                  !! [H L ~> m2 or kg m-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: Datv    !< A fixed estimate of the face areas at v points
                                                                  !! [H L ~> m2 or kg m-1].
  type(local_bt_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
                                                                  !! for a dynamic estimate of the face areas at
                                                                  !! u-points.
  type(local_bt_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
                                                                  !! for a dynamic estimate of the face areas at
                                                                  !! v-points.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: uhbt0   !< A correction to the zonal transport so that
                                                                  !! the barotropic functions agree with the sum
                                                                  !! of the layer transports
                                                                  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: vhbt0   !< A correction to the meridional transport so that
                                                                  !! the barotropic functions agree with the sum
                                                                  !! of the layer transports
                                                                  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
 
  ! Local variables
  real :: vel_prev    ! The previous velocity [L T-1 ~> m s-1].
  real :: vel_trans   ! The combination of the previous and current velocity
                      ! that does the mass transport [L T-1 ~> m s-1].
  real :: H_u         ! The total thickness at the u-point [H ~> m or kg m-2].
  real :: H_v         ! The total thickness at the v-point [H ~> m or kg m-2].
  real :: cfl         ! The CFL number at the point in question [nondim]
  real :: u_inlet     ! The zonal inflow velocity [L T-1 ~> m s-1]
  real :: v_inlet     ! The meridional inflow velocity [L T-1 ~> m s-1]
  real :: h_in
  real :: cff, Cx, Cy, tau
  real :: dhdt, dhdx, dhdy
  integer :: i, j, is, ie, js, je
  real, dimension(SZIB_(G),SZJB_(G)) :: grad
  real, parameter :: eps = 1.0e-20
  real :: rx_max, ry_max ! coefficients for radiation
  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
  rx_max = obc%rx_max ; ry_max = obc%rx_max
 
  if (bt_obc%apply_u_OBCs) then
    do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
      if (obc%segment(obc%segnum_u(i,j))%specified) then
        uhbt(i,j) = bt_obc%uhbt(i,j)
        ubt(i,j) = bt_obc%ubt_outer(i,j)
        vel_trans = ubt(i,j)
      elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
        if (obc%segment(obc%segnum_u(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_u(i,j) * us%L_to_m*g%IdxCu(i,j) ! CFL
          u_inlet = cfl*ubt_old(i-1,j) + (1.0-cfl)*ubt_old(i,j)  ! Valid for cfl<1
          h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j))      ! internal
          h_u = bt_obc%H_u(i,j)
          vel_prev = ubt(i,j)
          ubt(i,j) = 0.5*((u_inlet + bt_obc%ubt_outer(i,j)) + &
              (bt_obc%Cg_u(i,j)/h_u) * (h_in-bt_obc%eta_outer_u(i,j)))
          vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(i,j)
        elseif (obc%segment(obc%segnum_u(i,j))%gradient) then
          ubt(i,j) = ubt(i-1,j)
          vel_trans = ubt(i,j)
        endif
      elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
        if (obc%segment(obc%segnum_u(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_u(i,j) * us%L_to_m*g%IdxCu(i,j) ! CFL
          u_inlet = cfl*ubt_old(i+1,j) + (1.0-cfl)*ubt_old(i,j)  ! Valid for cfl<1
          h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j))  ! external
 
          h_u = bt_obc%H_u(i,j)
          vel_prev = ubt(i,j)
          ubt(i,j) = 0.5*((u_inlet + bt_obc%ubt_outer(i,j)) + &
              (bt_obc%Cg_u(i,j)/h_u) * (bt_obc%eta_outer_u(i,j)-h_in))
 
          vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(i,j)
        elseif (obc%segment(obc%segnum_u(i,j))%gradient) then
          ubt(i,j) = ubt(i+1,j)
          vel_trans = ubt(i,j)
        endif
      endif
 
      if (.not. obc%segment(obc%segnum_u(i,j))%specified) then
        if (use_bt_cont) then
          uhbt(i,j) = find_uhbt(vel_trans, btcl_u(i,j), us) + uhbt0(i,j)
        else
          uhbt(i,j) = datu(i,j)*vel_trans + uhbt0(i,j)
        endif
      endif
 
      ubt_trans(i,j) = vel_trans
    endif ; enddo ; enddo
  endif
 
  if (bt_obc%apply_v_OBCs) then
    do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
      if (obc%segment(obc%segnum_v(i,j))%specified) then
        vhbt(i,j) = bt_obc%vhbt(i,j)
        vbt(i,j) = bt_obc%vbt_outer(i,j)
        vel_trans = vbt(i,j)
      elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
        if (obc%segment(obc%segnum_v(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_v(i,j) * us%L_to_m*g%IdyCv(i,j) ! CFL
          v_inlet = cfl*vbt_old(i,j-1) + (1.0-cfl)*vbt_old(i,j)  ! Valid for cfl<1
          h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1))      ! internal
 
          h_v = bt_obc%H_v(i,j)
          vel_prev = vbt(i,j)
          vbt(i,j) = 0.5*((v_inlet + bt_obc%vbt_outer(i,j)) + &
              (bt_obc%Cg_v(i,j)/h_v) * (h_in-bt_obc%eta_outer_v(i,j)))
 
          vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,j)
        elseif (obc%segment(obc%segnum_v(i,j))%gradient) then
          vbt(i,j) = vbt(i,j-1)
          vel_trans = vbt(i,j)
        endif
      elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
        if (obc%segment(obc%segnum_v(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_v(i,j) * us%L_to_m*g%IdyCv(i,j) ! CFL
          v_inlet = cfl*vbt_old(i,j+1) + (1.0-cfl)*vbt_old(i,j)  ! Valid for cfl <1
          h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2))  ! internal
 
          h_v = bt_obc%H_v(i,j)
          vel_prev = vbt(i,j)
          vbt(i,j) = 0.5*((v_inlet + bt_obc%vbt_outer(i,j)) + &
              (bt_obc%Cg_v(i,j)/h_v) * (bt_obc%eta_outer_v(i,j)-h_in))
 
          vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,j)
        elseif (obc%segment(obc%segnum_v(i,j))%gradient) then
          vbt(i,j) = vbt(i,j+1)
          vel_trans = vbt(i,j)
        endif
      endif
 
      if (.not. obc%segment(obc%segnum_v(i,j))%specified) then
        if (use_bt_cont) then
           vhbt(i,j) = find_vhbt(vel_trans, btcl_v(i,j), us) + vhbt0(i,j)
        else
           vhbt(i,j) = vel_trans*datv(i,j) + vhbt0(i,j)
        endif
      endif
 
      vbt_trans(i,j) = vel_trans
    endif ; enddo ; enddo
  endif
 
end subroutine apply_velocity_obcs
 
!> This subroutine sets up the private structure used to apply the open
!! boundary conditions, as developed by Mehmet Ilicak.
subroutine set_up_bt_obc(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v)
  type(ocean_obc_type),                  pointer       :: OBC    !< An associated pointer to an OBC type.
  type(memory_size_type),                intent(in)    :: MS     !< A type that describes the memory sizes of the
                                                                 !! argument arrays.
  real, dimension(SZIW_(MS),SZJW_(MS)),  intent(in)    :: eta    !< The barotropic free surface height anomaly or
                                                                 !! column mass anomaly [H ~> m or kg m-2].
  type(bt_obc_type),                     intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
                                                                 !! related to the open boundary conditions,
                                                                 !! set by set_up_BT_OBC.
  type(mom_domain_type),                 intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
  type(ocean_grid_type),                 intent(inout) :: G      !< The ocean's grid structure.
  type(verticalgrid_type),               intent(in)    :: GV     !< The ocean's vertical grid structure.
  type(unit_scale_type),                 intent(in)    :: US     !< A dimensional unit scaling type
  integer,                               intent(in)    :: halo   !< The extra halo size to use here.
  logical,                               intent(in)    :: use_BT_cont !< If true, use the BT_cont_types to calculate
                                                                 !! transports.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: Datu   !< A fixed estimate of the face areas at u points
                                                                 !! [L m ~> m2 or kg m-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: Datv   !< A fixed estimate of the face areas at v points
                                                                 !! [L m ~> m2 or kg m-1].
  type(local_bt_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
                                                                 !! for a dynamic estimate of the face areas at
                                                                 !! u-points.
  type(local_bt_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
                                                                 !! for a dynamic estimate of the face areas at
                                                                 !! v-points.
 
  ! Local variables
  integer :: i, j, k, is, ie, js, je, n, nz, Isq, Ieq, Jsq, Jeq
  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
  integer :: isdw, iedw, jsdw, jedw
  logical :: OBC_used
  type(obc_segment_type), pointer  :: segment !< Open boundary segment
 
 
  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed ; nz = g%ke
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  isdw = ms%isdw ; iedw = ms%iedw ; jsdw = ms%jsdw ; jedw = ms%jedw
 
 
  if ((isdw < isd) .or. (jsdw < jsd)) then
    call mom_error(fatal, "set_up_BT_OBC: Open boundary conditions are not "//&
                           "yet fully implemented with wide barotropic halos.")
  endif
 
  if (.not. bt_obc%is_alloced) then
    allocate(bt_obc%Cg_u(isdw-1:iedw,jsdw:jedw))        ; bt_obc%Cg_u(:,:) = 0.0
    allocate(bt_obc%H_u(isdw-1:iedw,jsdw:jedw))         ; bt_obc%H_u(:,:) = 0.0
    allocate(bt_obc%uhbt(isdw-1:iedw,jsdw:jedw))        ; bt_obc%uhbt(:,:) = 0.0
    allocate(bt_obc%ubt_outer(isdw-1:iedw,jsdw:jedw))   ; bt_obc%ubt_outer(:,:) = 0.0
    allocate(bt_obc%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; bt_obc%eta_outer_u(:,:) = 0.0
 
    allocate(bt_obc%Cg_v(isdw:iedw,jsdw-1:jedw))        ; bt_obc%Cg_v(:,:) = 0.0
    allocate(bt_obc%H_v(isdw:iedw,jsdw-1:jedw))         ; bt_obc%H_v(:,:) = 0.0
    allocate(bt_obc%vhbt(isdw:iedw,jsdw-1:jedw))        ; bt_obc%vhbt(:,:) = 0.0
    allocate(bt_obc%vbt_outer(isdw:iedw,jsdw-1:jedw))   ; bt_obc%vbt_outer(:,:) = 0.0
    allocate(bt_obc%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; bt_obc%eta_outer_v(:,:)=0.0
    bt_obc%is_alloced = .true.
    call create_group_pass(bt_obc%pass_uv, bt_obc%ubt_outer, bt_obc%vbt_outer, bt_domain)
    call create_group_pass(bt_obc%pass_uhvh, bt_obc%uhbt, bt_obc%vhbt, bt_domain)
    call create_group_pass(bt_obc%pass_eta_outer, bt_obc%eta_outer_u, bt_obc%eta_outer_v, bt_domain,to_all+scalar_pair)
    call create_group_pass(bt_obc%pass_h, bt_obc%H_u, bt_obc%H_v, bt_domain,to_all+scalar_pair)
    call create_group_pass(bt_obc%pass_cg, bt_obc%Cg_u, bt_obc%Cg_v, bt_domain,to_all+scalar_pair)
  endif
 
  if (bt_obc%apply_u_OBCs) then
    if (obc%specified_u_BCs_exist_globally) then
      do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_E_or_W .and. segment%specified) then
          do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
            bt_obc%uhbt(i,j) = 0.
          enddo ; enddo
          do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
            bt_obc%uhbt(i,j) = bt_obc%uhbt(i,j) + us%T_to_s*us%m_to_L**2*segment%normal_trans(i,j,k)
          enddo ; enddo ; enddo
        endif
      enddo
    endif
    do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
      ! Can this go in segment loop above? Is loop above wrong for wide halos??
      if (obc%segment(obc%segnum_u(i,j))%specified) then
        if (use_bt_cont) then
          bt_obc%ubt_outer(i,j) = uhbt_to_ubt(bt_obc%uhbt(i,j), btcl_u(i,j), us)
        else
          if (datu(i,j) > 0.0) bt_obc%ubt_outer(i,j) = bt_obc%uhbt(i,j) / datu(i,j)
        endif
      else  ! This is assuming Flather as only other option
        if (gv%Boussinesq) then
          if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
            bt_obc%H_u(i,j) = g%bathyT(i,j)*gv%Z_to_H + eta(i,j)
          elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
            bt_obc%H_u(i,j) = g%bathyT(i+1,j)*gv%Z_to_H + eta(i+1,j)
          endif
        else
          if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
            bt_obc%H_u(i,j) = eta(i,j)
          elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
            bt_obc%H_u(i,j) = eta(i+1,j)
          endif
        endif
        bt_obc%Cg_u(i,j) = sqrt(gv%g_prime(1) * gv%H_to_Z*bt_obc%H_u(i,j))
      endif
    endif ; enddo ; enddo
    if (obc%Flather_u_BCs_exist_globally) then
     do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_E_or_W .and. segment%Flather) then
          do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
            bt_obc%ubt_outer(i,j) = us%m_s_to_L_T*segment%normal_vel_bt(i,j)
            bt_obc%eta_outer_u(i,j) = segment%eta(i,j)
          enddo ; enddo
        endif
      enddo
    endif
  endif
 
  if (bt_obc%apply_v_OBCs) then
    if (obc%specified_v_BCs_exist_globally) then
      do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_N_or_S .and. segment%specified) then
          do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
            bt_obc%vhbt(i,j) = 0.
          enddo ; enddo
          do k=1,nz ; do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
            bt_obc%vhbt(i,j) = bt_obc%vhbt(i,j) + us%T_to_s*us%m_to_L**2*segment%normal_trans(i,j,k)
          enddo ; enddo ; enddo
        endif
      enddo
    endif
    do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
      ! Can this go in segment loop above? Is loop above wrong for wide halos??
      if (obc%segment(obc%segnum_v(i,j))%specified) then
        if (use_bt_cont) then
          bt_obc%vbt_outer(i,j) = vhbt_to_vbt(bt_obc%vhbt(i,j), btcl_v(i,j), us)
        else
          if (datv(i,j) > 0.0) bt_obc%vbt_outer(i,j) = bt_obc%vhbt(i,j) / datv(i,j)
        endif
      else  ! This is assuming Flather as only other option
        if (gv%Boussinesq) then
          if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
            bt_obc%H_v(i,j) = g%bathyT(i,j)*gv%Z_to_H + eta(i,j)
          elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
            bt_obc%H_v(i,j) = g%bathyT(i,j+1)*gv%Z_to_H + eta(i,j+1)
          endif
        else
          if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
            bt_obc%H_v(i,j) = eta(i,j)
          elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
            bt_obc%H_v(i,j) = eta(i,j+1)
          endif
        endif
        bt_obc%Cg_v(i,j) = sqrt(gv%g_prime(1) * gv%H_to_Z*bt_obc%H_v(i,j))
      endif
    endif ; enddo ; enddo
    if (obc%Flather_v_BCs_exist_globally) then
     do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_N_or_S .and. segment%Flather) then
          do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
            bt_obc%vbt_outer(i,j) = us%m_s_to_L_T*segment%normal_vel_bt(i,j)
            bt_obc%eta_outer_v(i,j) = segment%eta(i,j)
          enddo ; enddo
        endif
      enddo
    endif
  endif
 
  call do_group_pass(bt_obc%pass_uv, bt_domain)
  call do_group_pass(bt_obc%pass_uhvh, bt_domain)
  call do_group_pass(bt_obc%pass_eta_outer, bt_domain)
  call do_group_pass(bt_obc%pass_h, bt_domain)
  call do_group_pass(bt_obc%pass_cg, bt_domain)
 
end subroutine set_up_bt_obc
 
!> Clean up the BT_OBC memory.
subroutine destroy_bt_obc(BT_OBC)
  type(bt_obc_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
                                             !! related to the open boundary conditions,
                                             !! set by set_up_BT_OBC.
 
  if (bt_obc%is_alloced) then
    deallocate(bt_obc%Cg_u)
    deallocate(bt_obc%H_u)
    deallocate(bt_obc%uhbt)
    deallocate(bt_obc%ubt_outer)
    deallocate(bt_obc%eta_outer_u)
 
    deallocate(bt_obc%Cg_v)
    deallocate(bt_obc%H_v)
    deallocate(bt_obc%vhbt)
    deallocate(bt_obc%vbt_outer)
    deallocate(bt_obc%eta_outer_v)
    bt_obc%is_alloced = .false.
  endif
end subroutine destroy_bt_obc
 
!> btcalc calculates the barotropic velocities from the full velocity and
!! thickness fields, determines the fraction of the total water column in each
!! layer at velocity points, and determines a corrective fictitious mass source
!! that will drive the barotropic estimate of the free surface height toward the
!! baroclinic estimate.
subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
  type(ocean_grid_type),   intent(inout) :: g    !< The ocean's grid structure.
  type(verticalgrid_type), intent(in)    :: gv   !< The ocean's vertical grid structure.
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
                           intent(in)    :: h    !< Layer thicknesses [H ~> m or kg m-2].
  type(barotropic_cs),     pointer       :: cs   !< The control structure returned by a previous
                                                 !! call to barotropic_init.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
                 optional, intent(in)    :: h_u  !< The specified thicknesses at u-points [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
                 optional, intent(in)    :: h_v  !< The specified thicknesses at v-points [H ~> m or kg m-2].
  logical,       optional, intent(in)    :: may_use_default !< An optional logical argument
                                                 !! to indicate that the default velocity point
                                                 !! thicknesses may be used for this particular
                                                 !! calculation, even though the setting of
                                                 !! CS%hvel_scheme would usually require that h_u
                                                 !! and h_v be passed in.
  type(ocean_obc_type), optional, pointer :: obc !< Open boundary control structure.
 
  ! Local variables
  real :: hatutot(szib_(g))    ! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2].
  real :: hatvtot(szi_(g))     ! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2].
  real :: ihatutot(szib_(g))   ! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1].
  real :: ihatvtot(szi_(g))    ! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1].
  real :: h_arith              ! The arithmetic mean thickness [H ~> m or kg m-2].
  real :: h_harm               ! The harmonic mean thicknesses [H ~> m or kg m-2].
  real :: h_neglect            ! A thickness that is so small it is usually lost
                               ! in roundoff and can be neglected [H ~> m or kg m-2].
  real :: wt_arith             ! The nondimensional weight for the arithmetic mean thickness.
                               ! The harmonic mean uses a weight of (1 - wt_arith).
  real :: rh                   ! A ratio of summed thicknesses, nondim.
  real :: e_u(szib_(g),szk_(g)+1) !   The interface heights at u-velocity and
  real :: e_v(szi_(g),szk_(g)+1)  ! v-velocity points [H ~> m or kg m-2].
  real :: d_shallow_u(szi_(g)) ! The shallower of the adjacent depths [H ~> m or kg m-2].
  real :: d_shallow_v(szib_(g))! The shallower of the adjacent depths [H ~> m or kg m-2].
  real :: htot                 ! The sum of the layer thicknesses [H ~> m or kg m-2].
  real :: ihtot                ! The inverse of htot [H-1 ~> m-1 or m2 kg-1].
 
  logical :: use_default, test_dflt, apply_obcs
  integer :: is, ie, js, je, isq, ieq, jsq, jeq, nz, i, j, k
  integer :: iss, ies, n
 
!    This section interpolates thicknesses onto u & v grid points with the
! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-).
  if (.not.associated(cs)) call mom_error(fatal, &
      "btcalc: Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
 
  use_default = .false.
  test_dflt = .false. ; if (present(may_use_default)) test_dflt = may_use_default
 
  if (test_dflt) then
    if (.not.((present(h_u) .and. present(h_v)) .or. &
              (cs%hvel_scheme == harmonic) .or. (cs%hvel_scheme == hybrid) .or.&
              (cs%hvel_scheme == arithmetic))) use_default = .true.
  else
    if (.not.((present(h_u) .and. present(h_v)) .or. &
              (cs%hvel_scheme == harmonic) .or. (cs%hvel_scheme == hybrid) .or.&
              (cs%hvel_scheme == arithmetic))) call mom_error(fatal, &
        "btcalc: Inconsistent settings of optional arguments and hvel_scheme.")
  endif
 
  apply_obcs = .false.
  if (present(obc)) then ; if (associated(obc)) then ; if (obc%OBC_pe) then
    ! Some open boundary condition points might be in this processor's symmetric
    ! computational domain.
    apply_obcs = (obc%number_of_segments > 0)
  endif ; endif ; endif
 
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
  h_neglect = gv%H_subroundoff
 
  !   This estimates the fractional thickness of each layer at the velocity
  ! points, using a harmonic mean estimate.
!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) &
!$OMP                          private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith)
 
  do j=js,je
    if (present(h_u)) then
      do i=is-1,ie ; hatutot(i) = h_u(i,j,1) ; enddo
      do k=2,nz ; do i=is-1,ie
        hatutot(i) = hatutot(i) + h_u(i,j,k)
      enddo ; enddo
      do i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is-1,ie
        cs%frhatu(i,j,k) = h_u(i,j,k) * ihatutot(i)
      enddo ; enddo
    else
      if (cs%hvel_scheme == arithmetic) then
        do i=is-1,ie
          cs%frhatu(i,j,1) = 0.5 * (h(i+1,j,1) + h(i,j,1))
          hatutot(i) = cs%frhatu(i,j,1)
        enddo
        do k=2,nz ; do i=is-1,ie
          cs%frhatu(i,j,k) = 0.5 * (h(i+1,j,k) + h(i,j,k))
          hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == hybrid .or. use_default) then
        do i=is-1,ie
          e_u(i,nz+1) = -0.5 * gv%Z_to_H * (g%bathyT(i+1,j) + g%bathyT(i,j))
          d_shallow_u(i) = -gv%Z_to_H * min(g%bathyT(i+1,j), g%bathyT(i,j))
          hatutot(i) = 0.0
        enddo
        do k=nz,1,-1 ; do i=is-1,ie
          e_u(i,k) = e_u(i,k+1) + 0.5 * (h(i+1,j,k) + h(i,j,k))
          h_arith = 0.5 * (h(i+1,j,k) + h(i,j,k))
          if (e_u(i,k+1) >= d_shallow_u(i)) then
            cs%frhatu(i,j,k) = h_arith
          else
            h_harm = (h(i+1,j,k) * h(i,j,k)) / (h_arith + h_neglect)
            if (e_u(i,k) <= d_shallow_u(i)) then
              cs%frhatu(i,j,k) = h_harm
            else
              wt_arith = (e_u(i,k) - d_shallow_u(i)) / (h_arith + h_neglect)
              cs%frhatu(i,j,k) = wt_arith*h_arith + (1.0-wt_arith)*h_harm
            endif
          endif
          hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == harmonic) then
        do i=is-1,ie
          cs%frhatu(i,j,1) = 2.0*(h(i+1,j,1) * h(i,j,1)) / &
                             ((h(i+1,j,1) + h(i,j,1)) + h_neglect)
          hatutot(i) = cs%frhatu(i,j,1)
        enddo
        do k=2,nz ; do i=is-1,ie
          cs%frhatu(i,j,k) = 2.0*(h(i+1,j,k) * h(i,j,k)) / &
                             ((h(i+1,j,k) + h(i,j,k)) + h_neglect)
          hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
        enddo ; enddo
      endif
      do i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is-1,ie
        cs%frhatu(i,j,k) = cs%frhatu(i,j,k) * ihatutot(i)
      enddo ; enddo
    endif
  enddo
 
!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) &
!$OMP                          private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith)
  do j=js-1,je
    if (present(h_v)) then
      do i=is,ie ; hatvtot(i) = h_v(i,j,1) ; enddo
      do k=2,nz ; do i=is,ie
        hatvtot(i) = hatvtot(i) + h_v(i,j,k)
      enddo ; enddo
      do i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is,ie
        cs%frhatv(i,j,k) = h_v(i,j,k) * ihatvtot(i)
      enddo ; enddo
    else
      if (cs%hvel_scheme == arithmetic) then
        do i=is,ie
          cs%frhatv(i,j,1) = 0.5 * (h(i,j+1,1) + h(i,j,1))
          hatvtot(i) = cs%frhatv(i,j,1)
        enddo
        do k=2,nz ; do i=is,ie
          cs%frhatv(i,j,k) = 0.5 * (h(i,j+1,k) + h(i,j,k))
          hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == hybrid .or. use_default) then
        do i=is,ie
          e_v(i,nz+1) = -0.5 * gv%Z_to_H * (g%bathyT(i,j+1) + g%bathyT(i,j))
          d_shallow_v(i) = -gv%Z_to_H * min(g%bathyT(i,j+1), g%bathyT(i,j))
          hatvtot(i) = 0.0
        enddo
        do k=nz,1,-1 ; do i=is,ie
          e_v(i,k) = e_v(i,k+1) + 0.5 * (h(i,j+1,k) + h(i,j,k))
          h_arith = 0.5 * (h(i,j+1,k) + h(i,j,k))
          if (e_v(i,k+1) >= d_shallow_v(i)) then
            cs%frhatv(i,j,k) = h_arith
          else
            h_harm = (h(i,j+1,k) * h(i,j,k)) / (h_arith + h_neglect)
            if (e_v(i,k) <= d_shallow_v(i)) then
              cs%frhatv(i,j,k) = h_harm
            else
              wt_arith = (e_v(i,k) - d_shallow_v(i)) / (h_arith + h_neglect)
              cs%frhatv(i,j,k) = wt_arith*h_arith + (1.0-wt_arith)*h_harm
            endif
          endif
          hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == harmonic) then
        do i=is,ie
          cs%frhatv(i,j,1) = 2.0*(h(i,j+1,1) * h(i,j,1)) / &
                             ((h(i,j+1,1) + h(i,j,1)) + h_neglect)
          hatvtot(i) = cs%frhatv(i,j,1)
        enddo
        do k=2,nz ; do i=is,ie
          cs%frhatv(i,j,k) = 2.0*(h(i,j+1,k) * h(i,j,k)) / &
                             ((h(i,j+1,k) + h(i,j,k)) + h_neglect)
          hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
        enddo ; enddo
      endif
      do i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is,ie
        cs%frhatv(i,j,k) = cs%frhatv(i,j,k) * ihatvtot(i)
      enddo ; enddo
    endif
  enddo
 
  if (apply_obcs) then ; do n=1,obc%number_of_segments ! Test for segment type?
    if (.not. obc%segment(n)%on_pe) cycle
    if (obc%segment(n)%direction == obc_direction_n) then
      j = obc%segment(n)%HI%JsdB
      if ((j >= js-1) .and. (j <= je)) then
        iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied)
        do i=iss,ies ; hatvtot(i) = h(i,j,1) ; enddo
        do k=2,nz ; do i=iss,ies
          hatvtot(i) = hatvtot(i) + h(i,j,k)
        enddo ; enddo
        do i=iss,ies
          ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect)
        enddo
        do k=1,nz ; do i=iss,ies
          cs%frhatv(i,j,k) = h(i,j,k) * ihatvtot(i)
        enddo ; enddo
      endif
    elseif (obc%segment(n)%direction == obc_direction_s) then
      j = obc%segment(n)%HI%JsdB
      if ((j >= js-1) .and. (j <= je)) then
        iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied)
        do i=iss,ies ; hatvtot(i) = h(i,j+1,1) ; enddo
        do k=2,nz ; do i=iss,ies
          hatvtot(i) = hatvtot(i) + h(i,j+1,k)
        enddo ; enddo
        do i=iss,ies
          ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect)
        enddo
        do k=1,nz ; do i=iss,ies
          cs%frhatv(i,j,k) = h(i,j+1,k) * ihatvtot(i)
        enddo ; enddo
      endif
    elseif (obc%segment(n)%direction == obc_direction_e) then
      i = obc%segment(n)%HI%IsdB
      if ((i >= is-1) .and. (i <= ie)) then
        do j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed)
          htot = h(i,j,1)
          do k=2,nz ; htot = htot + h(i,j,k) ; enddo
          ihtot = g%mask2dCu(i,j) / (htot + h_neglect)
          do k=1,nz ; cs%frhatu(i,j,k) = h(i,j,k) * ihtot ; enddo
        enddo
      endif
    elseif (obc%segment(n)%direction == obc_direction_w) then
      i = obc%segment(n)%HI%IsdB
      if ((i >= is-1) .and. (i <= ie)) then
        do j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed)
          htot = h(i+1,j,1)
          do k=2,nz ; htot = htot + h(i+1,j,k) ; enddo
          ihtot = g%mask2dCu(i,j) / (htot + h_neglect)
          do k=1,nz ; cs%frhatu(i,j,k) = h(i+1,j,k) * ihtot ; enddo
        enddo
      endif
    else
      call mom_error(fatal, "btcalc encountered and OBC segment of indeterminate direction.")
    endif
  enddo ; endif
 
  if (cs%debug) then
    call uvchksum("btcalc frhat[uv]", cs%frhatu, cs%frhatv, g%HI, 0, .true., .true.)
    if (present(h_u) .and. present(h_v)) &
      call uvchksum("btcalc h_[uv]", h_u, h_v, g%HI, 0, .true., .true., scale=gv%H_to_m)
    call hchksum(h, "btcalc h",g%HI, haloshift=1, scale=gv%H_to_m)
  endif
 
end subroutine btcalc
 
!> The function find_uhbt determines the zonal transport for a given velocity.
function find_uhbt(u, BTC, US) result(uhbt)
  real, intent(in) :: u    !< The local zonal velocity [L T-1 ~> m s-1]
  type(local_bt_cont_u_type), intent(in) :: btc !< A structure containing various fields that
                           !! allow the barotropic transports to be calculated consistently
                           !! with the layers' continuity equations.
  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
 
  real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1]
 
  if (u == 0.0) then
    uhbt = 0.0
  elseif (u < btc%uBT_EE) then
    uhbt = (u - btc%uBT_EE) * btc%FA_u_EE + btc%uh_EE
  elseif (u < 0.0) then
    uhbt = u * (btc%FA_u_E0 + btc%uh_crvE * u**2)
  elseif (u <= btc%uBT_WW) then
    uhbt = u * (btc%FA_u_W0 + btc%uh_crvW * u**2)
  else ! (u > BTC%uBT_WW)
    uhbt = (u - btc%uBT_WW) * btc%FA_u_WW + btc%uh_WW
  endif
 
end function find_uhbt
 
!> This function inverts the transport function to determine the barotopic
!! velocity that is consistent with a given transport.
function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt)
  real, intent(in) :: uhbt                      !< The barotropic zonal transport that should be inverted for,
                                                !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  type(local_bt_cont_u_type), intent(in) :: btc !< A structure containing various fields that allow the
                                                !! barotropic transports to be calculated consistently with the
                                                !! layers' continuity equations.
  type(unit_scale_type),      intent(in) :: us  !< A dimensional unit scaling type
  real, optional, intent(in) :: guess           !< A guess at what ubt will be [L T-1 ~> m s-1].  The result
                                                !! is not allowed to be dramatically larger than guess.
  real :: ubt                                   !< The result - The velocity that gives uhbt transport [m s-1].
 
  ! Local variables
  real :: ubt_min, ubt_max, uhbt_err, derr_du
  real :: uherr_min, uherr_max
  real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
  real :: dvel  ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
  real :: vsr   ! Temporary variable used in the limiting the velocity [nondim].
  real, parameter :: vs1 = 1.25  ! Nondimensional parameters used in limiting
  real, parameter :: vs2 = 2.0   ! the velocity, starting at vs1, with the
                                 ! maximum increase of vs2, both nondim.
  integer :: itt, max_itt = 20
 
  ! Find the value of ubt that gives uhbt.
  if (uhbt == 0.0) then
    ubt = 0.0
  elseif (uhbt < btc%uh_EE) then
    ubt = btc%uBT_EE + (uhbt - btc%uh_EE) / btc%FA_u_EE
  elseif (uhbt < 0.0) then
    ! Iterate to convergence with Newton's method (when bounded) and the
    ! false position method otherwise.  ubt will be negative.
    ubt_min = btc%uBT_EE ; uherr_min = btc%uh_EE - uhbt
    ubt_max = 0.0 ; uherr_max = -uhbt
    ! Use a false-position method first guess.
    ubt = btc%uBT_EE * (uhbt / btc%uh_EE)
    do itt = 1, max_itt
      uhbt_err = ubt * (btc%FA_u_E0 + btc%uh_crvE * ubt**2) - uhbt
 
      if (abs(uhbt_err) < tol*abs(uhbt)) exit
      if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
      if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
 
      derr_du = btc%FA_u_E0 + 3.0 * btc%uh_crvE * ubt**2
      if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
          (-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
        ! Use a false-position method guess.
        ubt = ubt_max + (ubt_min-ubt_max) * (uherr_max / (uherr_max-uherr_min))
      else ! Use Newton's method.
        ubt = ubt - uhbt_err / derr_du
        if (abs(uhbt_err) < (0.01*tol)*abs(ubt_min*derr_du)) exit
      endif
    enddo
  elseif (uhbt <= btc%uh_WW) then
    ! Iterate to convergence with Newton's method.  ubt will be positive.
    ubt_min = 0.0 ; uherr_min = -uhbt
    ubt_max = btc%uBT_WW ; uherr_max = btc%uh_WW - uhbt
    ! Use a false-position method first guess.
    ubt = btc%uBT_WW * (uhbt / btc%uh_WW)
    do itt = 1, max_itt
      uhbt_err = ubt * (btc%FA_u_W0 + btc%uh_crvW * ubt**2) - uhbt
 
      if (abs(uhbt_err) < tol*abs(uhbt)) exit
      if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
      if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
 
      derr_du = btc%FA_u_W0 + 3.0 * btc%uh_crvW * ubt**2
      if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
          (-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
        ! Use a false-position method guess.
        ubt = ubt_min + (ubt_max-ubt_min) * (-uherr_min / (uherr_max-uherr_min))
      else ! Use Newton's method.
        ubt = ubt - uhbt_err / derr_du
        if (abs(uhbt_err) < (0.01*tol)*(ubt_max*derr_du)) exit
      endif
    enddo
  else ! (uhbt > BTC%uh_WW)
    ubt = btc%uBT_WW + (uhbt - btc%uh_WW) / btc%FA_u_WW
  endif
 
  if (present(guess)) then
    dvel = abs(ubt) - vs1*abs(guess)
    if (dvel > 0.0) then ! Limit the velocity
      if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then
        vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1)))
      else  ! The exp be less than 4e-18 anyway in this case, so neglect it.
        vsr = vs2
      endif
      ubt = sign(vsr * guess, ubt)
    endif
  endif
 
end function uhbt_to_ubt
 
!> The function find_vhbt determines the meridional transport for a given velocity.
function find_vhbt(v, BTC, US) result(vhbt)
  real, intent(in) :: v    !< The local meridional velocity [L T-1 ~> m s-1]
  type(local_bt_cont_v_type), intent(in) :: btc !< A structure containing various fields that
                           !! allow the barotropic transports to be calculated consistently
                           !! with the layers' continuity equations.
  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
  real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1]
 
  if (v == 0.0) then
    vhbt = 0.0
  elseif (v < btc%vBT_NN) then
    vhbt = (v - btc%vBT_NN) * btc%FA_v_NN + btc%vh_NN
  elseif (v < 0.0) then
    vhbt = v * (btc%FA_v_N0 + btc%vh_crvN * v**2)
  elseif (v <= btc%vBT_SS) then
    vhbt = v * (btc%FA_v_S0 + btc%vh_crvS * v**2)
  else ! (v > BTC%vBT_SS)
    vhbt = (v - btc%vBT_SS) * btc%FA_v_SS + btc%vh_SS
  endif
 
end function find_vhbt
 
!> This function inverts the transport function to determine the barotopic
!! velocity that is consistent with a given transport.
function vhbt_to_vbt(vhbt, BTC, US, guess) result(vbt)
  real, intent(in) :: vhbt                      !< The barotropic meridional transport that should be
                                                !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1].
  type(local_bt_cont_v_type), intent(in) :: btc !< A structure containing various fields that allow the
                                                !! barotropic transports to be calculated consistently
                                                !! with the layers' continuity equations.
  type(unit_scale_type),      intent(in) :: us  !< A dimensional unit scaling type
  real, optional, intent(in) :: guess           !< A guess at what vbt will be. The result is not allowed
                                                !! to be dramatically larger than guess [L T-1 ~> m s-1].
  real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1].
 
  ! Local variables
  real :: vbt_min, vbt_max, vhbt_err, derr_dv
  real :: vherr_min, vherr_max
  real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
  real :: dvel  ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
  real :: vsr   ! Temporary variable used in the limiting the velocity [nondim].
  real, parameter :: vs1 = 1.25  ! Nondimensional parameters used in limiting
  real, parameter :: vs2 = 2.0   ! the velocity, starting at vs1, with the
                                 ! maximum increase of vs2, both nondim.
  integer :: itt, max_itt = 20
 
  ! Find the value of vbt that gives vhbt.
  if (vhbt == 0.0) then
    vbt = 0.0
  elseif (vhbt < btc%vh_NN) then
    vbt = btc%vBT_NN + (vhbt - btc%vh_NN) / btc%FA_v_NN
  elseif (vhbt < 0.0) then
    ! Iterate to convergence with Newton's method (when bounded) and the
    ! false position method otherwise.  vbt will be negative.
    vbt_min = btc%vBT_NN ; vherr_min = btc%vh_NN - vhbt
    vbt_max = 0.0 ; vherr_max = -vhbt
    ! Use a false-position method first guess.
    vbt = btc%vBT_NN * (vhbt / btc%vh_NN)
    do itt = 1, max_itt
      vhbt_err = vbt * (btc%FA_v_N0 + btc%vh_crvN * vbt**2) - vhbt
 
      if (abs(vhbt_err) < tol*abs(vhbt)) exit
      if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
      if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
 
      derr_dv = btc%FA_v_N0 + 3.0 * btc%vh_crvN * vbt**2
      if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
          (-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
        ! Use a false-position method guess.
        vbt = vbt_max + (vbt_min-vbt_max) * (vherr_max / (vherr_max-vherr_min))
      else ! Use Newton's method.
        vbt = vbt - vhbt_err / derr_dv
        if (abs(vhbt_err) < (0.01*tol)*abs(derr_dv*vbt_min)) exit
      endif
    enddo
  elseif (vhbt <= btc%vh_SS) then
    ! Iterate to convergence with Newton's method.  vbt will be positive.
    vbt_min = 0.0 ; vherr_min = -vhbt
    vbt_max = btc%vBT_SS ; vherr_max = btc%vh_SS - vhbt
    ! Use a false-position method first guess.
    vbt = btc%vBT_SS * (vhbt / btc%vh_SS)
    do itt = 1, max_itt
      vhbt_err = vbt * (btc%FA_v_S0 + btc%vh_crvS * vbt**2) - vhbt
 
      if (abs(vhbt_err) < tol*abs(vhbt)) exit
      if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
      if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
 
      derr_dv = btc%FA_v_S0 + 3.0 * btc%vh_crvS * vbt**2
      if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
          (-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
        ! Use a false-position method guess.
        vbt = vbt_min + (vbt_max-vbt_min) * (-vherr_min / (vherr_max-vherr_min))
      else ! Use Newton's method.
        vbt = vbt - vhbt_err / derr_dv
        if (abs(vhbt_err) < (0.01*tol)*(vbt_max*derr_dv)) exit
      endif
    enddo
  else ! (vhbt > BTC%vh_SS)
    vbt = btc%vBT_SS + (vhbt - btc%vh_SS) / btc%FA_v_SS
  endif
 
  if (present(guess)) then
    dvel = abs(vbt) - vs1*abs(guess)
    if (dvel > 0.0) then ! Limit the velocity
      if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then
        vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1)))
      else  ! The exp be less than 4e-18 anyway in this case, so neglect it.
        vsr = vs2
      endif
      vbt = sign(guess * vsr, vbt)
    endif
  endif
 
end function vhbt_to_vbt
 
!> This subroutine sets up reordered versions of the BT_cont type in the
!! local_BT_cont types, which have wide halos properly filled in.
subroutine set_local_bt_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo)
  type(bt_cont_type),                                    intent(inout) :: BT_cont    !< The BT_cont_type input to the
                                                                                     !! barotropic solver.
  type(memory_size_type),                                intent(in)    :: MS         !< A type that describes the
                                                                                     !! memory sizes of the argument
                                                                                     !! arrays.
  type(local_bt_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(out) :: BTCL_u !< A structure with the u
                                                                                     !! information from BT_cont.
  type(local_bt_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v
                                                                                     !! information from BT_cont.
  type(ocean_grid_type),                                 intent(in)    :: G          !< The ocean's grid structure.
  type(unit_scale_type),                                 intent(in)    :: US         !< A dimensional unit scaling type
  type(mom_domain_type),                                 intent(inout) :: BT_Domain  !< The domain to use for updating
                                                                                     !! the halos of wide arrays.
  integer,                                     optional, intent(in)    :: halo       !< The extra halo size to use here.
 
  ! Local variables
  real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
    u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
  real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
    v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
  real, parameter :: C1_3 = 1.0/3.0
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
 
  ! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays.
!$OMP parallel default(none) shared(is,ie,js,je,hs,u_polarity,uBT_EE,uBT_WW,FA_u_EE, &
!$OMP                               FA_u_E0,FA_u_W0,FA_u_WW,v_polarity,vBT_NN,vBT_SS,&
!$OMP                               FA_v_NN,FA_v_N0,FA_v_S0,FA_v_SS,BT_cont )
!$OMP do
  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
    u_polarity(i,j) = 1.0
    ubt_ee(i,j) = 0.0 ; ubt_ww(i,j) = 0.0
    fa_u_ee(i,j) = 0.0 ; fa_u_e0(i,j) = 0.0 ; fa_u_w0(i,j) = 0.0 ; fa_u_ww(i,j) = 0.0
  enddo ; enddo
!$OMP do
  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
    v_polarity(i,j) = 1.0
    vbt_nn(i,j) = 0.0 ; vbt_ss(i,j) = 0.0
    fa_v_nn(i,j) = 0.0 ; fa_v_n0(i,j) = 0.0 ; fa_v_s0(i,j) = 0.0 ; fa_v_ss(i,j) = 0.0
  enddo ; enddo
!$OMP do
  do j=js,je; do i=is-1,ie
    ubt_ee(i,j) = bt_cont%uBT_EE(i,j) ; ubt_ww(i,j) = bt_cont%uBT_WW(i,j)
    fa_u_ee(i,j) = bt_cont%FA_u_EE(i,j) ; fa_u_e0(i,j) = bt_cont%FA_u_E0(i,j)
    fa_u_w0(i,j) = bt_cont%FA_u_W0(i,j) ; fa_u_ww(i,j) = bt_cont%FA_u_WW(i,j)
  enddo ; enddo
!$OMP do
  do j=js-1,je; do i=is,ie
    vbt_nn(i,j) = bt_cont%vBT_NN(i,j) ; vbt_ss(i,j) = bt_cont%vBT_SS(i,j)
    fa_v_nn(i,j) = bt_cont%FA_v_NN(i,j) ; fa_v_n0(i,j) = bt_cont%FA_v_N0(i,j)
    fa_v_s0(i,j) = bt_cont%FA_v_S0(i,j) ; fa_v_ss(i,j) = bt_cont%FA_v_SS(i,j)
  enddo ; enddo
!$OMP end parallel
 
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
!--- begin setup for group halo update
  call create_group_pass(bt_cont%pass_polarity_BT, u_polarity, v_polarity, bt_domain)
  call create_group_pass(bt_cont%pass_polarity_BT, ubt_ee, vbt_nn, bt_domain)
  call create_group_pass(bt_cont%pass_polarity_BT, ubt_ww, vbt_ss, bt_domain)
 
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_ee, fa_v_nn, bt_domain, to_all+scalar_pair)
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_e0, fa_v_n0, bt_domain, to_all+scalar_pair)
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_w0, fa_v_s0, bt_domain, to_all+scalar_pair)
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_ww, fa_v_ss, bt_domain, to_all+scalar_pair)
!--- end setup for group halo update
  ! Do halo updates on BT_cont.
  call do_group_pass(bt_cont%pass_polarity_BT, bt_domain)
  call do_group_pass(bt_cont%pass_FA_uv, bt_domain)
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
!$OMP parallel default(none) shared(is,ie,js,je,hs,BTCL_u,FA_u_EE,FA_u_E0,FA_u_W0, &
!$OMP                               FA_u_WW,uBT_EE,uBT_WW,u_polarity,BTCL_v,       &
!$OMP                               FA_v_NN,FA_v_N0,FA_v_S0,FA_v_SS,vBT_NN,vBT_SS, &
!$OMP                               v_polarity )
!$OMP do
  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
    btcl_u(i,j)%FA_u_EE = fa_u_ee(i,j) ; btcl_u(i,j)%FA_u_E0 = fa_u_e0(i,j)
    btcl_u(i,j)%FA_u_W0 = fa_u_w0(i,j) ; btcl_u(i,j)%FA_u_WW = fa_u_ww(i,j)
    btcl_u(i,j)%uBT_EE = ubt_ee(i,j)   ; btcl_u(i,j)%uBT_WW = ubt_ww(i,j)
    ! Check for reversed polarity in the tripolar halo regions.
    if (u_polarity(i,j) < 0.0) then
      call swap(btcl_u(i,j)%FA_u_EE, btcl_u(i,j)%FA_u_WW)
      call swap(btcl_u(i,j)%FA_u_E0, btcl_u(i,j)%FA_u_W0)
      call swap(btcl_u(i,j)%uBT_EE,  btcl_u(i,j)%uBT_WW)
    endif
 
    btcl_u(i,j)%uh_EE = btcl_u(i,j)%uBT_EE * &
        (c1_3 * (2.0*btcl_u(i,j)%FA_u_E0 + btcl_u(i,j)%FA_u_EE))
    btcl_u(i,j)%uh_WW = btcl_u(i,j)%uBT_WW * &
        (c1_3 * (2.0*btcl_u(i,j)%FA_u_W0 + btcl_u(i,j)%FA_u_WW))
 
    btcl_u(i,j)%uh_crvE = 0.0 ; btcl_u(i,j)%uh_crvW = 0.0
    if (abs(btcl_u(i,j)%uBT_WW) > 0.0) btcl_u(i,j)%uh_crvW = &
      (c1_3 * (btcl_u(i,j)%FA_u_WW - btcl_u(i,j)%FA_u_W0)) / btcl_u(i,j)%uBT_WW**2
    if (abs(btcl_u(i,j)%uBT_EE) > 0.0) btcl_u(i,j)%uh_crvE = &
      (c1_3 * (btcl_u(i,j)%FA_u_EE - btcl_u(i,j)%FA_u_E0)) / btcl_u(i,j)%uBT_EE**2
  enddo ; enddo
!$OMP do
  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
    btcl_v(i,j)%FA_v_NN = fa_v_nn(i,j) ; btcl_v(i,j)%FA_v_N0 = fa_v_n0(i,j)
    btcl_v(i,j)%FA_v_S0 = fa_v_s0(i,j) ; btcl_v(i,j)%FA_v_SS = fa_v_ss(i,j)
    btcl_v(i,j)%vBT_NN = vbt_nn(i,j)   ; btcl_v(i,j)%vBT_SS = vbt_ss(i,j)
    ! Check for reversed polarity in the tripolar halo regions.
    if (v_polarity(i,j) < 0.0) then
      call swap(btcl_v(i,j)%FA_v_NN, btcl_v(i,j)%FA_v_SS)
      call swap(btcl_v(i,j)%FA_v_N0, btcl_v(i,j)%FA_v_S0)
      call swap(btcl_v(i,j)%vBT_NN,  btcl_v(i,j)%vBT_SS)
    endif
 
    btcl_v(i,j)%vh_NN = btcl_v(i,j)%vBT_NN * &
        (c1_3 * (2.0*btcl_v(i,j)%FA_v_N0 + btcl_v(i,j)%FA_v_NN))
    btcl_v(i,j)%vh_SS = btcl_v(i,j)%vBT_SS * &
        (c1_3 * (2.0*btcl_v(i,j)%FA_v_S0 + btcl_v(i,j)%FA_v_SS))
 
    btcl_v(i,j)%vh_crvN = 0.0 ; btcl_v(i,j)%vh_crvS = 0.0
    if (abs(btcl_v(i,j)%vBT_SS) > 0.0) btcl_v(i,j)%vh_crvS = &
      (c1_3 * (btcl_v(i,j)%FA_v_SS - btcl_v(i,j)%FA_v_S0)) / btcl_v(i,j)%vBT_SS**2
    if (abs(btcl_v(i,j)%vBT_NN) > 0.0) btcl_v(i,j)%vh_crvN = &
      (c1_3 * (btcl_v(i,j)%FA_v_NN - btcl_v(i,j)%FA_v_N0)) / btcl_v(i,j)%vBT_NN**2
  enddo ; enddo
!$OMP end parallel
end subroutine set_local_bt_cont_types
 
 
!> Adjust_local_BT_cont_types sets up reordered versions of the BT_cont type
!! in the local_BT_cont types, which have wide halos properly filled in.
subroutine adjust_local_bt_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
                                      G, US, MS, halo)
  type(memory_size_type), intent(in)  :: MS   !< A type that describes the memory sizes of the argument arrays.
  real, dimension(SZIBW_(MS),SZJW_(MS)), &
                          intent(in)  :: ubt  !< The linearization zonal barotropic velocity [m s-1].
  real, dimension(SZIBW_(MS),SZJW_(MS)), &
                          intent(in)  :: uhbt !< The linearization zonal barotropic transport
                                              !! [H m2 s-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), &
                          intent(in)  :: vbt  !< The linearization meridional barotropic velocity [m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), &
                          intent(in)  :: vhbt !< The linearization meridional barotropic transport
                                              !! [H m2 s-1 ~> m3 s-1 or kg s-1].
  type(local_bt_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
                          intent(out) :: BTCL_u !< A structure with the u information from BT_cont.
  type(local_bt_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
                          intent(out) :: BTCL_v !< A structure with the v information from BT_cont.
  type(ocean_grid_type),  intent(in)  :: G    !< The ocean's grid structure.
  type(unit_scale_type),  intent(in)  :: US   !< A dimensional unit scaling type
  integer,      optional, intent(in)  :: halo !< The extra halo size to use here.
 
  ! Local variables
  real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
    u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
  real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
    v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
  real, parameter :: C1_3 = 1.0/3.0
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
 
  !$OMP parallel do default(shared)
  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
    if ((ubt(i,j) > btcl_u(i,j)%uBT_WW) .and. (uhbt(i,j) > btcl_u(i,j)%uh_WW)) then
      ! Expand the cubic fit to use this new point.  ubt is negative.
      btcl_u(i,j)%ubt_WW = ubt(i,j)
      if (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl_u(i,j)%FA_u_W0) then
        ! No further bounding is needed.
        btcl_u(i,j)%uh_crvW = (uhbt(i,j) - ubt(i,j) * btcl_u(i,j)%FA_u_W0) / ubt(i,j)**3
      else ! This should not happen often!
        btcl_u(i,j)%FA_u_W0 = 1.5*uhbt(i,j) / ubt(i,j)
        btcl_u(i,j)%uh_crvW = -0.5*uhbt(i,j) / ubt(i,j)**3
      endif
      btcl_u(i,j)%uh_WW = uhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_u(I,j)%FA_u_WW = min(BTCL_u(I,j)%FA_u_WW, uhbt(I,j) / ubt(I,j))
    elseif ((ubt(i,j) < btcl_u(i,j)%uBT_EE) .and. (uhbt(i,j) < btcl_u(i,j)%uh_EE)) then
      ! Expand the cubic fit to use this new point.  ubt is negative.
      btcl_u(i,j)%ubt_EE = ubt(i,j)
      if (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl_u(i,j)%FA_u_E0) then
        ! No further bounding is needed.
        btcl_u(i,j)%uh_crvE = (uhbt(i,j) - ubt(i,j) * btcl_u(i,j)%FA_u_E0) / ubt(i,j)**3
      else ! This should not happen often!
        btcl_u(i,j)%FA_u_E0 = 1.5*uhbt(i,j) / ubt(i,j)
        btcl_u(i,j)%uh_crvE = -0.5*uhbt(i,j) / ubt(i,j)**3
      endif
      btcl_u(i,j)%uh_EE = uhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_u(I,j)%FA_u_EE = min(BTCL_u(I,j)%FA_u_EE, uhbt(I,j) / ubt(I,j))
    endif
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
    if ((vbt(i,j) > btcl_v(i,j)%vBT_SS) .and. (vhbt(i,j) > btcl_v(i,j)%vh_SS)) then
      ! Expand the cubic fit to use this new point.  vbt is negative.
      btcl_v(i,j)%vbt_SS = vbt(i,j)
      if (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl_v(i,j)%FA_v_S0) then
        ! No further bounding is needed.
        btcl_v(i,j)%vh_crvS = (vhbt(i,j) - vbt(i,j) * btcl_v(i,j)%FA_v_S0) / vbt(i,j)**3
      else ! This should not happen often!
        btcl_v(i,j)%FA_v_S0 = 1.5*vhbt(i,j) / (vbt(i,j))
        btcl_v(i,j)%vh_crvS = -0.5*vhbt(i,j) / vbt(i,j)**3
      endif
      btcl_v(i,j)%vh_SS = vhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J))
    elseif ((vbt(i,j) < btcl_v(i,j)%vBT_NN) .and. (vhbt(i,j) < btcl_v(i,j)%vh_NN)) then
      ! Expand the cubic fit to use this new point.  vbt is negative.
      btcl_v(i,j)%vbt_NN = vbt(i,j)
      if (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl_v(i,j)%FA_v_N0) then
        ! No further bounding is needed.
        btcl_v(i,j)%vh_crvN = (vhbt(i,j) - vbt(i,j) * btcl_v(i,j)%FA_v_N0) / vbt(i,j)**3
      else ! This should not happen often!
        btcl_v(i,j)%FA_v_N0 = 1.5*vhbt(i,j) / (vbt(i,j))
        btcl_v(i,j)%vh_crvN = -0.5*vhbt(i,j) / vbt(i,j)**3
      endif
      btcl_v(i,j)%vh_NN = vhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_v(i,J)%FA_v_NN = min(BTCL_v(i,J)%FA_v_NN, vhbt(i,J) / vbt(i,J))
    endif
  enddo ; enddo
 
end subroutine adjust_local_bt_cont_types
 
!> This subroutine uses the BTCL types to find typical or maximum face
!! areas, which can then be used for finding wave speeds, etc.
subroutine bt_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize)
  type(bt_cont_type),     intent(inout) :: BT_cont    !< The BT_cont_type input to the
                                                      !! barotropic solver.
  type(memory_size_type), intent(in)    :: MS         !< A type that describes the memory
                                                      !! sizes of the argument arrays.
  real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
                          intent(out)   :: Datu       !< The effective zonal face area [H L ~> m2 or kg m-1].
  real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
                          intent(out)   :: Datv       !< The effective meridional face area [H L ~> m2 or kg m-1].
  type(ocean_grid_type),  intent(in)    :: G          !< The ocean's grid structure.
  type(unit_scale_type),  intent(in)    :: US   !< A dimensional unit scaling type
  integer,      optional, intent(in)    :: halo       !< The extra halo size to use here.
  logical,      optional, intent(in)    :: maximize   !< If present and true, find the
                                                      !! maximum face area for any velocity.
 
  ! Local variables
  logical :: find_max
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
  find_max = .false. ; if (present(maximize)) find_max = maximize
 
  if (find_max) then
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i,j) = max(bt_cont%FA_u_EE(i,j), bt_cont%FA_u_E0(i,j), &
                      bt_cont%FA_u_W0(i,j), bt_cont%FA_u_WW(i,j))
    enddo ; enddo
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i,j) = max(bt_cont%FA_v_NN(i,j), bt_cont%FA_v_N0(i,j), &
                      bt_cont%FA_v_S0(i,j), bt_cont%FA_v_SS(i,j))
    enddo ; enddo
  else
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i,j) = 0.5 * (bt_cont%FA_u_E0(i,j) + bt_cont%FA_u_W0(i,j))
    enddo ; enddo
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i,j) = 0.5 * (bt_cont%FA_v_N0(i,j) + bt_cont%FA_v_S0(i,j))
    enddo ; enddo
  endif
 
end subroutine bt_cont_to_face_areas
 
!> Swap the values of two real variables
subroutine swap(a,b)
  real, intent(inout) :: a !< The first variable to be swapped.
  real, intent(inout) :: b !< The second variable to be swapped.
  real :: tmp
  tmp = a ; a = b ; b = tmp
end subroutine swap
 
!> This subroutine determines the open face areas of cells for calculating
!! the barotropic transport.
subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max)
  type(memory_size_type),  intent(in) :: MS    !< A type that describes the memory sizes of the argument arrays.
  real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
                           intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1].
  real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
                           intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1].
  type(ocean_grid_type),   intent(in)  :: G    !< The ocean's grid structure.
  type(verticalgrid_type), intent(in)  :: GV   !< The ocean's vertical grid structure.
  type(unit_scale_type),   intent(in)  :: US   !< A dimensional unit scaling type
  type(barotropic_cs),     pointer     :: CS   !< The control structure returned by a previous
                                               !! call to barotropic_init.
  real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), &
                 optional, intent(in)  :: eta  !< The barotropic free surface height anomaly
                                               !! or column mass anomaly [H ~> m or kg m-2].
  integer,       optional, intent(in)  :: halo !< The halo size to use, default = 1.
  real,          optional, intent(in)  :: add_max !< A value to add to the maximum depth (used
                                               !! to overestimate the external wave speed) [Z ~> m].
 
  ! Local variables
  real :: H1, H2      ! Temporary total thicknesses [H ~> m or kg m-2].
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
 
!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,CS,Datu,Datv,add_max) &
!$OMP                       private(H1,H2)
  if (present(eta)) then
    ! The use of harmonic mean thicknesses ensure positive definiteness.
    if (gv%Boussinesq) then
!$OMP do
      do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
        h1 = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j) ; h2 = cs%bathyT(i+1,j)*gv%Z_to_H + eta(i+1,j)
        datu(i,j) = 0.0 ; if ((h1 > 0.0) .and. (h2 > 0.0)) &
        datu(i,j) = cs%dy_Cu(i,j) * (2.0 * h1 * h2) / (h1 + h2)
!       Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
      enddo ; enddo
!$OMP do
      do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
        h1 = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j) ; h2 = cs%bathyT(i,j+1)*gv%Z_to_H + eta(i,j+1)
        datv(i,j) = 0.0 ; if ((h1 > 0.0) .and. (h2 > 0.0)) &
        datv(i,j) = cs%dx_Cv(i,j) * (2.0 * h1 * h2) / (h1 + h2)
!       Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2)
      enddo ; enddo
    else
!$OMP do
      do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
        datu(i,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) &
        datu(i,j) = cs%dy_Cu(i,j) * (2.0 * eta(i,j) * eta(i+1,j)) / &
                                  (eta(i,j) + eta(i+1,j))
        ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))
      enddo ; enddo
!$OMP do
      do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
        datv(i,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) &
        datv(i,j) = cs%dx_Cv(i,j) * (2.0 * eta(i,j) * eta(i,j+1)) / &
                                  (eta(i,j) + eta(i,j+1))
        ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (eta(i,j) + eta(i,j+1))
      enddo ; enddo
    endif
  elseif (present(add_max)) then
!$OMP do
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i,j) = cs%dy_Cu(i,j) * gv%Z_to_H * &
                 (max(cs%bathyT(i+1,j), cs%bathyT(i,j)) + add_max)
    enddo ; enddo
!$OMP do
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i,j) = cs%dx_Cv(i,j) * gv%Z_to_H * &
                 (max(cs%bathyT(i,j+1), cs%bathyT(i,j)) + add_max)
    enddo ; enddo
  else
!$OMP do
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i, j) = 0.0
      !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain
      if (cs%bathyT(i+1,j)+cs%bathyT(i,j)>0.) &
        datu(i,j) = 2.0*cs%dy_Cu(i,j) * gv%Z_to_H * &
                  (cs%bathyT(i+1,j) * cs%bathyT(i,j)) / &
                  (cs%bathyT(i+1,j) + cs%bathyT(i,j))
    enddo ; enddo
!$OMP do
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i, j) = 0.0
      !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain
      if (cs%bathyT(i,j+1)+cs%bathyT(i,j)>0.) &
        datv(i,j) = 2.0*cs%dx_Cv(i,j) * gv%Z_to_H * &
                  (cs%bathyT(i,j+1) * cs%bathyT(i,j)) / &
                  (cs%bathyT(i,j+1) + cs%bathyT(i,j))
    enddo ; enddo
  endif
!$OMP end parallel
 
end subroutine find_face_areas
 
!> bt_mass_source determines the appropriately limited mass source for
!! the barotropic solver, along with a corrective fictitious mass source that
!! will drive the barotropic estimate of the free surface height toward the
!! baroclinic estimate.
subroutine bt_mass_source(h, eta, set_cor, G, GV, CS)
  type(ocean_grid_type),              intent(in) :: g        !< The ocean's grid structure.
  type(verticalgrid_type),            intent(in) :: gv       !< The ocean's vertical grid structure.
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h  !< Layer thicknesses [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJ_(G)),   intent(in) :: eta      !< The free surface height that is to be
                                                             !! corrected [H ~> m or kg m-2].
  logical,                            intent(in) :: set_cor  !< A flag to indicate whether to set the corrective
                                                             !! fluxes (and update the slowly varying part of eta_cor)
                                                             !! (.true.) or whether to incrementally update the
                                                             !! corrective fluxes.
  type(barotropic_cs),                pointer    :: cs       !< The control structure returned by a previous call
                                                             !! to barotropic_init.
 
  ! Local variables
  real :: h_tot(szi_(g))      ! The sum of the layer thicknesses [H ~> m or kg m-2].
  real :: eta_h(szi_(g))      ! The free surface height determined from
                              ! the sum of the layer thicknesses [H ~> m or kg m-2].
  real :: d_eta               ! The difference between estimates of the total
                              ! thicknesses [H ~> m or kg m-2].
  real :: limit_dt            ! The fractional mass-source limit divided by the
                              ! thermodynamic time step [s-1].
  integer :: is, ie, js, je, nz, i, j, k
  real, parameter :: frac_cor = 0.25
  real, parameter :: slow_rate = 0.125
 
  if (.not.associated(cs)) call mom_error(fatal, "bt_mass_source: "// &
        "Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
 
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
 
  !$OMP parallel do default(shared) private(eta_h,h_tot,limit_dt,d_eta)
  do j=js,je
    do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo
    if (gv%Boussinesq) then
      do i=is,ie ; eta_h(i) = h(i,j,1) - g%bathyT(i,j)*gv%Z_to_H ; enddo
    else
      do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo
    endif
    do k=2,nz ; do i=is,ie
      eta_h(i) = eta_h(i) + h(i,j,k)
      h_tot(i) = h_tot(i) + h(i,j,k)
    enddo ; enddo
 
    if (set_cor) then
      do i=is,ie
        d_eta = eta_h(i) - eta(i,j)
        cs%eta_cor(i,j) = d_eta
      enddo
    else
      do i=is,ie
        d_eta = eta_h(i) - eta(i,j)
        cs%eta_cor(i,j) = cs%eta_cor(i,j) + d_eta
      enddo
    endif
  enddo
 
end subroutine bt_mass_source
 
!> barotropic_init initializes a number of time-invariant fields used in the
!! barotropic calculation and initializes any barotropic fields that have not
!! already been initialized.
subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, &
                           restart_CS, calc_dtbt, BT_cont, tides_CSp)
  type(ocean_grid_type),   intent(inout) :: g    !< The ocean's grid structure.
  type(verticalgrid_type), intent(in)    :: gv   !< The ocean's vertical grid structure.
  type(unit_scale_type),   intent(in)    :: us   !< A dimensional unit scaling type
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
                           intent(in)    :: u    !< The zonal velocity [m s-1].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
                           intent(in)    :: v    !< The meridional velocity [m s-1].
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
                           intent(in)    :: h    !< Layer thicknesses [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJ_(G)), &
                           intent(in)    :: eta  !< Free surface height or column mass anomaly
                                                 !! [Z ~> m] or [H ~> kg m-2].
  type(time_type), target, intent(in)    :: time !< The current model time.
  type(param_file_type),   intent(in)    :: param_file !< A structure to parse for run-time parameters.
  type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
                                                 !! output.
  type(barotropic_cs),     pointer       :: cs   !< A pointer to the control structure for this module
                                                 !! that is set in register_barotropic_restarts.
  type(mom_restart_cs),    pointer       :: restart_cs !< A pointer to the restart control structure.
  logical,                 intent(out)   :: calc_dtbt  !< If true, the barotropic time step must
                                                 !! be recalculated before stepping.
  type(bt_cont_type), optional, &
                           pointer       :: bt_cont    !< A structure with elements that describe the
                                                 !! effective open face areas as a function of
                                                 !! barotropic flow.
  type(tidal_forcing_cs), optional, &
                           pointer       :: tides_csp  !< A pointer to the control structure of the
                                                 !! tide module.
 
! This include declares and sets the variable "version".
#include "version_variable.h"
  ! Local variables
  character(len=40)  :: mdl = "MOM_barotropic"  ! This module's name.
  real :: datu(szibs_(g),szj_(g))   ! Zonal open face area [H L ~> m2 or kg m-1].
  real :: datv(szi_(g),szjbs_(g))   ! Meridional open face area [H L ~> m2 or kg m-1].
  real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce.
  real :: ssh_extra     ! An estimate of how much higher SSH might get, for use
                        ! in calculating the safe external wave speed [Z ~> m].
  real :: dtbt_input, dtbt_tmp
  real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag
                          ! piston velocities.
  character(len=200) :: inputdir       ! The directory in which to find input files.
  character(len=200) :: wave_drag_file ! The file from which to read the wave
                                       ! drag piston velocity.
  character(len=80)  :: wave_drag_var  ! The wave drag piston velocity variable
                                       ! name in wave_drag_file.
  real :: vel_rescale ! A rescaling factor for horizontal velocity from the representation in
                      ! a restart file to the internal representation in this run.
  real :: uh_rescale  ! A rescaling factor for thickness transports from the representation in
                      ! a restart file to the internal representation in this run.
  real, allocatable, dimension(:,:) :: lin_drag_h
  type(memory_size_type) :: ms
  type(group_pass_type) :: pass_static_data, pass_q_d_cor
  type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity
  logical :: apply_bt_drag, use_bt_cont_type
  character(len=48) :: thickness_units, flux_units
  character*(40) :: hvel_str
  integer :: is, ie, js, je, isq, ieq, jsq, jeq, nz
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
  integer :: isdw, iedw, jsdw, jedw
  integer :: i, j, k
  integer :: wd_halos(2), bt_halo_sz
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
  ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed
 
  if (cs%module_is_initialized) then
    call mom_error(warning, "barotropic_init called with a control structure "// &
                            "that has already been initialized.")
    return
  endif
  cs%module_is_initialized = .true.
 
  cs%diag => diag ; cs%Time => time
  if (present(tides_csp)) then
    if (associated(tides_csp)) cs%tides_CSp => tides_csp
  endif
 
  ! Read all relevant parameters and write them to the model log.
  call log_version(param_file, mdl, version, "")
  call get_param(param_file, mdl, "SPLIT", cs%split, &
                 "Use the split time stepping if true.", default=.true.)
  if (.not.cs%split) return
 
  call get_param(param_file, mdl, "BOUND_BT_CORRECTION", cs%bound_BT_corr, &
                 "If true, the corrective pseudo mass-fluxes into the "//&
                 "barotropic solver are limited to values that require "//&
                 "less than maxCFL_BT_cont to be accommodated.",default=.false.)
  call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", cs%BT_cont_bounds, &
                 "If true, and BOUND_BT_CORRECTION is true, use the "//&
                 "BT_cont_type variables to set limits determined by "//&
                 "MAXCFL_BT_CONT on the CFL number of the velocities "//&
                 "that are likely to be driven by the corrective mass fluxes.", &
                 default=.true.) !, do_not_log=.not.CS%bound_BT_corr)
  call get_param(param_file, mdl, "ADJUST_BT_CONT", cs%adjust_BT_cont, &
                 "If true, adjust the curve fit to the BT_cont type "//&
                 "that is used by the barotropic solver to match the "//&
                 "transport about which the flow is being linearized.", default=.false.)
  call get_param(param_file, mdl, "GRADUAL_BT_ICS", cs%gradual_BT_ICs, &
                 "If true, adjust the initial conditions for the "//&
                 "barotropic solver to the values from the layered "//&
                 "solution over a whole timestep instead of instantly. "//&
                 "This is a decent approximation to the inclusion of "//&
                 "sum(u dh_dt) while also correcting for truncation errors.", &
                 default=.false.)
  call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", cs%visc_rem_u_uh0, &
                 "If true, use the viscous remnants when estimating the "//&
                 "barotropic velocities that were used to calculate uh0 "//&
                 "and vh0.  False is probably the better choice.", default=.false.)
  call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", cs%use_wide_halos, &
                 "If true, use wide halos and march in during the "//&
                 "barotropic time stepping for efficiency.", default=.true., &
                 layoutparam=.true.)
  call get_param(param_file, mdl, "BTHALO", bt_halo_sz, &
                 "The minimum halo size for the barotropic solver.", default=0, &
                 layoutparam=.true.)
#ifdef STATIC_MEMORY_
  if ((bt_halo_sz > 0) .and. (bt_halo_sz /= bthalo_)) call mom_error(fatal, &
      "barotropic_init: Run-time values of BTHALO must agree with the "//&
      "macro BTHALO_ with STATIC_MEMORY_.")
  wd_halos(1) = whaloi_+nihalo_ ; wd_halos(2) = whaloj_+njhalo_
#else
  wd_halos(1) = bt_halo_sz; wd_halos(2) =  bt_halo_sz
#endif
  call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), &
                 "The barotropic x-halo size that is actually used.", &
                 layoutparam=.true.)
  call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), &
                 "The barotropic y-halo size that is actually used.", &
                 layoutparam=.true.)
 
  call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_bt_cont_type, &
               "If true, use a structure with elements that describe "//&
               "effective face areas from the summed continuity solver "//&
               "as a function the barotropic flow in coupling between "//&
               "the barotropic and baroclinic flow.  This is only used "//&
               "if SPLIT is true. \n", default=.true.)
  call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", &
                                cs%Nonlinear_continuity, &
                 "If true, use nonlinear transports in the barotropic "//&
                 "continuity equation.  This does not apply if "//&
                 "USE_BT_CONT_TYPE is true.", default=.false.)
  cs%Nonlin_cont_update_period = 1
  if (cs%Nonlinear_continuity) &
    call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", &
                                  cs%Nonlin_cont_update_period, &
                 "If NONLINEAR_BT_CONTINUITY is true, this is the number "//&
                 "of barotropic time steps between updates to the face "//&
                 "areas, or 0 to update only before the barotropic stepping.",&
                 units="nondim", default=1)
  call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", cs%BT_project_velocity,&
                 "If true, step the barotropic velocity first and project "//&
                 "out the velocity tendency by 1+BEBT when calculating the "//&
                 "transport.  The default (false) is to use a predictor "//&
                 "continuity step to find the pressure field, and then "//&
                 "to do a corrector continuity step using a weighted "//&
                 "average of the old and new velocities, with weights "//&
                 "of (1-BEBT) and BEBT.", default=.false.)
 
  call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", cs%dynamic_psurf, &
                 "If true, add a dynamic pressure due to a viscous ice "//&
                 "shelf, for instance.", default=.false.)
  if (cs%dynamic_psurf) then
    call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", cs%ice_strength_length, &
                 "The length scale at which the Rayleigh damping rate due "//&
                 "to the ice strength should be the same as if a Laplacian "//&
                 "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", &
                 units="m", default=1.0e4, scale=us%m_to_L)
    call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", cs%Dmin_dyn_psurf, &
                  "The minimum depth to use in limiting the size of the "//&
                  "dynamic surface pressure for stability, if "//&
                  "DYNAMIC_SURFACE_PRESSURE is true..", &
                  units="m", default=1.0e-6, scale=us%m_to_Z)
    call get_param(param_file, mdl, "CONST_DYN_PSURF", cs%const_dyn_psurf, &
                 "The constant that scales the dynamic surface pressure, "//&
                 "if DYNAMIC_SURFACE_PRESSURE is true.  Stable values "//&
                 "are < ~1.0.", units="nondim", default=0.9)
  endif
 
  call get_param(param_file, mdl, "TIDES", cs%tides, &
                 "If true, apply tidal momentum forcing.", default=.false.)
  call get_param(param_file, mdl, "SADOURNY", cs%Sadourny, &
                 "If true, the Coriolis terms are discretized with the "//&
                 "Sadourny (1975) energy conserving scheme, otherwise "//&
                 "the Arakawa & Hsu scheme is used.  If the internal "//&
                 "deformation radius is not resolved, the Sadourny scheme "//&
                 "should probably be used.", default=.true.)
 
  call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, &
                 "A string describing the scheme that is used to set the "//&
                 "open face areas used for barotropic transport and the "//&
                 "relative weights of the accelerations. Valid values are:\n"//&
                 "\t ARITHMETIC - arithmetic mean layer thicknesses \n"//&
                 "\t HARMONIC - harmonic mean layer thicknesses \n"//&
                 "\t HYBRID (the default) - use arithmetic means for \n"//&
                 "\t    layers above the shallowest bottom, the harmonic \n"//&
                 "\t    mean for layers below, and a weighted average for \n"//&
                 "\t    layers that straddle that depth \n"//&
                 "\t FROM_BT_CONT - use the average thicknesses kept \n"//&
                 "\t    in the h_u and h_v fields of the BT_cont_type", &
                 default=bt_cont_string)
  select case (hvel_str)
    case (hybrid_string) ; cs%hvel_scheme = hybrid
    case (harmonic_string) ; cs%hvel_scheme = harmonic
    case (arithmetic_string) ; cs%hvel_scheme = arithmetic
    case (bt_cont_string) ; cs%hvel_scheme = from_bt_cont
    case default
      call mom_mesg('barotropic_init: BT_THICK_SCHEME ="'//trim(hvel_str)//'"', 0)
      call mom_error(fatal, "barotropic_init: Unrecognized setting "// &
            "#define BT_THICK_SCHEME "//trim(hvel_str)//" found in input file.")
  end select
  if ((cs%hvel_scheme == from_bt_cont) .and. .not.use_bt_cont_type) &
    call mom_error(fatal, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//&
                           "can only be used if USE_BT_CONT_TYPE is defined.")
 
  call get_param(param_file, mdl, "BT_STRONG_DRAG", cs%strong_drag, &
                 "If true, use a stronger estimate of the retarding "//&
                 "effects of strong bottom drag, by making it implicit "//&
                 "with the barotropic time-step instead of implicit with "//&
                 "the baroclinic time-step and dividing by the number of "//&
                 "barotropic steps.", default=.false.)
  call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", cs%linear_wave_drag, &
                 "If true, apply a linear drag to the barotropic velocities, "//&
                 "using rates set by lin_drag_u & _v divided by the depth of "//&
                 "the ocean.  This was introduced to facilitate tide modeling.", &
                 default=.false.)
  call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, &
                 "The name of the file with the barotropic linear wave drag "//&
                 "piston velocities.", default="", do_not_log=.not.cs%linear_wave_drag)
  call get_param(param_file, mdl, "BT_WAVE_DRAG_VAR", wave_drag_var, &
                 "The name of the variable in BT_WAVE_DRAG_FILE with the "//&
                 "barotropic linear wave drag piston velocities at h points.", &
                 default="rH", do_not_log=.not.cs%linear_wave_drag)
  call get_param(param_file, mdl, "BT_WAVE_DRAG_SCALE", wave_drag_scale, &
                 "A scaling factor for the barotropic linear wave drag "//&
                 "piston velocities.", default=1.0, units="nondim", &
                 do_not_log=.not.cs%linear_wave_drag)
 
  call get_param(param_file, mdl, "CLIP_BT_VELOCITY", cs%clip_velocity, &
                 "If true, limit any velocity components that exceed "//&
                 "CFL_TRUNCATE.  This should only be used as a desperate "//&
                 "debugging measure.", default=.false.)
  call get_param(param_file, mdl, "CFL_TRUNCATE", cs%CFL_trunc, &
                 "The value of the CFL number that will cause velocity "//&
                 "components to be truncated; instability can occur past 0.5.", &
                 units="nondim", default=0.5, do_not_log=.not.cs%clip_velocity)
  call get_param(param_file, mdl, "MAXVEL", cs%maxvel, &
                 "The maximum velocity allowed before the velocity "//&
                 "components are truncated.", units="m s-1", default=3.0e8, scale=us%m_s_to_L_T, &
                 do_not_log=.not.cs%clip_velocity)
  call get_param(param_file, mdl, "MAXCFL_BT_CONT", cs%maxCFL_BT_cont, &
                 "The maximum permitted CFL number associated with the "//&
                 "barotropic accelerations from the summed velocities "//&
                 "times the time-derivatives of thicknesses.", units="nondim", &
                 default=0.25)
  call get_param(param_file, mdl, "VEL_UNDERFLOW", cs%vel_underflow, &
                 "A negligibly small velocity magnitude below which velocity "//&
                 "components are set to 0.  A reasonable value might be "//&
                 "1e-30 m/s, which is less than an Angstrom divided by "//&
                 "the age of the universe.", units="m s-1", default=0.0, scale=us%m_s_to_L_T)
 
  call get_param(param_file, mdl, "DT_BT_FILTER", cs%dt_bt_filter, &
                 "A time-scale over which the barotropic mode solutions "//&
                 "are filtered, in seconds if positive, or as a fraction "//&
                 "of DT if negative. When used this can never be taken to "//&
                 "be longer than 2*dt.  Set this to 0 to apply no filtering.", &
                 units="sec or nondim", default=-0.25)
  if (cs%dt_bt_filter > 0.0) cs%dt_bt_filter = us%s_to_T*cs%dt_bt_filter
  call get_param(param_file, mdl, "G_BT_EXTRA", cs%G_extra, &
                 "A nondimensional factor by which gtot is enhanced.", &
                 units="nondim", default=0.0)
  call get_param(param_file, mdl, "SSH_EXTRA", ssh_extra, &
                 "An estimate of how much higher SSH might get, for use "//&
                 "in calculating the safe external wave speed. The "//&
                 "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", &
                 units="m", default=min(10.0,0.05*g%max_depth*us%Z_to_m), scale=us%m_to_Z)
 
  call get_param(param_file, mdl, "DEBUG", cs%debug, &
                 "If true, write out verbose debugging data.", &
                 default=.false., debuggingparam=.true.)
  call get_param(param_file, mdl, "DEBUG_BT", cs%debug_bt, &
                 "If true, write out verbose debugging data within the "//&
                 "barotropic time-stepping loop. The data volume can be "//&
                 "quite large if this is true.", default=cs%debug, &
                 debuggingparam=.true.)
 
  cs%linearized_BT_PV = .true.
  call get_param(param_file, mdl, "BEBT", cs%bebt, &
                 "BEBT determines whether the barotropic time stepping "//&
                 "uses the forward-backward time-stepping scheme or a "//&
                 "backward Euler scheme. BEBT is valid in the range from "//&
                 "0 (for a forward-backward treatment of nonrotating "//&
                 "gravity waves) to 1 (for a backward Euler treatment). "//&
                 "In practice, BEBT must be greater than about 0.05.", &
                 units="nondim", default=0.1)
  call get_param(param_file, mdl, "DTBT", dtbt_input, &
                 "The barotropic time step, in s. DTBT is only used with "//&
                 "the split explicit time stepping. To set the time step "//&
                 "automatically based the maximum stable value use 0, or "//&
                 "a negative value gives the fraction of the stable value. "//&
                 "Setting DTBT to 0 is the same as setting it to -0.98. "//&
                 "The value of DTBT that will actually be used is an "//&
                 "integer fraction of DT, rounding down.", units="s or nondim",&
                 default = -0.98)
  call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", &
                 cs%use_old_coriolis_bracket_bug , &
                 "If True, use an order of operations that is not bitwise "//&
                 "rotationally symmetric in the meridional Coriolis term of "//&
                 "the barotropic solver.", default=.false.)
 
  ! Initialize a version of the MOM domain that is specific to the barotropic solver.
  call clone_mom_domain(g%Domain, cs%BT_Domain, min_halo=wd_halos, symmetric=.true.)
#ifdef STATIC_MEMORY_
  if (wd_halos(1) /= whaloi_+nihalo_) call mom_error(fatal, "barotropic_init: "//&
          "Barotropic x-halo sizes are incorrectly resized with STATIC_MEMORY_.")
  if (wd_halos(2) /= whaloj_+njhalo_) call mom_error(fatal, "barotropic_init: "//&
          "Barotropic y-halo sizes are incorrectly resized with STATIC_MEMORY_.")
#else
  if (bt_halo_sz > 0) then
    if (wd_halos(1) > bt_halo_sz) &
      call mom_mesg("barotropic_init: barotropic x-halo size increased.", 3)
    if (wd_halos(2) > bt_halo_sz) &
      call mom_mesg("barotropic_init: barotropic y-halo size increased.", 3)
  endif
#endif
 
  cs%isdw = g%isc-wd_halos(1) ; cs%iedw = g%iec+wd_halos(1)
  cs%jsdw = g%jsc-wd_halos(2) ; cs%jedw = g%jec+wd_halos(2)
  isdw = cs%isdw ; iedw = cs%iedw ; jsdw = cs%jsdw ; jedw = cs%jedw
 
  alloc_(cs%frhatu(isdb:iedb,jsd:jed,nz)) ; alloc_(cs%frhatv(isd:ied,jsdb:jedb,nz))
  alloc_(cs%eta_cor(isd:ied,jsd:jed))
  if (cs%bound_BT_corr) then
    alloc_(cs%eta_cor_bound(isd:ied,jsd:jed)) ; cs%eta_cor_bound(:,:) = 0.0
  endif
  alloc_(cs%IDatu(isdb:iedb,jsd:jed)) ; alloc_(cs%IDatv(isd:ied,jsdb:jedb))
 
  alloc_(cs%ua_polarity(isdw:iedw,jsdw:jedw))
  alloc_(cs%va_polarity(isdw:iedw,jsdw:jedw))
 
  cs%frhatu(:,:,:) = 0.0 ; cs%frhatv(:,:,:) = 0.0
  cs%eta_cor(:,:) = 0.0
  cs%IDatu(:,:) = 0.0 ; cs%IDatv(:,:) = 0.0
 
  cs%ua_polarity(:,:) = 1.0 ; cs%va_polarity(:,:) = 1.0
  call create_group_pass(pass_a_polarity, cs%ua_polarity, cs%va_polarity, cs%BT_domain, to_all, agrid)
  call do_group_pass(pass_a_polarity, cs%BT_domain)
 
  if (use_bt_cont_type) &
    call alloc_bt_cont_type(bt_cont, g, (cs%hvel_scheme == from_bt_cont))
 
  if (cs%debug) then ! Make a local copy of loop ranges for chksum calls
    allocate(cs%debug_BT_HI)
    cs%debug_BT_HI%isc=g%isc
    cs%debug_BT_HI%iec=g%iec
    cs%debug_BT_HI%jsc=g%jsc
    cs%debug_BT_HI%jec=g%jec
    cs%debug_BT_HI%IscB=g%isc-1
    cs%debug_BT_HI%IecB=g%iec
    cs%debug_BT_HI%JscB=g%jsc-1
    cs%debug_BT_HI%JecB=g%jec
    cs%debug_BT_HI%isd=cs%isdw
    cs%debug_BT_HI%ied=cs%iedw
    cs%debug_BT_HI%jsd=cs%jsdw
    cs%debug_BT_HI%jed=cs%jedw
    cs%debug_BT_HI%IsdB=cs%isdw-1
    cs%debug_BT_HI%IedB=cs%iedw
    cs%debug_BT_HI%JsdB=cs%jsdw-1
    cs%debug_BT_HI%JedB=cs%jedw
  endif
 
  ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.
  alloc_(cs%IareaT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IareaT(:,:) = 0.0
  alloc_(cs%bathyT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%bathyT(:,:) = gv%Angstrom_m !### Change to 0.0?
  alloc_(cs%IdxCu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IdxCu(:,:) = 0.0
  alloc_(cs%IdyCv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%IdyCv(:,:) = 0.0
  alloc_(cs%dy_Cu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%dy_Cu(:,:) = 0.0
  alloc_(cs%dx_Cv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%dx_Cv(:,:) = 0.0
  do j=g%jsd,g%jed ; do i=g%isd,g%ied
    cs%IareaT(i,j) = us%L_to_m**2*g%IareaT(i,j)
    cs%bathyT(i,j) = g%bathyT(i,j)
  enddo ; enddo
 
  ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without
  !   wide halos.
  do j=g%jsd,g%jed ; do i=g%IsdB,g%IedB
    cs%IdxCu(i,j) = us%L_to_m*g%IdxCu(i,j) ; cs%dy_Cu(i,j) = us%m_to_L*g%dy_Cu(i,j)
  enddo ; enddo
  do j=g%JsdB,g%JedB ; do i=g%isd,g%ied
    cs%IdyCv(i,j) = us%L_to_m*g%IdyCv(i,j) ; cs%dx_Cv(i,j) = us%m_to_L*g%dx_Cv(i,j)
  enddo ; enddo
  call create_group_pass(pass_static_data, cs%IareaT, cs%BT_domain, to_all)
  call create_group_pass(pass_static_data, cs%bathyT, cs%BT_domain, to_all)
  call create_group_pass(pass_static_data, cs%IdxCu, cs%IdyCv, cs%BT_domain, to_all+scalar_pair)
  call create_group_pass(pass_static_data, cs%dy_Cu, cs%dx_Cv, cs%BT_domain, to_all+scalar_pair)
  call do_group_pass(pass_static_data, cs%BT_domain)
 
  if (cs%linearized_BT_PV) then
    alloc_(cs%q_D(cs%isdw-1:cs%iedw,cs%jsdw-1:cs%jedw))
    alloc_(cs%D_u_Cor(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw))
    alloc_(cs%D_v_Cor(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw))
    cs%q_D(:,:) = 0.0 ; cs%D_u_Cor(:,:) = 0.0 ; cs%D_v_Cor(:,:) = 0.0
    do j=js,je ; do i=is-1,ie
      cs%D_u_Cor(i,j) = 0.5 * (g%bathyT(i+1,j) + g%bathyT(i,j))
    enddo ; enddo
    do j=js-1,je ; do i=is,ie
      cs%D_v_Cor(i,j) = 0.5 * (g%bathyT(i,j+1) + g%bathyT(i,j))
    enddo ; enddo
    do j=js-1,je ; do i=is-1,ie
      if (g%mask2dT(i,j)+g%mask2dT(i,j+1)+g%mask2dT(i+1,j)+g%mask2dT(i+1,j+1)>0.) then
        cs%q_D(i,j) = 0.25 * g%CoriolisBu(i,j) * &
           ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / &
           ((g%areaT(i,j) * g%bathyT(i,j) + g%areaT(i+1,j+1) * g%bathyT(i+1,j+1)) + &
            (g%areaT(i+1,j) * g%bathyT(i+1,j) + g%areaT(i,j+1) * g%bathyT(i,j+1)) )
      else ! All four h points are masked out so q_D(I,J) will is meaningless
        cs%q_D(i,j) = 0.
      endif
    enddo ; enddo
    ! With very wide halos, q and D need to be calculated on the available data
    ! domain and then updated onto the full computational domain.
    call create_group_pass(pass_q_d_cor, cs%q_D, cs%BT_Domain, to_all, position=corner)
    call create_group_pass(pass_q_d_cor, cs%D_u_Cor, cs%D_v_Cor, cs%BT_Domain, &
                           to_all+scalar_pair)
    call do_group_pass(pass_q_d_cor, cs%BT_Domain)
  endif
 
  if (cs%linear_wave_drag) then
    alloc_(cs%lin_drag_u(isdb:iedb,jsd:jed)) ; cs%lin_drag_u(:,:) = 0.0
    alloc_(cs%lin_drag_v(isd:ied,jsdb:jedb)) ; cs%lin_drag_v(:,:) = 0.0
 
    if (len_trim(wave_drag_file) > 0) then
      inputdir = "." ;  call get_param(param_file, mdl, "INPUTDIR", inputdir)
      wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
      call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
 
      allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0
 
      call mom_read_data(wave_drag_file, wave_drag_var, lin_drag_h, g%Domain, scale=us%m_to_Z*us%T_to_s)
      call pass_var(lin_drag_h, g%Domain)
      do j=js,je ; do i=is-1,ie
        cs%lin_drag_u(i,j) = (gv%Z_to_H * wave_drag_scale) * &
           0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        cs%lin_drag_v(i,j) = (gv%Z_to_H * wave_drag_scale) * &
            0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
      enddo ; enddo
      deallocate(lin_drag_h)
    endif
  endif
 
  cs%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) cs%dtbt_fraction = -dtbt_input
 
  dtbt_tmp = -1.0
  if (query_initialized(cs%dtbt, "DTBT", restart_cs)) dtbt_tmp = cs%dtbt
 
  ! Estimate the maximum stable barotropic time step.
  gtot_estimate = 0.0
  do k=1,g%ke ; gtot_estimate = gtot_estimate + gv%g_prime(k) ; enddo
  call set_dtbt(g, gv, us, cs, gtot_est=gtot_estimate, ssh_add=ssh_extra)
 
  if (dtbt_input > 0.0) then
    cs%dtbt = dtbt_input
  elseif (dtbt_tmp > 0.0) then
    cs%dtbt = dtbt_tmp
  endif
  if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false.
 
  call log_param(param_file, mdl, "DTBT as used", cs%dtbt)
  call log_param(param_file, mdl, "estimated maximum DTBT", cs%dtbt_max)
 
  ! ubtav, vbtav, ubt_IC, vbt_IC, uhbt_IC, and vhbt_IC are allocated and
  ! initialized in register_barotropic_restarts.
 
  if (gv%Boussinesq) then
    thickness_units = "m" ; flux_units = "m3 s-1"
  else
    thickness_units = "kg m-2" ; flux_units = "kg s-1"
  endif
 
  cs%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, time, &
      'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, time, &
      'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, time, &
      'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, time, &
      'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, time, &
      'Barotropic zonal acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, time, &
      'Barotropic meridional acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, time, &
      'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, time, &
      'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=us%L_T2_to_m_s2)
 
  cs%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, time, &
      'Barotropic end SSH', thickness_units)
  cs%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, time, &
      'Barotropic end zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, time, &
      'Barotropic end meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, time, &
      'Barotropic start SSH', thickness_units)
  cs%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, time, &
      'Barotropic start zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, time, &
      'Barotropic start meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, time, &
      'Barotropic time-average zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, time, &
      'Barotropic time-average meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, time, &
      'Corrective mass flux', 'm s-1')
  cs%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, time, &
      'Viscous remnant at u', 'nondim')
  cs%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, time, &
      'Viscous remnant at v', 'nondim')
  cs%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, time, &
      'gtot to North', 'm s-2', conversion=us%L_T_to_m_s**2)
  cs%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, time, &
      'gtot to South', 'm s-2', conversion=us%L_T_to_m_s**2)
  cs%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, time, &
      'gtot to East', 'm s-2', conversion=us%L_T_to_m_s**2)
  cs%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, time, &
      'gtot to West', 'm s-2', conversion=us%L_T_to_m_s**2)
  cs%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, time, &
      'High Frequency Barotropic SSH', thickness_units)
  cs%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, time, &
      'High Frequency Barotropic zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, time, &
      'High Frequency Barotropic meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, time, &
      'High Frequency Predictor Barotropic SSH', thickness_units)
  cs%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, time, &
      'High Frequency Barotropic zonal transport', 'm3 s-1')
  cs%id_vhbt_hifreq = register_diag_field('ocean_model', 'vhbt_hifreq', diag%axesCv1, time, &
      'High Frequency Barotropic meridional transport', 'm3 s-1')
  cs%id_frhatu = register_diag_field('ocean_model', 'frhatu', diag%axesCuL, time, &
      'Fractional thickness of layers in u-columns', 'nondim')
  cs%id_frhatv = register_diag_field('ocean_model', 'frhatv', diag%axesCvL, time, &
      'Fractional thickness of layers in v-columns', 'nondim')
  cs%id_frhatu1 = register_diag_field('ocean_model', 'frhatu1', diag%axesCuL, time, &
      'Predictor Fractional thickness of layers in u-columns', 'nondim')
  cs%id_frhatv1 = register_diag_field('ocean_model', 'frhatv1', diag%axesCvL, time, &
      'Predictor Fractional thickness of layers in v-columns', 'nondim')
  cs%id_uhbt = register_diag_field('ocean_model', 'uhbt', diag%axesCu1, time, &
      'Barotropic zonal transport averaged over a baroclinic step', 'm3 s-1')
  cs%id_vhbt = register_diag_field('ocean_model', 'vhbt', diag%axesCv1, time, &
      'Barotropic meridional transport averaged over a baroclinic step', 'm3 s-1')
 
  if (use_bt_cont_type) then
    cs%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, time, &
        'BTCont type far east face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, time, &
        'BTCont type near east face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, time, &
        'BTCont type far west face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, time, &
        'BTCont type near west face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, time, &
        'BTCont type far east velocity', 'm s-1')
    cs%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, time, &
        'BTCont type far west velocity', 'm s-1')
    cs%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, time, &
        'BTCont type far north face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, time, &
        'BTCont type near north face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, time, &
        'BTCont type far south face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, time, &
        'BTCont type near south face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, time, &
        'BTCont type far north velocity', 'm s-1', conversion=us%L_T_to_m_s)
    cs%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, time, &
        'BTCont type far south velocity', 'm s-1', conversion=us%L_T_to_m_s)
  endif
  cs%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, time, &
      'Barotropic zonal transport difference', 'm3 s-1', conversion=gv%H_to_m*us%L_to_m**2*us%s_to_T)
  cs%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, time, &
      'Barotropic meridional transport difference', 'm3 s-1', conversion=gv%H_to_m*us%L_to_m**2*us%s_to_T)
 
  if (cs%id_frhatu1 > 0) call safe_alloc_ptr(cs%frhatu1, isdb,iedb,jsd,jed,nz)
  if (cs%id_frhatv1 > 0) call safe_alloc_ptr(cs%frhatv1, isd,ied,jsdb,jedb,nz)
 
  if (.NOT.query_initialized(cs%ubtav,"ubtav",restart_cs) .or. &
      .NOT.query_initialized(cs%vbtav,"vbtav",restart_cs)) then
    call btcalc(h, g, gv, cs, may_use_default=.true.)
    cs%ubtav(:,:) = 0.0 ; cs%vbtav(:,:) = 0.0
    do k=1,nz ; do j=js,je ; do i=is-1,ie
      cs%ubtav(i,j) = cs%ubtav(i,j) + cs%frhatu(i,j,k) * us%m_s_to_L_T*u(i,j,k)
    enddo ; enddo ; enddo
    do k=1,nz ; do j=js-1,je ; do i=is,ie
      cs%vbtav(i,j) = cs%vbtav(i,j) + cs%frhatv(i,j,k) * us%m_s_to_L_T*v(i,j,k)
    enddo ; enddo ; enddo
  elseif ((us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
          (us%m_to_L*us%s_to_T_restart) /= (us%m_to_L_restart*us%s_to_T)) then
    do j=js,je ; do i=is-1,ie ; cs%ubtav(i,j) = vel_rescale * cs%ubtav(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbtav(i,j) = vel_rescale * cs%vbtav(i,j) ; enddo ; enddo
  endif
 
  if (.NOT.query_initialized(cs%ubt_IC,"ubt_IC",restart_cs) .or. &
      .NOT.query_initialized(cs%vbt_IC,"vbt_IC",restart_cs)) then
    do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = cs%ubtav(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = cs%vbtav(i,j) ; enddo ; enddo
  elseif ((us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
          (us%m_to_L*us%s_to_T_restart) /= (us%m_to_L_restart*us%s_to_T)) then
    vel_rescale = (us%m_to_L*us%s_to_T_restart) / (us%m_to_L_restart*us%s_to_T)
    do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = vel_rescale * cs%ubt_IC(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = vel_rescale * cs%vbt_IC(i,j) ; enddo ; enddo
  endif
 
!   Calculate other constants which are used for btstep.
 
  ! The following is only valid with the Boussinesq approximation.
! if (GV%Boussinesq) then
    do j=js,je ; do i=is-1,ie
      if (g%mask2dCu(i,j)>0.) then
        cs%IDatu(i,j) = g%mask2dCu(i,j) * 2.0 / (g%bathyT(i+1,j) + g%bathyT(i,j))
      else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless
        cs%IDatu(i,j) = 0.
      endif
    enddo ; enddo
    do j=js-1,je ; do i=is,ie
      if (g%mask2dCv(i,j)>0.) then
        cs%IDatv(i,j) = g%mask2dCv(i,j) * 2.0 / (g%bathyT(i,j+1) + g%bathyT(i,j))
      else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless
        cs%IDatv(i,j) = 0.
      endif
    enddo ; enddo
! else
!   do j=js,je ; do I=is-1,ie
!     CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j)))
!   enddo ; enddo
!   do J=js-1,je ; do i=is,ie
!     CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j)))
!   enddo ; enddo
! endif
 
  call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=1)
  if (cs%bound_BT_corr) then
    ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
    ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
    do j=js,je ; do i=is,ie
      cs%eta_cor_bound(i,j) = gv%m_to_H * us%L_to_m**2*g%IareaT(i,j) * 0.1 * cs%maxvel * &
         ((datu(i-1,j) + datu(i,j)) + (datv(i,j) + datv(i,j-1)))
    enddo ; enddo
  endif
 
  if (.NOT.query_initialized(cs%uhbt_IC,"uhbt_IC",restart_cs) .or. &
      .NOT.query_initialized(cs%vhbt_IC,"vhbt_IC",restart_cs)) then
    do j=js,je ; do i=is-1,ie ; cs%uhbt_IC(i,j) = cs%ubtav(i,j) * datu(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vhbt_IC(i,j) = cs%vbtav(i,j) * datv(i,j) ; enddo ; enddo
  elseif ((us%s_to_T_restart * us%m_to_L_restart * gv%m_to_H_restart /= 0.0) .and. &
          ((us%s_to_T_restart * us%m_to_L**2 * gv%m_to_H) /= &
           (us%s_to_T * us%m_to_L_restart**2 * gv%m_to_H_restart))) then
    uh_rescale = (us%s_to_T_restart * us%m_to_L**2 * gv%m_to_H) / &
                 (us%s_to_T * us%m_to_L_restart**2 * gv%m_to_H_restart)
    do j=js,je ; do i=is-1,ie ; cs%uhbt_IC(i,j) = uh_rescale * cs%uhbt_IC(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vhbt_IC(i,j) = uh_rescale * cs%vhbt_IC(i,j) ; enddo ; enddo
  endif
 
  call create_group_pass(pass_bt_hbt_btav, cs%ubt_IC, cs%vbt_IC, g%Domain)
  call create_group_pass(pass_bt_hbt_btav, cs%uhbt_IC, cs%vhbt_IC, g%Domain)
  call create_group_pass(pass_bt_hbt_btav, cs%ubtav, cs%vbtav, g%Domain)
  call do_group_pass(pass_bt_hbt_btav, g%Domain)
 
!  id_clock_pass = cpu_clock_id('(Ocean BT halo updates)', grain=CLOCK_ROUTINE)
  id_clock_calc_pre  = cpu_clock_id('(Ocean BT pre-calcs only)', grain=clock_routine)
  id_clock_pass_pre = cpu_clock_id('(Ocean BT pre-step halo updates)', grain=clock_routine)
  id_clock_calc = cpu_clock_id('(Ocean BT stepping calcs only)', grain=clock_routine)
  id_clock_pass_step = cpu_clock_id('(Ocean BT stepping halo updates)', grain=clock_routine)
  id_clock_calc_post = cpu_clock_id('(Ocean BT post-calcs only)', grain=clock_routine)
  id_clock_pass_post = cpu_clock_id('(Ocean BT post-step halo updates)', grain=clock_routine)
  if (dtbt_input <= 0.0) &
    id_clock_sync = cpu_clock_id('(Ocean BT global synch)', grain=clock_routine)
 
end subroutine barotropic_init
 
!> Copies ubtav and vbtav from private type into arrays
subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US)
  type(barotropic_cs),               pointer       :: cs    !< Control structure for this module
  type(ocean_grid_type),             intent(in)    :: g     !< Grid structure
  real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged
                                                            !! over a baroclinic timestep [m s-1]
  real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged
                                                            !! over a baroclinic timestep [m s-1]
  type(unit_scale_type),             intent(in)    :: us    !< A dimensional unit scaling type
  ! Local variables
  integer :: i,j
 
  do j=g%jsc,g%jec ; do i=g%isc-1,g%iec
    ubtav(i,j) = us%L_T_to_m_s*cs%ubtav(i,j)
  enddo ; enddo
 
  do j=g%jsc-1,g%jec ; do i=g%isc,g%iec
    vbtav(i,j) = us%L_T_to_m_s*cs%vbtav(i,j)
  enddo ; enddo
 
end subroutine barotropic_get_tav
 
 
!> Clean up the barotropic control structure.
subroutine barotropic_end(CS)
  type(barotropic_cs), pointer :: cs  !< Control structure to clear out.
  dealloc_(cs%frhatu)   ; dealloc_(cs%frhatv)
  dealloc_(cs%IDatu)    ; dealloc_(cs%IDatv)
  dealloc_(cs%ubtav)    ; dealloc_(cs%vbtav)
  dealloc_(cs%eta_cor)
  dealloc_(cs%ua_polarity) ; dealloc_(cs%va_polarity)
  if (cs%bound_BT_corr) then
    dealloc_(cs%eta_cor_bound)
  endif
 
  call destroy_bt_obc(cs%BT_OBC)
 
  deallocate(cs)
end subroutine barotropic_end
 
!> This subroutine is used to register any fields from MOM_barotropic.F90
!! that should be written to or read from the restart file.
subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS)
  type(hor_index_type),    intent(in) :: hi         !< A horizontal index type structure.
  type(param_file_type),   intent(in) :: param_file !< A structure to parse for run-time parameters.
  type(barotropic_cs),     pointer    :: cs         !< A pointer that is set to point to the control
                                                    !! structure for this module.
  type(verticalgrid_type), intent(in) :: gv         !< The ocean's vertical grid structure.
  type(mom_restart_cs),    pointer    :: restart_cs !< A pointer to the restart control structure.
 
  ! Local variables
  type(vardesc) :: vd(3)
  real :: slow_rate
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed
  isdb = hi%IsdB ; iedb = hi%IedB ; jsdb = hi%JsdB ; jedb = hi%JedB
 
  if (associated(cs)) then
    call mom_error(warning, "register_barotropic_restarts called with an associated "// &
                            "control structure.")
    return
  endif
  allocate(cs)
 
  alloc_(cs%ubtav(isdb:iedb,jsd:jed))      ; cs%ubtav(:,:) = 0.0
  alloc_(cs%vbtav(isd:ied,jsdb:jedb))      ; cs%vbtav(:,:) = 0.0
  alloc_(cs%ubt_IC(isdb:iedb,jsd:jed))     ; cs%ubt_IC(:,:) = 0.0
  alloc_(cs%vbt_IC(isd:ied,jsdb:jedb))     ; cs%vbt_IC(:,:) = 0.0
  alloc_(cs%uhbt_IC(isdb:iedb,jsd:jed))    ; cs%uhbt_IC(:,:) = 0.0
  alloc_(cs%vhbt_IC(isd:ied,jsdb:jedb))    ; cs%vhbt_IC(:,:) = 0.0
 
  vd(2) = var_desc("ubtav","m s-1","Time mean barotropic zonal velocity", &
                hor_grid='u', z_grid='1')
  vd(3) = var_desc("vbtav","m s-1","Time mean barotropic meridional velocity",&
                hor_grid='v', z_grid='1')
  call register_restart_field(cs%ubtav, vd(2), .false., restart_cs)
  call register_restart_field(cs%vbtav, vd(3), .false., restart_cs)
 
  vd(2) = var_desc("ubt_IC", "m s-1", &
              longname="Next initial condition for the barotropic zonal velocity", &
              hor_grid='u', z_grid='1')
  vd(3) = var_desc("vbt_IC", "m s-1", &
              longname="Next initial condition for the barotropic meridional velocity",&
              hor_grid='v', z_grid='1')
  call register_restart_field(cs%ubt_IC, vd(2), .false., restart_cs)
  call register_restart_field(cs%vbt_IC, vd(3), .false., restart_cs)
 
  if (gv%Boussinesq) then
    vd(2) = var_desc("uhbt_IC", "m3 s-1", &
                longname="Next initial condition for the barotropic zonal transport", &
                hor_grid='u', z_grid='1')
    vd(3) = var_desc("vhbt_IC", "m3 s-1", &
                longname="Next initial condition for the barotropic meridional transport",&
                hor_grid='v', z_grid='1')
  else
    vd(2) = var_desc("uhbt_IC", "kg s-1", &
                longname="Next initial condition for the barotropic zonal transport", &
                hor_grid='u', z_grid='1')
    vd(3) = var_desc("vhbt_IC", "kg s-1", &
                longname="Next initial condition for the barotropic meridional transport",&
                hor_grid='v', z_grid='1')
  endif
  call register_restart_field(cs%uhbt_IC, vd(2), .false., restart_cs)
  call register_restart_field(cs%vhbt_IC, vd(3), .false., restart_cs)
 
  call register_restart_field(cs%dtbt, "DTBT", .false., restart_cs, &
                              longname="Barotropic timestep", units="seconds")
 
end subroutine register_barotropic_restarts
 
!> \namespace mom_barotropic
!!
!!  By Robert Hallberg, April 1994 - January 2007
!!
!!    This program contains the subroutines that time steps the
!!  linearized barotropic equations.  btstep is used to actually
!!  time step the barotropic equations, and contains most of the
!!  substance of this module.
!!
!!    btstep uses a forwards-backwards based scheme to time step
!!  the barotropic equations, returning the layers' accelerations due
!!  to the barotropic changes in the ocean state, the final free
!!  surface height (or column mass), and the volume (or mass) fluxes
!!  summed through the layers and averaged over the baroclinic time
!!  step.  As input, btstep takes the initial 3-D velocities, the
!!  inital free surface height, the 3-D accelerations of the layers,
!!  and the external forcing.  Everything in btstep is cast in terms
!!  of anomalies, so if everything is in balance, there is explicitly
!!  no acceleration due to btstep.
!!
!!    The spatial discretization of the continuity equation is second
!!  order accurate.  A flux conservative form is used to guarantee
!!  global conservation of volume.  The spatial discretization of the
!!  momentum equation is second order accurate.  The Coriolis force
!!  is written in a form which does not contribute to the energy
!!  tendency and which conserves linearized potential vorticity, f/D.
!!  These terms are exactly removed from the baroclinic momentum
!!  equations, so the linearization of vorticity advection will not
!!  degrade the overall solution.
!!
!!    btcalc calculates the fractional thickness of each layer at the
!!  velocity points, for later use in calculating the barotropic
!!  velocities and the averaged accelerations.  Harmonic mean
!!  thicknesses (i.e. 2*h_L*h_R/(h_L + h_R)) are used to avoid overly
!!  strong weighting of overly thin layers.  This may later be relaxed
!!  to use thicknesses determined from the continuity equations.
!!
!!    bt_mass_source determines the real mass sources for the
!!  barotropic solver, along with the corrective pseudo-fluxes that
!!  keep the barotropic and baroclinic estimates of the free surface
!!  height close to each other.  Given the layer thicknesses and the
!!  free surface height that correspond to each other, it calculates
!!  a corrective mass source that is added to the barotropic continuity*
!!  equation, and optionally adjusts a slowly varying correction rate.
!!  Newer algorithmic changes have deemphasized the need for this, but
!!  it is still here to add net water sources to the barotropic solver.*
!!
!!    barotropic_init allocates and initializes any barotropic arrays
!!  that have not been read from a restart file, reads parameters from
!!  the inputfile, and sets up diagnostic fields.
!!
!!    barotropic_end deallocates anything allocated in barotropic_init
!!  or register_barotropic_restarts.
!!
!!    register_barotropic_restarts is used to indicate any fields that
!!  are private to the barotropic solver that need to be included in
!!  the restart files, and to ensure that they are read.
 
end module mom_barotropic