src/core/MOM_barotropic.F90

portedportable, not yet portedexecuted, not portableexecutable, not hit by this run

1		! This file is part of MOM6, the Modular Ocean Model version 6.
2		! See the LICENSE file for licensing information.
3		! SPDX-License-Identifier: Apache-2.0
4
5		#include "do_concurrent_compat.h"
6
7		!> Barotropic solver
8		module MOM_barotropic
9
10		use MOM_checksums, only : chksum0
11		use MOM_coms, only : any_across_PEs
12		use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
13		use MOM_debugging, only : hchksum, uvchksum, Bchksum
14		use MOM_intrinsic_functions, only : nth_root
15		use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
16		use MOM_diag_mediator, only : diag_ctrl, enable_averaging, enable_averages
17		use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain
18		use MOM_domains, only : To_All, Scalar_Pair, AGRID, CORNER, MOM_domain_type
19		use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
20		use MOM_domains, only : start_group_pass, complete_group_pass, pass_var, pass_vector
21		use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
22		use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
23		use MOM_forcing_type, only : mech_forcing
24		use MOM_grid, only : ocean_grid_type
25		use MOM_harmonic_analysis, only : HA_accum, harmonic_analysis_CS
26		use MOM_hor_index, only : hor_index_type
27		use MOM_io, only : vardesc, var_desc, MOM_read_data, slasher, NORTH_FACE, EAST_FACE
28		use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, open_boundary_query
29		use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W
30		use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type
31		use MOM_restart, only : register_restart_field, register_restart_pair
32		use MOM_restart, only : query_initialized, MOM_restart_CS
33		use MOM_self_attr_load, only : scalar_SAL_sensitivity
34		use MOM_self_attr_load, only : SAL_CS
35		use MOM_streaming_filter, only : Filt_register, Filt_init, Filt_accum, Filter_CS
36		use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-)
37		use MOM_unit_scaling, only : unit_scale_type
38		use MOM_variables, only : BT_cont_type, alloc_bt_cont_type
39		use MOM_verticalGrid, only : verticalGrid_type
40		use MOM_variables, only : accel_diag_ptrs
41		use MOM_wave_drag, only : wave_drag_init, wave_drag_calc, wave_drag_CS
42
43		implicit none ; private
44
45		#include <MOM_memory.h>
46		#ifdef STATIC_MEMORY_
47		# ifndef BTHALO_
48		# define BTHALO_ 0
49		# endif
50		# define WHALOI_ MAX(BTHALO_-NIHALO_,0)
51		# define WHALOJ_ MAX(BTHALO_-NJHALO_,0)
52		# define NIMEMW_ 1-WHALOI_:NIMEM_+WHALOI_
53		# define NJMEMW_ 1-WHALOJ_:NJMEM_+WHALOJ_
54		# define NIMEMBW_ -WHALOI_:NIMEM_+WHALOI_
55		# define NJMEMBW_ -WHALOJ_:NJMEM_+WHALOJ_
56		# define SZIW_(G) NIMEMW_
57		# define SZJW_(G) NJMEMW_
58		# define SZIBW_(G) NIMEMBW_
59		# define SZJBW_(G) NJMEMBW_
60		#else
61		# define NIMEMW_ :
62		# define NJMEMW_ :
63		# define NIMEMBW_ :
64		# define NJMEMBW_ :
65		# define SZIW_(G) G%isdw:G%iedw
66		# define SZJW_(G) G%jsdw:G%jedw
67		# define SZIBW_(G) G%isdw-1:G%iedw
68		# define SZJBW_(G) G%jsdw-1:G%jedw
69		#endif
70
71		public btcalc, bt_mass_source, btstep, barotropic_init, barotropic_end
72		public register_barotropic_restarts, set_dtbt, barotropic_get_tav
73
74		! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
75		! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
76		! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
77		! vary with the Boussinesq approximation, the Boussinesq variant is given first.
78
79		!> The barotropic stepping open boundary condition type
80		type, private :: BT_OBC_type
81		real, allocatable :: Cg_u(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1].
82		real, allocatable :: Cg_v(:,:) !< The external wave speed at u-points [L T-1 ~> m s-1].
83		real, allocatable :: dZ_u(:,:) !< The total vertical column extent at the u-points [Z ~> m].
84		real, allocatable :: dZ_v(:,:) !< The total vertical column extent at the v-points [Z ~> m].
85		real, allocatable :: uhbt(:,:) !< The zonal barotropic thickness fluxes specified
86		!! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
87		real, allocatable :: vhbt(:,:) !< The meridional barotropic thickness fluxes specified
88		!! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1].
89		real, allocatable :: ubt_outer(:,:) !< The zonal velocities just outside the domain,
90		!! as set by the open boundary conditions [L T-1 ~> m s-1].
91		real, allocatable :: vbt_outer(:,:) !< The meridional velocities just outside the domain,
92		!! as set by the open boundary conditions [L T-1 ~> m s-1].
93		real, allocatable :: SSH_outer_u(:,:) !< The surface height outside of the domain
94		!! at a u-point with an open boundary condition [Z ~> m].
95		real, allocatable :: SSH_outer_v(:,:) !< The surface height outside of the domain
96		!! at a v-point with an open boundary condition [Z ~> m].
97		integer, allocatable :: u_OBC_type(:,:) !< An integer encoding the type and direction of u-point OBCs
98		integer, allocatable :: v_OBC_type(:,:) !< An integer encoding the type and direction of v-point OBCs
99		logical :: u_OBCs_on_PE !< True if this PE has an open boundary at any u-points.
100		logical :: v_OBCs_on_PE !< True if this PE has an open boundary at any v-points.
101		!>@{ Index ranges on the local PE for the open boundary conditions in various directions
102		integer :: Is_u_W_obc, Ie_u_W_obc, js_u_W_obc, je_u_W_obc
103		integer :: Is_u_E_obc, Ie_u_E_obc, js_u_E_obc, je_u_E_obc
104		integer :: is_v_S_obc, ie_v_S_obc, Js_v_S_obc, Je_v_S_obc
105		integer :: is_v_N_obc, ie_v_N_obc, Js_v_N_obc, Je_v_N_obc
106		!>@}
107
108		type(group_pass_type) :: pass_uv !< Structure for group halo pass of vectors
109		type(group_pass_type) :: scalar_pass !< Structure for group halo pass of scalars
110		end type BT_OBC_type
111
112		integer, parameter :: SPECIFIED_OBC = 1 !< An integer used to encode a specified OBC point
113		integer, parameter :: FLATHER_OBC = 2 !< An integer used to encode a Flather OBC point
114		integer, parameter :: GRADIENT_OBC = 4 !< An integer used to encode a gradient OBC point
115
116		!> The barotropic stepping control structure
117		type, public :: barotropic_CS ; private
118		real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu
119		!< The fraction of the total column thickness interpolated to u grid points in each layer [nondim].
120		real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv
121		!< The fraction of the total column thickness interpolated to v grid points in each layer [nondim].
122		real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu
123		!< Inverse of the total thickness at u grid points [H-1 ~> m-1 or m2 kg-1].
124		real, allocatable, dimension(:,:) :: lin_drag_u
125		!< A spatially varying linear drag coefficient acting on the zonal barotropic flow
126		!! [H T-1 ~> m s-1 or kg m-2 s-1].
127		real, allocatable, dimension(:,:) :: ubt_IC
128		!< The barotropic solvers estimate of the zonal velocity that will be the initial
129		!! condition for the next call to btstep [L T-1 ~> m s-1].
130		real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav
131		!< The barotropic zonal velocity averaged over the baroclinic time step [L T-1 ~> m s-1].
132		real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv
133		!< Inverse of the basin depth at v grid points [Z-1 ~> m-1].
134		real, allocatable, dimension(:,:) :: lin_drag_v
135		!< A spatially varying linear drag coefficient acting on the zonal barotropic flow
136		!! [H T-1 ~> m s-1 or kg m-2 s-1].
137		real, allocatable, dimension(:,:) :: vbt_IC
138		!< The barotropic solvers estimate of the zonal velocity that will be the initial
139		!! condition for the next call to btstep [L T-1 ~> m s-1].
140		real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav
141		!< The barotropic meridional velocity averaged over the baroclinic time step [L T-1 ~> m s-1].
142		real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor
143		!< The difference between the free surface height from the barotropic calculation and the sum
144		!! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic
145		!! calculation over a baroclinic timestep [H ~> m or kg m-2].
146		real, allocatable, dimension(:,:) :: eta_cor_bound
147		!< A limit on the rate at which eta_cor can be applied while avoiding instability
148		!! [H T-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true.
149		real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: &
150		ua_polarity, & !< Test vector components for checking grid polarity [nondim]
151		va_polarity, & !< Test vector components for checking grid polarity [nondim]
152		bathyT !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m]
153		real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT
154		!< This is a copy of G%IareaT with wide halos, but will
155		!! still utilize the macro IareaT when referenced, [L-2 ~> m-2].
156		real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: &
157		dy_Cu, & !< A copy of G%dy_Cu with wide halos [L ~> m].
158		IdxCu, & !< A copy of G%IdxCu with wide halos [L-1 ~> m-1].
159		OBCmask_u !< An array to multiplicatively mask out changes at OBC points, 0 or 1 [nondim]
160		real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: &
161		dx_Cv, & !< A copy of G%dx_Cv with wide halos [L ~> m].
162		IdyCv, & !< A copy of G%IdyCv with wide halos [L-1 ~> m-1].
163		OBCmask_v !< An array to multiplicatively mask out changes at OBC points, 0 or 1 [nondim]
164		real, allocatable, dimension(:,:) :: &
165		D_u_Cor, & !< A simply averaged depth at u points recast as a thickness [H ~> m or kg m-2]
166		D_v_Cor, & !< A simply averaged depth at v points recast as a thickness [H ~> m or kg m-2]
167		q_D !< f / D at PV points [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]
168		real, allocatable, dimension(:,:,:) :: &
169		q_wt !< The area weights for the thicknesses around a corner point to be used when
170		!! calculating PV for use in the Coriolis term, taking OBCs into account [L2 ~> m2].
171		!! The order of the 4 values at a point is the order in which the neighboring
172		!! tracer points occur in memory, i.e. SW, SE, NW then NE.
173		real, allocatable :: frhatu1(:,:,:) !< Predictor step values of frhatu stored for diagnostics [nondim]
174		real, allocatable :: frhatv1(:,:,:) !< Predictor step values of frhatv stored for diagnostics [nondim]
175		real, allocatable :: IareaT_OBCmask(:,:) !< If non-zero, work on given points [L-2 ~> m-2].
176
177		type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields
178		!! for applying open boundary conditions.
179
180		real :: dtbt !< The barotropic time step [T ~> s].
181		real :: dtbt_fraction !< The fraction of the maximum time-step that
182		!! should used [nondim]. The default is 0.98.
183		real :: dtbt_max !< The maximum stable barotropic time step [T ~> s].
184		real :: dt_bt_filter !< The time-scale over which the barotropic mode solutions are
185		!! filtered [T ~> s] if positive, or as a fraction of DT if
186		!! negative [nondim]. This can never be taken to be longer than 2*dt.
187		!! Set this to 0 to apply no filtering.
188		integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic
189		!! time step the last time btstep was called.
190		real :: bebt !< A nondimensional number, from 0 to 1, that
191		!! determines the gravity wave time stepping scheme [nondim].
192		!! 0.0 gives a forward-backward scheme, while 1.0
193		!! give backward Euler. In practice, bebt should be
194		!! of order 0.2 or greater.
195		real :: Rho_BT_lin !< A density that is used to convert total water column thicknesses
196		!! into mass in non-Boussinesq mode with linearized options in the
197		!! barotropic solver or when estimating the stable barotropic timestep
198		!! without access to the full baroclinic model state [R ~> kg m-3]
199		logical :: split !< If true, use the split time stepping scheme.
200		logical :: bound_BT_corr !< If true, the magnitude of the fake mass source
201		!! in the barotropic equation that drives the two
202		!! estimates of the free surface height toward each
203		!! other is bounded to avoid driving corrective
204		!! velocities that exceed MAXCFL_BT_CONT.
205		logical :: gradual_BT_ICs !< If true, adjust the initial conditions for the
206		!! barotropic solver to the values from the layered
207		!! solution over a whole timestep instead of
208		!! instantly. This is a decent approximation to the
209		!! inclusion of sum(u dh_dt) while also correcting
210		!! for truncation errors.
211		logical :: Sadourny !< If true, the Coriolis terms are discretized
212		!! with Sadourny's energy conserving scheme,
213		!! otherwise the Arakawa & Hsu scheme is used. If
214		!! the deformation radius is not resolved Sadourny's
215		!! scheme should probably be used.
216		logical :: integral_bt_cont !< If true, use the time-integrated velocity over the barotropic steps
217		!! to determine the integrated transports used to update the continuity
218		!! equation. Otherwise the transports are the sum of the transports
219		!! based on a series of instantaneous velocities and the BT_CONT_TYPE
220		!! for transports. This is only valid if a BT_CONT_TYPE is used.
221		logical :: bt_adjust_src_for_filter !< If true, increases the rate at which BT mass sources are
222		!! applied so that they are all used up before the steps within the
223		!! filtering period start. This avoids the mass sink driving the SSH
224		!! below the bottom during the period of filtering.
225		logical :: bt_limit_integral_transport !< If true, limit the time-integrated transports by the
226		!! initial volume accounting for sinks of mass.
227		logical :: integral_OBCs !< This is true if integral_bt_cont is true and there are open boundary
228		!! conditions being applied somewhere in the global domain.
229		logical :: Nonlinear_continuity !< If true, the barotropic continuity equation
230		!! uses the full ocean thickness for transport.
231		integer :: Nonlin_cont_update_period !< The number of barotropic time steps
232		!! between updates to the face area, or 0 only to
233		!! update at the start of a call to btstep. The
234		!! default is 1.
235		logical :: BT_project_velocity !< If true, step the barotropic velocity first
236		!! and project out the velocity tendency by 1+BEBT
237		!! when calculating the transport. The default
238		!! (false) is to use a predictor continuity step to
239		!! find the pressure field, and then do a corrector
240		!! continuity step using a weighted average of the
241		!! old and new velocities, with weights of (1-BEBT) and BEBT.
242		logical :: nonlin_stress !< If true, use the full depth of the ocean at the start of the
243		!! barotropic step when calculating the surface stress contribution to
244		!! the barotropic accelerations. Otherwise use the depth based on bathyT.
245		real :: BT_Coriolis_scale !< A factor by which the barotropic Coriolis acceleration anomaly
246		!! terms are scaled [nondim].
247		integer :: answer_date !< The vintage of the expressions in the barotropic solver.
248		!! Values below 20190101 recover the answers from the end of 2018,
249		!! while higher values use more efficient or general expressions.
250
251		logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous
252		!! ice shelf, for instance.
253		real :: Dmin_dyn_psurf !< The minimum total thickness to use in limiting the size
254		!! of the dynamic surface pressure for stability [H ~> m or kg m-2].
255		real :: ice_strength_length !< The length scale at which the damping rate
256		!! due to the ice strength should be the same as if
257		!! a Laplacian were applied [L ~> m].
258		real :: const_dyn_psurf !< The constant that scales the dynamic surface
259		!! pressure [nondim]. Stable values are < ~1.0.
260		!! The default is 0.9.
261		logical :: calculate_SAL !< If true, calculate self-attraction and loading.
262		logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the
263		!! barotropic solver has the wrong sign, replicating a long-standing
264		!! bug.
265		real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim].
266		integer :: hvel_scheme !< An integer indicating how the thicknesses at
267		!! velocity points are calculated. Valid values are
268		!! given by the parameters defined below:
269		!! HARMONIC, ARITHMETIC, HYBRID, and FROM_BT_CONT
270		logical :: strong_drag !< If true, use a stronger estimate of the retarding
271		!! effects of strong bottom drag.
272		logical :: rescale_strong_drag !< If true, reduce the barotropic contribution to the layer
273		!! accelerations to account for the difference between the forces that
274		!! can be counteracted by the stronger drag with BT_STRONG_DRAG and the
275		!! average of the layer viscous remnants after a baroclinic timestep.
276		logical :: linear_wave_drag !< If true, apply a linear drag to the barotropic
277		!! velocities, using rates set by lin_drag_u & _v
278		!! divided by the depth of the ocean.
279		logical :: linearized_BT_PV !< If true, the PV and interface thicknesses used
280		!! in the barotropic Coriolis calculation is time
281		!! invariant and linearized.
282		logical :: use_filter !< If true, use streaming band-pass filter to detect the
283		!! instantaneous tidal signals in the simulation.
284		logical :: linear_freq_drag !< If true, apply a linear frequency-dependent drag to the tidal
285		!! velocities. The streaming band-pass filter must be turned on.
286		logical :: use_wide_halos !< If true, use wide halos and march in during the
287		!! barotropic time stepping for efficiency.
288		integer :: min_stencil !< The minimum stencil width to use with the wide halo iterations.
289		!! A nonzero value may reflect the distribution of OBC faces or it
290		!! may be useful for debugging purposes.
291		logical :: clip_velocity !< If true, limit any velocity components that are
292		!! are large enough for a CFL number to exceed
293		!! CFL_trunc. This should only be used as a
294		!! desperate debugging measure.
295		logical :: debug !< If true, write verbose checksums for debugging purposes.
296		logical :: debug_bt !< If true, write verbose checksums from within the barotropic
297		!! time-stepping loop for debugging purposes.
298		logical :: debug_wide_halos !< If true, write the checksums on the full wide halos. Otherwise
299		!! only the output for the final computational domain is written.
300		real :: vel_underflow !< Velocity components smaller than vel_underflow
301		!! are set to 0 [L T-1 ~> m s-1].
302		real :: maxvel !< Velocity components greater than maxvel are
303		!! truncated to maxvel [L T-1 ~> m s-1].
304		real :: CFL_trunc !< If clip_velocity is true, velocity components will
305		!! be truncated when they are large enough that the
306		!! corresponding CFL number exceeds this value [nondim].
307		real :: maxCFL_BT_cont !< The maximum permitted CFL number associated with the
308		!! barotropic accelerations from the summed velocities
309		!! times the time-derivatives of thicknesses [nondim]. The
310		!! default is 0.1, and there will probably be real
311		!! problems if this were set close to 1.
312		logical :: BT_cont_bounds !< If true, use the BT_cont_type variables to set limits
313		!! on the magnitude of the corrective mass fluxes.
314		logical :: visc_rem_u_uh0 !< If true, use the viscous remnants when estimating
315		!! the barotropic velocities that were used to
316		!! calculate uh0 and vh0. False is probably the
317		!! better choice.
318		logical :: adjust_BT_cont !< If true, adjust the curve fit to the BT_cont type
319		!! that is used by the barotropic solver to match the
320		!! transport about which the flow is being linearized.
321		logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations
322		!! that is not bitwise rotationally symmetric in the
323		!! meridional Coriolis term of the barotropic solver.
324		logical :: tidal_sal_flather !< Apply adjustment to external gravity wave speed
325		!! consistent with tidal self-attraction and loading
326		!! used within the barotropic solver
327		logical :: wt_uv_bug = .true. !< If true, recover a bug that wt_[uv] that is not normalized.
328		logical :: exterior_OBC_bug = .true. !< If true, recover a bug with boundary conditions
329		!! inside the domain.
330		logical :: interior_OBC_PV !< If true, use only interior ocean points at OBCs to specify the PV
331		!! used in the barotropic Coriolis anomalies. Otherwise the
332		!! calculation relies on bathymetry and eta being projected outward
333		!! across OBCs. Unfortunately, this option does change answers near
334		!! convex (peninsula-type) pairs of OBC segments.
335		type(time_type), pointer :: Time => NULL() !< A pointer to the ocean models clock.
336		type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate
337		!! the timing of diagnostic output.
338		type(MOM_domain_type), pointer :: BT_Domain => NULL() !< Barotropic MOM domain
339		type(hor_index_type), pointer :: debug_BT_HI => NULL() !< debugging copy of horizontal index_type
340		type(SAL_CS), pointer :: SAL_CSp => NULL() !< Control structure for SAL
341		type(harmonic_analysis_CS), pointer :: HA_CSp => NULL() !< Control structure for harmonic analysis
342		type(Filter_CS) :: Filt_CS_u, & !< Control structures for the streaming band-pass filter of ubt
343		Filt_CS_v !< Control structures for the streaming band-pass filter of vbt
344		type(wave_drag_CS) :: Drag_CS !< Control structures for the frequency-dependent drag
345		logical :: module_is_initialized = .false. !< If true, module has been initialized
346
347		integer :: isdw !< The lower i-memory limit for the wide halo arrays.
348		integer :: iedw !< The upper i-memory limit for the wide halo arrays.
349		integer :: jsdw !< The lower j-memory limit for the wide halo arrays.
350		integer :: jedw !< The upper j-memory limit for the wide halo arrays.
351
352		type(group_pass_type) :: pass_q_DCor !< Handle for a group halo pass
353		type(group_pass_type) :: pass_gtot !< Handle for a group halo pass
354		type(group_pass_type) :: pass_tmp_uv !< Handle for a group halo pass
355		type(group_pass_type) :: pass_eta_bt_rem !< Handle for a group halo pass
356		type(group_pass_type) :: pass_force_hbt0_Cor_ref !< Handle for a group halo pass
357		type(group_pass_type) :: pass_Dat_uv !< Handle for a group halo pass
358		type(group_pass_type) :: pass_eta_ubt !< Handle for a group halo pass
359		type(group_pass_type) :: pass_etaav !< Handle for a group halo pass
360		type(group_pass_type) :: pass_ubt_Cor !< Handle for a group halo pass
361		type(group_pass_type) :: pass_ubta_uhbta !< Handle for a group halo pass
362		type(group_pass_type) :: pass_e_anom !< Handle for a group halo pass
363		type(group_pass_type) :: pass_SpV_avg !< Handle for a group halo pass
364
365		!>@{ Diagnostic IDs
366		integer :: id_PFu_bt = -1, id_PFv_bt = -1, id_Coru_bt = -1, id_Corv_bt = -1
367		integer :: id_LDu_bt = -1, id_LDv_bt = -1, id_eta_cor = -1
368		integer :: id_ubtforce = -1, id_vbtforce = -1, id_uaccel = -1, id_vaccel = -1
369		integer :: id_visc_rem_u = -1, id_visc_rem_v = -1, id_bt_rem_u = -1, id_bt_rem_v = -1
370		integer :: id_ubt = -1, id_vbt = -1, id_eta_bt = -1, id_ubtav = -1, id_vbtav = -1
371		integer :: id_ubt_st = -1, id_vbt_st = -1, id_eta_st = -1
372		integer :: id_ubtdt = -1, id_vbtdt = -1
373		integer :: id_ubt_hifreq = -1, id_vbt_hifreq = -1, id_eta_hifreq = -1
374		integer :: id_uhbt_hifreq = -1, id_vhbt_hifreq = -1, id_eta_pred_hifreq = -1
375		integer :: id_etaPF_hifreq = -1, id_etaPF_anom = -1
376		integer :: id_gtotn = -1, id_gtots = -1, id_gtote = -1, id_gtotw = -1
377		integer :: id_uhbt = -1, id_frhatu = -1, id_vhbt = -1, id_frhatv = -1
378		integer :: id_frhatu1 = -1, id_frhatv1 = -1
379
380		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
381		integer :: id_BTC_ubt_EE = -1, id_BTC_ubt_WW = -1
382		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
383		integer :: id_BTC_vbt_NN = -1, id_BTC_vbt_SS = -1
384		integer :: id_BTC_FA_u_rat0 = -1, id_BTC_FA_v_rat0 = -1, id_BTC_FA_h_rat0 = -1
385		integer :: id_uhbt0 = -1, id_vhbt0 = -1
386		integer :: id_SSH_u_OBC = -1, id_SSH_v_OBC = -1, id_ubt_OBC = -1, id_vbt_OBC = -1
387		!>@}
388
389		end type barotropic_CS
390
391		!> A description of the functional dependence of transport at a u-point
392		type, private :: local_BT_cont_u_type
393		real :: FA_u_EE !< The effective open face area for zonal barotropic transport
394		!! drawing from locations far to the east [H L ~> m2 or kg m-1].
395		real :: FA_u_E0 !< The effective open face area for zonal barotropic transport
396		!! drawing from nearby to the east [H L ~> m2 or kg m-1].
397		real :: FA_u_W0 !< The effective open face area for zonal barotropic transport
398		!! drawing from nearby to the west [H L ~> m2 or kg m-1].
399		real :: FA_u_WW !< The effective open face area for zonal barotropic transport
400		!! drawing from locations far to the west [H L ~> m2 or kg m-1].
401		real :: uBT_WW !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], or with INTEGRAL_BT_CONTINUITY
402		!! the time-integrated barotropic velocity [L ~> m], beyond which the marginal
403		!! open face area is FA_u_WW. uBT_WW must be non-negative.
404		real :: uBT_EE !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], or with INTEGRAL_BT_CONTINUITY
405		!! the time-integrated barotropic velocity [L ~> m], beyond which the marginal
406		!! open face area is FA_u_EE. uBT_EE must be non-positive.
407		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]
408		!! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY.
409		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]
410		!! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY.
411		real :: uh_WW !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent
412		!! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg].
413		real :: uh_EE !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent
414		!! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg].
415		end type local_BT_cont_u_type
416
417		!> A description of the functional dependence of transport at a v-point
418		type, private :: local_BT_cont_v_type
419		real :: FA_v_NN !< The effective open face area for meridional barotropic transport
420		!! drawing from locations far to the north [H L ~> m2 or kg m-1].
421		real :: FA_v_N0 !< The effective open face area for meridional barotropic transport
422		!! drawing from nearby to the north [H L ~> m2 or kg m-1].
423		real :: FA_v_S0 !< The effective open face area for meridional barotropic transport
424		!! drawing from nearby to the south [H L ~> m2 or kg m-1].
425		real :: FA_v_SS !< The effective open face area for meridional barotropic transport
426		!! drawing from locations far to the south [H L ~> m2 or kg m-1].
427		real :: vBT_SS !< vBT_SS is the barotropic velocity [L T-1 ~> m s-1], or with INTEGRAL_BT_CONTINUITY
428		!! the time-integrated barotropic velocity [L ~> m], beyond which the marginal
429		!! open face area is FA_v_SS. vBT_SS must be non-negative.
430		real :: vBT_NN !< vBT_NN is the barotropic velocity [L T-1 ~> m s-1], or with INTEGRAL_BT_CONTINUITY
431		!! the time-integrated barotropic velocity [L ~> m], beyond which the marginal
432		!! open face area is FA_v_NN. vBT_NN must be non-positive.
433		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]
434		!! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY.
435		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]
436		!! or [H L-1 ~> nondim or kg m-3] with INTEGRAL_BT_CONTINUITY.
437		real :: vh_SS !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent
438		!! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg].
439		real :: vh_NN !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1], or the equivalent
440		!! time-integrated transport with INTEGRAL_BT_CONTINUITY [H L2 ~> m3 or kg].
441		end type local_BT_cont_v_type
442
443		!> A container for passing around active tracer point memory limits
444		type, private :: memory_size_type
445		!>@{ Currently active memory limits
446		integer :: isdw, iedw, jsdw, jedw ! The memory limits of the wide halo arrays.
447		!>@}
448		end type memory_size_type
449
450		!>@{ CPU time clock IDs
451		integer :: id_clock_sync=-1, id_clock_calc=-1
452		integer :: id_clock_calc_pre=-1, id_clock_calc_post=-1
453		integer :: id_clock_pass_step=-1, id_clock_pass_pre=-1, id_clock_pass_post=-1
454		!>@}
455
456		!>@{ Enumeration values for various schemes
457		integer, parameter :: HARMONIC = 1
458		integer, parameter :: ARITHMETIC = 2
459		integer, parameter :: HYBRID = 3
460		integer, parameter :: FROM_BT_CONT = 4
461		integer, parameter :: HYBRID_BT_CONT = 5
462		character*(20), parameter :: HYBRID_STRING = "HYBRID"
463		character*(20), parameter :: HARMONIC_STRING = "HARMONIC"
464		character*(20), parameter :: ARITHMETIC_STRING = "ARITHMETIC"
465		character*(20), parameter :: BT_CONT_STRING = "FROM_BT_CONT"
466		!>@}
467
468		!> A negligible parameter which avoids division by zero, but is too small to
469		!! modify physical values [nondim].
470		real, parameter :: subroundoff = 1e-30
471
472		contains
473
474		!> This subroutine time steps the barotropic equations explicitly.
475		!! For gravity waves, anything between a forwards-backwards scheme
476		!! and a simulated backwards Euler scheme is used, with bebt between
477		!! 0.0 and 1.0 determining the scheme. In practice, bebt must be of
478		!! order 0.2 or greater. A forwards-backwards treatment of the
479		!! Coriolis terms is always used.
480	96	subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, &
481	48	eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, &
482	48	eta_out, uhbtav, vhbtav, G, GV, US, CS, &
483	48	visc_rem_u, visc_rem_v, SpV_avg, ADp, OBC, BT_cont, eta_PF_start, &
484	24	taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0, etaav)
485		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
486		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
487		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
488		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: U_in !< The initial (3-D) zonal
489		!! velocity [L T-1 ~> m s-1].
490		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: V_in !< The initial (3-D) meridional
491		!! velocity [L T-1 ~> m s-1].
492		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height
493		!! anomaly or column mass anomaly [H ~> m or kg m-2].
494		real, intent(in) :: dt !< The time increment to integrate over [T ~> s].
495		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations,
496		!! [L T-2 ~> m s-2].
497		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations,
498		!! [L T-2 ~> m s-2].
499		type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
500		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer
501		!! due to free surface height anomalies
502		!! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
503		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or
504		!! column mass anomaly) that was used to calculate the input
505		!! pressure gradient accelerations (or its final value if
506		!! eta_PF_start is provided [H ~> m or kg m-2].
507		!! Note: eta_in, pbce, and eta_PF_in must have up-to-date
508		!! values in the first point of their halos.
509		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to
510		!! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
511		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to
512		!! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
513		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due
514		!! to the barotropic calculation [L T-2 ~> m s-2].
515		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer
516		!! due to the barotropic calculation [L T-2 ~> m s-2].
517		real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface
518		!! height anomaly or column mass anomaly [H ~> m or kg m-2].
519		real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass
520		!! fluxes averaged through the barotropic steps
521		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
522		real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass
523		!! fluxes averaged through the barotropic steps
524		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
525		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
526		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: visc_rem_u !< Both the fraction of the momentum
527		!! originally in a layer that remains after a time-step of
528		!! viscosity, and the fraction of a time-step's worth of a
529		!! barotropic acceleration that a layer experiences after
530		!! viscosity is applied, in the zonal direction [nondim].
531		!! Visc_rem_u is between 0 (at the bottom) and 1 (far above).
532		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim].
533		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SpV_avg !< The column average specific volume, used
534		!! in non-Boussinesq OBC calculations [R-1 ~> m3 kg-1]
535		type(accel_diag_ptrs), pointer :: ADp !< Acceleration diagnostic pointers
536		type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure.
537		type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe
538		!! the effective open face areas as a function of barotropic
539		!! flow.
540		real, dimension(:,:), pointer :: eta_PF_start !< The eta field consistent with the pressure
541		!! gradient at the start of the barotropic stepping
542		!! [H ~> m or kg m-2].
543		real, dimension(:,:), pointer :: taux_bot !< The zonal bottom frictional stress from
544		!! ocean to the seafloor [R L Z T-2 ~> Pa].
545		real, dimension(:,:), pointer :: tauy_bot !< The meridional bottom frictional stress
546		!! from ocean to the seafloor [R L Z T-2 ~> Pa].
547		real, dimension(:,:,:), pointer :: uh0 !< The zonal layer transports at reference
548		!! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
549		real, dimension(:,:,:), pointer :: u_uh0 !< The velocities used to calculate
550		!! uh0 [L T-1 ~> m s-1]
551		real, dimension(:,:,:), pointer :: vh0 !< The zonal layer transports at reference
552		!! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
553		real, dimension(:,:,:), pointer :: v_vh0 !< The velocities used to calculate
554		!! vh0 [L T-1 ~> m s-1]
555		real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass
556		!! averaged over the barotropic integration [H ~> m or kg m-2].
557
558		! Local variables
559	96	real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been
560	96	real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis
561		! terms [L T-1 ~> m s-1].
562	96	real :: wt_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! wt_u and wt_v are the
563	96	real :: wt_v(SZI_(G),SZJB_(G),SZK_(GV)) ! normalized weights to
564		! be used in calculating barotropic velocities, possibly with
565		! sums less than one due to viscous losses [nondim]
566	96	real :: Iwt_u_tot(SZIB_(G),SZJ_(G)) ! Iwt_u_tot and Iwt_v_tot are the
567	96	real :: Iwt_v_tot(SZI_(G),SZJB_(G)) ! inverses of wt_u and wt_v vertical integrals,
568		! used to normalize wt_u and wt_v [nondim]
569		real, dimension(SZIB_(G),SZJ_(G)) :: &
570	144	av_rem_u, & ! The weighted average of visc_rem_u [nondim]
571	96	tmp_u, & ! A temporary array at u points [L T-2 ~> m s-2] or [nondim]
572	96	ubt_st, & ! The zonal barotropic velocity at the start of timestep [L T-1 ~> m s-1].
573	96	ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].
574	96	PFu_avg, & ! The average zonal barotropic pressure gradient force [L T-2 ~> m s-2].
575	96	Coru_avg, & ! The average zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
576	96	LDu_avg, & ! The average zonal barotropic linear wave drag acceleration [L T-2 ~> m s-2].
577	96	ubt_dt ! The zonal barotropic velocity tendency [L T-2 ~> m s-2].
578		real, dimension(SZI_(G),SZJB_(G)) :: &
579	96	av_rem_v, & ! The weighted average of visc_rem_v [nondim]
580	96	tmp_v, & ! A temporary array at v points [L T-2 ~> m s-2] or [nondim]
581	96	vbt_st, & ! The meridional barotropic velocity at the start of timestep [L T-1 ~> m s-1].
582	96	vbt_wtd, & ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].
583	96	PFv_avg, & ! The average meridional barotropic pressure gradient force [L T-2 ~> m s-2].
584	96	Corv_avg, & ! The average meridional barotropic Coriolis acceleration [L T-2 ~> m s-2].
585	96	LDv_avg, & ! The average meridional barotropic linear wave drag acceleration [L T-2 ~> m s-2].
586	96	vbt_dt ! The meridional barotropic velocity tendency [L T-2 ~> m s-2].
587		real, dimension(SZI_(G),SZJ_(G)) :: &
588	96	tmp_h, & ! A temporary array at h points [nondim]
589	96	e_anom ! The anomaly in the sea surface height or column mass
590		! averaged between the beginning and end of the time step,
591		! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
592
593		! These are always allocated with symmetric memory and wide halos.
594	96	real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]
595		real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
596	96	ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1].
597	96	bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains
598		! after a time step, the remainder being lost to bottom drag [nondim].
599		! bt_rem_u is between 0 and 1.
600	96	BT_force_u, & ! The vertical average of all of the u-accelerations that are
601		! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
602	96	u_accel_bt, & ! The difference between the zonal acceleration from the
603		! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
604	96	uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
605	96	uhbt0, & ! The difference between the sum of the layer zonal thickness
606		! fluxes and the barotropic thickness flux using the same
607		! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
608	96	Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due
609		! to the reference velocities [L T-2 ~> m s-2].
610	96	Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points for drag parameterizations
611		! that introduced directly into the barotropic solver rather than coming in via
612		! the visc_rem_u arrays from the layered equations [T-1 ~> s-1].
613		! This is nonzero mostly for a barotropic tidal body drag.
614	96	DCor_u, & ! An averaged total thickness at u points [H ~> m or kg m-2].
615	96	Datu ! Basin depth at u-velocity grid points times the y-grid
616		! spacing [H L ~> m2 or kg m-1].
617		real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
618	96	vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1].
619	96	bt_rem_v, & ! The fraction of the barotropic meridional velocity that
620		! remains after a time step, the rest being lost to bottom
621		! drag [nondim]. bt_rem_v is between 0 and 1.
622	96	BT_force_v, & ! The vertical average of all of the v-accelerations that are
623		! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
624	96	v_accel_bt, & ! The difference between the meridional acceleration from the
625		! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
626	96	vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
627	96	vhbt0, & ! The difference between the sum of the layer meridional
628		! thickness fluxes and the barotropic thickness flux using
629		! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
630	96	Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due
631		! to the reference velocities [L T-2 ~> m s-2].
632	96	Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points for drag parameterizations
633		! that introduced directly into the barotropic solver rather than coming
634		! in via the visc_rem_v arrays from the layered equations [T-1 ~> s-1].
635		! This is nonzero mostly for a barotropic tidal body drag.
636	96	DCor_v, & ! An averaged total thickness at v points [H ~> m or kg m-2].
637	96	Datv ! Basin depth at v-velocity grid points times the x-grid
638		! spacing [H L ~> m2 or kg m-1].
639		real, dimension(4,SZIBW_(CS),SZJW_(CS)) :: &
640	96	f_4_u !< The terms giving the contribution to the Coriolis acceleration at a zonal
641		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
642		!! These are the products of thicknesses at v points and appropriately staggered
643		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
644		!! they are approximately f / 4. The 4 values on the innermost loop are for
645		!! v-velocities to the southwest, southeast, northwest and northeast.
646		real, dimension(4,SZIW_(CS),SZJBW_(CS)) :: &
647	96	f_4_v !< The terms giving the contribution to the Coriolis acceleration at a meridional
648		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
649		!! These are the products of thicknesses at u points and appropriately staggered
650		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
651		!! they are approximately f / 4. The 4 values on the innermost loop are for
652		!! u-velocities to the southwest, southeast, northwest and northeast.
653	48	real, dimension(:,:,:), pointer :: ufilt, vfilt
654		! Filtered velocities from the output of streaming filters [L T-1 ~> m s-1]
655	96	real, dimension(SZIB_(G),SZJ_(G)) :: Drag_u
656		! The zonal acceleration due to frequency-dependent drag [L T-2 ~> m s-2]
657	96	real, dimension(SZI_(G),SZJB_(G)) :: Drag_v
658		! The meridional acceleration due to frequency-dependent drag [L T-2 ~> m s-2]
659		real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
660	96	eta ! The barotropic free surface height anomaly or column mass
661		! anomaly [H ~> m or kg m-2]
662		real, dimension(SZIW_(CS),SZJW_(CS)) :: &
663	96	eta_sum, & ! eta summed across the timesteps [H ~> m or kg m-2].
664	96	eta_wtd, & ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2].
665	96	eta_IC, & ! A local copy of the initial 2-D eta field (eta_in) [H ~> m or kg m-2]
666	96	eta_PF, & ! A local copy of the 2-D eta field (either SSH anomaly or
667		! column mass anomaly) that was used to calculate the input
668		! pressure gradient accelerations [H ~> m or kg m-2].
669	96	eta_PF_1, & ! The initial value of eta_PF, when interp_eta_PF is
670		! true [H ~> m or kg m-2].
671	96	d_eta_PF, & ! The change in eta_PF over the barotropic time stepping when
672		! interp_eta_PF is true [H ~> m or kg m-2].
673	96	gtot_E, & ! gtot_X is the effective total reduced gravity used to relate
674	96	gtot_W, & ! free surface height deviations to pressure forces (including
675	96	gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
676	96	gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, E, or W)
677		! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
678		! (See Hallberg, J Comp Phys 1997 for a discussion.)
679	96	eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2].
680	96	SpV_col_avg, & ! The column average specific volume [R-1 ~> m3 kg-1]
681	96	dyn_coef_eta ! The coefficient relating the changes in eta to the
682		! dynamic surface pressure under rigid ice
683		! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
684		type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: &
685	96	BTCL_u ! A repackaged version of the u-point information in BT_cont.
686		type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: &
687	48	BTCL_v ! A repackaged version of the v-point information in BT_cont.
688		! End of wide-sized variables.
689
690		real :: visc_rem ! A work variable that may equal visc_rem_[uv] [nondim]
691		real :: dtbt ! The barotropic time step [T ~> s].
692		real :: Idt ! The inverse of dt [T-1 ~> s-1].
693		real :: det_de ! The partial derivative due to self-attraction and loading
694		! of the reference geopotential with the sea surface height [nondim].
695		! This is typically ~0.09 or less.
696		real :: dgeo_de ! The constant of proportionality between geopotential and sea surface height
697		! [nondim]. It is of order 1, but for stability this may be made larger than
698		! the physical problem would suggest.
699		real :: dgeo_de_OBC ! The value of dgeo_de to be used with Flather open boundary conditions [nondim].
700		real :: Instep ! The inverse of the number of barotropic time steps to take [nondim].
701		integer :: nstep ! The number of barotropic time steps to take.
702		real :: Htot_avg ! The average total thickness of the tracer columns adjacent to a
703		! velocity point [H ~> m or kg m-2]
704		logical :: use_BT_cont, find_etaav
705		logical :: integral_BT_cont ! If true, update the barotropic continuity equation directly
706		! from the initial condition using the time-integrated barotropic velocity.
707		logical :: ice_is_rigid, nonblock_setup, interp_eta_PF
708		logical :: add_uh0
709
710		real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta
711		! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
712		real :: ice_strength = 0.0 ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].
713		real :: H_to_Z ! A local unit conversion factor used with rigid ice [Z H-1 ~> nondim or m3 kg-1]
714		real :: Idt_max2 ! The squared inverse of the local maximum stable
715		! barotropic time step [T-2 ~> s-2].
716		real :: H_min_dyn ! The minimum depth to use in limiting the size of the
717		! dynamic surface pressure for stability [H ~> m or kg m-2].
718		real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing
719		! squared [H L-2 ~> m-1 or kg m-4].
720		real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1].
721		real :: uint_cor, vint_cor ! The maximum time-integrated corrective velocities [L ~> m].
722		real :: Htot ! The total thickness [H ~> m or kg m-2].
723		real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2].
724		real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2].
725		real :: h_a_neglect ! A cell volume or mass that is so small it is usually lost
726		! in roundoff and can be neglected [H L2 ~> m3 or kg].
727
728	48	real, allocatable :: wt_vel(:) ! The raw or relative weights of each of the barotropic timesteps
729		! in determining the average velocities [nondim]
730	48	real, allocatable :: wt_eta(:) ! The raw or relative weights of each of the barotropic timesteps
731		! in determining the average eta [nondim]
732	48	real, allocatable :: wt_accel(:) ! The raw or relative weights of each of the barotropic timesteps
733		! in determining the average accelerations [nondim]
734	48	real, allocatable :: wt_trans(:) ! The raw or relative weights of each of the barotropic timesteps
735		! in determining the average transports [nondim]
736	48	real, allocatable :: wt_accel2(:) ! A potentially un-normalized copy of wt_accel [nondim]
737		real :: sum_wt_vel ! The sum of the raw weights used to find average velocities [nondim]
738		real :: sum_wt_eta ! The sum of the raw weights used to find average eta [nondim]
739		real :: sum_wt_accel ! The sum of the raw weights used to find average accelerations [nondim]
740		real :: sum_wt_trans ! The sum of the raw weights used to find average transports [nondim]
741		real :: I_sum_wt_vel ! The inverse of the sum of the raw weights used to find average velocities [nondim]
742		real :: I_sum_wt_eta ! The inverse of the sum of the raw weights used to find eta [nondim]
743		real :: I_sum_wt_accel ! The inverse of the sum of the raw weights used to find average accelerations [nondim]
744		real :: I_sum_wt_trans ! The inverse of the sum of the raw weights used to find average transports [nondim]
745		real :: dt_filt ! The half-width of the barotropic filter [T ~> s].
746		integer :: nfilter
747
748		logical :: apply_OBCs, apply_OBC_flather
749		type(memory_size_type) :: MS
750		character(len=200) :: mesg
751		integer :: stencil ! The stencil size of the algorithm, often 1 or 2.
752		integer :: isvf, ievf, jsvf, jevf, num_cycles
753		integer :: i, j, k, n
754		integer :: is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq
755		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
756
757	48	if (.not.CS%module_is_initialized) call MOM_error(FATAL, &
758	0	"btstep: Module MOM_barotropic must be initialized before it is used.")
759
760	48	if (.not.CS%split) return
761	48	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
762	48	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
763	48	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
764	48	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
765	48	MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw
766	48	h_a_neglect = GV%H_subroundoff * (1.0 * US%m_to_L**2)
767
768	48	Idt = 1.0 / dt
769	48	accel_underflow = CS%vel_underflow * Idt
770
771	48	use_BT_cont = associated(BT_cont)
772	48	integral_BT_cont = use_BT_cont .and. CS%integral_BT_cont
773
774	48	interp_eta_PF = associated(eta_PF_start)
775
776		! Figure out the fullest arrays that could be updated.
777	48	stencil = max(1, CS%min_stencil)
778	48	if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. &
779	0	(CS%Nonlin_cont_update_period > 0)) stencil = max(2, CS%min_stencil)
780
781	48	find_etaav = present(etaav)
782
783	48	add_uh0 = associated(uh0)
784	48	if (add_uh0 .and. .not.(associated(vh0) .and. associated(u_uh0) .and. &
785		associated(v_vh0))) call MOM_error(FATAL, &
786	0	"btstep: vh0, u_uh0, and v_vh0 must be associated if uh0 is used.")
787
788		! This can be changed to try to optimize the performance.
789	48	nonblock_setup = G%nonblocking_updates
790
791	48	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
792
793	48	apply_OBC_flather = .false.
794	48	apply_OBCs = .false.
795	48	if (associated(OBC)) then
796	0	apply_OBC_flather = open_boundary_query(OBC, apply_Flather_OBC=.true.)
797		apply_OBCs = open_boundary_query(OBC, apply_specified_OBC=.true.) .or. &
798	0	apply_OBC_flather .or. open_boundary_query(OBC, apply_open_OBC=.true.)
799		endif
800
801	48	num_cycles = 1
802	48	if (CS%use_wide_halos) &
803	48	num_cycles = min((is-CS%isdw) / stencil, (js-CS%jsdw) / stencil)
804	48	isvf = is - (num_cycles-1)stencil ; ievf = ie + (num_cycles-1)stencil
805	48	jsvf = js - (num_cycles-1)stencil ; jevf = je + (num_cycles-1)stencil
806
807	48	nstep = CEILING(dt/CS%dtbt - 0.0001)
808	48	if (is_root_PE() .and. ((nstep /= CS%nstep_last) .or. CS%debug)) then
809		write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, &
810	1	& " seconds, max ", ES12.6, ".")') (US%T_to_sdt/nstep), US%T_to_sCS%dtbt_max
811	1	call MOM_mesg(mesg, 3)
812		endif
813	48	CS%nstep_last = nstep
814
815		! Set the actual barotropic time step.
816	48	Instep = 1.0 / real(nstep)
817	48	dtbt = dt * Instep
818
819		!--- begin setup for group halo update
820	48	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
821	48	if (.not. CS%linearized_BT_PV) then
822	0	call create_group_pass(CS%pass_q_DCor, q, CS%BT_Domain, To_All, position=CORNER)
823		call create_group_pass(CS%pass_q_DCor, DCor_u, DCor_v, CS%BT_Domain, &
824	0	To_All+Scalar_Pair)
825		endif
826	48	if ((Isq > is-1) .or. (Jsq > js-1)) &
827	0	call create_group_pass(CS%pass_tmp_uv, tmp_u, tmp_v, G%Domain)
828		call create_group_pass(CS%pass_gtot, gtot_E, gtot_N, CS%BT_Domain, &
829	48	To_All+Scalar_Pair, AGRID)
830		call create_group_pass(CS%pass_gtot, gtot_W, gtot_S, CS%BT_Domain, &
831	48	To_All+Scalar_Pair, AGRID)
832
833	48	if (CS%dynamic_psurf) &
834	0	call create_group_pass(CS%pass_eta_bt_rem, dyn_coef_eta, CS%BT_Domain)
835	48	if (interp_eta_PF) then
836	0	call create_group_pass(CS%pass_eta_bt_rem, eta_PF_1, CS%BT_Domain)
837	0	call create_group_pass(CS%pass_eta_bt_rem, d_eta_PF, CS%BT_Domain)
838		else
839	48	call create_group_pass(CS%pass_eta_bt_rem, eta_PF, CS%BT_Domain)
840		endif
841	48	if (integral_BT_cont) &
842	0	call create_group_pass(CS%pass_eta_bt_rem, eta_IC, CS%BT_Domain)
843	48	call create_group_pass(CS%pass_eta_bt_rem, eta_src, CS%BT_Domain)
844
845		call create_group_pass(CS%pass_eta_bt_rem, bt_rem_u, bt_rem_v, &
846	48	CS%BT_Domain, To_All+Scalar_Pair)
847	48	if (CS%linear_wave_drag) &
848		call create_group_pass(CS%pass_eta_bt_rem, Rayleigh_u, Rayleigh_v, &
849	0	CS%BT_Domain, To_All+Scalar_Pair)
850
851		! The following halo update is not needed without wide halos. RWH
852	48	if (((G%isd > CS%isdw) .or. (G%jsd > CS%jsdw)) .or. (Isq <= is-1) .or. (Jsq <= js-1)) &
853	48	call create_group_pass(CS%pass_force_hbt0_Cor_ref, BT_force_u, BT_force_v, CS%BT_Domain)
854	48	if (add_uh0) call create_group_pass(CS%pass_force_hbt0_Cor_ref, uhbt0, vhbt0, CS%BT_Domain)
855	48	call create_group_pass(CS%pass_force_hbt0_Cor_ref, Cor_ref_u, Cor_ref_v, CS%BT_Domain)
856	48	if (.not. use_BT_cont) then
857	0	call create_group_pass(CS%pass_Dat_uv, Datu, Datv, CS%BT_Domain, To_All+Scalar_Pair)
858		endif
859	48	if (apply_OBC_flather .and. .not.GV%Boussinesq) &
860	0	call create_group_pass(CS%pass_SpV_avg, SpV_col_avg, CS%BT_domain)
861
862	48	call create_group_pass(CS%pass_ubt_Cor, ubt_Cor, vbt_Cor, G%Domain)
863		! These passes occur at the end of the routine, as data is being readied to
864		! share with the main part of the MOM6 code.
865	48	if (find_etaav) then
866	24	call create_group_pass(CS%pass_etaav, etaav, G%Domain)
867		endif
868	48	call create_group_pass(CS%pass_e_anom, e_anom, G%Domain)
869	48	call create_group_pass(CS%pass_ubta_uhbta, CS%ubtav, CS%vbtav, G%Domain)
870	48	call create_group_pass(CS%pass_ubta_uhbta, uhbtav, vhbtav, G%Domain)
871
872	48	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
873		!--- end setup for group halo update
874		!$omp target enter data &
875		!$omp map(alloc: ubt_Cor, vbt_Cor, wt_u, wt_v, av_rem_u, av_rem_v, ubt_wtd, vbt_wtd, Coru_avg, &
876		!$omp Corv_avg, LDu_avg, LDv_avg, e_anom, q, ubt, vbt, bt_rem_u, bt_rem_v, BT_force_u, &
877		!$omp BT_force_v, u_accel_bt, v_accel_bt, uhbt, vhbt, uhbt0, vhbt0, &
878		!$omp Cor_ref_u, Cor_ref_v, DCor_u, DCor_v, &
879		!$omp Datu, Datv, f_4_u, f_4_v, eta, eta_sum, eta_wtd, eta_IC, eta_PF, eta_PF_1, &
880		!$omp d_eta_PF, gtot_E, gtot_W, gtot_N, gtot_S, eta_src, dyn_coef_eta, BTCL_u, BTCL_v, &
881		!$omp PFu_avg, PFv_avg)
882
883		! Calculate the constant coefficients for the Coriolis force terms in the
884		! barotropic momentum equations. This has to be done quite early to start
885		! the halo update that needs to be completed before the next calculations.
886	48	if (CS%linearized_BT_PV) then
887	6240	do concurrent (J=jsvf-2:jevf+1, I=isvf-2:ievf+1)
888	433488	q(I,J) = CS%q_D(I,j)
889		enddo
890	6240	do concurrent (j=jsvf-1:jevf+1, I=isvf-2:ievf+1)
891	427296	DCor_u(I,j) = CS%D_u_Cor(I,j)
892		enddo
893	6192	do concurrent (J=jsvf-2:jevf+1, i=isvf-1:ievf+1)
894	430128	DCor_v(i,J) = CS%D_v_Cor(i,J)
895		enddo
896		else
897	0	q(:,:) = 0.0 ; DCor_u(:,:) = 0.0 ; DCor_v(:,:) = 0.0
898	0	if (GV%Boussinesq) then
899		!$OMP parallel do default(shared)
900	0	do j=js,je ; do I=is-1,ie
901		DCor_u(I,j) = 0.5 * (max(GV%Z_to_H*G%bathyT(i+1,j) + eta_in(i+1,j), 0.0) + &
902	0	max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0) )
903		enddo ; enddo
904	0	if (CS%interior_OBC_PV .and. CS%BT_OBC%u_OBCs_on_PE) then
905		!$OMP parallel do default(shared)
906	0	do j = max(js,CS%BT_OBC%js_u_W_obc), min(je,CS%BT_OBC%je_u_W_obc)
907	0	do I = max(is-1,CS%BT_OBC%Is_u_W_obc), min(ie,CS%BT_OBC%Ie_u_W_obc)
908	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) & ! Western boundary condition
909	0	DCor_u(I,j) = max(GV%Z_to_H*G%bathyT(i+1,j) + eta_in(i+1,j), 0.0)
910		enddo
911		enddo
912		!$OMP parallel do default(shared)
913	0	do j = max(js,CS%BT_OBC%js_u_E_obc), min(je,CS%BT_OBC%je_u_E_obc)
914	0	do I = max(is-1,CS%BT_OBC%Is_u_E_obc), min(ie,CS%BT_OBC%Ie_u_E_obc)
915	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) & ! Eastern boundary condition
916	0	DCor_u(I,j) = max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0)
917		enddo
918		enddo
919		endif
920
921		!$OMP parallel do default(shared)
922	0	do J=js-1,je ; do i=is,ie
923		DCor_v(i,J) = 0.5 * (max(GV%Z_to_H*G%bathyT(i,j+1) + eta_in(i+1,j), 0.0) + &
924	0	max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0) )
925		enddo ; enddo
926	0	if (CS%interior_OBC_PV .and. CS%BT_OBC%v_OBCs_on_PE) then
927		!$OMP parallel do default(shared)
928	0	do j = max(js,CS%BT_OBC%js_v_S_obc), min(je,CS%BT_OBC%je_v_S_obc)
929	0	do I = max(is-1,CS%BT_OBC%Is_v_S_obc), min(ie,CS%BT_OBC%Ie_v_S_obc)
930	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) & ! Southern boundary condition
931	0	DCor_v(i,J) = max(GV%Z_to_H*G%bathyT(i,j+1) + eta_in(i,j+1), 0.0)
932		enddo
933		enddo
934		!$OMP parallel do default(shared)
935	0	do j = max(js,CS%BT_OBC%js_v_N_obc), min(je,CS%BT_OBC%je_v_N_obc)
936	0	do I = max(is-1,CS%BT_OBC%Is_v_N_obc), min(ie,CS%BT_OBC%Ie_v_N_obc)
937	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) & ! Northern boundary condition
938	0	DCor_v(i,J) = max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0)
939		enddo
940		enddo
941		endif
942		!$OMP parallel do default(shared)
943	0	do J=js-1,je ; do I=is-1,ie
944		q(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
945		((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J))) / &
946		(max(((CS%q_wt(1,I,J) * max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0)) + &
947		(CS%q_wt(4,I,J) * max(GV%Z_to_H*G%bathyT(i+1,j+1) + eta_in(i+1,j+1), 0.0))) + &
948		((CS%q_wt(2,I,J) * max(GV%Z_to_H*G%bathyT(i+1,j) + eta_in(i+1,j), 0.0)) + &
949	0	(CS%q_wt(3,I,J) * max(GV%Z_to_H*G%bathyT(i,j+1) + eta_in(i,j+1), 0.0))), h_a_neglect) )
950		enddo ; enddo
951		else ! Non-Boussinesq
952		!$OMP parallel do default(shared)
953	0	do j=js,je ; do I=is-1,ie
954	0	DCor_u(I,j) = 0.5 * (eta_in(i+1,j) + eta_in(i,j))
955		enddo ; enddo
956	0	if (CS%interior_OBC_PV .and. CS%BT_OBC%u_OBCs_on_PE) then
957		!$OMP parallel do default(shared)
958	0	do j = max(js,CS%BT_OBC%js_u_W_obc), min(je,CS%BT_OBC%je_u_W_obc)
959	0	do I = max(is-1,CS%BT_OBC%Is_u_W_obc), min(ie,CS%BT_OBC%Ie_u_W_obc)
960	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) DCor_u(I,j) = eta_in(i+1,j) ! Western boundary condition
961		enddo
962		enddo
963		!$OMP parallel do default(shared)
964	0	do j = max(js,CS%BT_OBC%js_u_E_obc), min(je,CS%BT_OBC%je_u_E_obc)
965	0	do I = max(is-1,CS%BT_OBC%Is_u_E_obc), min(ie,CS%BT_OBC%Ie_u_E_obc)
966	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) DCor_u(I,j) = eta_in(i,j) ! Eastern boundary condition
967		enddo
968		enddo
969		endif
970
971		!$OMP parallel do default(shared)
972	0	do J=js-1,je ; do i=is,ie
973	0	DCor_v(i,J) = 0.5 * (eta_in(i,j+1) + eta_in(i,j))
974		enddo ; enddo
975	0	if (CS%interior_OBC_PV .and. CS%BT_OBC%v_OBCs_on_PE) then
976		!$OMP parallel do default(shared)
977	0	do j = max(js,CS%BT_OBC%js_v_S_obc), min(je,CS%BT_OBC%je_v_S_obc)
978	0	do I = max(is-1,CS%BT_OBC%Is_v_S_obc), min(ie,CS%BT_OBC%Ie_v_S_obc)
979	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) DCor_v(i,J) = eta_in(i,j+1) ! Southern boundary condition
980		enddo
981		enddo
982		!$OMP parallel do default(shared)
983	0	do j = max(js,CS%BT_OBC%js_v_N_obc), min(je,CS%BT_OBC%je_v_N_obc)
984	0	do I = max(is-1,CS%BT_OBC%Is_v_N_obc), min(ie,CS%BT_OBC%Ie_v_N_obc)
985	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) DCor_v(i,J) = eta_in(i,j) ! Northern boundary condition
986		enddo
987		enddo
988		endif
989
990		!$OMP parallel do default(shared)
991	0	do J=js-1,je ; do I=is-1,ie
992		q(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
993		((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J))) / &
994		(max(((CS%q_wt(1,I,J) * eta_in(i,j)) + (CS%q_wt(4,I,J) * eta_in(i+1,j+1))) + &
995	0	((CS%q_wt(2,I,J) * eta_in(i+1,j)) + (CS%q_wt(3,I,J) * eta_in(i,j+1))), h_a_neglect) )
996		enddo ; enddo
997		endif
998
999		! With very wide halos, q and D need to be calculated on the available data
1000		! domain and then updated onto the full computational domain.
1001		! These calculations can be done almost immediately, but the halo updates
1002		! must be done before the [abcd]mer and [abcd]zon are calculated.
1003	0	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1004	0	if (nonblock_setup) then
1005		!$omp target update from(q, DCor_u, DCor_v)
1006	0	call start_group_pass(CS%pass_q_DCor, CS%BT_Domain, clock=id_clock_pass_pre)
1007		else
1008	0	call do_group_pass(CS%pass_q_DCor, CS%BT_Domain, clock=id_clock_pass_pre, omp_offload=.true.)
1009		endif
1010	0	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1011		endif
1012
1013		! Zero out various wide-halo arrays.
1014	6192	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw:CS%iedw)
1015	417792	gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0
1016	417792	gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0
1017	417792	eta(i,j) = 0.0
1018	417792	eta_PF(i,j) = 0.0
1019	417792	if (interp_eta_PF) then
1020	0	eta_PF_1(i,j) = 0.0 ; d_eta_PF(i,j) = 0.0
1021		endif
1022	417792	if (integral_BT_cont) then
1023	0	eta_IC(i,j) = 0.0
1024		endif
1025	423984	if (CS%dynamic_psurf) dyn_coef_eta(i,j) = 0.0
1026		enddo
1027		! The halo regions of various arrays need to be initialized to
1028		! non-NaNs in case the neighboring domains are not part of the ocean.
1029		! Otherwise a halo update later on fills in the correct values.
1030	6240	do concurrent (j=CS%jsdw:CS%jedw, I=CS%isdw-1:CS%iedw)
1031	421056	Cor_ref_u(I,j) = 0.0 ; BT_force_u(I,j) = 0.0 ; ubt(I,j) = 0.0
1032	427296	Datu(I,j) = 0.0 ; bt_rem_u(I,j) = 0.0 ; uhbt0(I,j) = 0.0
1033		enddo
1034	6192	do concurrent (J=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
1035	423936	Cor_ref_v(i,J) = 0.0 ; BT_force_v(i,J) = 0.0 ; vbt(i,J) = 0.0
1036	430128	Datv(i,J) = 0.0 ; bt_rem_v(i,J) = 0.0 ; vhbt0(i,J) = 0.0
1037		enddo
1038
1039	48	if (apply_OBCs) then
1040	0	SpV_col_avg(:,:) = 0.0
1041	0	if (apply_OBC_flather .and. .not.GV%Boussinesq) then
1042		! Copy the column average specific volumes into a wide halo array
1043		!$OMP parallel do default(shared)
1044	0	do j=js,je ; do i=is,ie
1045	0	SpV_col_avg(i,j) = Spv_avg(i,j)
1046		enddo ; enddo
1047	0	if (nonblock_setup) then
1048	0	call start_group_pass(CS%pass_SpV_avg, CS%BT_domain)
1049		else
1050	0	call do_group_pass(CS%pass_SpV_avg, CS%BT_domain)
1051		endif
1052		endif
1053		endif
1054
1055	48	if (CS%linear_wave_drag) then
1056		!$OMP parallel do default(shared)
1057	0	do j=CS%jsdw,CS%jedw ; do I=CS%isdw-1,CS%iedw
1058	0	Rayleigh_u(I,j) = 0.0
1059		enddo ; enddo
1060		!$OMP parallel do default(shared)
1061	0	do J=CS%jsdw-1,CS%jedw ; do i=CS%isdw,CS%iedw
1062	0	Rayleigh_v(i,J) = 0.0
1063		enddo ; enddo
1064		endif
1065
1066		! Copy input arrays into their wide-halo counterparts.
1067	48	if (interp_eta_PF) then
1068	0	do concurrent (j=G%jsd:G%jed, i=G%isd:G%ied)
1069		! Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?
1070	0	eta(i,j) = eta_in(i,j)
1071	0	eta_PF_1(i,j) = eta_PF_start(i,j)
1072	0	d_eta_PF(i,j) = eta_PF_in(i,j) - eta_PF_start(i,j)
1073		enddo
1074		else
1075	6192	do concurrent (j=G%Jsd:G%Jed, i=G%isd:G%ied)
1076		! Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?
1077	417792	eta(i,j) = eta_in(i,j)
1078	423984	eta_PF(i,j) = eta_PF_in(i,j)
1079		enddo
1080		endif
1081	48	if (integral_BT_cont) then
1082	0	do concurrent (j=G%jsd:G%jed, i=G%isd:G%ied)
1083	0	eta_IC(i,j) = eta_in(i,j)
1084		enddo
1085		endif
1086
1087	48	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
1088		! rem needs to be greater than visc_rem_u and 1-Instep/visc_rem_u.
1089		! The 0.5 below is just for safety.
1090		! NOTE: subroundoff is a negligible value used to prevent division by zero.
1091		! When 1-0.5*Instep/visc_rem exceeds visc_rem, the subroundoff is too small
1092		! to modify the significand. When visc_rem is small, the max() operators
1093		! select visc_rem or 0. So subroundoff cannot impact the final value.
1094	26136000	visc_rem = min(visc_rem_u(I,j,k), 1.)
1095	26136000	visc_rem = max(visc_rem, 1. - 0.5 * Instep / (visc_rem + subroundoff))
1096	26136000	visc_rem = max(visc_rem, 0.)
1097	26490336	wt_u(I,j,k) = CS%frhatu(I,j,k) * visc_rem
1098		enddo
1099	48	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
1100		! As above, rem must be greater than visc_rem_v and 1-Instep/visc_rem_v.
1101	26352000	visc_rem = min(visc_rem_v(I,j,k), 1.)
1102	26352000	visc_rem = max(visc_rem, 1. - 0.5 * Instep / (visc_rem + subroundoff))
1103	26352000	visc_rem = max(visc_rem, 0.)
1104	26709168	wt_v(i,J,k) = CS%frhatv(i,J,k) * visc_rem
1105		enddo
1106
1107	48	if (.not. CS%wt_uv_bug) then
1108	48	do concurrent (j=js:je, I=is-1:ie)
1109	354336	Iwt_u_tot(I,j) = wt_u(I,j,1)
1110		enddo
1111	3600	do k=2,nz ; do concurrent (j=js:je, I=is-1:ie)
1112	26220864	Iwt_u_tot(I,j) = Iwt_u_tot(I,j) + wt_u(I,j,k)
1113		enddo ; enddo
1114	354336	do concurrent (j=js:je, I=is-1:ie, abs(Iwt_u_tot(I,j)) > 0.0)
1115	354336	Iwt_u_tot(I,j) = G%mask2dCu(I,j) / Iwt_u_tot(I,j)
1116		enddo
1117	48	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
1118	26490336	wt_u(I,j,k) = wt_u(I,j,k) * Iwt_u_tot(I,j)
1119		enddo
1120
1121	48	do concurrent (J=js-1:je, i=is:ie)
1122	357168	Iwt_v_tot(i,J) = wt_v(i,J,1)
1123		enddo
1124	3600	do k=2,nz ; do concurrent (J=js-1:je, i=is:ie)
1125	26430432	Iwt_v_tot(i,J) = Iwt_v_tot(i,J) + wt_v(i,J,k)
1126		enddo ; enddo
1127	357168	do concurrent (J=js-1:je, i=is:ie, abs(Iwt_v_tot(i,J)) > 0.0)
1128	357168	Iwt_v_tot(i,J) = G%mask2dCv(i,J) / Iwt_v_tot(i,J)
1129		enddo
1130	48	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
1131	26709168	wt_v(i,J,k) = wt_v(i,J,k) * Iwt_v_tot(i,J)
1132		enddo
1133		endif
1134
1135		! Use u_Cor and v_Cor as the reference values for the Coriolis terms,
1136		! including the viscous remnant.
1137	5856	do concurrent (j=js-1:je+1, I=is-1:ie)
1138	365952	ubt_Cor(I,j) = 0.0
1139		enddo
1140	48	do concurrent (J=js-1:je, i=is-1:ie+1)
1141	363120	vbt_Cor(i,J) = 0.0
1142		enddo
1143	48	do concurrent (j=js:je)
1144	218928	do k=1,nz
1145	2880	do concurrent (I=is-1:ie)
1146	26352000	ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * U_Cor(I,j,k)
1147		enddo
1148		enddo
1149		enddo
1150	48	do concurrent (J=js-1:je)
1151	222576	do k=1,nz
1152	2928	do concurrent (i=is:ie)
1153	26571600	vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * V_Cor(i,J,k)
1154		enddo
1155		enddo
1156		enddo
1157
1158		! The gtot arrays are the effective layer-weighted reduced gravities for
1159		! accelerations across the various faces, with names for the relative
1160		! locations of the faces to the pressure point. They will have their halos
1161		! updated later on.
1162	48	do concurrent (j=js:je)
1163	218928	do k=1,nz
1164	2880	do concurrent (i=is-1:ie)
1165	26136000	gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * wt_u(I,j,k)
1166	26352000	gtot_W(i+1,j) = gtot_W(i+1,j) + pbce(i+1,j,k) * wt_u(I,j,k)
1167		enddo
1168		enddo
1169		enddo
1170	48	do concurrent (J=js-1:je)
1171	222576	do k=1,nz
1172	2928	do concurrent (i=is:ie)
1173	26352000	gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * wt_v(i,J,k)
1174	26571600	gtot_S(i,j+1) = gtot_S(i,j+1) + pbce(i,j+1,k) * wt_v(i,J,k)
1175		enddo
1176		enddo
1177		enddo
1178
1179	48	if (CS%BT_OBC%u_OBCs_on_PE) then
1180	0	do concurrent (j=js:je, I=is-1:ie)
1181	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) & ! Eastern boundary condition
1182	0	gtot_W(i+1,j) = gtot_W(i,j) ! Perhaps this should be gtot_E(i,j)?
1183	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) & ! Western boundary condition
1184	0	gtot_E(i,j) = gtot_E(i+1,j) ! Perhaps this should be gtot_W(i+1,j)?
1185		enddo
1186		endif
1187	48	if (CS%BT_OBC%v_OBCs_on_PE) then
1188	0	do concurrent (J=js-1:je, i=is:ie)
1189	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) & ! Northern boundary condition
1190	0	gtot_S(i,j+1) = gtot_S(i,j) !### Should this be gtot_N(i,j) to use wt_v at the same point?
1191	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) & ! Southern boundary condition
1192	0	gtot_N(i,j) = gtot_N(i,j+1) ! Perhaps this should be gtot_S(i,j+1)?
1193		enddo
1194		endif
1195
1196	48	if (CS%calculate_SAL) then
1197	0	call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
1198	0	if (CS%tidal_sal_bug) then
1199	0	dgeo_de = 1.0 + det_de + CS%G_extra
1200		else
1201	0	dgeo_de = (1.0 - det_de) + CS%G_extra
1202		endif
1203		else
1204	48	dgeo_de = 1.0 + CS%G_extra
1205		endif
1206
1207	48	if (nonblock_setup .and. .not.CS%linearized_BT_PV) then
1208	0	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1209	0	call complete_group_pass(CS%pass_q_DCor, CS%BT_Domain, clock=id_clock_pass_pre)
1210		!$omp target update to(q, DCor_u, DCor_v)
1211	0	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1212		endif
1213
1214		! Calculate the open areas at the velocity points.
1215		! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor.
1216	48	if (integral_BT_cont) then
1217	0	call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie, dt_baroclinic=dt)
1218	48	elseif (use_BT_cont) then
1219	48	call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie)
1220		else
1221	0	if (CS%Nonlinear_continuity) then
1222	0	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1, eta)
1223		else
1224	0	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1)
1225		endif
1226		endif
1227
1228		! Set up fields related to the open boundary conditions. These calls include halo updates that
1229		! must occur on all PEs when there are open boundary conditions anywhere.
1230	48	if (apply_OBCs) then
1231		!$omp target update from(eta, Datu, Datv, BTCL_u, BTCL_v)
1232	0	if (nonblock_setup .and. apply_OBC_flather .and. .not.GV%Boussinesq) &
1233	0	call complete_group_pass(CS%pass_SpV_avg, CS%BT_domain)
1234
1235	0	dgeo_de_OBC = 1.0 ; if (CS%tidal_SAL_Flather) dgeo_de_OBC = dgeo_de
1236		call set_up_BT_OBC(OBC, eta, SpV_col_avg, CS%BT_OBC, CS%BT_Domain, G, GV, US, CS, MS, ievf-ie, &
1237	0	use_BT_cont, integral_BT_cont, dt, Datu, Datv, BTCL_u, BTCL_v, dgeo_de_OBC)
1238		endif
1239
1240		! Determine the difference between the sum of the layer fluxes and the
1241		! barotropic fluxes found from the same input velocities.
1242	48	if (add_uh0) then
1243	48	do concurrent (j=js:je, I=is-1:ie)
1244	354336	uhbt(I,j) = 0.0 ; ubt(I,j) = 0.0
1245		enddo
1246	48	do concurrent (J=js-1:je, i=is:ie)
1247	357168	vhbt(i,J) = 0.0 ; vbt(i,J) = 0.0
1248		enddo
1249	48	if (CS%visc_rem_u_uh0) then
1250	0	do k=1,nz ; do concurrent (j=js:je, I=is-1:ie)
1251	0	uhbt(I,j) = uhbt(I,j) + uh0(I,j,k)
1252	0	ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * u_uh0(I,j,k)
1253		enddo ; enddo
1254	0	do k=1,nz ; do concurrent (J=js-1:je, i=is:ie)
1255	0	vhbt(i,J) = vhbt(i,J) + vh0(i,J,k)
1256	0	vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * v_vh0(i,J,k)
1257		enddo ; enddo
1258		else
1259	48	do concurrent (j=js:je)
1260	218928	do k=1,nz
1261	2880	do concurrent (I=is-1:ie)
1262	26136000	uhbt(I,j) = uhbt(I,j) + uh0(I,j,k)
1263	26352000	ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * u_uh0(I,j,k)
1264		enddo
1265		enddo
1266		enddo
1267	48	do concurrent (J=js-1:je)
1268	222576	do k=1,nz
1269	2928	do concurrent (i=is:ie)
1270	26352000	vhbt(i,J) = vhbt(i,J) + vh0(i,J,k)
1271	26571600	vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * v_vh0(i,J,k)
1272		enddo
1273		enddo
1274		enddo
1275		endif
1276	48	if ((use_BT_cont .or. integral_BT_cont) .and. CS%adjust_BT_cont) then
1277		! Use the additional input transports to broaden the fits
1278		! over which the bt_cont_type applies.
1279
1280		! Fill in the halo data for ubt, vbt, uhbt, and vhbt.
1281	0	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1282	0	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1283		!$omp target update from(ubt, vbt, uhbt, vhbt)
1284	0	call pass_vector(ubt, vbt, CS%BT_Domain, complete=.false., halo=1+ievf-ie)
1285	0	call pass_vector(uhbt, vhbt, CS%BT_Domain, complete=.true., halo=1+ievf-ie)
1286		!$omp target update to(ubt, vbt, uhbt, vhbt)
1287	0	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1288	0	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1289		!$omp target update from(BTCL_u, BTCL_v)
1290	0	if (integral_BT_cont) then
1291		call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
1292	0	G, US, MS, 1+ievf-ie, dt_baroclinic=dt)
1293		else
1294		call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
1295	0	G, US, MS, 1+ievf-ie)
1296		endif
1297		!$omp target update to(BTCL_u, BTCL_v)
1298		endif
1299	48	if (integral_BT_cont) then
1300	0	do concurrent (j=js:je, I=is-1:ie)
1301	0	uhbt0(I,j) = uhbt(I,j) - find_uhbt(dtubt(I,j), BTCL_u(I,j)) Idt
1302		enddo
1303	0	do concurrent (J=js-1:je, i=is:ie)
1304	0	vhbt0(i,J) = vhbt(i,J) - find_vhbt(dtvbt(i,J), BTCL_v(i,J)) Idt
1305		enddo
1306	48	elseif (use_BT_cont) then
1307	48	do concurrent (j=js:je, I=is-1:ie)
1308	354336	uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j), BTCL_u(I,j))
1309		enddo
1310	48	do concurrent (J=js-1:je, i=is:ie)
1311	357168	vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J), BTCL_v(i,J))
1312		enddo
1313		else
1314	0	do concurrent (j=js:je, I=is-1:ie)
1315	0	uhbt0(I,j) = uhbt(I,j) - Datu(I,j)*ubt(I,j)
1316		enddo
1317	0	do concurrent (J=js-1:je, i=is:ie)
1318	0	vhbt0(i,J) = vhbt(i,J) - Datv(i,J)*vbt(i,J)
1319		enddo
1320		endif
1321	48	if (CS%BT_OBC%u_OBCs_on_PE) then ! Zero out the reference transport at OBC points
1322	0	do concurrent(j=js:je, I=is-1:ie, CS%BT_OBC%u_OBC_type(I,j) /= 0)
1323	0	uhbt0(I,j) = 0.0
1324		enddo
1325		endif
1326	48	if (CS%BT_OBC%v_OBCs_on_PE) then !Zero out the reference transport at OBC points
1327	0	do concurrent (J=js-1:je, i=is:ie, CS%BT_OBC%v_OBC_type(i,J) /= 0)
1328	0	vhbt0(i,J) = 0.0
1329		enddo
1330		endif
1331		endif
1332
1333		! Calculate the initial barotropic velocities from the layer's velocities.
1334	48	call btstep_ubt_from_layer(U_in, V_in, wt_u, wt_v, ubt, vbt, G, GV, CS)
1335
1336	6240	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw-1:CS%iedw)
1337	427296	uhbt(i,j) = 0.0 ; u_accel_bt(i,j) = 0.0
1338		enddo
1339	6192	do concurrent (j=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
1340	430128	vhbt(i,j) = 0.0 ; v_accel_bt(i,j) = 0.0
1341		enddo
1342
1343	48	if (apply_OBCs .or. (CS%id_ubtdt > 0)) then
1344		!$omp target update from(ubt)
1345	0	do j=js,je ; do I=is-1,ie
1346	0	ubt_st(I,j) = ubt(I,j)
1347		enddo ; enddo
1348		endif
1349
1350	48	if (apply_OBCs .or. (CS%id_vbtdt > 0)) then
1351		!$omp target update from(vbt)
1352	0	do J=js-1,je ; do i=is,ie
1353	0	vbt_st(i,J) = vbt(i,J)
1354		enddo ; enddo
1355		endif
1356
1357		! Here the vertical average accelerations due to the Coriolis, advective,
1358		! pressure gradient and horizontal viscous terms in the layer momentum
1359		! equations are calculated. These will be used to determine the difference
1360		! between the accelerations due to the average of the layer equations and the
1361		! barotropic calculation.
1362
1363	354336	do concurrent (j=js:je, I=is-1:ie) ; if (G%OBCmaskCu(I,j) > 0.0) then
1364	237504	if (CS%nonlin_stress) then
1365	0	if (GV%Boussinesq) then
1366		Htot_avg = 0.5(max(CS%bathyT(i,j)GV%Z_to_H + eta(i,j), 0.0) + &
1367	0	max(CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j), 0.0))
1368		else
1369	0	Htot_avg = 0.5*(eta(i,j) + eta(i+1,j))
1370		endif
1371	0	if (Htot_avg*CS%dy_Cu(I,j) <= 0.0) then
1372	0	CS%IDatu(I,j) = 0.0
1373	0	elseif (integral_BT_cont) then
1374		CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), &
1375	0	CS%dy_Cu(I,j)*Htot_avg) )
1376	0	elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling.
1377		CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), &
1378	0	CS%dy_Cu(I,j)*Htot_avg) )
1379		else
1380	0	CS%IDatu(I,j) = 1.0 / Htot_avg
1381		endif
1382		endif
1383
1384	237504	BT_force_u(I,j) = forces%taux(I,j) * GV%RZ_to_H * CS%IDatu(I,j)*visc_rem_u(I,j,1)
1385		else
1386	110976	BT_force_u(I,j) = 0.0
1387		endif ; enddo
1388
1389	357168	do concurrent (J=js-1:je, i=is:ie) ; if (G%OBCmaskCv(i,J) > 0.0) then
1390	234912	if (CS%nonlin_stress) then
1391	0	if (GV%Boussinesq) then
1392		Htot_avg = 0.5(max(CS%bathyT(i,j)GV%Z_to_H + eta(i,j), 0.0) + &
1393	0	max(CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1), 0.0))
1394		else
1395	0	Htot_avg = 0.5*(eta(i,j) + eta(i,j+1))
1396		endif
1397	0	if (Htot_avg*CS%dx_Cv(i,J) <= 0.0) then
1398	0	CS%IDatv(i,J) = 0.0
1399	0	elseif (integral_BT_cont) then
1400		CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), &
1401	0	CS%dx_Cv(i,J)*Htot_avg) )
1402	0	elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling.
1403		CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), &
1404	0	CS%dx_Cv(i,J)*Htot_avg) )
1405		else
1406	0	CS%IDatv(i,J) = 1.0 / Htot_avg
1407		endif
1408		endif
1409
1410	234912	BT_force_v(i,J) = forces%tauy(i,J) * GV%RZ_to_H * CS%IDatv(i,J)*visc_rem_v(i,J,1)
1411		else
1412	116448	BT_force_v(i,J) = 0.0
1413		endif ; enddo
1414
1415	48	if (associated(taux_bot) .and. associated(tauy_bot)) then
1416	0	do concurrent (j=js:je, I=is-1:ie, G%mask2dCu(I,j) > 0.0)
1417	0	BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * GV%RZ_to_H * CS%IDatu(I,j)
1418		enddo
1419	0	do concurrent (J=js-1:je, i=is:ie, G%mask2dCv(i,J) > 0.0)
1420	0	BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * GV%RZ_to_H * CS%IDatv(i,J)
1421		enddo
1422		endif
1423
1424		! bc_accel_u & bc_accel_v are only available on the potentially
1425		! non-symmetric computational domain.
1426	48	do concurrent (j=js:je)
1427	218928	do k=1,nz
1428	2880	do concurrent (I=Isq:Ieq)
1429	26352000	BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * bc_accel_u(I,j,k)
1430		enddo
1431		enddo
1432		enddo
1433	48	do concurrent (J=Jsq:Jeq)
1434	222576	do k=1,nz
1435	2928	do concurrent (i=is:ie)
1436	26571600	BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * bc_accel_v(i,J,k)
1437		enddo
1438		enddo
1439		enddo
1440
1441	48	if (CS%gradual_BT_ICs) then
1442	0	do concurrent (j=js:je, I=is-1:ie)
1443	0	BT_force_u(I,j) = BT_force_u(I,j) + (ubt(I,j) - CS%ubt_IC(I,j)) * Idt
1444	0	ubt(I,j) = CS%ubt_IC(I,j)
1445	0	if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0
1446		enddo
1447	0	do concurrent (J=js-1:je, i=is:ie)
1448	0	BT_force_v(i,J) = BT_force_v(i,J) + (vbt(i,J) - CS%vbt_IC(i,J)) * Idt
1449	0	vbt(i,J) = CS%vbt_IC(i,J)
1450	0	if (abs(vbt(i,J)) < CS%vel_underflow) vbt(i,J) = 0.0
1451		enddo
1452		endif
1453
1454		! Compute instantaneous tidal velocities and apply frequency-dependent drag.
1455		! Note that the filtered velocities are only updated during the current predictor step,
1456		! and are calculated using the barotropic velocity from the previous correction step.
1457	48	if (CS%use_filter) then
1458		!$omp target update from(ubt, vbt)
1459	0	call Filt_accum(ubt(G%IsdB:G%IedB,G%jsd:G%jed), ufilt, CS%Time, US, CS%Filt_CS_u)
1460	0	call Filt_accum(vbt(G%isd:G%ied,G%JsdB:G%JedB), vfilt, CS%Time, US, CS%Filt_CS_v)
1461		endif
1462
1463	48	if (CS%use_filter .and. CS%linear_freq_drag) then
1464	0	call wave_drag_calc(ufilt, vfilt, Drag_u, Drag_v, G, CS%Drag_CS)
1465	0	do concurrent (j=js:je, I=is-1:ie)
1466	0	Htot = 0.5 * (eta(i,j) + eta(i+1,j))
1467	0	if (GV%Boussinesq) &
1468	0	Htot = Htot + 0.5GV%Z_to_H (CS%bathyT(i,j) + CS%bathyT(i+1,j))
1469	0	if (Htot > 0.0) then
1470	0	Drag_u(I,j) = Drag_u(I,j) / Htot
1471	0	BT_force_u(I,j) = BT_force_u(I,j) - Drag_u(I,j)
1472		else
1473	0	Drag_u(I,j) = 0.0
1474		endif
1475		enddo
1476	0	do concurrent (J=js-1:je, i=is:ie)
1477	0	Htot = 0.5 * (eta(i,j) + eta(i,j+1))
1478	0	if (GV%Boussinesq) &
1479	0	Htot = Htot + 0.5GV%Z_to_H (CS%bathyT(i,j) + CS%bathyT(i,j+1))
1480	0	if (Htot > 0.0) then
1481	0	Drag_v(i,J) = Drag_v(i,J) / Htot
1482	0	BT_force_v(i,J) = BT_force_v(i,J) - Drag_v(i,J)
1483		else
1484	0	Drag_v(i,J) = 0.0
1485		endif
1486		enddo
1487		endif
1488
1489		! Mask out the forcing at OBC points
1490	48	if (CS%BT_OBC%u_OBCs_on_PE) then
1491	0	do concurrent (j=js:je, I=is-1:ie)
1492	0	BT_force_u(I,j) = CS%OBCmask_u(I,j) * BT_force_u(I,j)
1493		enddo
1494		endif
1495	48	if (CS%BT_OBC%v_OBCs_on_PE) then
1496	0	do concurrent (J=js-1:je, i=is:ie)
1497	0	BT_force_v(i,J) = CS%OBCmask_v(i,J) * BT_force_v(i,J)
1498		enddo
1499		endif
1500
1501	48	if ((Isq > is-1) .or. (Jsq > js-1)) then
1502		! Non-symmetric memory is being used, so the edge values need to be
1503		! filled in with a halo update of a non-symmetric array.
1504	0	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1505	0	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1506	0	tmp_u(:,:) = 0.0 ; tmp_v(:,:) = 0.0
1507		!$omp target update from(BT_force_u, BT_force_v)
1508	0	do j=js,je ; do I=Isq,Ieq ; tmp_u(I,j) = BT_force_u(I,j) ; enddo ; enddo
1509	0	do J=Jsq,Jeq ; do i=is,ie ; tmp_v(i,J) = BT_force_v(i,J) ; enddo ; enddo
1510	0	if (nonblock_setup) then
1511	0	call start_group_pass(CS%pass_tmp_uv, G%Domain)
1512		else
1513	0	call do_group_pass(CS%pass_tmp_uv, G%Domain)
1514	0	do j=jsd,jed ; do I=IsdB,IedB ; BT_force_u(I,j) = tmp_u(I,j) ; enddo ; enddo
1515	0	do J=JsdB,JedB ; do i=isd,ied ; BT_force_v(i,J) = tmp_v(i,J) ; enddo ; enddo
1516		!$omp target update to(BT_force_u, BT_force_v)
1517		endif
1518	0	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1519	0	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1520		endif
1521
1522	48	if (nonblock_setup) then
1523	0	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1524	0	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1525		! ensure correct data on host to be exchanged
1526		!$omp target update from(ubt_Cor, vbt_Cor, gtot_E, gtot_W, gtot_N, gtot_S)
1527	0	call start_group_pass(CS%pass_gtot, CS%BT_Domain)
1528	0	call start_group_pass(CS%pass_ubt_Cor, G%Domain)
1529	0	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1530	0	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1531		endif
1532
1533		! Determine the weighted Coriolis parameters for the neighboring velocities.
1534	48	call btstep_find_Cor(q, DCor_u, DCor_v, f_4_u, f_4_v, isvf, ievf, jsvf, jevf, CS)
1535
1536		! Complete the previously initiated message passing.
1537	48	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1538	48	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1539	48	if (nonblock_setup) then
1540	0	if ((Isq > is-1) .or. (Jsq > js-1)) then
1541	0	call complete_group_pass(CS%pass_tmp_uv, G%Domain)
1542	0	do j=jsd,jed ; do I=IsdB,IedB ; BT_force_u(I,j) = tmp_u(I,j) ; enddo ; enddo
1543	0	do J=JsdB,JedB ; do i=isd,ied ; BT_force_v(i,J) = tmp_v(i,J) ; enddo ; enddo
1544		!$omp target update to(BT_force_u, BT_force_v)
1545		endif
1546	0	call complete_group_pass(CS%pass_gtot, CS%BT_Domain)
1547	0	call complete_group_pass(CS%pass_ubt_Cor, G%Domain)
1548		!$omp target update to(Ubt_Cor, vbt_Cor, gtot_E, gtot_W, gtot_N, gtot_S)
1549		else
1550	48	call do_group_pass(CS%pass_gtot, CS%BT_Domain, omp_offload=.true.)
1551	48	call do_group_pass(CS%pass_ubt_Cor, G%Domain, omp_offload=.true.)
1552		endif
1553		! Update MPI-updated values are on GPU
1554		! The various elements of gtot are positive definite but directional, so use
1555		! the polarity arrays to sort out when the directions have shifted.
1556	6192	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
1557	417792	if (CS%ua_polarity(i,j) < 0.0) call swap(gtot_E(i,j), gtot_W(i,j))
1558	423984	if (CS%va_polarity(i,j) < 0.0) call swap(gtot_N(i,j), gtot_S(i,j))
1559		enddo
1560
1561	48	do concurrent (j=js:je, I=is-1:ie)
1562		Cor_ref_u(I,j) = &
1563		(((f_4_u(4,I,j) * vbt_Cor(i+1,j)) + (f_4_u(1,I,j) * vbt_Cor(i ,j-1))) + &
1564	354336	((f_4_u(3,I,j) * vbt_Cor(i ,j)) + (f_4_u(2,I,j) * vbt_Cor(i+1,j-1))))
1565		enddo
1566	48	do concurrent (J=js-1:je, i=is:ie)
1567		Cor_ref_v(i,J) = -1.0 * &
1568		(((f_4_v(1,i,J) * ubt_Cor(I-1,j)) + (f_4_v(4,i,J) * ubt_Cor(I ,j+1))) + &
1569	357168	((f_4_v(2,i,J) * ubt_Cor(I ,j)) + (f_4_v(3,i,J) * ubt_Cor(I-1,j+1))))
1570		enddo
1571
1572		! Now start new halo updates.
1573	48	if (nonblock_setup) then
1574	0	if (.not.use_BT_cont) then
1575		!$omp target update from(Datu, Datv)
1576	0	call start_group_pass(CS%pass_Dat_uv, CS%BT_Domain)
1577		endif
1578
1579		! The following halo update is not needed without wide halos. RWH
1580		!$omp target update from(BT_force_u, BT_force_v, Cor_ref_u, Cor_ref_v)
1581		!$omp target update if(add_uh0) from(uhbt0, vhbt0)
1582	0	call start_group_pass(CS%pass_force_hbt0_Cor_ref, CS%BT_Domain)
1583		endif
1584	48	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1585	48	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1586	5856	do concurrent (j=js-1:je+1, I=is-1:ie)
1587	365952	av_rem_u(I,j) = 0.0
1588		enddo
1589	48	do concurrent (j=js:je)
1590	218928	do k=1,nz
1591	2880	do concurrent (I=is-1:ie)
1592	26352000	av_rem_u(I,j) = av_rem_u(I,j) + CS%frhatu(I,j,k) * visc_rem_u(I,j,k)
1593		enddo
1594		enddo
1595		enddo
1596	48	do concurrent (J=js-1:je)
1597	2928	do concurrent(i=is-1:ie+1)
1598	360144	av_rem_v(i,J) = 0.0
1599		enddo
1600	225504	do k=1,nz
1601	2928	do concurrent (i=is:ie)
1602	26571600	av_rem_v(i,J) = av_rem_v(i,J) + CS%frhatv(i,J,k) * visc_rem_v(i,J,k)
1603		enddo
1604		enddo
1605		enddo
1606	48	if (CS%strong_drag) then
1607	48	do concurrent (j=js:je, I=is-1:ie)
1608		bt_rem_u(I,j) = G%mask2dCu(I,j) * &
1609	354336	((nstep * av_rem_u(I,j)) / (1.0 + (nstep-1)*av_rem_u(I,j)))
1610		enddo
1611	48	do concurrent (J=js-1:je, i=is:ie)
1612		bt_rem_v(i,J) = G%mask2dCv(i,J) * &
1613	357168	((nstep * av_rem_v(i,J)) / (1.0 + (nstep-1)*av_rem_v(i,J)))
1614		enddo
1615		else
1616		! `av_rem*Instep` lowers to `exp(Insteplog(av_rem))` which is not bit-identical
1617		! CPU <-> GPU when offloaded by stdpar. Use deterministic Newton nth_root instead.
1618	0	do concurrent (j=js:je, I=is-1:ie)
1619	0	bt_rem_u(I,j) = 0.0
1620	0	if (G%mask2dCu(I,j) * av_rem_u(I,j) > 0.0) &
1621	0	bt_rem_u(I,j) = G%mask2dCu(I,j) * (av_rem_u(I,j)**Instep) !nth_root(av_rem_u(I,j), nstep)
1622		enddo
1623	0	do concurrent (J=js-1:je, i=is:ie)
1624	0	bt_rem_v(i,J) = 0.0
1625	0	if (G%mask2dCv(i,J) * av_rem_v(i,J) > 0.0) &
1626	0	bt_rem_v(i,J) = G%mask2dCv(i,J) * (av_rem_v(i,J)**Instep) !nth_root(av_rem_v(i,J), nstep)
1627		enddo
1628		endif
1629
1630	48	if (CS%linear_wave_drag) then
1631	0	do concurrent (j=js:je, I=is-1:ie, G%mask2dCu(I,j) * CS%lin_drag_u(I,j) > 0.0)
1632	0	Htot = 0.5 * (eta(i,j) + eta(i+1,j))
1633
1634	0	if (GV%Boussinesq) &
1635	0	Htot = Htot + 0.5GV%Z_to_H (CS%bathyT(i,j) + CS%bathyT(i+1,j))
1636
1637		! If Htot == 0., linear wave drag is not used and Rayleigh_u = 0.0 (from
1638		! initialization) and bt_rem_u is unmodified.
1639	0	if (Htot > 0.0) then
1640	0	bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt))
1641	0	Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot
1642		endif
1643		enddo
1644
1645	0	do concurrent (J=js-1:je, i=is:ie, G%mask2dCv(i,J) * CS%lin_drag_v(i,J) > 0.0)
1646	0	Htot = 0.5 * (eta(i,j) + eta(i,j+1))
1647
1648	0	if (GV%Boussinesq) &
1649	0	Htot = Htot + 0.5GV%Z_to_H (CS%bathyT(i,j) + CS%bathyT(i,j+1))
1650
1651		! If Htot == 0., linear wave drag is not used and Rayleigh_v = 0.0 (from
1652		! initialization) and bt_rem_v is unmodified.
1653	0	if (Htot > 0.0) then
1654	0	bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt))
1655	0	Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot
1656		endif
1657		enddo
1658		endif
1659
1660		! Avoid changing the velocities at OBC points due to non-OBC calculations.
1661	48	if (CS%BT_OBC%u_OBCs_on_PE) then
1662	0	do concurrent (j=js:je, I=is-1:ie, CS%BT_OBC%u_OBC_type(I,j) /= 0)
1663	0	bt_rem_u(I,j) = 1.0
1664		enddo
1665		endif
1666	48	if (CS%BT_OBC%v_OBCs_on_PE) then
1667	0	do concurrent (J=js-1:je, i=is:ie, CS%BT_OBC%v_OBC_type(i,J) /= 0)
1668	0	bt_rem_v(i,J) = 1.0
1669		enddo
1670		endif
1671
1672		! Set the mass source, after first initializing the halos to 0.
1673	6192	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
1674	423984	eta_src(i,j) = 0.0
1675		enddo
1676	48	if (CS%bound_BT_corr) then ; if ((use_BT_Cont.or.integral_BT_cont) .and. CS%BT_cont_bounds) then
1677		do concurrent (j=js:je, i=is:ie, G%mask2dT(i,j) > 0.0) &
1678	351408	DO_LOCALITY(local(uint_cor, vint_cor, u_max_cor, v_max_cor))
1679	351408	if (CS%eta_cor(i,j) > 0.0) then
1680		! Limit the source (outward) correction to be a fraction the mass that
1681		! can be transported out of the cell by velocities with a CFL number of CFL_cor.
1682	64362	if (integral_BT_cont) then
1683	0	uint_cor = G%dxT(i,j) * CS%maxCFL_BT_cont
1684	0	vint_cor = G%dyT(i,j) * CS%maxCFL_BT_cont
1685		eta_cor_max = (CS%IareaT(i,j) * &
1686		(((find_uhbt(uint_cor, BTCL_u(I,j)) + dt*uhbt0(I,j)) - &
1687		(find_uhbt(-uint_cor, BTCL_u(I-1,j)) + dt*uhbt0(I-1,j))) + &
1688		((find_vhbt(vint_cor, BTCL_v(i,J)) + dt*vhbt0(i,J)) - &
1689	0	(find_vhbt(-vint_cor, BTCL_v(i,J-1)) + dt*vhbt0(i,J-1))) ))
1690		else ! (use_BT_Cont) then
1691	64362	u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
1692	64362	v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
1693		eta_cor_max = dt * (CS%IareaT(i,j) * &
1694		(((find_uhbt(u_max_cor, BTCL_u(I,j)) + uhbt0(I,j)) - &
1695		(find_uhbt(-u_max_cor, BTCL_u(I-1,j)) + uhbt0(I-1,j))) + &
1696		((find_vhbt(v_max_cor, BTCL_v(i,J)) + vhbt0(i,J)) - &
1697	64362	(find_vhbt(-v_max_cor, BTCL_v(i,J-1)) + vhbt0(i,J-1))) ))
1698		endif
1699	64362	CS%eta_cor(i,j) = min(CS%eta_cor(i,j), max(0.0, eta_cor_max))
1700		else
1701		! Limit the sink (inward) correction to the amount of mass that is already inside the cell.
1702	176310	Htot = eta(i,j)
1703	176310	if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j)
1704
1705	176310	CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot))
1706		endif
1707		enddo
1708		else
1709	0	do concurrent (j=js:je, i=is:ie, abs(CS%eta_cor(i,j)) > dt*CS%eta_cor_bound(i,j))
1710	0	CS%eta_cor(i,j) = sign(dt*CS%eta_cor_bound(i,j), CS%eta_cor(i,j))
1711		enddo
1712		endif ; endif
1713
1714	48	do concurrent (j=js:je, i=is:ie)
1715	351408	eta_src(i,j) = G%mask2dT(i,j) * (Instep * CS%eta_cor(i,j))
1716		enddo
1717
1718	48	if (CS%dynamic_psurf) then
1719		ice_is_rigid = (associated(forces%rigidity_ice_u) .and. &
1720	0	associated(forces%rigidity_ice_v))
1721	0	H_min_dyn = CS%Dmin_dyn_psurf
1722	0	if (ice_is_rigid .and. use_BT_cont) &
1723	0	call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0)
1724	0	if (ice_is_rigid) then
1725	0	if (GV%Boussinesq) then
1726	0	H_to_Z = GV%H_to_Z
1727		else
1728	0	H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin
1729		endif
1730	0	do concurrent (j=js:je, i=is:ie)
1731		! First determine the maximum stable value for dyn_coef_eta.
1732
1733		! This estimate of the maximum stable time step is pretty accurate for
1734		! gravity waves, but it is a conservative estimate since it ignores the
1735		! stabilizing effect of the bottom drag.
1736		Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0CS%bebt)) (G%IareaT(i,j) * &
1737		(((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j))) + &
1738		(gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j)))) + &
1739		((gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J))) + &
1740		(gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1))))) + &
1741		((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
1742	0	(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1))) * CS%BT_Coriolis_scale**2 )
1743		H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j)2) + (G%IdyT(i,j)2)), &
1744		G%IareaT(i,j) * &
1745		(((Datu(I,j)G%IdxCu(I,j)) + (Datu(I-1,j)G%IdxCu(I-1,j))) + &
1746	0	((Datv(i,J)G%IdyCv(i,J)) + (Datv(i,J-1)G%IdyCv(i,J-1))) ) )
1747		dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt*2 Idt_max2) / &
1748	0	(dtbt*2 H_eff_dx2)
1749
1750		! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [L4 Z-1 T-1 ~> m3 s-1].
1751		ice_strength = ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + &
1752		(forces%rigidity_ice_v(i,J) + forces%rigidity_ice_v(i,J-1))) / &
1753	0	(CS%ice_strength_length*2 dtbt)
1754
1755		! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]
1756	0	dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * H_to_Z)
1757		enddo
1758		endif
1759		endif
1760
1761	48	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1762	48	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1763	48	if (nonblock_setup) then
1764		!$omp target update from(bt_rem_u, bt_rem_v, eta_src)
1765		!$omp target update if(integral_BT_cont) from(eta_IC)
1766		!$omp target update if(.not.interp_eta_PF) from(eta_PF)
1767		!$omp target update if(interp_eta_PF) from(eta_PF_1, d_eta_PF)
1768		!$omp target update if(CS%dynamic_psurf) from(dyn_coef_eta)
1769	0	call start_group_pass(CS%pass_eta_bt_rem, CS%BT_Domain)
1770		! The following halo update is not needed without wide halos. RWH
1771		else
1772	48	call do_group_pass(CS%pass_eta_bt_rem, CS%BT_Domain, omp_offload=.true.)
1773	48	if (.not.use_BT_cont) call do_group_pass(CS%pass_Dat_uv, CS%BT_Domain, omp_offload=.true.)
1774	48	call do_group_pass(CS%pass_force_hbt0_Cor_ref, CS%BT_Domain, omp_offload=.true.)
1775		endif
1776	48	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1777	48	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1778
1779		! Complete all of the outstanding halo updates.
1780	48	if (nonblock_setup) then
1781	0	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1782	0	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1783
1784	0	if (.not.use_BT_cont) then
1785	0	call complete_group_pass(CS%pass_Dat_uv, CS%BT_Domain)
1786		!$omp target update to(Datu, Datv)
1787		endif
1788	0	call complete_group_pass(CS%pass_force_hbt0_Cor_ref, CS%BT_Domain)
1789	0	call complete_group_pass(CS%pass_eta_bt_rem, CS%BT_Domain)
1790		!$omp target update to(bt_rem_u, bt_rem_v, BT_force_u, BT_force_v, Cor_ref_u, Cor_ref_v, eta_src)
1791		!$omp target update if(integral_BT_cont) to(eta_IC)
1792		!$omp target update if(.not.interp_eta_PF) to(eta_PF)
1793		!$omp target update if(interp_eta_PF) to(eta_PF_1, d_eta_PF)
1794		!$omp target update if(CS%dynamic_psurf) to(dyn_coef_eta)
1795		!$omp target update if(add_uh0) to(uhbt0, vhbt0)
1796
1797	0	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1798	0	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1799		endif
1800
1801	48	if (CS%debug) then
1802		!$omp target update from(uhbt, vhbt)
1803		call uvchksum("BT [uv]hbt", uhbt, vhbt, CS%debug_BT_HI, haloshift=0, &
1804	0	unscale=US%s_to_TUS%L_to_m2GV%H_to_m)
1805		!$omp target update from(ubt, vbt)
1806	0	call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0, unscale=US%L_T_to_m_s)
1807		!$omp target update from(eta)
1808	0	call hchksum(eta, "BT Initial eta", CS%debug_BT_HI, haloshift=0, unscale=GV%H_to_MKS)
1809		!$omp target update from(BT_force_u, BT_force_v)
1810		call uvchksum("BT BT_force_[uv]", BT_force_u, BT_force_v, &
1811	0	CS%debug_BT_HI, haloshift=0, unscale=US%L_T2_to_m_s2)
1812	0	if (interp_eta_PF) then
1813	0	call hchksum(eta_PF_1, "BT eta_PF_1", CS%debug_BT_HI, haloshift=0, unscale=GV%H_to_MKS)
1814	0	call hchksum(d_eta_PF, "BT d_eta_PF", CS%debug_BT_HI, haloshift=0, unscale=GV%H_to_MKS)
1815		else
1816		!$omp target update from(eta_PF, eta_PF_in)
1817	0	call hchksum(eta_PF, "BT eta_PF", CS%debug_BT_HI, haloshift=0, unscale=GV%H_to_MKS)
1818	0	call hchksum(eta_PF_in, "BT eta_PF_in", G%HI, haloshift=0, unscale=GV%H_to_MKS)
1819		endif
1820	0	if (CS%linearized_BT_PV) then
1821		!$omp target update from(CS%q_D)
1822	0	call Bchksum(CS%q_D, "BT PV (q_D)", CS%debug_BT_HI, haloshift=0, symmetric=.true., unscale=US%s_to_T/GV%H_to_MKS)
1823		else
1824		!$omp target update from(q)
1825	0	call Bchksum(q, "BT PV (q)", CS%debug_BT_HI, haloshift=0, symmetric=.true., unscale=US%s_to_T/GV%H_to_MKS)
1826		endif
1827		!$omp target update from(DCor_u, DCor_v)
1828		call uvchksum("BT DCor_[uv]", DCor_u, DCor_v, G%HI, haloshift=0, &
1829	0	symmetric=.true., omit_corners=.true., scalar_pair=.true., unscale=GV%H_to_MKS)
1830		!$omp target update from(Cor_ref_u, Cor_ref_v)
1831	0	call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0, unscale=US%L_T2_to_m_s2)
1832		!$omp target update from(uhbt0, vhbt0)
1833		call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, haloshift=0, &
1834	0	unscale=US%L_to_m*2US%s_to_T*GV%H_to_m)
1835	0	if (.not. use_BT_cont) then
1836	0	call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, unscale=US%L_to_m*GV%H_to_m)
1837		endif
1838		!$omp target update from(wt_u, wt_v)
1839		call uvchksum("BT wt_[uv]", wt_u, wt_v, G%HI, haloshift=0, &
1840	0	symmetric=.true., omit_corners=.true., scalar_pair=.true.)
1841		!$omp target update from(CS%frhatu, CS%frhatv)
1842		call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, haloshift=0, &
1843	0	symmetric=.true., omit_corners=.true., scalar_pair=.true.)
1844		!$omp target update from(visc_rem_u, visc_rem_v)
1845		call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=0, &
1846	0	symmetric=.true., omit_corners=.true., scalar_pair=.true.)
1847		!$omp target update from(bc_accel_u, bc_accel_v)
1848	0	call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0, unscale=US%L_T2_to_m_s2)
1849		!$omp target update from(CS%IDatu, CS%IDatv)
1850		call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, &
1851	0	unscale=GV%m_to_H, scalar_pair=.true.)
1852		call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, &
1853	0	haloshift=1, scalar_pair=.true.)
1854
1855	0	if (apply_OBCs) then
1856		call uvchksum("BT_OBC%[uv]bt_outer", CS%BT_OBC%ubt_outer, CS%BT_OBC%vbt_outer, CS%debug_BT_HI, &
1857	0	symmetric=.true., omit_corners=.true., unscale=US%L_T_to_m_s)
1858	0	if (allocated(CS%BT_OBC%SSH_outer_u) .and. allocated(CS%BT_OBC%SSH_outer_v)) &
1859		call uvchksum("BT_OBC%SSH_outer[uv]", CS%BT_OBC%SSH_outer_u, CS%BT_OBC%SSH_outer_v, CS%debug_BT_HI, &
1860	0	symmetric=.true., omit_corners=.true., unscale=US%Z_to_m, scalar_pair=.true.)
1861	0	if (allocated(CS%BT_OBC%Cg_u) .and. allocated(CS%BT_OBC%Cg_v)) &
1862		call uvchksum("BT_OBC%Cg_[uv]", CS%BT_OBC%Cg_u, CS%BT_OBC%Cg_v, CS%debug_BT_HI, &
1863	0	symmetric=.true., omit_corners=.true., unscale=US%L_T_to_m_s, scalar_pair=.true.)
1864	0	if (allocated(CS%BT_OBC%dZ_u) .and. allocated(CS%BT_OBC%dZ_v)) &
1865		call uvchksum("BT_OBC%dZ_[uv]", CS%BT_OBC%dZ_u, CS%BT_OBC%dZ_v, CS%debug_BT_HI, &
1866	0	symmetric=.true., omit_corners=.true., unscale=US%Z_to_m, scalar_pair=.true.)
1867		endif
1868		endif
1869
1870	48	if (query_averaging_enabled(CS%diag)) then
1871	24	if (CS%id_eta_st > 0) call post_data(CS%id_eta_st, eta(isd:ied,jsd:jed), CS%diag)
1872	24	if (CS%id_ubt_st > 0) call post_data(CS%id_ubt_st, ubt(IsdB:IedB,jsd:jed), CS%diag)
1873	24	if (CS%id_vbt_st > 0) call post_data(CS%id_vbt_st, vbt(isd:ied,JsdB:JedB), CS%diag)
1874		endif
1875
1876	48	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1877	48	if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
1878
1879	48	if (CS%dt_bt_filter >= 0.0) then
1880	0	dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt))
1881		else
1882	48	dt_filt = 0.5 * max(0.0, dt * min(-CS%dt_bt_filter, 2.0))
1883		endif
1884	48	nfilter = ceiling(dt_filt / dtbt)
1885
1886	48	if ( nstep+nfilter<=0 ) call MOM_error(FATAL, &
1887	0	"btstep: number of barotropic step (nstep+nfilter) is 0")
1888	48	if ( CS%bt_limit_integral_transport .and. nstep-nfilter<=0 ) call MOM_error(FATAL, &
1889	0	"btstep: barotropic filter steps too large (nstep-nfilter) is 0")
1890
1891		! Set up the normalized weights for the filtered velocity.
1892	48	sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
1893	48	allocate(wt_vel(nstep+nfilter)) ; allocate(wt_eta(nstep+nfilter))
1894	48	allocate(wt_trans(nstep+nfilter+1)) ; allocate(wt_accel(nstep+nfilter+1))
1895	48	allocate(wt_accel2(nstep+nfilter+1))
1896	576	do n=1,nstep+nfilter
1897		! Modify this to use a different filter...
1898
1899		! This is a filter that ramps down linearly over a time dt_filt.
1900	576	if ( (n==nstep) .or. (dt_filt - abs(n-nstep)*dtbt >= 0.0)) then
1901	144	wt_vel(n) = 1.0 ; wt_eta(n) = 1.0
1902	384	elseif (dtbt + dt_filt - abs(n-nstep)*dtbt > 0.0) then
1903	96	wt_vel(n) = 1.0 + (dt_filt / dtbt) - abs(n-nstep) ; wt_eta(n) = wt_vel(n)
1904		else
1905	288	wt_vel(n) = 0.0 ; wt_eta(n) = 0.0
1906		endif
1907		! This is a simple stepfunction filter.
1908		! if (n < nstep-nfilter) then ; wt_vel(n) = 0.0 ; else ; wt_vel(n) = 1.0 ; endif
1909		! wt_eta(n) = wt_vel(n)
1910
1911		! The rest should not be changed.
1912		enddo
1913		! do sum reduction on CPU to preserve fp summation order (nstep+filter is small)
1914	576	do n=1,nstep+nfilter
1915	576	sum_wt_vel = sum_wt_vel + wt_vel(n) ; sum_wt_eta = sum_wt_eta + wt_eta(n)
1916		enddo
1917	48	wt_trans(nstep+nfilter+1) = 0.0 ; wt_accel(nstep+nfilter+1) = 0.0
1918	576	do n=nstep+nfilter,1,-1
1919	528	wt_trans(n) = wt_trans(n+1) + wt_eta(n)
1920	528	wt_accel(n) = wt_accel(n+1) + wt_vel(n)
1921	576	sum_wt_accel = sum_wt_accel + wt_accel(n) ; sum_wt_trans = sum_wt_trans + wt_trans(n)
1922		enddo
1923		! Normalize the weights.
1924	48	I_sum_wt_vel = 1.0 / sum_wt_vel ; I_sum_wt_accel = 1.0 / sum_wt_accel
1925	48	I_sum_wt_eta = 1.0 / sum_wt_eta ; I_sum_wt_trans = 1.0 / sum_wt_trans
1926	576	do n=1,nstep+nfilter
1927	528	wt_vel(n) = wt_vel(n) * I_sum_wt_vel
1928	528	if (CS%answer_date < 20190101) then
1929	0	wt_accel2(n) = wt_accel(n)
1930		! wt_trans(n) = wt_trans(n) * I_sum_wt_trans
1931		else
1932	528	wt_accel2(n) = wt_accel(n) * I_sum_wt_accel
1933	528	wt_trans(n) = wt_trans(n) * I_sum_wt_trans
1934		endif
1935	528	wt_accel(n) = wt_accel(n) * I_sum_wt_accel
1936	576	wt_eta(n) = wt_eta(n) * I_sum_wt_eta
1937		enddo
1938	48	if (CS%answer_date < 20190101) then
1939		! Recalculate the sum of the weights even that they may have been renormalized already.
1940	0	sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_trans = 0.0 ; sum_wt_accel = 0.0
1941	0	do n=1,nstep+nfilter
1942	0	sum_wt_vel = sum_wt_vel + wt_vel(n)
1943	0	sum_wt_eta = sum_wt_eta + wt_eta(n)
1944	0	sum_wt_accel = sum_wt_accel + wt_accel2(n)
1945	0	sum_wt_trans = sum_wt_trans + wt_trans(n)
1946		enddo
1947	0	I_sum_wt_vel = 1.0 / sum_wt_vel ; I_sum_wt_eta = 1.0 / sum_wt_eta
1948	0	I_sum_wt_accel = 1.0 / sum_wt_accel ; I_sum_wt_trans = 1.0 / sum_wt_trans
1949		else
1950	48	I_sum_wt_vel = 1.0 ; I_sum_wt_eta = 1.0 ; I_sum_wt_accel = 1.0 ; I_sum_wt_trans = 1.0
1951		endif
1952		!$omp target enter data map(to: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2)
1953
1954		! March the barotropic solver through all of its time steps.
1955		call btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL_v, eta_IC, &
1956		eta_PF_1, d_eta_PF, eta_src, dyn_coef_eta, uhbtav, vhbtav, u_accel_bt, v_accel_bt, &
1957		f_4_u, f_4_v, bt_rem_u, bt_rem_v, &
1958		BT_force_u, BT_force_v, Cor_ref_u, Cor_ref_v, Rayleigh_u, Rayleigh_v, &
1959		eta_PF, gtot_E, gtot_W, gtot_N, gtot_S, SpV_col_avg, dgeo_de, &
1960		eta_sum, eta_wtd, ubt_wtd, vbt_wtd, Coru_avg, PFu_avg, LDu_avg, Corv_avg, PFv_avg, &
1961		LDv_avg, use_BT_cont, interp_eta_PF, find_etaav, dt, dtbt, nstep, nfilter, &
1962	48	wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2, ADp, CS%BT_OBC, CS, G, MS, GV, US)
1963
1964		!$omp target exit data map(release: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2)
1965
1966	48	if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
1967	48	if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
1968
1969	48	if (find_etaav) then ; do concurrent (j=js:je, i=is:ie)
1970	175704	etaav(i,j) = eta_sum(i,j) * I_sum_wt_accel
1971		enddo ; endif
1972	5904	do concurrent (j=js-1:je+1, i=is-1:ie+1)
1973	368976	e_anom(i,j) = 0.0
1974		enddo
1975	48	if (interp_eta_PF) then
1976	0	do j=js,je ; do i=is,ie
1977		e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - &
1978	0	(eta_PF_1(i,j) + 0.5*d_eta_PF(i,j)))
1979		enddo ; enddo
1980		else
1981	48	do concurrent (j=js:je, i=is:ie)
1982	351408	e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - eta_PF(i,j))
1983		enddo
1984		endif
1985	48	if (apply_OBCs) then
1986		! This block of code may be unnecessary because e_anom is only used for accelerations that
1987		! are then recalculated at OBC points.
1988	0	if (CS%BT_OBC%u_OBCs_on_PE) then ! copy back the value for u-points on the boundary.
1989	0	do concurrent (j=js:je, I=is-1:ie)
1990	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) e_anom(i+1,j) = e_anom(i,j) ! OBC_DIRECTION_E
1991	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) e_anom(i,j) = e_anom(i+1,j) ! OBC_DIRECTION_W
1992		enddo
1993		endif
1994
1995	0	if (CS%BT_OBC%v_OBCs_on_PE) then ! copy back the value for v-points on the boundary.
1996	0	do concurrent (J=js-1:je, i=is:ie)
1997	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) e_anom(i,j+1) = e_anom(i,j) ! OBC_DIRECTION_N
1998	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) e_anom(i,j) = e_anom(i,j+1) ! OBC_DIRECTION_S
1999		enddo
2000		endif
2001		endif
2002
2003		! Note that it is possible that eta_out and eta_in are the same array.
2004	48	do concurrent (j=js:je, i=is:ie)
2005	351408	eta_out(i,j) = eta_wtd(i,j) * I_sum_wt_eta
2006		enddo
2007
2008		! Accumulator is updated at the end of every baroclinic time step.
2009		! Harmonic analysis will not be performed of a field that is not registered.
2010	48	if (associated(CS%HA_CSp) .and. find_etaav) then
2011	0	call HA_accum('ubt', ubt, CS%Time, G, CS%HA_CSp)
2012	0	call HA_accum('vbt', vbt, CS%Time, G, CS%HA_CSp)
2013		endif
2014
2015	48	if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2016	48	if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
2017	48	if (G%nonblocking_updates) then
2018		!$omp target update from(e_anom)
2019	0	call start_group_pass(CS%pass_e_anom, G%Domain)
2020		else
2021	48	if (find_etaav) call do_group_pass(CS%pass_etaav, G%Domain)
2022	48	call do_group_pass(CS%pass_e_anom, G%Domain, omp_offload=.true.)
2023		endif
2024	48	if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
2025	48	if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
2026
2027		! Find or store the weighted time-mean velocities and transports.
2028	48	if (CS%answer_date < 20190101) then
2029	0	do concurrent (j=js:je, I=is-1:ie)
2030	0	CS%ubtav(I,j) = CS%ubtav(I,j) * I_sum_wt_trans
2031	0	uhbtav(I,j) = uhbtav(I,j) * I_sum_wt_trans
2032	0	ubt_wtd(I,j) = ubt_wtd(I,j) * I_sum_wt_vel
2033		enddo
2034
2035	0	do concurrent (J=js-1:je, i=is:ie)
2036	0	CS%vbtav(i,J) = CS%vbtav(i,J) * I_sum_wt_trans
2037	0	vhbtav(i,J) = vhbtav(i,J) * I_sum_wt_trans
2038	0	vbt_wtd(i,J) = vbt_wtd(i,J) * I_sum_wt_vel
2039		enddo
2040		endif
2041
2042	48	if (CS%use_filter .and. CS%linear_freq_drag) then ! Apply frequency-dependent drag
2043	0	do concurrent (j=js:je, I=is-1:ie)
2044	0	u_accel_bt(I,j) = u_accel_bt(I,j) - Drag_u(I,j)
2045		enddo
2046	0	do concurrent (J=js-1:je, i=is:ie)
2047	0	v_accel_bt(i,J) = v_accel_bt(i,J) - Drag_v(i,J)
2048		enddo
2049
2050	0	if ((CS%id_LDu_bt > 0) .or. (associated(ADp%bt_lwd_u))) then
2051	0	do concurrent (j=js:je, I=is-1:ie)
2052	0	LDu_avg(I,j) = LDu_avg(I,j) - Drag_u(I,j)
2053		enddo
2054		endif
2055	0	if ((CS%id_LDv_bt > 0) .or. (associated(ADp%bt_lwd_v))) then
2056	0	do concurrent (J=js-1:je, i=is:ie)
2057	0	LDv_avg(i,J) = LDv_avg(i,J) - Drag_v(i,J)
2058		enddo
2059		endif
2060		endif
2061
2062	48	if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2063	48	if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
2064	48	if (G%nonblocking_updates) then
2065	0	call complete_group_pass(CS%pass_e_anom, G%Domain)
2066	0	if (find_etaav) call start_group_pass(CS%pass_etaav, G%Domain)
2067	0	call start_group_pass(CS%pass_ubta_uhbta, G%DoMain)
2068		!$omp target update to(e_anom)
2069		else
2070	48	call do_group_pass(CS%pass_ubta_uhbta, G%Domain, omp_offload=.true.)
2071		endif
2072	48	if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
2073	48	if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
2074
2075	48	if (CS%strong_drag .and. CS%rescale_strong_drag) then
2076	0	do j=js,je ; do I=is-1,ie
2077	0	if (G%mask2dCu(I,j) * av_rem_u(I,j) > 0.0) &
2078	0	u_accel_bt(I,j) = u_accel_bt(I,j) * min(bt_rem_u(I,j)**nstep / av_rem_u(I,j), 1.0)
2079		enddo ; enddo
2080	0	do J=js-1,je ; do i=is,ie
2081	0	if (G%mask2dCv(i,J) * av_rem_v(i,J) > 0.0) &
2082	0	v_accel_bt(i,J) = v_accel_bt(i,J) * min(bt_rem_v(i,J)**nstep / av_rem_v(i,J), 1.0)
2083		enddo ; enddo
2084		endif
2085
2086		! Now calculate each layer's accelerations.
2087		call btstep_layer_accel(dt, u_accel_bt, v_accel_bt, pbce, gtot_E, gtot_W, gtot_N, gtot_S, &
2088	48	e_anom, G, GV, CS, accel_layer_u, accel_layer_v)
2089
2090	48	if (apply_OBCs) then
2091		! Correct the accelerations at OBC velocity points, but only in the
2092		! symmetric-memory computational domain, not in the wide halo regions.
2093	0	if (CS%BT_OBC%u_OBCs_on_PE) then ; do j=js,je ; do I=is-1,ie
2094	0	if (CS%BT_OBC%u_OBC_type(I,j) /= 0) then
2095	0	u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_st(I,j)) / dt
2096	0	do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo
2097		endif
2098		enddo ; enddo ; endif
2099	0	if (CS%BT_OBC%v_OBCs_on_PE) then ; do J=js-1,je ; do i=is,ie
2100	0	if (CS%BT_OBC%v_OBC_type(i,J) /= 0) then
2101	0	v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_st(i,J)) / dt
2102	0	do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo
2103		endif
2104		enddo ; enddo ; endif
2105		endif
2106
2107	48	if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2108
2109		! Calculate diagnostic quantities.
2110	48	if (query_averaging_enabled(CS%diag)) then
2111
2112	24	if (CS%gradual_BT_ICs) then
2113	0	do concurrent (j=js:je, I=is-1:ie)
2114	0	CS%ubt_IC(I,j) = ubt_wtd(I,j)
2115		enddo
2116	0	do concurrent (J=js-1:je, i=is:ie)
2117	0	CS%vbt_IC(i,J) = vbt_wtd(i,J)
2118		enddo
2119		endif
2120
2121		! Calculate various time-averaged barotropic diagnostics.
2122	24	if (CS%answer_date >= 20190101) then
2123	24	if (CS%id_PFu_bt > 0) call post_data(CS%id_PFu_bt, PFu_avg, CS%diag)
2124	24	if (CS%id_PFv_bt > 0) call post_data(CS%id_PFv_bt, PFv_avg, CS%diag)
2125	24	if (CS%id_Coru_bt > 0) call post_data(CS%id_Coru_bt, Coru_avg, CS%diag)
2126	24	if (CS%id_Corv_bt > 0) call post_data(CS%id_Corv_bt, Corv_avg, CS%diag)
2127	24	if (CS%id_LDu_bt > 0) call post_data(CS%id_LDu_bt, LDu_avg, CS%diag)
2128	24	if (CS%id_LDv_bt > 0) call post_data(CS%id_LDv_bt, LDv_avg, CS%diag)
2129		else ! if (CS%answer_date < 20190101) then
2130	0	if (CS%id_PFu_bt > 0) then
2131	0	do concurrent (j=js:je, I=is-1:ie)
2132	0	PFu_avg(I,j) = PFu_avg(I,j) * I_sum_wt_accel
2133		enddo
2134		!$omp target update from(PFu_avg)
2135	0	call post_data(CS%id_PFu_bt, PFu_avg, CS%diag)
2136		endif
2137	0	if (CS%id_PFv_bt > 0) then
2138	0	do concurrent (J=js-1:je, i=is:ie)
2139	0	PFv_avg(i,J) = PFv_avg(i,J) * I_sum_wt_accel
2140		enddo
2141		!$omp target update from(PFv_avg)
2142	0	call post_data(CS%id_PFv_bt, PFv_avg, CS%diag)
2143		endif
2144	0	if (CS%id_Coru_bt > 0) then
2145	0	do concurrent (j=js:je, I=is-1:ie)
2146	0	Coru_avg(I,j) = Coru_avg(I,j) * I_sum_wt_accel
2147		enddo
2148		!$omp target update from(Coru_avg)
2149	0	call post_data(CS%id_Coru_bt, Coru_avg, CS%diag)
2150		endif
2151	0	if (CS%id_Corv_bt > 0) then
2152	0	do concurrent (J=js-1:je, i=is:ie)
2153	0	Corv_avg(i,J) = Corv_avg(i,J) * I_sum_wt_accel
2154		enddo
2155		!$omp target update from(Corv_avg)
2156	0	call post_data(CS%id_Corv_bt, Corv_avg, CS%diag)
2157		endif
2158		endif
2159
2160		! Diagnostics for time tendency
2161	24	if (CS%id_ubtdt > 0) then
2162	0	do concurrent (j=js:je, I=is-1:ie)
2163	0	ubt_dt(I,j) = (ubt_wtd(I,j) - ubt_st(I,j))*Idt
2164		enddo
2165	0	call post_data(CS%id_ubtdt, ubt_dt(IsdB:IedB,jsd:jed), CS%diag)
2166		endif
2167	24	if (CS%id_vbtdt > 0) then
2168	0	do concurrent (J=js-1:je, i=is:ie)
2169	0	vbt_dt(i,J) = (vbt_wtd(i,J) - vbt_st(i,J))*Idt
2170		enddo
2171	0	call post_data(CS%id_vbtdt, vbt_dt(isd:ied,JsdB:JedB), CS%diag)
2172		endif
2173
2174		! Copy decomposed barotropic accelerations to ADp
2175	24	if (associated(ADp%bt_pgf_u)) then
2176		! Note that CS%IdxCu is 0 at OBC points, so ADp%bt_pgf_u is zeroed out there.
2177	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
2178		ADp%bt_pgf_u(I,j,k) = PFu_avg(I,j) - &
2179		(((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j)) - &
2180	0	((pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j))) * CS%IdxCu(I,j)
2181		enddo
2182		endif
2183	24	if (associated(ADp%bt_pgf_v)) then
2184		! Note that CS%IdyCv is 0 at OBC points, so ADp%bt_pgf_v is zeroed out there.
2185	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
2186		ADp%bt_pgf_v(i,J,k) = PFv_avg(i,J) - &
2187		(((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1)) - &
2188	0	((pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j))) * CS%IdyCv(i,J)
2189		enddo
2190		endif
2191
2192	24	if (associated(ADp%bt_cor_u)) then ; do concurrent (j=js:je, I=is-1:ie)
2193	0	ADp%bt_cor_u(I,j) = Coru_avg(I,j)
2194		enddo ; endif
2195	24	if (associated(ADp%bt_cor_v)) then ; do concurrent (J=js-1:je, i=is:ie)
2196	0	ADp%bt_cor_v(i,J) = Corv_avg(i,J)
2197		enddo ; endif
2198
2199	24	if (associated(ADp%bt_lwd_u)) then ; do concurrent (j=js:je, I=is-1:ie)
2200	0	ADp%bt_lwd_u(I,j) = LDu_avg(I,j)
2201		enddo ; endif
2202	24	if (associated(ADp%bt_lwd_v)) then ; do concurrent (J=js-1:je, i=is:ie)
2203	0	ADp%bt_lwd_v(i,J) = LDv_avg(i,J)
2204		enddo ; endif
2205
2206	24	if (CS%id_ubtforce > 0) call post_data(CS%id_ubtforce, BT_force_u(IsdB:IedB,jsd:jed), CS%diag)
2207	24	if (CS%id_vbtforce > 0) call post_data(CS%id_vbtforce, BT_force_v(isd:ied,JsdB:JedB), CS%diag)
2208	24	if (CS%id_uaccel > 0) call post_data(CS%id_uaccel, u_accel_bt(IsdB:IedB,jsd:jed), CS%diag)
2209	24	if (CS%id_vaccel > 0) call post_data(CS%id_vaccel, v_accel_bt(isd:ied,JsdB:JedB), CS%diag)
2210
2211	24	if (CS%id_eta_cor > 0) call post_data(CS%id_eta_cor, CS%eta_cor, CS%diag)
2212	24	if (CS%id_eta_bt > 0) call post_data(CS%id_eta_bt, eta_out, CS%diag) ! - G%Z_ref?
2213	24	if (CS%id_gtotn > 0) call post_data(CS%id_gtotn, gtot_N(isd:ied,jsd:jed), CS%diag)
2214	24	if (CS%id_gtots > 0) call post_data(CS%id_gtots, gtot_S(isd:ied,jsd:jed), CS%diag)
2215	24	if (CS%id_gtote > 0) call post_data(CS%id_gtote, gtot_E(isd:ied,jsd:jed), CS%diag)
2216	24	if (CS%id_gtotw > 0) call post_data(CS%id_gtotw, gtot_W(isd:ied,jsd:jed), CS%diag)
2217	24	if (CS%id_ubt > 0) call post_data(CS%id_ubt, ubt_wtd(IsdB:IedB,jsd:jed), CS%diag)
2218	24	if (CS%id_vbt > 0) call post_data(CS%id_vbt, vbt_wtd(isd:ied,JsdB:JedB), CS%diag)
2219	24	if (CS%id_ubtav > 0) call post_data(CS%id_ubtav, CS%ubtav, CS%diag)
2220	24	if (CS%id_vbtav > 0) call post_data(CS%id_vbtav, CS%vbtav, CS%diag)
2221	24	if (CS%id_visc_rem_u > 0) call post_data(CS%id_visc_rem_u, visc_rem_u, CS%diag)
2222	24	if (CS%id_visc_rem_v > 0) call post_data(CS%id_visc_rem_v, visc_rem_v, CS%diag)
2223
2224	24	if (CS%id_frhatu > 0) call post_data(CS%id_frhatu, CS%frhatu, CS%diag)
2225	24	if (CS%id_uhbt > 0) call post_data(CS%id_uhbt, uhbtav, CS%diag)
2226	24	if (CS%id_frhatv > 0) call post_data(CS%id_frhatv, CS%frhatv, CS%diag)
2227	24	if (CS%id_vhbt > 0) call post_data(CS%id_vhbt, vhbtav, CS%diag)
2228	24	if (CS%id_uhbt0 > 0) call post_data(CS%id_uhbt0, uhbt0(IsdB:IedB,jsd:jed), CS%diag)
2229	24	if (CS%id_vhbt0 > 0) call post_data(CS%id_vhbt0, vhbt0(isd:ied,JsdB:JedB), CS%diag)
2230
2231	24	if (CS%id_frhatu1 > 0) call post_data(CS%id_frhatu1, CS%frhatu1, CS%diag)
2232	24	if (CS%id_frhatv1 > 0) call post_data(CS%id_frhatv1, CS%frhatv1, CS%diag)
2233
2234	24	if (CS%id_bt_rem_u > 0) call post_data(CS%id_bt_rem_u, bt_rem_u(IsdB:IedB,jsd:jed), CS%diag)
2235	24	if (CS%id_bt_rem_v > 0) call post_data(CS%id_bt_rem_v, bt_rem_v(isd:ied,JsdB:JedB), CS%diag)
2236	24	if (CS%id_etaPF_anom > 0) call post_data(CS%id_etaPF_anom, e_anom(isd:ied,jsd:jed), CS%diag)
2237
2238	24	if (use_BT_cont) then
2239	24	if (CS%id_BTC_FA_u_EE > 0) call post_data(CS%id_BTC_FA_u_EE, BT_cont%FA_u_EE, CS%diag)
2240	24	if (CS%id_BTC_FA_u_E0 > 0) call post_data(CS%id_BTC_FA_u_E0, BT_cont%FA_u_E0, CS%diag)
2241	24	if (CS%id_BTC_FA_u_W0 > 0) call post_data(CS%id_BTC_FA_u_W0, BT_cont%FA_u_W0, CS%diag)
2242	24	if (CS%id_BTC_FA_u_WW > 0) call post_data(CS%id_BTC_FA_u_WW, BT_cont%FA_u_WW, CS%diag)
2243	24	if (CS%id_BTC_uBT_EE > 0) call post_data(CS%id_BTC_uBT_EE, BT_cont%uBT_EE, CS%diag)
2244	24	if (CS%id_BTC_uBT_WW > 0) call post_data(CS%id_BTC_uBT_WW, BT_cont%uBT_WW, CS%diag)
2245	24	if (CS%id_BTC_FA_u_rat0 > 0) then
2246	0	tmp_u(:,:) = 0.0
2247	0	do j=js,je ; do I=is-1,ie
2248	0	if ((G%mask2dCu(I,j) > 0.0) .and. (BT_cont%FA_u_W0(I,j) > 0.0)) then
2249	0	tmp_u(I,j) = (BT_cont%FA_u_E0(I,j)/ BT_cont%FA_u_W0(I,j))
2250		else
2251	0	tmp_u(I,j) = 1.0
2252		endif
2253		enddo ; enddo
2254	0	call post_data(CS%id_BTC_FA_u_rat0, tmp_u, CS%diag)
2255		endif
2256	24	if (CS%id_BTC_FA_v_NN > 0) call post_data(CS%id_BTC_FA_v_NN, BT_cont%FA_v_NN, CS%diag)
2257	24	if (CS%id_BTC_FA_v_N0 > 0) call post_data(CS%id_BTC_FA_v_N0, BT_cont%FA_v_N0, CS%diag)
2258	24	if (CS%id_BTC_FA_v_S0 > 0) call post_data(CS%id_BTC_FA_v_S0, BT_cont%FA_v_S0, CS%diag)
2259	24	if (CS%id_BTC_FA_v_SS > 0) call post_data(CS%id_BTC_FA_v_SS, BT_cont%FA_v_SS, CS%diag)
2260	24	if (CS%id_BTC_vBT_NN > 0) call post_data(CS%id_BTC_vBT_NN, BT_cont%vBT_NN, CS%diag)
2261	24	if (CS%id_BTC_vBT_SS > 0) call post_data(CS%id_BTC_vBT_SS, BT_cont%vBT_SS, CS%diag)
2262	24	if (CS%id_BTC_FA_v_rat0 > 0) then
2263	0	tmp_v(:,:) = 0.0
2264	0	do J=js-1,je ; do i=is,ie
2265	0	if ((G%mask2dCv(i,J) > 0.0) .and. (BT_cont%FA_v_S0(i,J) > 0.0)) then
2266	0	tmp_v(i,J) = (BT_cont%FA_v_N0(i,J)/ BT_cont%FA_v_S0(i,J))
2267		else
2268	0	tmp_v(i,J) = 1.0
2269		endif
2270		enddo ; enddo
2271	0	call post_data(CS%id_BTC_FA_v_rat0, tmp_v, CS%diag)
2272		endif
2273	24	if (CS%id_BTC_FA_h_rat0 > 0) then
2274	0	tmp_h(:,:) = 0.0
2275	0	do j=js,je ; do i=is,ie
2276	0	tmp_h(i,j) = 1.0
2277	0	if ((G%mask2dCu(I,j) > 0.0) .and. (BT_cont%FA_u_W0(I,j) > 0.0) .and. (BT_cont%FA_u_E0(I,j) > 0.0)) then
2278	0	if (BT_cont%FA_u_W0(I,j) > BT_cont%FA_u_E0(I,j)) then
2279	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_u_W0(I,j)/ BT_cont%FA_u_E0(I,j)))
2280		else
2281	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_u_E0(I,j)/ BT_cont%FA_u_W0(I,j)))
2282		endif
2283		endif
2284	0	if ((G%mask2dCu(I-1,j) > 0.0) .and. (BT_cont%FA_u_W0(I-1,j) > 0.0) .and. (BT_cont%FA_u_E0(I-1,j) > 0.0)) then
2285	0	if (BT_cont%FA_u_W0(I-1,j) > BT_cont%FA_u_E0(I-1,j)) then
2286	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_u_W0(I-1,j)/ BT_cont%FA_u_E0(I-1,j)))
2287		else
2288	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_u_E0(I-1,j)/ BT_cont%FA_u_W0(I-1,j)))
2289		endif
2290		endif
2291	0	if ((G%mask2dCv(i,J) > 0.0) .and. (BT_cont%FA_v_S0(i,J) > 0.0) .and. (BT_cont%FA_v_N0(i,J) > 0.0)) then
2292	0	if (BT_cont%FA_v_S0(i,J) > BT_cont%FA_v_N0(i,J)) then
2293	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_v_S0(i,J)/ BT_cont%FA_v_N0(i,J)))
2294		else
2295	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_v_N0(i,J)/ BT_cont%FA_v_S0(i,J)))
2296		endif
2297		endif
2298	0	if ((G%mask2dCv(i,J-1) > 0.0) .and. (BT_cont%FA_v_S0(i,J-1) > 0.0) .and. (BT_cont%FA_v_N0(i,J-1) > 0.0)) then
2299	0	if (BT_cont%FA_v_S0(i,J-1) > BT_cont%FA_v_N0(i,J-1)) then
2300	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_v_S0(i,J-1)/ BT_cont%FA_v_N0(i,J-1)))
2301		else
2302	0	tmp_h(i,j) = max(tmp_h(i,j), (BT_cont%FA_v_N0(i,J-1)/ BT_cont%FA_v_S0(i,J-1)))
2303		endif
2304		endif
2305		enddo ; enddo
2306	0	call post_data(CS%id_BTC_FA_h_rat0, tmp_h, CS%diag)
2307		endif
2308		endif
2309
2310	24	if (CS%id_SSH_u_OBC > 0) call post_data(CS%id_SSH_u_OBC, CS%BT_OBC%SSH_outer_u(IsdB:IedB,jsd:jed), CS%diag)
2311	24	if (CS%id_SSH_v_OBC > 0) call post_data(CS%id_SSH_v_OBC, CS%BT_OBC%SSH_outer_v(isd:ied,JsdB:JedB), CS%diag)
2312	24	if (CS%id_ubt_OBC > 0) call post_data(CS%id_ubt_OBC, CS%BT_OBC%ubt_outer(IsdB:IedB,jsd:jed), CS%diag)
2313	24	if (CS%id_vbt_OBC > 0) call post_data(CS%id_vbt_OBC, CS%BT_OBC%vbt_outer(isd:ied,JsdB:JedB), CS%diag)
2314		else
2315	24	if (CS%id_frhatu1 > 0) then
2316		!$omp target update from(CS%frhatu)
2317	0	CS%frhatu1(:,:,:) = CS%frhatu(:,:,:)
2318		endif
2319	24	if (CS%id_frhatv1 > 0) then
2320		!$omp target update from(CS%frhatv)
2321	0	CS%frhatv1(:,:,:) = CS%frhatv(:,:,:)
2322		endif
2323		endif
2324
2325	48	if (associated(ADp%diag_hfrac_u)) then
2326	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
2327	0	ADp%diag_hfrac_u(I,j,k) = CS%frhatu(I,j,k)
2328		enddo
2329		endif
2330	48	if (associated(ADp%diag_hfrac_v)) then
2331	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
2332	0	ADp%diag_hfrac_v(i,J,k) = CS%frhatv(i,J,k)
2333		enddo
2334		endif
2335
2336	48	if (use_BT_cont .and. associated(ADp%diag_hu)) then
2337	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
2338	0	ADp%diag_hu(I,j,k) = BT_cont%h_u(I,j,k)
2339		enddo
2340		endif
2341	48	if (use_BT_cont .and. associated(ADp%diag_hv)) then
2342	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
2343	0	ADp%diag_hv(i,J,k) = BT_cont%h_v(i,J,k)
2344		enddo
2345		endif
2346	48	if (associated(ADp%visc_rem_u)) then
2347	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
2348	0	ADp%visc_rem_u(I,j,k) = visc_rem_u(I,j,k)
2349		enddo
2350		endif
2351	48	if (associated(ADp%visc_rem_v)) then
2352	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
2353	0	ADp%visc_rem_v(i,J,k) = visc_rem_v(i,J,k)
2354		enddo
2355		endif
2356
2357	48	if (G%nonblocking_updates) then
2358	0	if (find_etaav) call complete_group_pass(CS%pass_etaav, G%Domain)
2359	0	call complete_group_pass(CS%pass_ubta_uhbta, G%Domain)
2360		endif
2361
2362		!$omp target exit data &
2363		!$omp map(release: ubt_Cor, vbt_Cor, wt_u, wt_v, av_rem_u, av_rem_v, ubt_wtd, vbt_wtd, Coru_avg, &
2364		!$omp Corv_avg, LDu_avg, LDv_avg, e_anom, q, ubt, vbt, bt_rem_u, bt_rem_v, BT_force_u, &
2365		!$omp BT_force_v, u_accel_bt, v_accel_bt, uhbt, vhbt, uhbt0, vhbt0, &
2366		!$omp Cor_ref_u, Cor_ref_v, DCor_u, DCor_v, &
2367		!$omp Datu, Datv, f_4_u, f_4_v, eta, eta_sum, eta_wtd, eta_IC, eta_PF, eta_PF_1, &
2368		!$omp d_eta_PF, gtot_E, gtot_W, gtot_N, gtot_S, eta_src, dyn_coef_eta, BTCL_u, BTCL_v, &
2369		!$omp PFu_avg, PFv_avg)
2370
2371	48	deallocate(wt_vel, wt_eta, wt_trans, wt_accel, wt_accel2)
2372
2373	120	end subroutine btstep
2374
2375		!> Update the barotropic solver through multiple time steps.
2376	48	subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL_v, eta_IC, &
2377	48	eta_PF_1, d_eta_PF, eta_src, dyn_coef_eta, uhbtav, vhbtav, u_accel_bt, v_accel_bt, &
2378	48	f_4_u, f_4_v, bt_rem_u, bt_rem_v, &
2379	48	BT_force_u, BT_force_v, Cor_ref_u, Cor_ref_v, Rayleigh_u, Rayleigh_v, &
2380	48	eta_PF, gtot_E, gtot_W, gtot_N, gtot_S, SpV_col_avg, dgeo_de, &
2381	48	eta_sum, eta_wtd, ubt_wtd, vbt_wtd, Coru_avg, PFu_avg, LDu_avg, Corv_avg, PFv_avg, &
2382	48	LDv_avg, use_BT_cont, interp_eta_PF, find_etaav, dt, dtbt, nstep, nfilter, &
2383	48	wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2, ADp, BT_OBC, CS, G, MS, GV, US)
2384
2385		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
2386		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (inout to allow for halo updates)
2387		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
2388		!! the argument arrays.
2389		real, dimension(SZIW_(CS),SZJW_(CS)), target, intent(inout) :: &
2390		eta !< The barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2]
2391		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
2392		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1]
2393		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
2394		vbt !< The meridional barotropic velocity [L T-1 ~> m s-1]
2395		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
2396		uhbt0 !< The difference between the sum of the layer zonal thickness flux and the
2397		!! barotropic thickness flux using the same velocity [H L2 T-1 ~> m3 s-1 or kg s-1]
2398		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
2399		Datu !< Basin depth at u-velocity grid points times the y-grid spacing [H L ~> m2 or kg m-1]
2400		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: &
2401		BTCL_u !< Structure of information used for a dynamic estimate of the face areas at u-points.
2402		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
2403		vhbt0 !< The difference between the sum of the layer meridional thickness flux and the
2404		!! barotropic thickness flux using the same velocity [H L2 T-1 ~> m3 s-1 or kg s-1]
2405		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
2406		Datv !< Basin depth at v-velocity grid points times the x-grid spacing [H L ~> m2 or kg m-1]
2407		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: &
2408		BTCL_v !< Structure of information used for a dynamic estimate of the face areas at v-points
2409		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2410		eta_IC !< A local copy of the initial 2-D eta field (eta_in) [H ~> m or kg m-2]
2411		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2412		eta_PF_1 !< The initial value of eta_PF, when interp_eta_PF is true [H ~> m or kg m-2]
2413		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2414		d_eta_PF !< The change in eta_PF over the barotropic time stepping when
2415		!! interp_eta_PF is true [H ~> m or kg m-2]
2416		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2417		eta_src !< The source of eta per barotropic timestep [H ~> m or kg m-2]
2418		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2419		dyn_coef_eta !< The coefficient relating the changes in eta to the dynamic surface pressure
2420		!! under rigid ice [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
2421		real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: &
2422		uhbtav !< the barotropic zonal volume or mass fluxes averaged through the barotropic
2423		!! steps [H L2 T-1 ~> m3 s-1 or kg s-1].
2424		real, dimension(SZI_(G),SZJB_(G)), intent(out) :: &
2425		vhbtav !< the barotropic meridional volume or mass fluxes averaged through the barotropic
2426		!! steps [H L2 T-1 ~> m3 s-1 or kg s-1].
2427		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
2428		u_accel_bt !! The difference between the zonal acceleration from the
2429		!< barotropic calculation and BT_force_v [L T-2 ~> m s-2].
2430		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
2431		v_accel_bt !< The difference between the meridional acceleration from the
2432		!! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
2433		real, dimension(4,SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
2434		f_4_u !< The terms giving the contribution to the Coriolis acceleration at a zonal
2435		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
2436		!! These are the products of thicknesses at v points and appropriately staggered
2437		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
2438		!! they are approximately f / 4. The 4 values on the innermost loop are for
2439		!! v-velocities to the southwest, southeast, northwest and northeast.
2440		real, dimension(4,SZIW_(CS),SZJBW_(CS)), intent(in) :: &
2441		f_4_v !< The terms giving the contribution to the Coriolis acceleration at a meridional
2442		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
2443		!! These are the products of thicknesses at u points and appropriately staggered
2444		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
2445		!! they are approximately f / 4. The 4 values on the innermost loop are for
2446		!! u-velocities to the southwest, southeast, northwest and northeast.
2447		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
2448		bt_rem_u !< The fraction of the barotropic zonal velocity that remains after a time step,
2449		!! the rest being lost to bottom drag [nondim]. bt_rem_v is between 0 and 1.
2450		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
2451		bt_rem_v !< The fraction of the barotropic meridional velocity that remains after a time step,
2452		!! the rest being lost to bottom drag [nondim]. bt_rem_v is between 0 and 1.
2453		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
2454		BT_force_u !< The vertical average of all of the v-accelerations that are
2455		!! not explicitly included in the barotropic equation [L T-2 ~> m s-2]
2456		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
2457		BT_force_v !< The vertical average of all of the v-accelerations that are
2458		!! not explicitly included in the barotropic equation [L T-2 ~> m s-2]
2459		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
2460		Cor_ref_u !< The meridional barotropic Coriolis acceleration due
2461		!! to the reference velocities [L T-2 ~> m s-2].
2462		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
2463		Cor_ref_v !< The meridional barotropic Coriolis acceleration due
2464		!! to the reference velocities [L T-2 ~> m s-2].
2465		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
2466		Rayleigh_u !< A Rayleigh drag timescale operating at u-points for drag parameterizations
2467		!! that introduced directly into the barotropic solver rather than coming
2468		!! in via the visc_rem_u arrays from the layered equations [T-1 ~> s-1]
2469		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
2470		Rayleigh_v !< A Rayleigh drag timescale operating at v-points for drag parameterizations
2471		!! that introduced directly into the barotropic solver rather than coming
2472		!! in via the visc_rem_v arrays from the layered equations [T-1 ~> s-1]
2473		real, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
2474		eta_PF !< The 2-D eta field (either SSH anomaly or column mass anomaly) that was used to
2475		!! calculate the input pressure gradient accelerations [H ~> m or kg m-2]
2476		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2477		gtot_E !< The effective total reduced gravity used to relate free surface height
2478		!! deviations to pressure forces (including GFS and baroclinic contributions)
2479		!! in the barotropic momentum equations half a grid-point to the east of a
2480		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
2481		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2482		gtot_W !< The effective total reduced gravity used to relate free surface height
2483		!! deviations to pressure forces (including GFS and baroclinic contributions)
2484		!! in the barotropic momentum equations half a grid-point to the west of a
2485		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
2486		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E and gtot_W.)
2487		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2488		gtot_N !< The effective total reduced gravity used to relate free surface height
2489		!! deviations to pressure forces (including GFS and baroclinic contributions)
2490		!! in the barotropic momentum equations half a grid-point to the north of a
2491		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
2492		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
2493		gtot_S !< The effective total reduced gravity used to relate free surface height
2494		!! deviations to pressure forces (including GFS and baroclinic contributions)
2495		!! in the barotropic momentum equations half a grid-point to the south of a
2496		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]
2497		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E and gtot_W.)
2498		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: &
2499		SpV_col_avg !< The column average specific volume [R-1 ~> m3 kg-1]
2500		real, intent(in) :: dgeo_de !< The constant of proportionality between geopotential and
2501		!! sea surface height [nondim]. It is of order 1, but for stability this
2502		!! may be made larger than the physical problem would suggest.
2503		real, dimension(SZIW_(CS),SZJW_(CS)), intent(out) :: &
2504		eta_sum !< eta summed across the timesteps [H ~> m or kg m-2]
2505		real, dimension(SZIW_(CS),SZJW_(CS)), intent(out) :: &
2506		eta_wtd !< A weighted estimate used to calculate eta_out [H ~> m or kg m-2]
2507		real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: &
2508		ubt_wtd !< A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1]
2509		real, dimension(SZI_(G),SZJB_(G)), intent(out) :: &
2510		vbt_wtd !< A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1]
2511		real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: &
2512		Coru_avg !< The average zonal barotropic Coriolis acceleration [L T-2 ~> m s-2]
2513		real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: &
2514		PFu_avg !< The average zonal barotropic pressure gradient force [L T-2 ~> m s-2]
2515		real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: &
2516		LDu_avg !< The average zonal barotropic linear wave drag acceleration [L T-2 ~> m s-2]
2517		real, dimension(SZI_(G),SZJB_(G)), intent(out) :: &
2518		Corv_avg !< The average meridional barotropic Coriolis acceleration [L T-2 ~> m s-2]
2519		real, dimension(SZI_(G),SZJB_(G)), intent(out) :: &
2520		PFv_avg !< The average meridional barotropic pressure gradient force [L T-2 ~> m s-2]
2521		real, dimension(SZI_(G),SZJB_(G)), intent(out) :: &
2522		LDv_avg !< The average meridional barotropic linear wave drag acceleration [L T-2 ~> m s-2]
2523		logical, intent(in) :: use_BT_cont !< If true, use the information in the bt_cont_types to
2524		!! calculate the mass transports
2525		logical, intent(in) :: interp_eta_PF !< If true, interpolate the reference value of eta used
2526		!! to calculate the pressure force with time.
2527		logical, intent(in) :: find_etaav !< If true, diagnose the time mean value of eta
2528		real, intent(in) :: dt !< The time increment to integrate over [T ~> s]
2529		real, intent(in) :: dtbt !< The barotropic time step [T ~> s]
2530		integer, intent(in) :: nstep !< The number of barotropic time steps to take to cover the specified time interval
2531		integer, intent(in) :: nfilter !< The number of extra barotropic steps to take to allow for time filtering
2532		real, dimension(nstep+nfilter), intent(in) :: &
2533		wt_vel !< The raw or relative weights of each of the barotropic timesteps
2534		!! in determining the average velocities [nondim]
2535		real, dimension(nstep+nfilter), intent(in) :: &
2536		wt_eta !< The raw or relative weights of each of the barotropic timesteps
2537		!! in determining the average eta [nondim]
2538		real, dimension(nstep+nfilter+1), intent(in) :: &
2539		wt_accel !< The raw or relative weights of each of the barotropic timesteps
2540		!! in determining the average accelerations [nondim]
2541		real, dimension(nstep+nfilter+1), intent(in) :: &
2542		wt_trans !< The raw or relative weights of each of the barotropic timesteps
2543		!! in determining the average transports [nondim]
2544		real, dimension(nstep+nfilter+1), intent(in) :: &
2545		wt_accel2 !< Potentially un-normalized relative weights of each of the
2546		!! barotropic timesteps in determining the average accelerations [nondim]
2547		type(accel_diag_ptrs), pointer :: ADp !< Acceleration diagnostic pointers
2548		type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
2549		!! related to the open boundary conditions,
2550		!! with time evolving data stored via set_up_BT_OBC
2551		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
2552		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
2553
2554		! Local variables
2555		real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
2556	96	uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]
2557	96	ubt_prev, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1]
2558	96	ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]
2559	96	PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2]
2560	96	Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]
2561	96	ubt_int, & ! The running time integral of ubt over the time steps [L ~> m]
2562	96	uhbt_int, & ! The running time integral of uhbt over the time steps [H L2 ~> m3 or kg]
2563	96	ubt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m]
2564	96	uhbt_int_prev ! Previous value of time-integrated transport stored for integral_BT_cont [H L2 ~> m3 or kg]
2565		real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
2566	96	vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]
2567	96	vbt_prev, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1]
2568	96	vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1]
2569	96	PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2]
2570	96	Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2]
2571	96	vbt_int, & ! The running time integral of vbt over the time steps [L ~> m]
2572	96	vhbt_int, & ! The running time integral of vhbt over the time steps [H L2 ~> m3 or kg]
2573	96	vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m]
2574	96	vhbt_int_prev ! Previous value of time-integrated transport stored for integral_BT_cont [H L2 ~> m3 or kg]
2575		real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
2576	96	eta_pred ! A predictor value of eta [H ~> m or kg m-2] like eta
2577		real, dimension(SZIW_(CS),SZJW_(CS)) :: &
2578	96	p_surf_dyn, & !< A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2]
2579	96	cfl_ltd_vol !< The volume available after removing sinks used to limit uhbt_int and vhbt_int [H L2 ~> m3 or kg]
2580		real, dimension(SZI_(G),SZJ_(G)) :: &
2581	96	eta_anom_PF ! The eta anomalies used to find the pressure force anomalies [H ~> m or kg m-2]
2582		real :: wt_end ! The weighting of the final value of eta_PF [nondim]
2583		real :: Instep ! The inverse of the number of barotropic time steps to take [nondim]
2584		real :: trans_wt1, trans_wt2 ! The weights used to compute ubt_trans and vbt_trans [nondim]
2585		real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1]
2586		type(time_type) :: &
2587		time_bt_start, & ! The starting time of the barotropic steps.
2588		time_step_end, & ! The end time of a barotropic step.
2589		time_end_in ! The end time for diagnostics when this routine started.
2590		real :: dtbt_diag ! The nominal barotropic time step used in hifreq diagnostics [T ~> s]
2591		! dtbt_diag = dt/(nstep+nfilter)
2592		real :: time_int_in ! The diagnostics' time interval when this routine started [s]
2593		real :: be_proj ! The fractional amount by which velocities are projected
2594		! when project_velocity is true [nondim]. For now be_proj is set
2595		! to equal bebt, as they have similar roles and meanings.
2596		real :: eta_cor_multiplier ! Increases the rate of applying CS%eta_cor so that the mass
2597		! source is all used up by the beginning of the filtering [nondim]
2598		real :: eta_acc ! Change due to divergence of mass transport [H ~> m or kg m-2]
2599		logical :: do_hifreq_output ! If true, output occurs every barotropic step.
2600		logical :: do_ave ! If true, diagnostics are enabled on this step.
2601		logical :: evolving_face_areas
2602		logical :: v_first ! If true, update the v-velocity first with the present loop iteration
2603		logical :: integral_BT_cont ! If true, update the barotropic continuity equation directly
2604		! from the initial condition using the time-integrated barotropic velocity.
2605		character(len=200) :: mesg
2606		integer :: isv, iev, jsv, jev ! The valid array size at the end of a step.
2607		integer :: isvf, ievf, jsvf, jevf ! The fullest range of array indices that could be used.
2608		integer :: num_cycles ! The number of timesteps before a halo update is needed.
2609		integer :: stencil ! The stencil size of the algorithm, often 1 or 2.
2610		integer :: err_count ! A counter to limit the volume of error messages written to stdout.
2611		integer :: i, j, n, is, ie, js, je
2612		integer :: debug_halo ! The halo size to use for debugging checksums
2613		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
2614	96	logical :: submerged(SZIW_(CS),SZJW_(CS)), eta_is_submerged
2615
2616	48	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
2617	48	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
2618	48	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
2619	48	err_count = 0
2620
2621		! Figure out the fullest arrays that could be updated.
2622	48	stencil = max(1, CS%min_stencil)
2623	48	if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. (CS%Nonlin_cont_update_period > 0)) &
2624	0	stencil = max(2, CS%min_stencil)
2625
2626	48	num_cycles = 1
2627	48	if (CS%use_wide_halos) &
2628	48	num_cycles = min((is-CS%isdw) / stencil, (js-CS%jsdw) / stencil)
2629	48	isvf = is - (num_cycles-1)stencil ; ievf = ie + (num_cycles-1)stencil
2630	48	jsvf = js - (num_cycles-1)stencil ; jevf = je + (num_cycles-1)stencil
2631
2632	48	integral_BT_cont = use_BT_cont .and. CS%integral_BT_cont
2633		evolving_face_areas = (.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. &
2634	48	(CS%Nonlin_cont_update_period > 0)
2635	48	Instep = 1.0 / real(nstep)
2636	48	Idtbt = 1.0 / dtbt
2637
2638		!--- setup the weight when computing vbt_trans and ubt_trans
2639	48	if (CS%BT_project_velocity) then
2640	48	be_proj = CS%bebt
2641	48	trans_wt1 = (1.0 + be_proj) ; trans_wt2 = -be_proj
2642		else
2643	0	trans_wt1 = CS%bebt ; trans_wt2 = (1.0-CS%bebt)
2644		endif
2645
2646		! Manage diagnostics
2647		do_ave = query_averaging_enabled(CS%diag) .and. &
2648		((CS%id_PFu_bt > 0) .or. (CS%id_Coru_bt > 0) .or. (CS%id_LDu_bt > 0) .or. &
2649		(CS%id_PFv_bt > 0) .or. (CS%id_Corv_bt > 0) .or. (CS%id_LDv_bt > 0) .or. &
2650		associated(ADp%bt_pgf_u) .or. associated(ADp%bt_cor_u) .or. associated(ADp%bt_lwd_u) .or. &
2651	48	associated(ADp%bt_pgf_v) .or. associated(ADp%bt_cor_v) .or. associated(ADp%bt_lwd_v))
2652
2653	48	do_hifreq_output = .false.
2654		if ((CS%id_ubt_hifreq > 0) .or. (CS%id_vbt_hifreq > 0) .or. &
2655		(CS%id_eta_hifreq > 0) .or. (CS%id_eta_pred_hifreq > 0) .or. (CS%id_etaPF_hifreq > 0) .or. &
2656	48	(CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) &
2657	0	do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in)
2658	48	if (do_hifreq_output) then
2659	0	time_bt_start = time_end_in - real_to_time(dt, unscale=US%T_to_s)
2660	0	dtbt_diag = dt/(nstep+nfilter) ! Note that this is not dtbt.
2661		endif
2662
2663		!$omp target enter data &
2664		!$omp map(alloc: uhbt, vhbt, ubt_prev, vbt_prev, ubt_trans, vbt_trans, PFu, PFv, Cor_u, Cor_v, &
2665		!$omp p_surf_dyn, submerged)
2666
2667		! Zero out the arrays for various time-averaged quantities.
2668	48	if (find_etaav) then
2669	3096	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
2670	211992	eta_sum(i,j) = 0.0 ; eta_wtd(i,j) = 0.0
2671		enddo
2672		else
2673	3096	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
2674	211992	eta_wtd(i,j) = 0.0
2675		enddo
2676		endif
2677	48	do concurrent (j=js:je, I=is-1:ie)
2678	348480	CS%ubtav(I,j) = 0.0 ; uhbtav(I,j) = 0.0
2679	348480	PFu_avg(I,j) = 0.0 ; Coru_avg(I,j) = 0.0
2680	354336	LDu_avg(I,j) = 0.0 ; ubt_wtd(I,j) = 0.0
2681		enddo
2682	6144	do concurrent (j=jsvf-1:jevf+1, I=isvf-1:ievf)
2683	420672	ubt_trans(I,j) = 0.0
2684		enddo
2685	48	do concurrent (J=js-1:je, i=is:ie)
2686	351360	CS%vbtav(i,J) = 0.0 ; vhbtav(i,J) = 0.0
2687	351360	PFv_avg(i,J) = 0.0 ; Corv_avg(i,J) = 0.0
2688	357168	LDv_avg(i,J) = 0.0 ; vbt_wtd(i,J) = 0.0
2689		enddo
2690	48	do concurrent (J=jsvf-1:jevf, i=isvf-1:ievf+1)
2691	417840	vbt_trans(i,J) = 0.0
2692		enddo
2693
2694	48	if (integral_BT_cont) then
2695		!$omp target enter data map(alloc: ubt_int, uhbt_int, vbt_int, vhbt_int, cfl_ltd_vol)
2696
2697	0	do concurrent (j=CS%jsdw:CS%jedw, I=CS%isdw-1:CS%iedw)
2698	0	ubt_int(I,j) = 0.
2699	0	uhbt_int(I,j) = 0.
2700		enddo
2701
2702	0	do concurrent (J=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
2703	0	vbt_int(i,J) = 0.
2704	0	vhbt_int(i,J) = 0.
2705		enddo
2706
2707	0	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw:CS%iedw)
2708	0	cfl_ltd_vol(i,j) = huge(GV%Z_to_H)
2709		enddo
2710		endif
2711
2712	6192	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw:CS%iedw)
2713	423984	p_surf_dyn(i,j) = 0.0
2714		enddo
2715
2716	48	if (CS%bt_limit_integral_transport) then
2717		!$omp target update from(eta_IC)
2718		! Issue warnings if there are unphysical values of the initial sea surface height or total water column mass.
2719	0	if (GV%Boussinesq) then
2720	0	do j=js,je ; do i=is,ie
2721	0	if ((eta_IC(i,j) < -GV%Z_to_H*G%bathyT(i,j)) .and. (G%mask2dT(i,j) > 0.0)) then
2722	0	write(mesg,'(ES24.16," vs. ",ES24.16, " at ", ES12.4, ES12.4, i7, i7)') GV%H_to_m*eta(i,j), &
2723	0	-US%Z_to_m*G%bathyT(i,j), G%geoLonT(i,j), G%geoLatT(i,j), i + G%HI%idg_offset, j + G%HI%jdg_offset
2724	0	call MOM_error(FATAL, "btstep: eta_IC starts below bathyT: "//trim(mesg), all_print=.true.)
2725		endif
2726		enddo ; enddo
2727		else
2728	0	do j=js,je ; do i=is,ie
2729	0	if ((eta_IC(i,j) < 0.0) .and. (G%mask2dT(i,j) > 0.0)) then
2730		write(mesg,'(" at ", ES12.4, ES12.4, i7, i7)') &
2731	0	G%geoLonT(i,j), G%geoLatT(i,j), i + G%HI%idg_offset, j + G%HI%jdg_offset
2732		call MOM_error(FATAL, "btstep: negative eta_IC at start of a non-Boussinesq barotropic solver "//&
2733	0	trim(mesg), all_print=.true.)
2734		endif
2735		enddo ; enddo
2736		endif
2737		endif
2738
2739		! Set up the group pass used for halo updates within the barotropic time stepping loops.
2740	48	call create_group_pass(CS%pass_eta_ubt, eta, CS%BT_Domain)
2741	48	call create_group_pass(CS%pass_eta_ubt, ubt, vbt, CS%BT_Domain)
2742	48	if (integral_BT_cont) then
2743	0	call create_group_pass(CS%pass_eta_ubt, ubt_int, vbt_int, CS%BT_Domain)
2744		! This is only needed with integral_BT_cont, OBCs and multiple barotropic steps between halo updates.
2745	0	if (CS%integral_OBCs) &
2746	0	call create_group_pass(CS%pass_eta_ubt, uhbt_int, vhbt_int, CS%BT_Domain)
2747		endif
2748
2749		! The following loop contains all of the time steps.
2750	48	isv = is ; iev = ie ; jsv = js ; jev = je
2751	576	do n=1,nstep+nfilter
2752	528	if (CS%clip_velocity) call truncate_velocities(ubt, vbt, dt, G, CS, isv, iev, jsv, jev)
2753
2754		! Update the range of valid points, either by doing a halo update or by marching inward.
2755	528	if ((iev - stencil < ie) .or. (jev - stencil < je)) then
2756	144	if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
2757	144	call do_group_pass(CS%pass_eta_ubt, CS%BT_Domain, clock=id_clock_pass_step, omp_offload=.true.)
2758	144	isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf
2759	144	if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
2760		else
2761	384	isv = isv+stencil ; iev = iev-stencil
2762	384	jsv = jsv+stencil ; jev = jev-stencil
2763		endif
2764
2765		! Store the previous velocities for time-filtered transports and OBCs.
2766	528	do concurrent (j=jsv:jev, I=isv-2:iev+1)
2767	4288128	ubt_prev(I,j) = ubt(I,j)
2768		enddo
2769
2770	65616	do concurrent (J=jsv-2:jev+1, i=isv:iev)
2771	4381584	vbt_prev(i,J) = vbt(i,J)
2772		enddo
2773
2774	528	if (integral_BT_cont) then
2775	0	do concurrent (j=jsv-1:jev+1, I=isv-2:iev+1)
2776	0	uhbt_int_prev(I,j) = uhbt_int(I,j)
2777		enddo
2778	0	do concurrent (J=jsv-2:jev+1, i=isv-1:iev+1)
2779	0	vhbt_int_prev(i,J) = vhbt_int(i,J)
2780		enddo
2781		endif
2782
2783		! Do a predictor step update of eta
2784	528	if (evolving_face_areas) then
2785	0	if ((n>1) .and. (mod(n-1,CS%Nonlin_cont_update_period) == 0)) &
2786	0	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1+iev-ie, eta)
2787		endif
2788
2789	528	if (CS%dynamic_psurf .or. (.not.CS%BT_project_velocity)) then
2790		! Estimate the change in the free surface height.
2791		call btloop_eta_predictor(n, dtbt, ubt, vbt, eta, ubt_int, vbt_int, uhbt, vhbt, uhbt0, vhbt0, &
2792		uhbt_int, vhbt_int, BTCL_u, BTCL_v, Datu, Datv, eta_IC, eta_src, eta_pred, &
2793	0	isv, iev, jsv, jev, integral_BT_cont, use_BT_cont, G, US, CS)
2794		endif
2795
2796	528	if (interp_eta_PF) then
2797		! Interpolate the effective surface pressure in time
2798	0	wt_end = nInstep ! This could be (n-0.5)Instep.
2799	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
2800	0	eta_PF(i,j) = eta_PF_1(i,j) + wt_end*d_eta_PF(i,j)
2801		enddo
2802		endif
2803
2804	528	v_first = (MOD(n+G%first_direction,2)==1)
2805
2806		! Determine the pressure force accelerations due to the updated eta anomalies.
2807	528	if (CS%BT_project_velocity) then
2808		call btloop_find_PF(PFu, PFv, isv, iev, jsv, jev, eta, eta_PF, &
2809		gtot_N, gtot_S, gtot_E, gtot_W, dgeo_de, find_etaav, &
2810	528	wt_accel2(n), eta_sum, v_first, G, US, CS)
2811		else
2812		call btloop_find_PF(PFu, PFv, isv, iev, jsv, jev, eta_pred, eta_PF, &
2813		gtot_N, gtot_S, gtot_E, gtot_W, dgeo_de, find_etaav, &
2814	0	wt_accel2(n), eta_sum, v_first, G, US, CS)
2815		endif
2816
2817		! Use the change in eta to determine an additional divergence damping due to the ice strength.
2818	528	if (CS%dynamic_psurf) then
2819		call btloop_add_dyn_PF(PFu, PFv, eta_pred, eta, dyn_coef_eta, p_surf_dyn, &
2820	0	isv, iev, jsv, jev, v_first, G, US, CS)
2821		endif
2822
2823	528	if (v_first) then
2824		! On odd-steps, update v first.
2825		call btloop_update_v(dtbt, ubt, vbt, v_accel_bt, Cor_v, PFv, isv-1, iev+1, jsv-1, jev, &
2826		f_4_v, bt_rem_v, BT_force_v, Cor_ref_v, Rayleigh_v, &
2827	288	wt_accel(n), G, US, CS)
2828
2829		! Now update the zonal velocity.
2830		call btloop_update_u(dtbt, ubt, vbt, u_accel_bt, Cor_u, PFu, isv-1, iev, jsv, jev, &
2831		f_4_u, bt_rem_u, BT_force_u, Cor_ref_u, Rayleigh_u, &
2832	288	wt_accel(n), G, US, CS)
2833
2834		else
2835		! On even steps, update u first.
2836		call btloop_update_u(dtbt, ubt, vbt, u_accel_bt, Cor_u, PFu, isv-1, iev, jsv-1, jev+1, &
2837		f_4_u, bt_rem_u, BT_force_u, Cor_ref_u, Rayleigh_u, &
2838	240	wt_accel(n), G, US, CS)
2839		! Now update the meridional velocity.
2840		call btloop_update_v(dtbt, ubt, vbt, v_accel_bt, Cor_v, PFv, isv, iev, jsv-1, jev, &
2841		f_4_v, bt_rem_v, BT_force_v, Cor_ref_v, Rayleigh_v, &
2842	240	wt_accel(n), G, US, CS, Cor_bracket_bug=CS%use_old_coriolis_bracket_bug)
2843		endif
2844
2845		! Determine the transports based on the updated velocities when no OBCs are applied
2846	528	if (integral_BT_cont) then
2847	0	if (CS%bt_limit_integral_transport) then
2848		! Calculate the volume that could be used for divergent transport to use for a limter. This applies to
2849		! uhbt_int and vhbt_int at each BT step. It does not allow for temporary flooding during the BT cycling.
2850		! Only the sink is accounted for: if diverent motion occurs at the beginning of the BT cycling but the volume
2851		! was due only to a +ve source being applied gradually, then the instantaneous eta could drop below the bottom.
2852	0	if (GV%Boussinesq) then
2853	0	do concurrent (j=jsv:jev, i=isv:iev)
2854		cfl_ltd_vol(i,j) = ( CS%maxCFL_BT_cont * G%areaT(i,j) ) * &
2855	0	max( 0., ( GV%Z_to_HG%bathyT(i,j) + eta_IC(i,j) ) + nstep min( 0., eta_src(i,j) ) )
2856		enddo
2857		else
2858	0	do concurrent (j=jsv:jev, i=isv:iev)
2859		cfl_ltd_vol(i,j) = ( CS%maxCFL_BT_cont * G%areaT(i,j) ) * &
2860	0	max( 0., eta_IC(i,j) + nstep * min( 0., eta_src(i,j) ) )
2861		enddo
2862		endif
2863		endif
2864
2865	0	do concurrent (j=jsv:jev, I=isv-1:iev)
2866	0	ubt_trans(I,j) = trans_wt1ubt(I,j) + trans_wt2ubt_prev(I,j)
2867	0	ubt_int_prev(I,j) = ubt_int(I,j) ! Store the previous integrated velocity so it can be reset by at OBC points
2868	0	ubt_int(I,j) = ubt_int(I,j) + dtbt * ubt_trans(I,j)
2869	0	uhbt_int(I,j) = find_uhbt(ubt_int(I,j), BTCL_u(I,j)) + ndtbtuhbt0(I,j)
2870	0	uhbt_int(I,j) = max( -cfl_ltd_vol(i+1,j), min( uhbt_int(I,j), cfl_ltd_vol(i,j) ) )
2871		! Estimate the mass flux within a single timestep to take the filtered average.
2872	0	uhbt(I,j) = (uhbt_int(I,j) - uhbt_int_prev(I,j)) * Idtbt
2873		enddo
2874	0	do concurrent (J=jsv-1:jev, i=isv:iev)
2875	0	vbt_trans(i,J) = trans_wt1vbt(i,J) + trans_wt2vbt_prev(i,J)
2876	0	vbt_int_prev(i,J) = vbt_int(i,J) ! Store the previous integrated velocity so it can be reset by at OBC points
2877	0	vbt_int(i,J) = vbt_int(i,J) + dtbt * vbt_trans(i,J)
2878	0	vhbt_int(i,J) = find_vhbt(vbt_int(i,J), BTCL_v(i,J)) + ndtbtvhbt0(i,J)
2879	0	vhbt_int(i,J) = max( -cfl_ltd_vol(i,j+1), min( vhbt_int(i,J), cfl_ltd_vol(i,j) ) )
2880		! Estimate the mass flux within a single timestep to take the filtered average.
2881	0	vhbt(i,J) = (vhbt_int(i,J) - vhbt_int_prev(i,J)) * Idtbt
2882		enddo
2883	528	elseif (use_BT_cont) then
2884	528	do concurrent (j=jsv:jev, I=isv-1:iev)
2885	4154112	ubt_trans(I,j) = trans_wt1ubt(I,j) + trans_wt2ubt_prev(I,j)
2886	4220256	uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
2887		enddo
2888	65616	do concurrent (J=jsv-1:jev, i=isv:iev)
2889	4185792	vbt_trans(i,J) = trans_wt1vbt(i,J) + trans_wt2vbt_prev(i,J)
2890	4251408	vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J)) + vhbt0(i,J)
2891		enddo
2892		else
2893	0	do concurrent (j=jsv:jev, I=isv-1:iev)
2894	0	ubt_trans(I,j) = trans_wt1ubt(I,j) + trans_wt2ubt_prev(I,j)
2895	0	uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
2896		enddo
2897	0	do concurrent (J=jsv-1:jev, i=isv:iev)
2898	0	vbt_trans(i,J) = trans_wt1vbt(i,J) + trans_wt2vbt_prev(i,J)
2899	0	vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J)
2900		enddo
2901		endif
2902
2903		! This might need to be moved outside of the OMP do loop directives.
2904	528	if (CS%debug_bt) then
2905	0	write(mesg,'("BT vel update ",I0)') n
2906	0	debug_halo = 0 ; if (CS%debug_wide_halos) debug_halo = iev - ie
2907		!$omp target update from(PFu, PFv)
2908		call uvchksum(trim(mesg)//" PF[uv]", PFu, PFv, CS%debug_BT_HI, haloshift=debug_halo, &
2909	0	symmetric=.true., unscale=US%L_T_to_m_s*US%s_to_T)
2910		!$omp target update from(Cor_u, Cor_v)
2911		call uvchksum(trim(mesg)//" Cor_[uv]", Cor_u, Cor_v, CS%debug_BT_HI, haloshift=debug_halo, &
2912	0	symmetric=.true., unscale=US%L_T_to_m_s*US%s_to_T)
2913		!$omp target update from(BT_force_u, BT_force_v)
2914		call uvchksum(trim(mesg)//" BT_force_[uv]", BT_force_u, BT_force_v, CS%debug_BT_HI, haloshift=debug_halo, &
2915	0	symmetric=.true., unscale=US%L_T_to_m_s*US%s_to_T)
2916		!$omp target update from(BT_rem_u, BT_rem_v)
2917		call uvchksum(trim(mesg)//" BT_rem_[uv]", BT_rem_u, BT_rem_v, CS%debug_BT_HI, haloshift=debug_halo, &
2918	0	symmetric=.true., scalar_pair=.true.)
2919		!$omp target update from(ubt, vbt)
2920		call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=debug_halo, &
2921	0	symmetric=.true., unscale=US%L_T_to_m_s)
2922		!$omp target update from(ubt_trans, vbt_trans)
2923		call uvchksum(trim(mesg)//" [uv]bt_trans", ubt_trans, vbt_trans, CS%debug_BT_HI, haloshift=debug_halo, &
2924	0	symmetric=.true., unscale=US%L_T_to_m_s)
2925		!$omp target update from(uhbt, vhbt)
2926		call uvchksum(trim(mesg)//" [uv]hbt", uhbt, vhbt, CS%debug_BT_HI, haloshift=debug_halo, &
2927	0	symmetric=.true., unscale=US%s_to_TUS%L_to_m2GV%H_to_m)
2928	0	if (integral_BT_cont) then
2929		!$omp target update from(uhbt_int, vhbt_int)
2930		call uvchksum(trim(mesg)//" [uv]hbt_int", uhbt_int, vhbt_int, CS%debug_BT_HI, haloshift=debug_halo, &
2931	0	symmetric=.true., unscale=US%L_to_m*2GV%H_to_m)
2932		endif
2933		endif
2934
2935		! Apply open boundary condition considerations to revise the updated velocities and transports.
2936	528	if (CS%BT_OBC%u_OBCs_on_PE) then
2937		!$omp target update from(ubt, uhbt, ubt_trans, eta, SpV_col_avg, ubt_prev, Datu, BTCL_u, uhbt0)
2938		call apply_u_velocity_OBCs(ubt, uhbt, ubt_trans, eta, SpV_col_avg, ubt_prev, BT_OBC, &
2939		G, MS, GV, US, CS, iev-ie, dtbt, CS%bebt, use_BT_cont, integral_BT_cont, n*dtbt, &
2940	0	Datu, BTCL_u, uhbt0, ubt_int, ubt_int_prev, uhbt_int, uhbt_int_prev)
2941		!$omp target update to(ubt, uhbt, ubt_trans)
2942		endif
2943
2944	528	if (CS%BT_OBC%v_OBCs_on_PE) then
2945		!$omp target update from(vbt, vhbt, vbt_trans, eta, SpV_col_avg, vbt_prev, Datv, BTCL_v, vhbt0)
2946		call apply_v_velocity_OBCs(vbt, vhbt, vbt_trans, eta, SpV_col_avg, vbt_prev, BT_OBC, &
2947		G, MS, GV, US, CS, iev-ie, dtbt, CS%bebt, use_BT_cont, integral_BT_cont, n*dtbt, &
2948	0	Datv, BTCL_v, vhbt0, vbt_int, vbt_int_prev, vhbt_int, vhbt_int_prev)
2949		!$omp target update to(vbt, vhbt, vbt_trans)
2950		endif
2951
2952		! Contribute to the running sums of the transports and velocities.
2953	528	do concurrent (j=js:je, I=is-1:ie)
2954	3833280	CS%ubtav(I,j) = CS%ubtav(I,j) + wt_trans(n) * ubt_trans(I,j)
2955	3833280	uhbtav(I,j) = uhbtav(I,j) + wt_trans(n) * uhbt(I,j)
2956	3897696	ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j)
2957		enddo
2958	528	do concurrent (J=js-1:je, i=is:ie)
2959	3864960	CS%vbtav(i,J) = CS%vbtav(i,J) + wt_trans(n) * vbt_trans(i,J)
2960	3864960	vhbtav(i,J) = vhbtav(i,J) + wt_trans(n) * vhbt(i,J)
2961	3928848	vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J)
2962		enddo
2963
2964	528	if (CS%debug_bt) then
2965		call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, CS%debug_BT_HI, haloshift=debug_halo, &
2966	0	symmetric=.true., unscale=US%s_to_TUS%L_to_m2GV%H_to_m)
2967	0	if (integral_BT_cont) &
2968		call uvchksum("BT [uv]hbt_int just after OBC", uhbt_int, vhbt_int, CS%debug_BT_HI, &
2969	0	haloshift=debug_halo, symmetric=.true., unscale=US%L_to_m*2GV%H_to_m)
2970		endif
2971
2972		! Update eta in a corrector step using the barotropic continuity equation.
2973	528	if (integral_BT_cont) then
2974	0	eta_cor_multiplier = n
2975	0	if ( CS%bt_adjust_src_for_filter ) then
2976	0	if ( nstep > nfilter ) then
2977	0	eta_cor_multiplier = min(nstep - nfilter, n) * nstep / real(nstep - nfilter)
2978		else
2979	0	eta_cor_multiplier = nstep
2980		endif
2981		endif
2982
2983	0	eta_is_submerged = .false.
2984	0	do concurrent (j=jsv:jev, i=isv:iev) DO_LOCALITY(reduce(.or.: eta_is_submerged))
2985		eta(i,j) = (eta_IC(i,j) + eta_cor_multiplier * eta_src(i,j)) + CS%IareaT_OBCmask(i,j) * &
2986	0	((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J)))
2987		! eta_acc contains the magnitude of the largest term in the above expression which
2988		! will be used to estimate a bound for round off when comparing to the bottom depth
2989		eta_acc = abs( CS%IareaT_OBCmask(i,j) * &
2990	0	((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J))) )
2991	0	eta_acc = max( eta_acc, abs( eta_cor_multiplier*eta_src(i,j) ), abs( eta_IC(i,j) ) )
2992	0	if ( G%mask2dT(i,j) * ( eta(i,j) + GV%Z_to_H*G%bathyT(i,j) ) > &
2993		-G%mask2dT(i,j) * eta_acc * epsilon(eta_acc) * 2. ) &
2994	0	eta(i,j) = max( eta(i,j), -GV%Z_to_H*G%bathyT(i,j) )
2995	0	eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n)
2996
2997	0	submerged(i,j) = eta(i,j) < -GV%Z_to_H*G%bathyT(i,j) .and. G%mask2dT(i,j) > 0.0
2998	0	eta_is_submerged = submerged(i,j)
2999		enddo
3000
3001	0	if (eta_is_submerged) then
3002		!$omp target update from(submerged)
3003	0	do j=jsv,jev ; do i=isv,iev ; if (submerged(i,j)) then
3004		write(mesg,'(ES24.16, " vs. ", ES24.16, " at ", ES12.4, ES12.4, i7, i7)') &
3005	0	GV%H_to_meta(i,j), -US%Z_to_mG%bathyT(i,j), G%geoLonT(i,j), G%geoLatT(i,j), &
3006	0	i + G%HI%idg_offset, j + G%HI%jdg_offset
3007	0	if (CS%bt_limit_integral_transport) &
3008	0	call MOM_error(FATAL, "btstep: eta has dropped below bathyT: " // trim(mesg))
3009		endif ; enddo ; enddo
3010		endif
3011		else
3012	528	do concurrent (j=jsv:jev, i=isv:iev)
3013		eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT_OBCmask(i,j)) * &
3014	4120704	((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J)))
3015	4186320	eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n)
3016		enddo
3017		endif
3018
3019	528	if (CS%debug_bt) then
3020	0	write(mesg,'("BT step ",I0)') n
3021		!$omp target update from(ubt, vbt)
3022		call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=debug_halo, &
3023	0	symmetric=.true., unscale=US%L_T_to_m_s)
3024		!$omp target update from(eta)
3025	0	call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=debug_halo, unscale=GV%H_to_MKS)
3026		endif
3027
3028		! Issue warnings if there are unphysical values of the sea surface height
3029		! or total water column mass.
3030	528	eta_is_submerged = .false.
3031	528	if (GV%Boussinesq) then
3032	528	do concurrent (j=js:je, i=is:ie) DO_LOCALITY(reduce(.or.: eta_is_submerged))
3033	3801600	submerged(i,j) = eta(i,j) < -GV%Z_to_H*G%bathyT(i,j) .and. G%mask2dT(i,j) > 0.0
3034	3865488	eta_is_submerged = submerged(i,j)
3035		enddo
3036
3037	528	if (eta_is_submerged) then
3038		!$omp target update from(submerged)
3039	0	do j=js,je ; do i=is,ie ; if (submerged(i,j)) then
3040		write(mesg,'(ES24.16, " vs. ", ES24.16, " at ", ES12.4, ES12.4, i7, i7)') &
3041	0	GV%H_to_meta(i,j), -US%Z_to_mG%bathyT(i,j), G%geoLonT(i,j), G%geoLatT(i,j), &
3042	0	i + G%HI%idg_offset, j + G%HI%jdg_offset
3043
3044	0	if (CS%bt_limit_integral_transport) &
3045	0	call MOM_error(FATAL, "btstep: eta has dropped below bathyT: "//trim(mesg))
3046
3047	0	if (err_count < 2) &
3048	0	call MOM_error(WARNING, "btstep: eta has dropped below bathyT: "//trim(mesg), all_print=.true.)
3049	0	err_count = err_count + 1
3050		endif ; enddo ; enddo
3051		endif
3052		else
3053	0	do concurrent (j=js:je, i=is:ie) DO_LOCALITY(reduce(.or.: eta_is_submerged))
3054	0	submerged(i,j) = eta(i,j) < 0.0 .and. G%mask2dT(i,j) > 0.0
3055	0	eta_is_submerged = submerged(i,j)
3056		enddo
3057
3058	0	if (eta_is_submerged) then
3059		!$omp target update from(submerged)
3060
3061	0	do j=js,je ; do i=is,ie ; if (submerged(i,j)) then
3062		write(mesg,'(" at ", ES12.4, ES12.4, i7, i7)') &
3063	0	G%geoLonT(i,j), G%geoLatT(i,j), i + G%HI%idg_offset, j + G%HI%jdg_offset
3064
3065	0	if (CS%bt_limit_integral_transport) &
3066	0	call MOM_error(FATAL, "btstep: negative eta in a non-Boussinesq barotropic solver "//trim(mesg))
3067
3068	0	if (err_count < 2) &
3069		call MOM_error(WARNING, "btstep: negative eta in a non-Boussinesq barotropic solver "//&
3070	0	trim(mesg), all_print=.true.)
3071
3072	0	err_count = err_count + 1
3073		endif ; enddo ; enddo
3074		endif
3075		endif
3076
3077		! Accumulate some diagnostics of time-averaged barotropic accelerations.
3078	528	if (do_ave) then
3079	0	if ((CS%id_PFu_bt > 0) .or. associated(ADp%bt_pgf_u)) then
3080	0	do concurrent (j=js:je, I=is-1:ie)
3081	0	PFu_avg(I,j) = PFu_avg(I,j) + wt_accel2(n) * PFu(I,j)
3082		enddo
3083		endif
3084	0	if ((CS%id_PFv_bt > 0) .or. associated(ADp%bt_pgf_v)) then
3085	0	do concurrent (J=js-1:je, i=is:ie)
3086	0	PFv_avg(i,J) = PFv_avg(i,J) + wt_accel2(n) * PFv(i,J)
3087		enddo
3088		endif
3089	0	if ((CS%id_Coru_bt > 0) .or. associated(ADp%bt_cor_u)) then
3090	0	do concurrent (j=js:je, I=is-1:ie)
3091	0	Coru_avg(I,j) = Coru_avg(I,j) + wt_accel2(n) * Cor_u(I,j)
3092		enddo
3093		endif
3094	0	if ((CS%id_Corv_bt > 0) .or. associated(ADp%bt_cor_v)) then
3095	0	do concurrent (J=js-1:je, i=is:ie)
3096	0	Corv_avg(i,J) = Corv_avg(i,J) + wt_accel2(n) * Cor_v(i,J)
3097		enddo
3098		endif
3099
3100	0	if (CS%linear_wave_drag) then
3101	0	if ((CS%id_LDu_bt > 0) .or. (associated(ADp%bt_lwd_u))) then
3102	0	do concurrent (j=js:je, I=is-1:ie)
3103	0	LDu_avg(I,j) = LDu_avg(I,j) - wt_accel2(n) * (ubt(I,j) * Rayleigh_u(I,j))
3104		enddo
3105		endif
3106	0	if ((CS%id_LDv_bt > 0) .or. (associated(ADp%bt_lwd_v))) then
3107	0	do concurrent (J=js-1:je, i=is:ie)
3108	0	LDv_avg(i,J) = LDv_avg(i,J) - wt_accel2(n) * (vbt(i,J) * Rayleigh_v(i,J))
3109		enddo
3110		endif
3111		endif
3112		endif
3113
3114	576	if (do_hifreq_output) then
3115		! Note that this compresses the time so that all of the timesteps, including those in the
3116		! extra timesteps for filtering, fit within dt.
3117	0	time_step_end = time_bt_start + real_to_time(n*dtbt_diag, unscale=US%T_to_s)
3118	0	call enable_averages(dtbt, time_step_end, CS%diag)
3119	0	if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag)
3120	0	if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag)
3121	0	if (CS%id_eta_hifreq > 0) call post_data(CS%id_eta_hifreq, eta(isd:ied,jsd:jed), CS%diag)
3122	0	if (CS%id_etaPF_hifreq > 0) then
3123	0	if (CS%BT_project_velocity) then
3124	0	do j=js,je ; do i=is,ie
3125	0	eta_anom_PF(i,j) = eta(i,j) - eta_PF(i,j)
3126		enddo ; enddo
3127		else
3128	0	do j=js,je ; do i=is,ie
3129	0	eta_anom_PF(i,j) = eta_pred(i,j) - eta_PF(i,j)
3130		enddo ; enddo
3131		endif
3132	0	call post_data(CS%id_etaPF_hifreq, eta_anom_PF(isd:ied,jsd:jed), CS%diag)
3133		endif
3134	0	if (CS%id_uhbt_hifreq > 0) call post_data(CS%id_uhbt_hifreq, uhbt(IsdB:IedB,jsd:jed), CS%diag)
3135	0	if (CS%id_vhbt_hifreq > 0) call post_data(CS%id_vhbt_hifreq, vhbt(isd:ied,JsdB:JedB), CS%diag)
3136	0	if (CS%BT_project_velocity) then
3137		! This diagnostic is redundant in this case and should probably be omitted.
3138	0	if (CS%id_eta_pred_hifreq > 0) call post_data(CS%id_eta_pred_hifreq, eta(isd:ied,jsd:jed), CS%diag)
3139		else
3140	0	if (CS%id_eta_pred_hifreq > 0) call post_data(CS%id_eta_pred_hifreq, eta_pred(isd:ied,jsd:jed), CS%diag)
3141		endif
3142		endif
3143		enddo ! end of do n=1,ntimestep
3144
3145		!$omp target exit data &
3146		!$omp map(release: uhbt, vhbt, ubt_prev, vbt_prev, ubt_trans, vbt_trans, PFu, PFv, Cor_u, Cor_v, &
3147		!$omp p_surf_dyn, submerged)
3148
3149		!$omp target exit data map(delete: ubt_int, uhbt_int, vbt_int, vhbt_int, cfl_ltd_vol) &
3150		!$omp if (integral_BT_cont)
3151
3152		! Reset the time information in the diag type.
3153	48	if (do_hifreq_output) call enable_averaging(time_int_in, time_end_in, CS%diag)
3154
3155	48	end subroutine btstep_timeloop
3156
3157
3158		!> Find the Coriolis force terms _zon and _mer.
3159	48	subroutine btstep_find_Cor(q, DCor_u, DCor_v, f_4_u, f_4_v, isvf, ievf, jsvf, jevf, CS)
3160		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3161		real, intent(in) :: q(SZIBW_(CS),SZJBW_(CS)) !< A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1]
3162		!! or [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]
3163		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3164		DCor_u !< An averaged depth or total thickness at u points [Z ~> m] or [H ~> m or kg m-2].
3165		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3166		DCor_v !< An averaged depth or total thickness at v points [Z ~> m] or [H ~> m or kg m-2].
3167		real, dimension(4,SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3168		f_4_u !< The terms giving the contribution to the Coriolis acceleration at a zonal
3169		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3170		!! These are the products of thicknesses at v points and appropriately staggered
3171		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3172		!! they are approximately f / 4. The 4 values on the innermost loop are for
3173		!! v-velocities to the southwest, southeast, northwest and northeast.
3174		real, dimension(4,SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3175		f_4_v !< The terms giving the contribution to the Coriolis acceleration at a meridional
3176		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3177		!! These are the products of thicknesses at u points and appropriately staggered
3178		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3179		!! they are approximately f / 4. The 4 values on the innermost loop are for
3180		!! u-velocities to the southwest, southeast, northwest and northeast.
3181		integer, intent(in) :: isvf !< The starting i-index of the largest valid range for tracer points
3182		integer, intent(in) :: ievf !< The ending i-index of the largest valid range for tracer points
3183		integer, intent(in) :: jsvf !< The starting j-index of the largest valid range for tracer points
3184		integer, intent(in) :: jevf !< The ending j-index of the largest valid range for tracer points
3185
3186		! real :: C1_3 ! One third [nondim]
3187		integer :: i, j
3188
3189	48	if (CS%Sadourny) then
3190	6192	do concurrent (J=jsvf-1:jevf, i=isvf-1:ievf+1)
3191	411648	f_4_v(1,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j) * q(I-1,J)
3192	411648	f_4_v(2,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j) * q(I,J)
3193	411648	f_4_v(4,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j+1) * q(I,J)
3194	417840	f_4_v(3,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j+1) * q(I-1,J)
3195		enddo
3196	6144	do concurrent (j=jsvf-1:jevf+1, I=isvf-1:ievf)
3197	414528	f_4_u(4,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J) * q(I,J)
3198	414528	f_4_u(3,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J) * q(I,J)
3199	414528	f_4_u(1,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J-1) * q(I,J-1)
3200	420672	f_4_u(2,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J-1) * q(I,J-1)
3201		enddo
3202		else !### if (CS%answer_date < 20250601) then ! Uncomment this later.
3203	0	do concurrent (J=jsvf-1:jevf, i=isvf-1:ievf+1)
3204	0	f_4_v(1,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j) * ((q(I,J) + q(I-1,J-1)) + q(I-1,J)) / 3.0
3205	0	f_4_v(2,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j) * (q(I,J) + (q(I-1,J) + q(I,J-1))) / 3.0
3206	0	f_4_v(4,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j+1) * (q(I,J) + (q(I-1,J) + q(I,J+1))) / 3.0
3207	0	f_4_v(3,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j+1) * ((q(I,J) + q(I-1,J+1)) + q(I-1,J)) / 3.0
3208		enddo
3209	0	do concurrent (j=jsvf-1:jevf+1, I=isvf-1:ievf)
3210	0	f_4_u(4,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J) * (q(I,J) + (q(I+1,J) + q(I,J-1))) / 3.0
3211	0	f_4_u(3,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J) * (q(I,J) + (q(I-1,J) + q(I,J-1))) / 3.0
3212	0	f_4_u(1,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J-1) * ((q(I,J) + q(I-1,J-1)) + q(I,J-1)) / 3.0
3213	0	f_4_u(2,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J-1) * ((q(I,J) + q(I+1,J-1)) + q(I,J-1)) / 3.0
3214		enddo
3215		! else
3216		! C1_3 = 1.0 / 3.0
3217		! !$OMP parallel do default(shared)
3218		! do J=jsvf-1,jevf ; do i=isvf-1,ievf+1
3219		! f_4_v(1,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j) * ((q(I,J) + q(I-1,J-1)) + q(I-1,J)) * C1_3
3220		! f_4_v(2,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j) * (q(I,J) + (q(I-1,J) + q(I,J-1))) * C1_3
3221		! f_4_v(4,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j+1) * (q(I,J) + (q(I-1,J) + q(I,J+1))) * C1_3
3222		! f_4_v(3,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j+1) * ((q(I,J) + q(I-1,J+1)) + q(I-1,J)) * C1_3
3223		! enddo ; enddo
3224		! !$OMP parallel do default(shared)
3225		! do j=jsvf-1,jevf+1 ; do I=isvf-1,ievf
3226		! f_4_u(4,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J) * (q(I,J) + (q(I+1,J) + q(I,J-1))) * C1_3
3227		! f_4_u(3,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J) * (q(I,J) + (q(I-1,J) + q(I,J-1))) * C1_3
3228		! f_4_u(1,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J-1) * ((q(I,J) + q(I-1,J-1)) + q(I,J-1)) * C1_3
3229		! f_4_u(2,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J-1) * ((q(I,J) + q(I+1,J-1)) + q(I,J-1)) * C1_3
3230		! enddo ; enddo
3231		endif
3232
3233	48	end subroutine btstep_find_Cor
3234
3235		!> Do a CFL-based truncation of any excessively large batotropic velocities.
3236		!! This should only be used as desperate debugging measure.
3237	0	subroutine truncate_velocities(ubt, vbt, dt, G, CS, isv, iev, jsv, jev)
3238		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3239		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3240		real, intent(inout) :: ubt(SZIBW_(CS),SZJW_(CS)) !< The zonal barotropic velocity [L T-1 ~> m s-1]
3241		real, intent(inout) :: vbt(SZIW_(CS),SZJBW_(CS)) !< The meridional barotropic velocity [L T-1 ~> m s-1]
3242		real, intent(in) :: dt !< The time increment to integrate over [T ~> s].
3243		integer, intent(in) :: isv !< The starting valid tracer array i-index that is being worked on
3244		integer, intent(in) :: iev !< The ending valid tracer array i-index that is being worked on
3245		integer, intent(in) :: jsv !< The starting valid tracer array j-index that is being worked on
3246		integer, intent(in) :: jev !< The ending valid tracer array j-index being that is worked on
3247
3248		integer :: i, j
3249
3250	0	if (CS%clip_velocity) then
3251	0	do concurrent (j=jsv:jev, I=isv-1:iev)
3252	0	if ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then
3253		! Add some error reporting later.
3254	0	ubt(I,j) = (-0.95CS%CFL_trunc) (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j)))
3255	0	elseif ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then
3256		! Add some error reporting later.
3257	0	ubt(I,j) = (0.95CS%CFL_trunc) (G%areaT(i,j) / (dt * G%dy_Cu(I,j)))
3258		endif
3259		enddo
3260	0	do concurrent (J=jsv-1:jev, i=isv:iev)
3261	0	if ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then
3262		! Add some error reporting later.
3263	0	vbt(i,J) = (-0.9CS%CFL_trunc) (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J)))
3264	0	elseif ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then
3265		! Add some error reporting later.
3266	0	vbt(i,J) = (0.9CS%CFL_trunc) (G%areaT(i,j) / (dt * G%dx_Cv(i,J)))
3267		endif
3268		enddo
3269		endif
3270
3271	0	end subroutine truncate_velocities
3272
3273
3274		!> A routine to set eta_pred and the running time integral of uhbt and vhbt.
3275	0	subroutine btloop_eta_predictor(n, dtbt, ubt, vbt, eta, ubt_int, vbt_int, uhbt, vhbt, uhbt0, vhbt0, &
3276	0	uhbt_int, vhbt_int, BTCL_u, BTCL_v, Datu, Datv, &
3277	0	eta_IC, eta_src, eta_pred, isv, iev, jsv, jev, &
3278		integral_BT_cont, use_BT_cont, G, US, CS)
3279		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
3280		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
3281		integer, intent(in) :: n !< The current step in loop of timesteps
3282		real, intent(in) :: dtbt !< The barotropic time step [T ~> s]
3283		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3284		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3285		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3286		vbt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3287		real, target, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3288		eta !< The barotropic free surface height anomaly or column mass
3289		!! anomaly [H ~> m or kg m-2]
3290		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3291		ubt_int !< The running time integral of ubt over the time steps [L ~> m].
3292		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3293		vbt_int !< The running time integral of vbt over the time steps [L ~> m].
3294		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3295		uhbt0 !< The difference between the sum of the layer zonal thickness
3296		!! fluxes and the barotropic thickness flux using the same
3297		!! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
3298		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3299		vhbt0 !< The difference between the sum of the layer meridional
3300		!! thickness fluxes and the barotropic thickness flux using
3301		!! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
3302		type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3303		BTCL_u !< A repackaged version of the u-point information in BT_cont.
3304		type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3305		BTCL_v !< A repackaged version of the v-point information in BT_cont.
3306		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3307		Datu !< Basin depth at u-velocity grid points times the y-grid
3308		!! spacing [H L ~> m2 or kg m-1].
3309		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3310		Datv !< Basin depth at v-velocity grid points times the x-grid
3311		!! spacing [H L ~> m2 or kg m-1].
3312		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3313		eta_IC !< A local copy of the initial 2-D eta field (eta_in) [H ~> m or kg m-2]
3314		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3315		eta_src !< The source of eta per barotropic timestep [H ~> m or kg m-2].
3316		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3317		uhbt !< The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
3318		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3319		vhbt !< The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
3320		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3321		uhbt_int !< The running time integral of uhbt over the time steps [H L2 ~> m3 or kg].
3322		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3323		vhbt_int !< The running time integral of vhbt over the time steps [H L2 ~> m3 or kg].
3324		real, target, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
3325		eta_pred !< A predictor value of eta [H ~> m or kg m-2] like eta.
3326		integer, intent(in) :: isv !< The starting i-index of eta_pred to calculate
3327		integer, intent(in) :: iev !< The ending i-index of eta_pred to calculate
3328		integer, intent(in) :: jsv !< The starting j-index of eta_pred to calculate
3329		integer, intent(in) :: jev !< The ending j-index of eta_pred to calculate
3330		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity equation directly
3331		!! from the initial condition using the time-integrated barotropic velocity.
3332		logical, intent(in) :: use_BT_cont !< If true, use the information in the BT_cont_type to determine
3333		!! barotropic transports as a function of the barotropic velocities.
3334		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3335
3336		integer :: i, j
3337
3338	0	if (integral_BT_cont) then
3339	0	do concurrent (j=jsv-1:jev+1, I=isv-2:iev+1)
3340	0	uhbt_int(I,j) = find_uhbt(ubt_int(I,j) + dtbtubt(I,j), BTCL_u(I,j)) + ndtbt*uhbt0(I,j)
3341		enddo
3342	0	do concurrent (J=jsv-2:jev+1, i=isv-1:iev+1)
3343	0	vhbt_int(i,J) = find_vhbt(vbt_int(i,J) + dtbtvbt(i,J), BTCL_v(i,J)) + ndtbt*vhbt0(i,J)
3344		enddo
3345	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3346		eta_pred(i,j) = (eta_IC(i,j) + neta_src(i,j)) + CS%IareaT_OBCmask(i,j) &
3347	0	((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J)))
3348		enddo
3349	0	elseif (use_BT_cont) then
3350	0	do concurrent (j=jsv-1:jev+1, I=isv-2:iev+1)
3351	0	uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j)) + uhbt0(I,j)
3352		enddo
3353	0	do concurrent (J=jsv-2:jev+1, i=isv-1:iev+1)
3354	0	vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J)) + vhbt0(i,J)
3355		enddo
3356	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3357		eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT_OBCmask(i,j)) * &
3358	0	((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J)))
3359		enddo
3360		else
3361	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3362		eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT_OBCmask(i,j)) * &
3363		(((Datu(I-1,j)*ubt(I-1,j) + uhbt0(I-1,j)) - &
3364		(Datu(I,j)*ubt(I,j) + uhbt0(I,j))) + &
3365		((Datv(i,J-1)*vbt(i,J-1) + vhbt0(i,J-1)) - &
3366	0	(Datv(i,J)*vbt(i,J) + vhbt0(i,J))))
3367		enddo
3368		endif
3369
3370	0	end subroutine btloop_eta_predictor
3371
3372	528	subroutine btloop_find_PF(PFu, PFv, isv, iev, jsv, jev, eta_PF_BT, eta_PF, &
3373	528	gtot_N, gtot_S, gtot_E, gtot_W, dgeo_de, find_etaav, &
3374	528	wt_accel2_n, eta_sum, v_first, G, US, CS)
3375		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3376		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3377		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3378		PFu !< The anomalous zonal pressure force acceleration [L T-2 ~> m s-2].
3379		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3380		PFv !< The meridional pressure force acceleration [L T-2 ~> m s-2].
3381		integer, intent(in) :: isv !< The starting i-index of eta being set in ths loop
3382		integer, intent(in) :: iev !< The ending i-index of eta_pred being set in ths loop
3383		integer, intent(in) :: jsv !< The starting j-index of eta_pred being set in ths loop
3384		integer, intent(in) :: jev !< The ending j-index of eta_pred being set in ths loop
3385		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3386		eta_PF_BT !< The eta array (either the SSH anomaly or column mass anomaly) that
3387		!! determines the barotropic pressure force [H ~> m or kg m-2]
3388		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3389		eta_PF !< The input 2-D eta field (either SSH anomaly or column mass anomaly)
3390		!! that was used to calculate the input pressure gradient
3391		!! accelerations [H ~> m or kg m-2].
3392		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3393		gtot_N !< The effective total reduced gravity used to relate free surface height
3394		!! deviations to pressure forces (including GFS and baroclinic contributions)
3395		!! in the barotropic momentum equations half a grid-point to the north of a
3396		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3397		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3398		gtot_S !< The effective total reduced gravity used to relate free surface height
3399		!! deviations to pressure forces (including GFS and baroclinic contributions)
3400		!! in the barotropic momentum equations half a grid-point to the south of a
3401		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3402		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E and gtot_W.)
3403		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3404		gtot_E !< The effective total reduced gravity used to relate free surface height
3405		!! deviations to pressure forces (including GFS and baroclinic contributions)
3406		!! in the barotropic momentum equations half a grid-point to the east of a
3407		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3408		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3409		gtot_W !< The effective total reduced gravity used to relate free surface height
3410		!! deviations to pressure forces (including GFS and baroclinic contributions)
3411		!! in the barotropic momentum equations half a grid-point to the west of a
3412		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3413		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E and gtot_W.)
3414		real, intent(in) :: dgeo_de !< The constant of proportionality between geopotential and
3415		!! sea surface height [nondim]. It is of order 1, but for stability this
3416		!! may be made larger than the physical problem would suggest.
3417		logical, intent(in) :: find_etaav !< If true, diagnose the time mean value of eta
3418		real, intent(in) :: wt_accel2_n !< The weighting value of wt_accel2 at step n.
3419		real, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
3420		eta_sum !< A weighted running sum of eta summed across the timesteps [H ~> m or kg m-2]
3421		logical, intent(in) :: v_first !< If true, update the v-velocity first with the present loop iteration
3422		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3423
3424		! Local variables
3425		integer :: i, j, js_u, je_u, is_v, ie_v
3426
3427		! Ensure that the extra points used for the temporally staggered Coriolis terms are updated.
3428	528	if (v_first) then
3429	288	is_v = isv-1 ; ie_v = iev+1 ; js_u = jsv ; je_u = jev
3430		else
3431	240	is_v = isv ; ie_v = iev ; js_u = jsv-1 ; je_u = jev+1
3432		endif
3433
3434	528	do concurrent (j=js_u:je_u, I=isv-1:iev)
3435		PFu(I,j) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_E(i,j)) - &
3436		((eta_PF_BT(i+1,j)-eta_PF(i+1,j))gtot_W(i+1,j))) &
3437	4279488	dgeo_de * CS%IdxCu(I,j)
3438		enddo
3439
3440	66192	do concurrent (J=jsv-1:jev, i=is_v:ie_v)
3441		PFv(i,J) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j)) - &
3442		((eta_PF_BT(i,j+1)-eta_PF(i,j+1))gtot_S(i,j+1))) &
3443	4289424	dgeo_de * CS%IdyCv(i,J)
3444		enddo
3445
3446	528	if (find_etaav .and. (abs(wt_accel2_n) > 0.0)) then
3447	31944	do concurrent (j=G%jsc:G%jec, i=G%isc:G%iec)
3448	1932744	eta_sum(i,j) = eta_sum(i,j) + wt_accel2_n * eta_PF_BT(i,j)
3449		enddo
3450		endif
3451
3452	528	end subroutine btloop_find_PF
3453
3454		!> This routine adds a dynamic pressure force based on the temporal changes in the predicted value
3455		!! of eta, perhaps as an effective divergence damping to emulate the rigidity of an ice-sheet.
3456	0	subroutine btloop_add_dyn_PF(PFu, PFv, eta_pred, eta, dyn_coef_eta, p_surf_dyn, &
3457		isv, iev, jsv, jev, v_first, G, US, CS)
3458		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3459		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3460		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3461		PFu !< The anomalous zonal pressure force acceleration [L T-2 ~> m s-2].
3462		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3463		PFv !< The meridional pressure force acceleration [L T-2 ~> m s-2].
3464		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3465		eta_pred !< The updated eta field (either SSH anomaly or column mass anomaly) that is
3466		!! used to estimate the divergence that is to be damped [H ~> m or kg m-2].
3467		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3468		eta !< The previous eta field (either SSH anomaly or column mass anomaly) that is
3469		!! used to estimate the divergence that is to be damped [H ~> m or kg m-2].
3470		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3471		dyn_coef_eta !< The coefficient relating the changes in eta to the dynamic surface pressure
3472		!! under rigid ice [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
3473		real, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
3474		p_surf_dyn !< A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].
3475		integer, intent(in) :: isv !< The starting i-index of eta being set in ths loop
3476		integer, intent(in) :: iev !< The ending i-index of eta_pred being set in ths loop
3477		integer, intent(in) :: jsv !< The starting j-index of eta_pred being set in ths loop
3478		integer, intent(in) :: jev !< The ending j-index of eta_pred being set in ths loop
3479		logical, intent(in) :: v_first !< If true, update the v-velocity first with the present loop iteration
3480		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3481
3482		! Local variables
3483		integer :: i, j, js_u, je_u, is_v, ie_v
3484
3485		! Ensure that the extra points used for the temporally staggered Coriolis terms are updated.
3486	0	if (v_first) then
3487	0	is_v = isv-1 ; ie_v = iev+1 ; js_u = jsv ; je_u = jev
3488		else
3489	0	is_v = isv ; ie_v = iev ; js_u = jsv-1 ; je_u = jev+1
3490		endif
3491
3492		! Use the change in eta to estimate the flow divergence and dynamic pressure.
3493	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3494	0	p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j))
3495		enddo
3496
3497	0	do concurrent (j=js_u:je_u, I=isv-1:iev)
3498	0	PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j)
3499		enddo
3500	0	do concurrent (J=jsv-1:jev, i=is_v:ie_v)
3501	0	PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J)
3502		enddo
3503
3504	0	end subroutine btloop_add_dyn_PF
3505
3506		!> Update meridional velocity.
3507	528	subroutine btloop_update_v(dtbt, ubt, vbt, v_accel_bt, &
3508	528	Cor_v, PFv, is_v, ie_v, Js_v, Je_v, f_4_v, &
3509	528	bt_rem_v, BT_force_v, Cor_ref_v, Rayleigh_v, &
3510		wt_accel_n, G, US, CS, Cor_bracket_bug)
3511		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3512		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3513		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3514		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3515		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3516		vbt !< The meridional barotropic velocity [L T-1 ~> m s-1].
3517		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3518		v_accel_bt !< The difference between the meridional acceleration from the
3519		!! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
3520		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3521		Cor_v !< The meridional Coriolis acceleration [L T-2 ~> m s-2]
3522		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3523		PFv !< The meridional pressure force acceleration [L T-2 ~> m s-2].
3524		real, dimension(4,SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3525		f_4_v !< The terms giving the contribution to the Coriolis acceleration at a meridional
3526		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3527		!! These are the products of thicknesses at u points and appropriately staggered
3528		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3529		!! they are approximately f / 4. The 4 values on the innermost loop are for
3530		!! u-velocities to the southwest, southeast, northwest and northeast.
3531		integer, intent(in) :: is_v !< The starting i-index of the range of v-point values to calculate
3532		integer, intent(in) :: ie_v !< The ending i-index of the range of v-point values to calculate
3533		integer, intent(in) :: Js_v !< The starting j-index of the range of v-point values to calculate
3534		integer, intent(in) :: Je_v !< The ending j-index of the range of v-point values to calculate
3535		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3536		bt_rem_v !< The fraction of the barotropic meridional velocity that
3537		!! remains after a time step, the rest being lost to bottom
3538		!! drag [nondim]. bt_rem_v is between 0 and 1.
3539		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3540		BT_force_v !< The vertical average of all of the v-accelerations that are
3541		!! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
3542		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3543		Cor_ref_v !< The meridional barotropic Coriolis acceleration due
3544		!! to the reference velocities [L T-2 ~> m s-2].
3545		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3546		Rayleigh_v !< A Rayleigh drag timescale operating at v-points for drag parameterizations
3547		!! that introduced directly into the barotropic solver rather than coming
3548		!! in via the visc_rem_v arrays from the layered equations [T-1 ~> s-1]
3549		real, intent(in) :: wt_accel_n !< The raw or relative weights of each of the barotropic timesteps
3550		!! in determining the average accelerations [nondim]
3551		real, intent(in) :: dtbt !< The barotropic time step [T ~> s].
3552		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3553		logical, optional, intent(in) :: Cor_bracket_bug !< If present and true, use an order of operations that is
3554		!! not bitwise rotationally symmetric in the meridional Coriolis term
3555
3556		! Local variables
3557		logical :: use_bracket_bug
3558		integer :: i, j
3559
3560	528	use_bracket_bug = .false. ; if (present(Cor_bracket_bug)) use_bracket_bug = Cor_bracket_bug
3561
3562		! The bracket bug only applies if v is second, use ioff to check.
3563	528	if (use_bracket_bug) then
3564	0	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3565		Cor_v(i,J) = -1.0(((f_4_v(1,i,J) ubt(I-1,j)) + (f_4_v(2,i,J) * ubt(I,j))) + &
3566	0	((f_4_v(4,i,J) * ubt(I,j+1)) + (f_4_v(3,i,J) * ubt(I-1,j+1)))) - Cor_ref_v(i,J)
3567		enddo
3568		else
3569	66192	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3570		Cor_v(i,J) = -1.0(((f_4_v(1,i,J) ubt(I-1,j)) + (f_4_v(4,i,J) * ubt(I,j+1))) + &
3571	4289424	((f_4_v(2,i,J) * ubt(I,j)) + (f_4_v(3,i,J) * ubt(I-1,j+1)))) - Cor_ref_v(i,J)
3572		enddo
3573		endif
3574
3575		! This updates the v-velocity, except at OBC points.
3576	66192	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3577		vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + &
3578	4223232	dtbt * ((BT_force_v(i,J) + Cor_v(i,J)) + PFv(i,J)))
3579	4289424	if (abs(vbt(i,J)) < CS%vel_underflow) vbt(i,J) = 0.0
3580		enddo
3581
3582	528	if (CS%linear_wave_drag) then
3583	0	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3584		v_accel_bt(i,J) = v_accel_bt(i,J) + wt_accel_n * &
3585	0	((Cor_v(i,J) + PFv(i,J)) - vbt(i,J)*Rayleigh_v(i,J))
3586		enddo
3587		else
3588	66192	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3589	4289424	v_accel_bt(i,J) = v_accel_bt(i,J) + wt_accel_n * (Cor_v(i,J) + PFv(i,J))
3590		enddo
3591		endif
3592
3593	528	end subroutine btloop_update_v
3594
3595		!> Update zonal velocity.
3596	528	subroutine btloop_update_u(dtbt, ubt, vbt, u_accel_bt, &
3597	528	Cor_u, PFu, Is_u, Ie_u, js_u, je_u, f_4_u, &
3598	528	bt_rem_u, BT_force_u, Cor_ref_u, Rayleigh_u, &
3599		wt_accel_n, G, US, CS)
3600		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3601		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3602		real, intent(in) :: dtbt !< The barotropic time step [T ~> s].
3603		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3604		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3605		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3606		vbt !< The meridional barotropic velocity [L T-1 ~> m s-1].
3607		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3608		u_accel_bt !! The difference between the zonal acceleration from the
3609		!< barotropic calculation and BT_force_v [L T-2 ~> m s-2].
3610		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3611		Cor_u !< The anomalous zonal Coriolis acceleration [L T-2 ~> m s-2]
3612		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3613		PFu !< The anomalous zonal pressure force acceleration [L T-2 ~> m s-2].
3614		integer, intent(in) :: Is_u !< The starting i-index of the range of u-point values to calculate
3615		integer, intent(in) :: Ie_u !< The ending i-index of the range of u-point values to calculate
3616		integer, intent(in) :: js_u !< The starting j-index of the range of u-point values to calculate
3617		integer, intent(in) :: je_u !< The ending j-index of the range of u-point values to calculate
3618		real, dimension(4,SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3619		f_4_u !< The terms giving the contribution to the Coriolis acceleration at a zonal
3620		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3621		!! These are the products of thicknesses at v points and appropriately staggered
3622		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3623		!! they are approximately f / 4. The 4 values on the innermost loop are for
3624		!! v-velocities to the southwest, southeast, northwest and northeast.
3625		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3626		bt_rem_u !< The fraction of the barotropic meridional velocity that
3627		!! remains after a time step, the rest being lost to bottom
3628		!! drag [nondim]. bt_rem_v is between 0 and 1.
3629		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3630		BT_force_u !< The vertical average of all of the v-accelerations that are
3631		!! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
3632		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3633		Cor_ref_u !< The meridional barotropic Coriolis acceleration due
3634		!! to the reference velocities [L T-2 ~> m s-2].
3635		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3636		Rayleigh_u !< A Rayleigh drag timescale operating at u-points for drag parameterizations
3637		!! that introduced directly into the barotropic solver rather than coming
3638		!! in via the visc_rem_u arrays from the layered equations [T-1 ~> s-1].
3639		real, intent(in) :: wt_accel_n !< The raw or relative weights of each of the barotropic timesteps
3640		!! in determining the average accelerations [nondim]
3641		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3642
3643		! Local variables
3644		integer :: i, j
3645
3646	66144	do concurrent (j=js_u:je_u, I=Is_u:Ie_u)
3647		Cor_u(I,j) = (((f_4_u(4,I,j) * vbt(i+1,J)) + (f_4_u(1,I,j) * vbt(i,J-1))) + &
3648		((f_4_u(3,I,j) * vbt(i,J)) + (f_4_u(2,I,j) * vbt(i+1,J-1)))) - &
3649	4213344	Cor_ref_u(I,j)
3650
3651		ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + &
3652	4213344	dtbt * ((BT_force_u(I,j) + Cor_u(I,j)) + PFu(I,j)))
3653	4279488	if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0
3654		enddo
3655
3656	528	if (CS%linear_wave_drag) then
3657	0	do concurrent (j=js_u:je_u, I=Is_u:Ie_u)
3658		u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel_n * &
3659	0	((Cor_u(I,j) + PFu(I,j)) - ubt(I,j)*Rayleigh_u(I,j))
3660		enddo
3661		else
3662	66144	do concurrent (j=js_u:je_u, I=Is_u:Ie_u)
3663	4279488	u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel_n * (Cor_u(I,j) + PFu(I,j))
3664		enddo
3665		endif
3666
3667	528	end subroutine btloop_update_u
3668
3669
3670		!> Calculate the zonal and meridional velocity from the 3-D velocity.
3671	48	subroutine btstep_ubt_from_layer(U_in, V_in, wt_u, wt_v, ubt, vbt, G, GV, CS)
3672		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3673		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3674		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3675		real, intent(in) :: U_in(SZIB_(G),SZJ_(G),SZK_(GV)) !< The initial (3-D) zonal velocity [L T-1 ~> m s-1]
3676		real, intent(in) :: V_in(SZI_(G),SZJB_(G),SZK_(GV)) !< The initial (3-D) meridional velocity [L T-1 ~> m s-1]
3677		real, intent(in) :: wt_u(SZIB_(G),SZJ_(G),SZK_(GV)) !< The normalized weights to be used in calculating
3678		!! zonal barotropic velocities, possibly with sums
3679		!! less than one due to viscous losses [nondim]
3680		real, intent(in) :: wt_v(SZI_(G),SZJB_(G),SZK_(GV)) !< The normalized weights to be used in calculating
3681		!! meridional barotropic velocities, possibly with
3682		!! sums less than one due to viscous losses [nondim]
3683		real, intent(out) :: ubt(SZIBW_(CS),SZJW_(CS)) !< The zonal barotropic velocity [L T-1 ~> m s-1]
3684		real, intent(out) :: vbt(SZIW_(CS),SZJBW_(CS)) !< The meridional barotropic velocity [L T-1 ~> m s-1]
3685
3686		! Local variables
3687		integer :: i, j, k, is, ie, js, je, nz
3688
3689	48	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
3690
3691	6240	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw-1:CS%iedw)
3692	427296	ubt(i,j) = 0.0
3693		enddo
3694	6192	do concurrent (j=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
3695	430128	vbt(i,j) = 0.0
3696		enddo
3697
3698	48	do concurrent (j=js:je)
3699	218880	do k=1,nz
3700	2880	do concurrent (I=is-1:ie)
3701	26352000	ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * U_in(I,j,k)
3702		enddo
3703		enddo
3704	2928	do concurrent (I=is-1:ie)
3705	351360	if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0
3706		enddo
3707		enddo
3708	48	do concurrent (J=js-1:je)
3709	222528	do k=1,nz
3710	2928	do concurrent (i=is:ie)
3711	26571600	vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k)
3712		enddo
3713		enddo
3714	2976	do concurrent (i=is:ie)
3715	354288	if (abs(vbt(i,J)) < CS%vel_underflow) vbt(i,J) = 0.0
3716		enddo
3717		enddo
3718
3719	48	end subroutine btstep_ubt_from_layer
3720
3721
3722		!> Calculate the zonal and meridional acceleration of each layer due to the barotropic calculation.
3723	48	subroutine btstep_layer_accel(dt, u_accel_bt, v_accel_bt, pbce, gtot_E, gtot_W, gtot_N, gtot_S, &
3724	48	e_anom, G, GV, CS, accel_layer_u, accel_layer_v)
3725		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3726		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3727		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3728		real, intent(in) :: dt !< The time increment to integrate over [T ~> s].
3729		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3730		u_accel_bt !< The difference between the zonal acceleration from the
3731		!! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
3732		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3733		v_accel_bt !< The difference between the meridional acceleration from the
3734		!! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
3735		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer
3736		!! due to free surface height anomalies
3737		!! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3738		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3739		gtot_E !< The effective total reduced gravity used to relate free surface height
3740		!! deviations to pressure forces (including GFS and baroclinic contributions)
3741		!! in the barotropic momentum equations half a grid-point to the east of a
3742		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3743		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3744		gtot_W !< The effective total reduced gravity used to relate free surface height
3745		!! deviations to pressure forces (including GFS and baroclinic contributions)
3746		!! in the barotropic momentum equations half a grid-point to the west of a
3747		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3748		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3749		gtot_N !< The effective total reduced gravity used to relate free surface height
3750		!! deviations to pressure forces (including GFS and baroclinic contributions)
3751		!! in the barotropic momentum equations half a grid-point to the north of a
3752		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3753		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3754		gtot_S !< The effective total reduced gravity used to relate free surface height
3755		!! deviations to pressure forces (including GFS and baroclinic contributions)
3756		!! in the barotropic momentum equations half a grid-point to the south of a
3757		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3758		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E, etc.)
3759		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: &
3760		e_anom !< The anomaly in the sea surface height or column mass
3761		!! averaged between the beginning and end of the time step,
3762		!! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
3763		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due
3764		!! to the barotropic calculation [L T-2 ~> m s-2].
3765		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer
3766		!! due to the barotropic calculation [L T-2 ~> m s-2].
3767
3768		! Local variables
3769		real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2].
3770		real :: Idt ! The inverse of dt [T-1 ~> s-1].
3771		integer :: i, j, k, is, ie, js, je, nz
3772
3773	48	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
3774
3775	48	Idt = 1.0 / dt
3776	48	accel_underflow = CS%vel_underflow * Idt
3777
3778		! Now calculate each layer's accelerations.
3779	48	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
3780		accel_layer_u(I,j,k) = (u_accel_bt(I,j) - &
3781		(((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j)) - &
3782	26136000	((pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j))) * CS%IdxCu(I,j) )
3783	26490336	if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0
3784		enddo
3785	48	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
3786		accel_layer_v(i,J,k) = (v_accel_bt(i,J) - &
3787		(((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1)) - &
3788	26352000	((pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j))) * CS%IdyCv(i,J) )
3789	26709168	if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0
3790		enddo
3791
3792	48	end subroutine btstep_layer_accel
3793
3794		!> This subroutine automatically determines an optimal value for dtbt based on some state of the ocean. Either pbce or
3795		!! gtot_est is required to calculate gravitational acceleration. Column thickness can be estimated using BT_cont, eta,
3796		!! and SSH_add (default=0), with priority given in that order. The subroutine sets CS%dtbt_max and CS%dtbt.
3797	26	subroutine set_dtbt(G, GV, US, CS, pbce, gtot_est, BT_cont, eta, SSH_add)
3798		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3799		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3800		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3801		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3802		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
3803		optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer due to free
3804		!! surface height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3805		real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational acceleration
3806		!! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3807		type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the effective open
3808		!! face areas as a function of barotropic flow.
3809		real, dimension(SZI_(G),SZJ_(G)), &
3810		optional, intent(in) :: eta !< The barotropic free surface height anomaly or column mass
3811		!! anomaly [H ~> m or kg m-2].
3812		real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to provide a margin of
3813		!! error when calculating the external wave speed [Z ~> m].
3814
3815		! Local variables
3816		real, dimension(SZI_(G),SZJ_(G)) :: &
3817	28	gtot_E, & ! gtot_X is the effective total reduced gravity used to relate
3818	28	gtot_W, & ! free surface height deviations to pressure forces (including
3819	28	gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
3820	28	gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W)
3821		! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3822		! (See Hallberg, J Comp Phys 1997 for a discussion.)
3823		real, dimension(SZIBS_(G),SZJ_(G)) :: &
3824	14	Datu ! Basin depth at u-velocity grid points times the y-grid
3825		! spacing [H L ~> m2 or kg m-1].
3826		real, dimension(SZI_(G),SZJBS_(G)) :: &
3827	14	Datv ! Basin depth at v-velocity grid points times the x-grid
3828		! spacing [H L ~> m2 or kg m-1].
3829		real :: det_de ! The partial derivative due to self-attraction and loading
3830		! of the reference geopotential with the sea surface height [nondim].
3831		! This is typically ~0.09 or less.
3832		real :: dgeo_de ! The constant of proportionality between geopotential and
3833		! sea surface height [nondim]. It is a nondimensional number of
3834		! order 1. For stability, this may be made larger
3835		! than physical problem would suggest.
3836		real :: add_SSH ! An additional contribution to SSH to provide a margin of error
3837		! when calculating the external wave speed [Z ~> m].
3838		real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic
3839		! timesteps [T2 ~> s2]
3840		real :: dtbt_max ! The maximum barotropic timestep [T ~> s]
3841		real :: Idt_max2 ! The squared inverse of the local maximum stable
3842		! barotropic time step [T-2 ~> s-2].
3843		logical :: use_BT_cont
3844		type(memory_size_type) :: MS
3845
3846		integer :: i, j, k, is, ie, js, je, nz
3847
3848	14	if (.not.CS%module_is_initialized) call MOM_error(FATAL, &
3849	0	"set_dtbt: Module MOM_barotropic must be initialized before it is used.")
3850
3851	14	if (.not.CS%split) return
3852	14	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
3853	14	MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed
3854
3855
3856	14	if (.not.(present(pbce) .or. present(gtot_est))) call MOM_error(FATAL, &
3857	0	"set_dtbt: Either pbce or gtot_est must be present.")
3858
3859	14	add_SSH = 0.0 ; if (present(SSH_add)) add_SSH = SSH_add
3860
3861	14	use_BT_cont = .false.
3862	14	if (present(BT_cont)) use_BT_cont = (associated(BT_cont))
3863
3864		!$omp target enter data map(alloc: gtot_E, gtot_W, gtot_N, gtot_S, Datu, Datv)
3865	14	if (use_BT_cont) then
3866	0	call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0)
3867	14	elseif (CS%Nonlinear_continuity .and. present(eta)) then
3868	0	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, eta=eta)
3869		else
3870	14	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, add_max=add_SSH)
3871		endif
3872
3873	14	det_de = 0.0
3874	14	if (CS%calculate_SAL) call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
3875	14	if (CS%tidal_sal_bug) then
3876	0	dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra)
3877		else
3878	14	dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de)
3879		endif
3880	14	if (present(pbce)) then
3881	13	do concurrent (j=js:je)
3882	780	do concurrent (i=is:ie)
3883	93600	gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0
3884	94380	gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0
3885		enddo
3886	60073	do k=1,nz
3887	780	do concurrent (i=is:ie)
3888	7020000	gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * CS%frhatu(I,j,k)
3889	7020000	gtot_W(i,j) = gtot_W(i,j) + pbce(i,j,k) * CS%frhatu(I-1,j,k)
3890	7020000	gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * CS%frhatv(i,J,k)
3891	7078500	gtot_S(i,j) = gtot_S(i,j) + pbce(i,j,k) * CS%frhatv(i,J-1,k)
3892		enddo
3893		enddo
3894		enddo
3895		else
3896	1	do concurrent (j=js:je, i=is:ie)
3897	7200	gtot_E(i,j) = gtot_est ; gtot_W(i,j) = gtot_est
3898	7321	gtot_N(i,j) = gtot_est ; gtot_S(i,j) = gtot_est
3899		enddo
3900		endif
3901
3902	14	min_max_dt2 = 1.0e38US%s_to_T*2 ! A huge value for the permissible timestep squared.
3903	14	do concurrent (j=js:je, i=is:ie) DO_LOCALITY(reduce(min:min_max_dt2))
3904		! This is pretty accurate for gravity waves, but it is a conservative
3905		! estimate since it ignores the stabilizing effect of the bottom drag.
3906		Idt_max2 = 0.5 * (1.0 + 2.0CS%bebt) (G%IareaT(i,j) * &
3907		(((gtot_E(i,j)Datu(I,j)G%IdxCu(I,j)) + (gtot_W(i,j)Datu(I-1,j)G%IdxCu(I-1,j))) + &
3908		((gtot_N(i,j)Datv(i,J)G%IdyCv(i,J)) + (gtot_S(i,j)Datv(i,J-1)G%IdyCv(i,J-1)))) + &
3909		((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
3910	100800	(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1))) * CS%BT_Coriolis_scale**2 )
3911	102494	if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2
3912		enddo
3913		!$omp target exit data map(release: gtot_E, gtot_W, gtot_N, gtot_S, Datu, Datv)
3914	14	dtbt_max = sqrt(min_max_dt2 / dgeo_de)
3915	14	if (id_clock_sync > 0) call cpu_clock_begin(id_clock_sync)
3916	14	call min_across_PEs(dtbt_max)
3917	14	if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync)
3918
3919	14	CS%dtbt = CS%dtbt_fraction * dtbt_max
3920	14	CS%dtbt_max = dtbt_max
3921
3922	14	if (CS%debug) then
3923	0	call chksum0(CS%dtbt, "End set_dtbt dtbt", unscale=US%T_to_s)
3924	0	call chksum0(CS%dtbt_max, "End set_dtbt dtbt_max", unscale=US%T_to_s)
3925		endif
3926	27	end subroutine set_dtbt
3927
3928		! The following 5 subroutines apply the open boundary conditions.
3929
3930		!> This subroutine applies the open boundary conditions on barotropic zonal
3931		!! velocities and mass transports, as developed by Mehmet Ilicak.
3932	0	subroutine apply_u_velocity_OBCs(ubt, uhbt, ubt_trans, eta, SpV_avg, ubt_old, BT_OBC, G, MS, &
3933		GV, US, CS, halo, dtbt, bebt, use_BT_cont, integral_BT_cont, dt_elapsed, &
3934	0	Datu, BTCL_u, uhbt0, ubt_int, ubt_int_prev, uhbt_int, uhbt_int_prev)
3935		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3936		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
3937		!! the argument arrays.
3938		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1].
3939		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport
3940		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
3941		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in
3942		!! transport [L T-1 ~> m s-1].
3943		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
3944		!! column mass anomaly [H ~> m or kg m-2].
3945		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
3946		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic
3947		!! step [L T-1 ~> m s-1].
3948		type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
3949		!! related to the open boundary conditions,
3950		!! set by set_up_BT_OBC.
3951		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3952		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3953		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
3954		integer, intent(in) :: halo !< The extra halo size to use here.
3955		real, intent(in) :: dtbt !< The time step [T ~> s].
3956		real, intent(in) :: bebt !< The fractional weighting of the future velocity
3957		!! in determining the transport [nondim]
3958		logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
3959		!! transports.
3960		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity
3961		!! equation directly from the initial condition
3962		!! using the time-integrated barotropic velocity.
3963		real, intent(in) :: dt_elapsed !< The amount of time in the barotropic stepping
3964		!! that will have elapsed [T ~> s].
3965		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
3966		!! [H L ~> m2 or kg m-1].
3967		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
3968		!! for a dynamic estimate of the face areas at
3969		!! u-points.
3970		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that
3971		!! the barotropic functions agree with the sum
3972		!! of the layer transports
3973		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
3974		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_int !< The time-integrated zonal barotropic
3975		!! velocity after this update [L T-1 ~> m s-1]
3976		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_int_prev !< The time-integrated zonal barotropic
3977		!! velocity before this update [L T-1 ~> m s-1]
3978		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt_int !< The time-integrated zonal barotropic transport
3979		!! after this update [H L2 T-1 ~> m3 s-1 or kg s-1]
3980		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt_int_prev !< The time-integrated zonal barotropic
3981		!! transport before this update
3982		!! [H L2 T-1 ~> m3 s-1 or kg s-1]
3983
3984		! Local variables
3985		real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
3986		real :: cfl ! The CFL number at the point in question [nondim]
3987		real :: u_inlet ! The zonal inflow velocity [L T-1 ~> m s-1]
3988		real :: uhbt_int_new ! The updated time-integrated zonal transport [H L2 ~> m3]
3989		real :: ssh_in ! The inflow sea surface height [Z ~> m]
3990		real :: ssh_1 ! The sea surface height in the interior cell adjacent to the an OBC face [Z ~> m]
3991		real :: ssh_2 ! The sea surface height in the next cell inward from the OBC face [Z ~> m]
3992		real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1]
3993		integer :: i, j, Is_u, Ie_u, js, je
3994
3995	0	if (.not.BT_OBC%u_OBCs_on_PE) return
3996
3997	0	Idtbt = 1.0 / dtbt
3998
3999		! Work on Eastern OBC points
4000	0	Is_u = max((G%isc-1)-halo, BT_OBC%Is_u_E_obc) ; Ie_u = min(G%iec+halo, BT_OBC%Ie_u_E_obc)
4001	0	js = max(G%jsc-halo, BT_OBC%js_u_E_obc) ; je = min(G%jec+halo, BT_OBC%je_u_E_obc)
4002	0	do j=js,je ; do I=Is_u,Ie_u ; if (BT_OBC%u_OBC_type(I,j) > 0) then
4003	0	if (BT_OBC%u_OBC_type(I,j) == SPECIFIED_OBC) then ! Eastern specified OBC
4004	0	uhbt(I,j) = BT_OBC%uhbt(I,j)
4005	0	ubt(I,j) = BT_OBC%ubt_outer(I,j)
4006	0	ubt_trans(I,j) = ubt(I,j)
4007	0	if (integral_BT_cont) then
4008	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4009	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4010		endif
4011	0	elseif (BT_OBC%u_OBC_type(I,j) == FLATHER_OBC) then ! Eastern Flather OBC
4012	0	cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
4013	0	u_inlet = cflubt_old(I-1,j) + (1.0-cfl)ubt_old(I,j) ! Valid for cfl<1
4014	0	if (I <= MS%isdw) then
4015		! Do not apply an Eastern Flather OBC at the western halo points on a PE, as doing so would
4016		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4017	0	ssh_in = BT_OBC%SSH_outer_u(I,j)
4018	0	elseif (GV%Boussinesq) then
4019	0	ssh_in = GV%H_to_Z(eta(i,j) + (0.5-cfl)(eta(i,j)-eta(i-1,j))) ! internal
4020		else
4021	0	ssh_1 = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j) - (CS%bathyT(i,j) + G%Z_ref)
4022	0	ssh_2 = GV%H_to_RZ * eta(i-1,j) * SpV_avg(i-1,j) - (CS%bathyT(i-1,j) + G%Z_ref)
4023	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4024		endif
4025	0	if (BT_OBC%dZ_u(I,j) > 0.0) then
4026	0	vel_prev = ubt(I,j)
4027		ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
4028	0	(BT_OBC%Cg_u(I,j)/BT_OBC%dZ_u(I,j)) * (ssh_in-BT_OBC%SSH_outer_u(I,j)))
4029	0	ubt_trans(I,j) = (1.0-bebt)vel_prev + bebtubt(I,j)
4030		else ! This point is now dry.
4031	0	ubt(I,j) = 0.0
4032	0	ubt_trans(I,j) = 0.0
4033		endif
4034	0	elseif (BT_OBC%u_OBC_type(I,j) == GRADIENT_OBC) then ! Eastern gradient OBC
4035	0	ubt(I,j) = ubt(I-1,j)
4036	0	ubt_trans(I,j) = ubt(I,j)
4037		endif
4038
4039		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4040	0	if (BT_OBC%u_OBC_type(I,j) > SPECIFIED_OBC) then ! Eastern Flather or gradient OBC
4041	0	if (integral_BT_cont) then
4042	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4043	0	uhbt_int_new = find_uhbt(ubt_int(I,j), BTCL_u(I,j)) + dt_elapsed*uhbt0(I,j)
4044	0	uhbt(I,j) = (uhbt_int_new - uhbt_int_prev(I,j)) * Idtbt
4045	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4046		! The line above is equivalent to: uhbt_int(I,j) = uhbt_int_new
4047	0	elseif (use_BT_cont) then
4048	0	uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
4049		else
4050	0	uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
4051		endif
4052		endif
4053
4054		endif ; enddo ; enddo
4055
4056		! Work on Western OBC points
4057	0	Is_u = max((G%isc-1)-halo, BT_OBC%Is_u_W_obc) ; Ie_u = min(G%iec+halo, BT_OBC%Ie_u_W_obc)
4058	0	js = max(G%jsc-halo, BT_OBC%js_u_W_obc) ; je = min(G%jec+halo, BT_OBC%je_u_W_obc)
4059	0	do j=js,je ; do I=Is_u,Ie_u ; if (BT_OBC%u_OBC_type(I,j) < 0) then
4060	0	if (BT_OBC%u_OBC_type(I,j) == -SPECIFIED_OBC) then ! Western specified OBC
4061	0	uhbt(I,j) = BT_OBC%uhbt(I,j)
4062	0	ubt(I,j) = BT_OBC%ubt_outer(I,j)
4063	0	ubt_trans(I,j) = ubt(I,j)
4064	0	if (integral_BT_cont) then
4065	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4066	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4067		endif
4068	0	elseif (BT_OBC%u_OBC_type(I,j) == -FLATHER_OBC) then ! Western Flather OBC
4069	0	cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
4070	0	u_inlet = cflubt_old(I+1,j) + (1.0-cfl)ubt_old(I,j) ! Valid for cfl<1
4071	0	if (I >= MS%iedw-1) then
4072		! Do not apply a Western Flather OBC at the eastern halo points on a PE, as doing so would
4073		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4074	0	ssh_in = BT_OBC%SSH_outer_u(I,j)
4075	0	elseif (GV%Boussinesq) then
4076	0	ssh_in = GV%H_to_Z(eta(i+1,j) + (0.5-cfl)(eta(i+1,j)-eta(i+2,j))) ! internal
4077		else
4078	0	ssh_1 = GV%H_to_RZ * eta(i+1,j) * SpV_avg(i+1,j) - (CS%bathyT(i+1,j) + G%Z_ref)
4079	0	ssh_2 = GV%H_to_RZ * eta(i+2,j) * SpV_avg(i+2,j) - (CS%bathyT(i+2,j) + G%Z_ref)
4080	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4081		endif
4082
4083	0	if (BT_OBC%dZ_u(I,j) > 0.0) then
4084	0	vel_prev = ubt(I,j)
4085		ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
4086	0	(BT_OBC%Cg_u(I,j)/BT_OBC%dZ_u(I,j)) * (BT_OBC%SSH_outer_u(I,j)-ssh_in))
4087	0	ubt_trans(I,j) = (1.0-bebt)vel_prev + bebtubt(I,j)
4088		else ! This point is now dry.
4089	0	ubt(I,j) = 0.0
4090	0	ubt_trans(I,j) = 0.0
4091		endif
4092	0	elseif (BT_OBC%u_OBC_type(I,j) == -GRADIENT_OBC) then ! Western gradient OBC
4093	0	ubt(I,j) = ubt(I+1,j)
4094	0	ubt_trans(I,j) = ubt(I,j)
4095		endif
4096
4097		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4098	0	if (BT_OBC%u_OBC_type(I,j) < -SPECIFIED_OBC) then ! Western Flather or gradient OBC
4099	0	if (integral_BT_cont) then
4100	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4101	0	uhbt_int_new = find_uhbt(ubt_int(I,j), BTCL_u(I,j)) + dt_elapsed*uhbt0(I,j)
4102	0	uhbt(I,j) = (uhbt_int_new - uhbt_int_prev(I,j)) * Idtbt
4103	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4104		! The line above is equivalent to: uhbt_int(I,j) = uhbt_int_new
4105	0	elseif (use_BT_cont) then
4106	0	uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
4107		else
4108	0	uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
4109		endif
4110		endif
4111
4112		endif ; enddo ; enddo
4113
4114		end subroutine apply_u_velocity_OBCs
4115
4116		!> This subroutine applies the open boundary conditions on barotropic meridional
4117		!! velocities and mass transports, as developed by Mehmet Ilicak.
4118	0	subroutine apply_v_velocity_OBCs(vbt, vhbt, vbt_trans, eta, SpV_avg, vbt_old, BT_OBC, &
4119		G, MS, GV, US, CS, halo, dtbt, bebt, use_BT_cont, integral_BT_cont, dt_elapsed, &
4120	0	Datv, BTCL_v, vhbt0, vbt_int, vbt_int_prev, vhbt_int, vhbt_int_prev)
4121		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
4122		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
4123		!! the argument arrays.
4124		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic velocity
4125		!! [L T-1 ~> m s-1].
4126		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport
4127		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
4128		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in
4129		!! transports [L T-1 ~> m s-1].
4130		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
4131		!! column mass anomaly [H ~> m or kg m-2].
4132		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
4133		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic
4134		!! step [L T-1 ~> m s-1].
4135		type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
4136		!! related to the open boundary conditions,
4137		!! set by set_up_BT_OBC.
4138		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4139		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
4140		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
4141		integer, intent(in) :: halo !< The extra halo size to use here.
4142		real, intent(in) :: dtbt !< The time step [T ~> s].
4143		real, intent(in) :: bebt !< The fractional weighting of the future velocity
4144		!! in determining the transport [nondim]
4145		logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
4146		!! transports.
4147		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity
4148		!! equation directly from the initial condition
4149		!! using the time-integrated barotropic velocity.
4150		real, intent(in) :: dt_elapsed !< The amount of time in the barotropic stepping
4151		!! that will have elapsed [T ~> s].
4152		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
4153		!! [H L ~> m2 or kg m-1].
4154		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
4155		!! for a dynamic estimate of the face areas at
4156		!! v-points.
4157		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that
4158		!! the barotropic functions agree with the sum
4159		!! of the layer transports
4160		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
4161		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_int !< The time-integrated meridional barotropic
4162		!! velocity after this update [L T-1 ~> m s-1].
4163		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_int_prev !< The time-integrated meridional barotropic
4164		!! velocity before this update [L T-1 ~> m s-1].
4165		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt_int !< The time-integrated meridional barotropic
4166		!! transport after this update
4167		!! [H L2 T-1 ~> m3 s-1 or kg s-1]
4168		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt_int_prev !< The time-integrated meridional barotropic
4169		!! transport before this update
4170		!! [H L2 T-1 ~> m3 s-1 or kg s-1]
4171
4172		! Local variables
4173		real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
4174		real :: cfl ! The CFL number at the point in question [nondim]
4175		real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1]
4176		real :: vhbt_int_new ! The updated time-integrated meridional transport [H L2 ~> m3]
4177		real :: ssh_in ! The inflow sea surface height [Z ~> m]
4178		real :: ssh_1 ! The sea surface height in the interior cell adjacent to the an OBC face [Z ~> m]
4179		real :: ssh_2 ! The sea surface height in the next cell inward from the OBC face [Z ~> m]
4180		real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1]
4181		integer :: i, j, is, ie, Js_v, Je_v
4182
4183	0	if (.not.BT_OBC%v_OBCs_on_PE) return
4184
4185	0	Idtbt = 1.0 / dtbt
4186
4187		! This routine uses separate blocks of code and loops for Northern and southern open boundary
4188		! condition points, despite this leading to some code duplication, because the OBCs almost always
4189		! occur at the edge of the domain, and in parallel appliations, most PEs will only have one or
4190		! the other.
4191
4192
4193		! Work on Northern OBC points
4194	0	is = max(G%isc-halo, BT_OBC%is_v_N_obc) ; ie = min(G%iec+halo, BT_OBC%ie_v_N_obc)
4195	0	Js_v = max((G%jsc-1)-halo, BT_OBC%Js_v_N_obc) ; Je_v = min(G%jec+halo, BT_OBC%Je_v_N_obc)
4196	0	do J=Js_v,Je_v ; do i=is,ie ; if (BT_OBC%v_OBC_type(i,J) > 0) then
4197	0	if (BT_OBC%v_OBC_type(i,J) == SPECIFIED_OBC) then ! Northern specified OBC
4198	0	vhbt(i,J) = BT_OBC%vhbt(i,J)
4199	0	vbt(i,J) = BT_OBC%vbt_outer(i,J)
4200	0	vbt_trans(i,J) = vbt(i,J)
4201	0	if (integral_BT_cont) then
4202	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt(i,J)
4203	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4204		endif
4205	0	elseif (BT_OBC%v_OBC_type(i,J) == FLATHER_OBC) then ! Northern Flather OBC
4206	0	cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! CFL
4207	0	v_inlet = cflvbt_old(i,J-1) + (1.0-cfl)vbt_old(i,J) ! Valid for cfl<1
4208	0	if (J <= MS%jsdw) then
4209		! Do not apply a Northern Flather OBC at the southern halo points on a PE, as doing so would
4210		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4211	0	ssh_in = BT_OBC%SSH_outer_v(i,J)
4212	0	elseif (GV%Boussinesq) then
4213	0	ssh_in = GV%H_to_Z(eta(i,j) + (0.5-cfl)(eta(i,j)-eta(i,j-1))) ! internal
4214		else
4215	0	ssh_1 = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j) - (CS%bathyT(i,j) + G%Z_ref)
4216	0	ssh_2 = GV%H_to_RZ * eta(i,j-1) * SpV_avg(i,j-1) - (CS%bathyT(i,j-1) + G%Z_ref)
4217	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4218		endif
4219
4220	0	if (BT_OBC%dZ_v(i,J) > 0.0) then
4221	0	vel_prev = vbt(i,J)
4222		vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
4223	0	(BT_OBC%Cg_v(i,J)/BT_OBC%dZ_v(i,J)) * (ssh_in-BT_OBC%SSH_outer_v(i,J)))
4224	0	vbt_trans(i,J) = (1.0-bebt)vel_prev + bebtvbt(i,J)
4225		else ! This point is now dry
4226	0	vbt(i,J) = 0.0
4227	0	vbt_trans(i,J) = 0.0
4228		endif
4229	0	elseif (BT_OBC%v_OBC_type(i,J) == GRADIENT_OBC) then ! Northern gradient OBC
4230	0	vbt(i,J) = vbt(i,J-1)
4231	0	vbt_trans(i,J) = vbt(i,J)
4232		endif
4233
4234		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4235	0	if (BT_OBC%v_OBC_type(i,J) > SPECIFIED_OBC) then ! Northern Flather or gradient OBC
4236	0	if (integral_BT_cont) then
4237	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt_trans(i,J)
4238	0	vhbt_int_new = find_vhbt(vbt_int(i,J), BTCL_v(i,J)) + dt_elapsed*vhbt0(i,J)
4239	0	vhbt(i,J) = (vhbt_int_new - vhbt_int_prev(i,J)) * Idtbt
4240	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4241		! The line above is equivalent to: vhbt_int(i,J) = vhbt_int_new
4242	0	elseif (use_BT_cont) then
4243	0	vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J)) + vhbt0(i,J)
4244		else
4245	0	vhbt(i,J) = vbt_trans(i,J)*Datv(i,J) + vhbt0(i,J)
4246		endif
4247		endif
4248
4249		endif ; enddo ; enddo
4250
4251		! Work on Southern OBC points
4252	0	is = max(G%isc-halo, BT_OBC%is_v_S_obc) ; ie = min(G%iec+halo, BT_OBC%ie_v_S_obc)
4253	0	Js_v = max((G%jsc-1)-halo, BT_OBC%Js_v_S_obc) ; Je_v = min(G%jec+halo, BT_OBC%Je_v_S_obc)
4254	0	do J=Js_v,Je_v ; do i=is,ie ; if (BT_OBC%v_OBC_type(i,J) < 0) then
4255	0	if (BT_OBC%v_OBC_type(i,J) == -SPECIFIED_OBC) then ! Southern specified OBC
4256	0	vhbt(i,J) = BT_OBC%vhbt(i,J)
4257	0	vbt(i,J) = BT_OBC%vbt_outer(i,J)
4258	0	vbt_trans(i,J) = vbt(i,J)
4259	0	if (integral_BT_cont) then
4260	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt(i,J)
4261	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4262		endif
4263	0	elseif (BT_OBC%v_OBC_type(i,J) == -FLATHER_OBC) then ! Southern Flather OBC
4264	0	cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! CFL
4265	0	v_inlet = cflvbt_old(i,J+1) + (1.0-cfl)vbt_old(i,J) ! Valid for cfl <1
4266	0	if (J >= MS%jedw-1) then
4267		! Do not apply a Southern Flather OBC at the northern halo points on a PE, as doing so would
4268		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4269	0	ssh_in = BT_OBC%SSH_outer_v(i,J)
4270	0	elseif (GV%Boussinesq) then
4271	0	ssh_in = GV%H_to_Z(eta(i,j+1) + (0.5-cfl)(eta(i,j+1)-eta(i,j+2))) ! internal
4272		else
4273	0	ssh_1 = GV%H_to_RZ * eta(i,j+1) * SpV_avg(i,j+1) - (CS%bathyT(i,j+1) + G%Z_ref)
4274	0	ssh_2 = GV%H_to_RZ * eta(i,j+2) * SpV_avg(i,j+2) - (CS%bathyT(i,j+2) + G%Z_ref)
4275	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4276		endif
4277
4278	0	if (BT_OBC%dZ_v(i,J) > 0.0) then
4279	0	vel_prev = vbt(i,J)
4280		vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
4281	0	(BT_OBC%Cg_v(i,J)/BT_OBC%dZ_v(i,J)) * (BT_OBC%SSH_outer_v(i,J)-ssh_in))
4282	0	vbt_trans(i,J) = (1.0-bebt)vel_prev + bebtvbt(i,J)
4283		else ! This point is now dry
4284	0	vbt(i,J) = 0.0
4285	0	vbt_trans(i,J) = 0.0
4286		endif
4287	0	elseif (BT_OBC%v_OBC_type(i,J) == -GRADIENT_OBC) then ! Southern gradient OBC
4288	0	vbt(i,J) = vbt(i,J+1)
4289	0	vbt_trans(i,J) = vbt(i,J)
4290		endif
4291
4292		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4293	0	if (BT_OBC%v_OBC_type(i,J) < -SPECIFIED_OBC) then ! Southern Flather or gradient OBC
4294	0	if (integral_BT_cont) then
4295	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt_trans(i,J)
4296	0	vhbt_int_new = find_vhbt(vbt_int(i,J), BTCL_v(i,J)) + dt_elapsed*vhbt0(i,J)
4297	0	vhbt(i,J) = (vhbt_int_new - vhbt_int_prev(i,J)) * Idtbt
4298	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4299		! The line above is equivalent to: vhbt_int(i,J) = vhbt_int_new
4300	0	elseif (use_BT_cont) then
4301	0	vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J)) + vhbt0(i,J)
4302		else
4303	0	vhbt(i,J) = vbt_trans(i,J)*Datv(i,J) + vhbt0(i,J)
4304		endif
4305		endif
4306
4307		endif ; enddo ; enddo
4308
4309		end subroutine apply_v_velocity_OBCs
4310
4311		!> This subroutine sets up the time-invariant control information about the open boundary
4312		!! conditions on the full wide halo domain used by the barotropic solver.
4313	0	subroutine initialize_BT_OBC(OBC, BT_OBC, G, CS)
4314		type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type.
4315		type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
4316		!! related to the open boundary conditions,
4317		!! set by set_up_BT_OBC.
4318		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
4319		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
4320
4321		! Local variables
4322		real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
4323	0	u_OBC ! A set of integers encoding the nature of the u-point open boundary conditions,
4324		! converted to real numbers to work with the MOM6 halo update code [nondim]
4325		real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
4326	0	v_OBC ! A set of integers encoding the nature of the v-point open boundary conditions,
4327		! converted to real numbers to work with the MOM6 halo update code [nondim]
4328		integer :: OBC_type ! The integer encoding the type of OBC being used at a point [nondim]
4329		logical :: reversed_OBCs ! True of there any OBCs in the opposite halo on this PE, e.g. points
4330		! with a southern OBC in a northern halo.
4331		logical :: any_reversed_OBCs
4332		integer :: i, j, isdw, iedw, jsdw, jedw
4333		integer :: l_seg, Flather_OBC_in_halo
4334
4335	0	isdw = CS%isdw ; iedw = CS%iedw ; jsdw = CS%jsdw ; jedw = CS%jedw
4336
4337	0	u_OBC(:,:) = 0.0
4338	0	v_OBC(:,:) = 0.0
4339
4340	0	do j=G%jsc,G%jec ; do I=G%isc-1,G%iec
4341
4342	0	OBC_type = 0
4343	0	if (OBC%segnum_u(I,j) /= 0) then
4344	0	l_seg = abs(OBC%segnum_u(I,j))
4345	0	if (OBC%segment(l_seg)%gradient) OBC_type = GRADIENT_OBC
4346	0	if (OBC%segment(l_seg)%Flather) OBC_type = FLATHER_OBC
4347	0	if (OBC%segment(l_seg)%specified) OBC_type = SPECIFIED_OBC
4348	0	u_OBC(I,j) = sign(OBC_type, OBC%segnum_u(I,j))
4349		endif
4350		enddo ; enddo
4351
4352	0	do J=G%jsc-1,G%jec ; do i=G%isc,G%iec
4353	0	OBC_type = 0
4354	0	if (OBC%segnum_v(i,J) /= 0) then
4355	0	l_seg = abs(OBC%segnum_v(i,J))
4356	0	if (OBC%segment(l_seg)%gradient) OBC_type = GRADIENT_OBC
4357	0	if (OBC%segment(l_seg)%Flather) OBC_type = FLATHER_OBC
4358	0	if (OBC%segment(l_seg)%specified) OBC_type = SPECIFIED_OBC
4359	0	v_OBC(i,J) = sign(OBC_type, OBC%segnum_v(i,J))
4360		endif
4361		enddo ; enddo
4362
4363	0	call pass_vector(u_OBC, v_OBC, CS%BT_Domain)
4364
4365	0	allocate(BT_OBC%u_OBC_type(isdw-1:iedw,jsdw:jedw), source=0)
4366	0	allocate(BT_OBC%v_OBC_type(isdw:iedw,jsdw-1:jedw), source=0)
4367
4368		! Determine the maximum and minimum index range for various directions of OBC points on this PE
4369		! by first setting these one point outside of the wrong side of the domain.
4370	0	BT_OBC%Is_u_W_obc = iedw + 1 ; BT_OBC%Ie_u_W_obc = isdw - 2
4371	0	BT_OBC%js_u_W_obc = jedw + 1 ; BT_OBC%je_u_W_obc = jsdw - 1
4372	0	BT_OBC%Is_u_E_obc = iedw + 1 ; BT_OBC%Ie_u_E_obc = isdw - 2
4373	0	BT_OBC%js_u_E_obc = jedw + 1 ; BT_OBC%je_u_E_obc = jsdw - 1
4374	0	BT_OBC%is_v_S_obc = iedw + 1 ; BT_OBC%ie_v_S_obc = isdw - 1
4375	0	BT_OBC%Js_v_S_obc = jedw + 1 ; BT_OBC%Je_v_S_obc = jsdw - 2
4376	0	BT_OBC%is_v_N_obc = iedw + 1 ; BT_OBC%ie_v_N_obc = isdw - 1
4377	0	BT_OBC%Js_v_N_obc = jedw + 1 ; BT_OBC%Je_v_N_obc = jsdw - 2
4378
4379	0	Flather_OBC_in_halo = 0
4380	0	do j=jsdw,jedw ; do I=isdw-1,iedw
4381	0	BT_OBC%u_OBC_type(I,j) = nint(u_OBC(I,j))
4382	0	if (BT_OBC%u_OBC_type(I,j) < 0) then ! This point has OBC_DIRECTION_W.
4383	0	if ((BT_OBC%u_OBC_type(I,j) == -FLATHER_OBC) .and. (I >= iedw-1)) then
4384		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4385	0	Flather_OBC_in_halo = 1
4386		else
4387	0	BT_OBC%Is_u_W_obc = min(I, BT_OBC%Is_u_W_obc) ; BT_OBC%Ie_u_W_obc = max(I, BT_OBC%Ie_u_W_obc)
4388	0	BT_OBC%js_u_W_obc = min(j, BT_OBC%js_u_W_obc) ; BT_OBC%je_u_W_obc = max(j, BT_OBC%je_u_W_obc)
4389		endif
4390		endif
4391	0	if (BT_OBC%u_OBC_type(I,j) > 0) then ! This point has OBC_DIRECTION_E.
4392	0	if ((BT_OBC%u_OBC_type(I,j) == FLATHER_OBC) .and. (I <= isdw)) then
4393		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4394	0	Flather_OBC_in_halo = 1
4395		else
4396	0	BT_OBC%Is_u_E_obc = min(I, BT_OBC%Is_u_E_obc) ; BT_OBC%Ie_u_E_obc = max(I, BT_OBC%Ie_u_E_obc)
4397	0	BT_OBC%js_u_E_obc = min(j, BT_OBC%js_u_E_obc) ; BT_OBC%je_u_E_obc = max(j, BT_OBC%je_u_E_obc)
4398		endif
4399		endif
4400		enddo ; enddo
4401
4402	0	do J=jsdw-1,jedw ; do i=isdw,iedw
4403	0	BT_OBC%v_OBC_type(i,J) = nint(v_OBC(i,J))
4404	0	if (BT_OBC%v_OBC_type(i,J) < 0) then ! This point has OBC_DIRECTION_S.
4405	0	if ((BT_OBC%v_OBC_type(i,J) == -FLATHER_OBC) .and. (J >= jedw-1)) then
4406		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4407	0	Flather_OBC_in_halo = 1
4408		else
4409	0	BT_OBC%is_v_S_obc = min(i, BT_OBC%is_v_S_obc) ; BT_OBC%ie_v_S_obc = max(i, BT_OBC%ie_v_S_obc)
4410	0	BT_OBC%Js_v_S_obc = min(J, BT_OBC%Js_v_S_obc) ; BT_OBC%Je_v_S_obc = max(J, BT_OBC%Je_v_S_obc)
4411		endif
4412		endif
4413	0	if (BT_OBC%v_OBC_type(i,J) > 0) then ! This point has OBC_DIRECTION_N.
4414	0	if ((BT_OBC%v_OBC_type(i,J) == FLATHER_OBC) .and. (J <= jsdw)) then
4415		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4416	0	Flather_OBC_in_halo = 1
4417		else
4418	0	BT_OBC%is_v_N_obc = min(i, BT_OBC%is_v_N_obc) ; BT_OBC%ie_v_N_obc = max(i, BT_OBC%ie_v_N_obc)
4419	0	BT_OBC%Js_v_N_obc = min(J, BT_OBC%Js_v_N_obc) ; BT_OBC%Je_v_N_obc = max(J, BT_OBC%Je_v_N_obc)
4420		endif
4421		endif
4422		enddo ; enddo
4423
4424	0	BT_OBC%u_OBCs_on_PE = ((BT_OBC%Is_u_E_obc <= iedw) .or. (BT_OBC%Is_u_W_obc <= iedw))
4425	0	BT_OBC%v_OBCs_on_PE = ((BT_OBC%is_v_N_obc <= iedw) .or. (BT_OBC%is_v_S_obc <= iedw))
4426
4427
4428		! Determine whether there are any OBCs in the opposite halo on any processors in the domain, e.g.,
4429		! points with OBC_DIRECTION_S in a northern halo.
4430		reversed_OBCs = (BT_OBC%u_OBCs_on_PE .and. ((BT_OBC%Is_u_E_obc <= G%isc-1) .or. (BT_OBC%Ie_u_W_obc >= G%iec))) .or. &
4431	0	(BT_OBC%v_OBCs_on_PE .and. ((BT_OBC%Js_v_N_obc <= G%jsc-1) .or. (BT_OBC%Je_v_S_obc >= G%jec)))
4432	0	any_reversed_OBCs = any_across_PEs(reversed_OBCs)
4433	0	if (any_reversed_OBCs) call MOM_mesg("OBCs in an opposite halo require the use of a wider stencil.", 5)
4434	0	if (any_reversed_OBCs) CS%min_stencil = max(CS%min_stencil, 2)
4435
4436		! Allocate time-varying arrays that will be used for open boundary conditions.
4437
4438		! This pair is used with either Flather or specified OBCs.
4439	0	allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw), source=0.0)
4440	0	allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw), source=0.0)
4441	0	call create_group_pass(BT_OBC%pass_uv, BT_OBC%ubt_outer, BT_OBC%vbt_outer, CS%BT_Domain)
4442
4443		! This pair is only used with specified OBCs.
4444	0	allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw), source=0.0)
4445	0	allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw), source=0.0)
4446	0	call create_group_pass(BT_OBC%pass_uv, BT_OBC%uhbt, BT_OBC%vhbt, CS%BT_Domain)
4447
4448	0	if (OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally) then
4449		! These 3 pairs are only used with Flather OBCs.
4450	0	allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw), source=0.0)
4451	0	allocate(BT_OBC%dZ_u(isdw-1:iedw,jsdw:jedw), source=0.0)
4452	0	allocate(BT_OBC%SSH_outer_u(isdw-1:iedw,jsdw:jedw), source=0.0)
4453
4454	0	allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw), source=0.0)
4455	0	allocate(BT_OBC%dZ_v(isdw:iedw,jsdw-1:jedw), source=0.0)
4456	0	allocate(BT_OBC%SSH_outer_v(isdw:iedw,jsdw-1:jedw), source=0.0)
4457
4458	0	call create_group_pass(BT_OBC%scalar_pass, BT_OBC%SSH_outer_u, BT_OBC%SSH_outer_v, CS%BT_Domain, To_All+Scalar_Pair)
4459	0	call create_group_pass(BT_OBC%scalar_pass, BT_OBC%dZ_u, BT_OBC%dZ_v, CS%BT_Domain, To_All+Scalar_Pair)
4460	0	call create_group_pass(BT_OBC%scalar_pass, BT_OBC%Cg_u, BT_OBC%Cg_v, CS%BT_Domain, To_All+Scalar_Pair)
4461		endif
4462
4463	0	end subroutine initialize_BT_OBC
4464
4465		!> This subroutine sets up the time-varying fields in the private structure used to apply the open
4466		!! boundary conditions, as developed by Mehmet Ilicak.
4467	0	subroutine set_up_BT_OBC(OBC, eta, SpV_avg, BT_OBC, BT_Domain, G, GV, US, CS, MS, halo, use_BT_cont, &
4468	0	integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v, dgeo_de)
4469		type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type.
4470		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the
4471		!! argument arrays.
4472		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
4473		!! column mass anomaly [H ~> m or kg m-2].
4474		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
4475		type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
4476		!! related to the open boundary conditions,
4477		!! set by set_up_BT_OBC.
4478		type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
4479		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
4480		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4481		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
4482		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
4483		integer, intent(in) :: halo !< The extra halo size to use here.
4484		logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
4485		!! transports.
4486		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity
4487		!! equation directly from the initial condition
4488		!! using the time-integrated barotropic velocity.
4489		real, intent(in) :: dt_baroclinic !< The baroclinic timestep for this cycle of
4490		!! updates to the barotropic solver [T ~> s]
4491		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
4492		!! [H L ~> m2 or kg m-1].
4493		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
4494		!! [H L ~> m2 or kg m-1].
4495		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
4496		!! for a dynamic estimate of the face areas at
4497		!! u-points.
4498		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
4499		!! for a dynamic estimate of the face areas at
4500		!! v-points.
4501		real, intent(in) :: dgeo_de !< The constant of proportionality between
4502		!! geopotential and sea surface height [nondim].
4503		! Local variables
4504		real :: I_dt ! The inverse of the time interval of this call [T-1 ~> s-1].
4505		integer :: i, j, k, is, ie, js, je, n, nz
4506		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
4507		integer :: isdw, iedw, jsdw, jedw
4508		type(OBC_segment_type), pointer :: segment !< Open boundary segment
4509
4510	0	is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
4511	0	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke
4512	0	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
4513	0	isdw = MS%isdw ; iedw = MS%iedw ; jsdw = MS%jsdw ; jedw = MS%jedw
4514
4515	0	I_dt = 1.0 / dt_baroclinic
4516
4517	0	if (BT_OBC%u_OBCs_on_PE) then
4518	0	if (OBC%specified_u_BCs_exist_globally) then
4519	0	do n = 1, OBC%number_of_segments
4520	0	segment => OBC%segment(n)
4521	0	if (segment%is_E_or_W .and. segment%specified) then
4522	0	do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
4523	0	BT_OBC%uhbt(I,j) = 0.
4524		enddo ; enddo
4525	0	do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
4526	0	BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k)
4527		enddo ; enddo ; enddo
4528		endif
4529		enddo
4530		endif
4531	0	do j=js,je ; do I=is-1,ie ; if (BT_OBC%u_OBC_type(I,j) /= 0) then
4532	0	if (abs(BT_OBC%u_OBC_type(I,j)) == SPECIFIED_OBC) then ! Eastern or western specified OBC
4533	0	if (integral_BT_cont) then
4534	0	BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j)dt_baroclinic, BTCL_u(I,j)) I_dt
4535	0	elseif (use_BT_cont) then
4536	0	BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j), BTCL_u(I,j))
4537		else
4538	0	if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j)
4539		endif
4540	0	elseif (BT_OBC%u_OBC_type(I,j) == FLATHER_OBC) then ! Eastern Flather OBC
4541	0	if (GV%Boussinesq) then
4542	0	BT_OBC%dZ_u(I,j) = CS%bathyT(i,j) + GV%H_to_Z*eta(i,j)
4543		else
4544	0	BT_OBC%dZ_u(I,j) = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j)
4545		endif
4546	0	BT_OBC%Cg_u(I,j) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_u(I,j))
4547	0	elseif (BT_OBC%u_OBC_type(I,j) == -FLATHER_OBC) then ! Western Flather OBC
4548	0	if (GV%Boussinesq) then
4549	0	BT_OBC%dZ_u(I,j) = CS%bathyT(i+1,j) + GV%H_to_Z*eta(i+1,j)
4550		else
4551	0	BT_OBC%dZ_u(I,j) = GV%H_to_RZ * eta(i+1,j) * SpV_avg(i+1,j)
4552		endif
4553	0	BT_OBC%Cg_u(I,j) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_u(I,j))
4554		endif
4555		endif ; enddo ; enddo
4556
4557	0	if (OBC%Flather_u_BCs_exist_globally) then
4558	0	do n = 1, OBC%number_of_segments
4559	0	segment => OBC%segment(n)
4560	0	if (segment%is_E_or_W .and. segment%Flather) then
4561	0	do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
4562	0	BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j)
4563	0	BT_OBC%SSH_outer_u(I,j) = segment%SSH(I,j) + G%Z_ref
4564		enddo ; enddo
4565		endif
4566		enddo
4567		endif
4568		endif
4569
4570	0	if (BT_OBC%v_OBCs_on_PE) then
4571	0	if (OBC%specified_v_BCs_exist_globally) then
4572	0	do n = 1, OBC%number_of_segments
4573	0	segment => OBC%segment(n)
4574	0	if (segment%is_N_or_S .and. segment%specified) then
4575	0	do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
4576	0	BT_OBC%vhbt(i,J) = 0.
4577		enddo ; enddo
4578	0	do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
4579	0	BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k)
4580		enddo ; enddo ; enddo
4581		endif
4582		enddo
4583		endif
4584	0	do J=js-1,je ; do i=is,ie ; if (BT_OBC%v_OBC_type(i,J) /= 0) then
4585	0	if (abs(BT_OBC%v_OBC_type(i,J)) == SPECIFIED_OBC) then ! Northern or southern specified OBC
4586	0	if (integral_BT_cont) then
4587	0	BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J)dt_baroclinic, BTCL_v(i,J)) I_dt
4588	0	elseif (use_BT_cont) then
4589	0	BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J), BTCL_v(i,J))
4590		else
4591	0	if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J)
4592		endif
4593	0	elseif (BT_OBC%v_OBC_type(i,J) == FLATHER_OBC) then ! Northern Flather OBC
4594	0	if (GV%Boussinesq) then
4595	0	BT_OBC%dZ_v(i,J) = CS%bathyT(i,j) + GV%H_to_Z*eta(i,j)
4596		else
4597	0	BT_OBC%dZ_v(i,J) = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j)
4598		endif
4599	0	BT_OBC%Cg_v(i,J) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_v(i,J))
4600	0	elseif (BT_OBC%v_OBC_type(i,J) == -FLATHER_OBC) then ! Southern Flather OBC
4601	0	if (GV%Boussinesq) then
4602	0	BT_OBC%dZ_v(i,J) = CS%bathyT(i,j+1) + GV%H_to_Z*eta(i,j+1)
4603		else
4604	0	BT_OBC%dZ_v(i,J) = GV%H_to_RZ * eta(i,j+1) * SpV_avg(i,j+1)
4605		endif
4606	0	BT_OBC%Cg_v(i,J) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_v(i,J))
4607		endif
4608		endif ; enddo ; enddo
4609	0	if (OBC%Flather_v_BCs_exist_globally) then
4610	0	do n = 1, OBC%number_of_segments
4611	0	segment => OBC%segment(n)
4612	0	if (segment%is_N_or_S .and. segment%Flather) then
4613	0	do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
4614	0	BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J)
4615	0	BT_OBC%SSH_outer_v(i,J) = segment%SSH(i,J) + G%Z_ref
4616		enddo ; enddo
4617		endif
4618		enddo
4619		endif
4620		endif
4621
4622	0	call do_group_pass(BT_OBC%pass_uv, BT_Domain)
4623	0	if (OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally) &
4624	0	call do_group_pass(BT_OBC%scalar_pass, BT_Domain)
4625
4626	0	end subroutine set_up_BT_OBC
4627
4628		!> Clean up the BT_OBC memory.
4629	1	subroutine destroy_BT_OBC(BT_OBC)
4630		type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
4631		!! related to the open boundary conditions,
4632		!! set by set_up_BT_OBC.
4633
4634	1	if (allocated(BT_OBC%u_OBC_type)) deallocate(BT_OBC%u_OBC_type)
4635	1	if (allocated(BT_OBC%v_OBC_type)) deallocate(BT_OBC%v_OBC_type)
4636
4637	1	if (allocated(BT_OBC%Cg_u)) deallocate(BT_OBC%Cg_u)
4638	1	if (allocated(BT_OBC%dZ_u)) deallocate(BT_OBC%dZ_u)
4639	1	if (allocated(BT_OBC%uhbt)) deallocate(BT_OBC%uhbt)
4640	1	if (allocated(BT_OBC%ubt_outer)) deallocate(BT_OBC%ubt_outer)
4641	1	if (allocated(BT_OBC%SSH_outer_u)) deallocate(BT_OBC%SSH_outer_u)
4642
4643	1	if (allocated(BT_OBC%Cg_v)) deallocate(BT_OBC%Cg_v)
4644	1	if (allocated(BT_OBC%dZ_v)) deallocate(BT_OBC%dZ_v)
4645	1	if (allocated(BT_OBC%vhbt)) deallocate(BT_OBC%vhbt)
4646	1	if (allocated(BT_OBC%vbt_outer)) deallocate(BT_OBC%vbt_outer)
4647	1	if (allocated(BT_OBC%SSH_outer_v)) deallocate(BT_OBC%SSH_outer_v)
4648
4649	1	end subroutine destroy_BT_OBC
4650
4651		!> btcalc determines the fraction of the total water column in each
4652		!! layer at velocity points.
4653	96	subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
4654		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
4655		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4656		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
4657		intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
4658		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
4659		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
4660		optional, intent(in) :: h_u !< The specified effective thicknesses at u-points,
4661		!! perhaps scaled down to account for viscosity and
4662		!! fractional open areas [H ~> m or kg m-2]. These
4663		!! are used here as non-normalized weights for each
4664		!! layer that are converted the normalized weights
4665		!! for determining the barotropic accelerations.
4666		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
4667		optional, intent(in) :: h_v !< The specified effective thicknesses at v-points,
4668		!! perhaps scaled down to account for viscosity and
4669		!! fractional open areas [H ~> m or kg m-2]. These
4670		!! are used here as non-normalized weights for each
4671		!! layer that are converted the normalized weights
4672		!! for determining the barotropic accelerations.
4673		logical, optional, intent(in) :: may_use_default !< An optional logical argument
4674		!! to indicate that the default velocity point
4675		!! thicknesses may be used for this particular
4676		!! calculation, even though the setting of
4677		!! CS%hvel_scheme would usually require that h_u
4678		!! and h_v be passed in.
4679		type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure.
4680
4681		! Local variables
4682	98	real :: hatutot(SZIB_(G),SZJ_(G)) ! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2].
4683	98	real :: hatvtot(SZI_(G),SZJB_(G)) ! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2].
4684	98	real :: Ihatutot(SZIB_(G),SZJ_(G)) ! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1].
4685	98	real :: Ihatvtot(SZI_(G),SZJB_(G)) ! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1].
4686		real :: h_arith ! The arithmetic mean thickness [H ~> m or kg m-2].
4687		real :: h_harm ! The harmonic mean thicknesses [H ~> m or kg m-2].
4688		real :: h_neglect ! A thickness that is so small it is usually lost
4689		! in roundoff and can be neglected [H ~> m or kg m-2].
4690		real :: wt_arith ! The weight for the arithmetic mean thickness [nondim].
4691		! The harmonic mean uses a weight of (1 - wt_arith).
4692	98	real :: e_u(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! The interface heights at u-velocity points [H ~> m or kg m-2]
4693	98	real :: e_v(SZI_(G),SZJB_(G),SZK_(GV)+1) ! The interface heights at v-velocity points [H ~> m or kg m-2]
4694	49	real :: D_shallow_u(SZI_(G),SZJB_(G)) ! The height of the shallower of the adjacent bathymetric depths
4695		! around a u-point (positive upward) [H ~> m or kg m-2]
4696	49	real :: D_shallow_v(SZIB_(G),SZJ_(G))! The height of the shallower of the adjacent bathymetric depths
4697		! around a v-point (positive upward) [H ~> m or kg m-2]
4698		real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3]
4699
4700		logical :: use_default, test_dflt
4701		integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k
4702
4703	49	if (.not.CS%module_is_initialized) call MOM_error(FATAL, &
4704	0	"btcalc: Module MOM_barotropic must be initialized before it is used.")
4705
4706	49	if (.not.CS%split) return
4707
4708	49	use_default = .false.
4709	49	test_dflt = .false. ; if (present(may_use_default)) test_dflt = may_use_default
4710
4711	49	if (test_dflt) then
4712	1	if (.not.((present(h_u) .and. present(h_v)) .or. &
4713		(CS%hvel_scheme == HARMONIC) .or. (CS%hvel_scheme == HYBRID) .or.&
4714	1	(CS%hvel_scheme == ARITHMETIC))) use_default = .true.
4715		else
4716	48	if (.not.((present(h_u) .and. present(h_v)) .or. &
4717		(CS%hvel_scheme == HARMONIC) .or. (CS%hvel_scheme == HYBRID) .or.&
4718		(CS%hvel_scheme == ARITHMETIC))) call MOM_error(FATAL, &
4719	0	"btcalc: Inconsistent settings of optional arguments and hvel_scheme.")
4720		endif
4721
4722	49	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
4723	49	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
4724	49	h_neglect = GV%H_subroundoff
4725
4726		!$omp target enter data map(alloc: hatutot, hatvtot, Ihatutot, Ihatvtot)
4727
4728	49	do concurrent (j=js:je, I=is-1:ie)
4729	361718	hatutot(I,j) = 0.0
4730		enddo
4731
4732	49	if (present(h_u)) then
4733	48	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4734	26490336	CS%frhatu(I,j,k) = h_u(I,j,k)
4735		enddo
4736	48	do concurrent (j=js:je, I=is-1:ie)
4737	26490336	do k=1,nz
4738	26484480	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4739		enddo
4740		enddo
4741	1	elseif (CS%hvel_scheme == ARITHMETIC) then
4742	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4743	0	CS%frhatu(I,j,k) = 0.5 * (h(i+1,j,k) + h(i,j,k))
4744		enddo
4745	0	do concurrent (j=js:je, I=is-1:ie)
4746	0	do k=1,nz
4747	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4748		enddo
4749		enddo
4750	1	elseif (CS%hvel_scheme == HYBRID .or. use_default) then
4751	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
4752		!$omp target data map(alloc: e_u, D_shallow_u)
4753	1	do concurrent (j=js:je, I=is-1:ie)
4754	7260	e_u(I,j,nz+1) = -0.5 * Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j))
4755	7382	D_shallow_u(I,j) = -Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j))
4756		enddo
4757	76	do k=nz,1,-1
4758	1	do concurrent (j=js:je, I=is-1:ie)
4759	544500	e_u(I,j,K) = e_u(I,j,K+1) + 0.5 * (h(i+1,j,k) + h(i,j,k))
4760	544500	h_arith = 0.5 * (h(i+1,j,k) + h(i,j,k))
4761	544500	if (e_u(I,j,K+1) >= D_shallow_u(I,j)) then
4762	411538	CS%frhatu(I,j,k) = h_arith
4763		else
4764	132962	h_harm = (h(i+1,j,k) * h(i,j,k)) / (h_arith + h_neglect)
4765	132962	if (e_u(I,j,K) <= D_shallow_u(I,j)) then
4766	127894	CS%frhatu(I,j,k) = h_harm
4767		else
4768	5068	wt_arith = (e_u(I,j,K) - D_shallow_u(I,j)) / (h_arith + h_neglect)
4769	5068	CS%frhatu(I,j,k) = wt_arithh_arith + (1.0-wt_arith)h_harm
4770		endif
4771		endif
4772	553650	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4773		enddo
4774		enddo
4775		!$omp end target data
4776	0	elseif (CS%hvel_scheme == HARMONIC) then
4777		! Interpolates thicknesses onto u grid points with the
4778		! second order accurate estimate h = 2(h+ h-)/(h+ + h-).
4779	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4780		CS%frhatu(I,j,k) = 2.0(h(i+1,j,k) h(i,j,k)) / &
4781	0	((h(i+1,j,k) + h(i,j,k)) + h_neglect)
4782		enddo
4783	0	do concurrent (j=js:je, I=is-1:ie)
4784	0	do k=1,nz
4785	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4786		enddo
4787		enddo
4788		endif
4789
4790	49	if (CS%BT_OBC%u_OBCs_on_PE) then
4791		! todo: put i,j iterations into single do concurrent
4792	0	do concurrent (j=js:je)
4793		! Reset velocity point thicknesses and their sums at OBC points
4794	0	if ((j >= CS%BT_OBC%js_u_E_obc) .and. (j <= CS%BT_OBC%je_u_E_obc)) then
4795		!$omp do
4796	0	do I = max(is-1,CS%BT_OBC%Is_u_E_obc), min(ie,CS%BT_OBC%Ie_u_E_obc)
4797	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) then ! Eastern boundary condition
4798	0	hatutot(I,j) = 0.0
4799	0	do k=1,nz
4800	0	CS%frhatu(I,j,k) = h(i,j,k)
4801	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4802		enddo
4803		endif
4804		enddo
4805		endif
4806	0	if ((j >= CS%BT_OBC%js_u_W_obc) .and. (j <= CS%BT_OBC%je_u_W_obc)) then
4807		!$omp do
4808	0	do I = max(is-1,CS%BT_OBC%Is_u_W_obc), min(ie,CS%BT_OBC%Ie_u_W_obc)
4809	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) then ! Western boundary condition
4810	0	hatutot(I,j) = 0.0
4811	0	do k=1,nz
4812	0	CS%frhatu(I,j,k) = h(i+1,j,k)
4813	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4814		enddo
4815		endif
4816		enddo
4817		endif
4818		enddo
4819		endif
4820
4821		! Determine the fractional thickness of each layer at the velocity points.
4822	49	do concurrent (j=js:je, I=is-1:ie)
4823	361718	Ihatutot(I,j) = G%mask2dCu(I,j) / (hatutot(I,j) + h_neglect)
4824		enddo
4825	49	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4826	27042218	CS%frhatu(I,j,k) = CS%frhatu(I,j,k) * Ihatutot(I,j)
4827		enddo
4828
4829	49	do concurrent (J=js-1:je, i=is:ie)
4830	364609	hatvtot(i,J) = 0.0
4831		enddo
4832
4833	49	if (present(h_v)) then
4834	48	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4835	26709168	CS%frhatv(i,J,k) = h_v(i,J,k)
4836		enddo
4837	48	do concurrent (J=js-1:je, i=is:ie)
4838	26709168	do k=1,nz
4839	26703360	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4840		enddo
4841		enddo
4842	1	elseif (CS%hvel_scheme == ARITHMETIC) then
4843	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4844	0	CS%frhatv(i,J,k) = 0.5 * (h(i,j+1,k) + h(i,j,k))
4845		enddo
4846	0	do concurrent (J=js-1:je, i=is:ie)
4847	0	do k=1,nz
4848	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4849		enddo
4850		enddo
4851	1	elseif (CS%hvel_scheme == HYBRID .or. use_default) then
4852	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
4853		!$omp target data map(alloc: e_v, D_shallow_v)
4854	1	do concurrent (J=js-1:je, i=is:ie)
4855	7320	e_v(i,J,nz+1) = -0.5 * Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j))
4856	7441	D_shallow_v(i,J) = -Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j))
4857		enddo
4858	76	do k=nz,1,-1
4859	1	do concurrent (J=js-1:je, i=is:ie)
4860	549000	e_v(i,J,K) = e_v(i,J,K+1) + 0.5 * (h(i,j+1,k) + h(i,j,k))
4861	549000	h_arith = 0.5 * (h(i,j+1,k) + h(i,j,k))
4862	549000	if (e_v(i,J,K+1) >= D_shallow_v(i,J)) then
4863	411614	CS%frhatv(i,J,k) = h_arith
4864		else
4865	137386	h_harm = (h(i,j+1,k) * h(i,j,k)) / (h_arith + h_neglect)
4866	137386	if (e_v(i,J,K) <= D_shallow_v(i,J)) then
4867	132252	CS%frhatv(i,J,k) = h_harm
4868		else
4869	5134	wt_arith = (e_v(i,J,K) - D_shallow_v(i,J)) / (h_arith + h_neglect)
4870	5134	CS%frhatv(i,J,k) = wt_arithh_arith + (1.0-wt_arith)h_harm
4871		endif
4872		endif
4873	558075	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4874		enddo
4875		enddo
4876		!$omp end target data
4877	0	elseif (CS%hvel_scheme == HARMONIC) then
4878	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4879		CS%frhatv(i,J,k) = 2.0(h(i,j+1,k) h(i,j,k)) / &
4880	0	((h(i,j+1,k) + h(i,j,k)) + h_neglect)
4881		enddo
4882	0	do concurrent (J=js-1:je, i=is:ie)
4883	0	do k=1,nz
4884	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4885		enddo
4886		enddo
4887		endif
4888
4889	49	if (CS%BT_OBC%v_OBCs_on_PE) then
4890		! todo: put i,j iterations into single do concurrent
4891	0	do concurrent (J=js-1:je)
4892		! Reset v-velocity point thicknesses and their sums at OBC points
4893	0	if ((J >= CS%BT_OBC%Js_v_N_obc) .and. (J <= CS%BT_OBC%Je_v_N_obc)) then
4894		!$omp do simd
4895	0	do i = max(is,CS%BT_OBC%is_v_N_obc), min(ie,CS%BT_OBC%ie_v_N_obc)
4896	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) then ! Northern boundary condition
4897	0	hatvtot(i,J) = 0.0
4898	0	do k=1,nz
4899	0	CS%frhatv(i,J,k) = h(i,j,k)
4900	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4901		enddo
4902		endif
4903		enddo
4904		endif
4905	0	if ((J >= CS%BT_OBC%Js_v_S_obc) .and. (J <= CS%BT_OBC%Je_v_S_obc)) then
4906		!$omp do simd
4907	0	do i = max(is,CS%BT_OBC%is_v_S_obc), min(ie,CS%BT_OBC%ie_v_S_obc)
4908	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) then ! Southern boundary condition
4909	0	hatvtot(i,J) = 0.0
4910	0	do k=1,nz
4911	0	CS%frhatv(i,J,k) = h(i,j+1,k)
4912	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4913		enddo
4914		endif
4915		enddo
4916		endif
4917		enddo
4918		endif
4919
4920		! Determine the fractional thickness of each layer at the velocity points.
4921	49	do concurrent (J=js-1:je, i=is:ie)
4922	364609	Ihatvtot(i,J) = G%mask2dCv(i,J) / (hatvtot(i,J) + h_neglect)
4923		enddo
4924	49	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4925	27265609	CS%frhatv(i,J,k) = CS%frhatv(i,J,k) * Ihatvtot(i,J)
4926		enddo
4927
4928		!$omp target exit data map(delete: hatutot, hatvtot, Ihatutot, Ihatvtot)
4929
4930	49	if (CS%debug) then
4931		!$omp target update from(CS%frhatu, CS%frhatv)
4932		call uvchksum("btcalc frhat[uv]", CS%frhatu, CS%frhatv, G%HI, &
4933		haloshift=0, symmetric=.true., omit_corners=.true., &
4934	0	scalar_pair=.true.)
4935
4936	0	if (present(h_u) .and. present(h_v)) then
4937		!$omp target update from(h_u, h_v)
4938		call uvchksum("btcalc h_[uv]", h_u, h_v, G%HI, haloshift=0, &
4939		symmetric=.true., omit_corners=.true., unscale=GV%H_to_MKS, &
4940	0	scalar_pair=.true.)
4941		endif
4942
4943	0	call hchksum(h, "btcalc h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
4944		endif
4945	97	end subroutine btcalc
4946
4947		!> The function find_uhbt determines the zonal transport for a given velocity, or with
4948		!! INTEGRAL_BT_CONT=True it determines the time-integrated zonal transport for a given
4949		!! time-integrated velocity.
4950	4631316	pure function find_uhbt(u, BTC) result(uhbt)
4951		real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
4952		type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
4953		!! allow the barotropic transports to be calculated consistently
4954		!! with the layers' continuity equations. The dimensions of some
4955		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
4956
4957		real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1] or time integrated transport [L2 H ~> m3]
4958
4959	4631316	if (u == 0.0) then
4960	1625236	uhbt = 0.0
4961	3006080	elseif (u < BTC%uBT_EE) then
4962	67353	uhbt = (u - BTC%uBT_EE) * BTC%FA_u_EE + BTC%uh_EE
4963	2938727	elseif (u < 0.0) then
4964	143544	uhbt = u * (BTC%FA_u_E0 + BTC%uh_crvE * u**2)
4965	2795183	elseif (u <= BTC%uBT_WW) then
4966	2087697	uhbt = u * (BTC%FA_u_W0 + BTC%uh_crvW * u**2)
4967		else ! (u > BTC%uBT_WW)
4968	707486	uhbt = (u - BTC%uBT_WW) * BTC%FA_u_WW + BTC%uh_WW
4969		endif
4970
4971	4631316	end function find_uhbt
4972
4973		!> The function find_duhbt_du determines the marginal zonal face area for a given velocity, or
4974		!! with INTEGRAL_BT_CONT=True for a given time-integrated velocity.
4975	0	pure function find_duhbt_du(u, BTC) result(duhbt_du)
4976		real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
4977		type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
4978		!! allow the barotropic transports to be calculated consistently
4979		!! with the layers' continuity equations. The dimensions of some
4980		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
4981		real :: duhbt_du !< The zonal barotropic face area [L H ~> m2 or kg m-1]
4982
4983	0	if (u == 0.0) then
4984	0	duhbt_du = 0.5*(BTC%FA_u_E0 + BTC%FA_u_W0) ! Note the potential discontinuity here.
4985	0	elseif (u < BTC%uBT_EE) then
4986	0	duhbt_du = BTC%FA_u_EE
4987	0	elseif (u < 0.0) then
4988	0	duhbt_du = (BTC%FA_u_E0 + 3.0BTC%uh_crvE u**2)
4989	0	elseif (u <= BTC%uBT_WW) then
4990	0	duhbt_du = (BTC%FA_u_W0 + 3.0BTC%uh_crvW u**2)
4991		else ! (u > BTC%uBT_WW)
4992	0	duhbt_du = BTC%FA_u_WW
4993		endif
4994
4995	0	end function find_duhbt_du
4996
4997		!> This function inverts the transport function to determine the barotopic
4998		!! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True
4999		!! this finds the time-integrated velocity that is consistent with a time-integrated transport.
5000	0	function uhbt_to_ubt(uhbt, BTC) result(ubt)
5001		real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for,
5002		!! [H L2 T-1 ~> m3 s-1 or kg s-1] or the time-integrated
5003		!! transport [H L2 ~> m3 or kg].
5004		type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the
5005		!! barotropic transports to be calculated consistently with the
5006		!! layers' continuity equations. The dimensions of some
5007		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5008		real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]
5009		!! or the time-integrated velocity [L ~> m].
5010
5011		! Local variables
5012		real :: ubt_min, ubt_max ! Bounding values of vbt [L T-1 ~> m s-1] or [L ~> m]
5013		real :: uhbt_err ! The transport error [H L2 T-1 ~> m3 s-1 or kg s-1] or [H L2 ~> m3 or kg].
5014		real :: derr_du ! The change in transport error with vbt, i.e. the face area [H L ~> m2 or kg m-1].
5015		real :: uherr_min, uherr_max ! The bounding values of the transport error [H L2 T-1 ~> m3 s-1 or kg s-1]
5016		! or [H L2 ~> m3 or kg].
5017		real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
5018		real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
5019		real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
5020		! maximum increase of vs2, both [nondim].
5021		integer :: itt, max_itt = 20
5022
5023		! Find the value of ubt that gives uhbt.
5024	0	if (uhbt == 0.0) then
5025	0	ubt = 0.0
5026	0	elseif (uhbt < BTC%uh_EE) then
5027	0	ubt = BTC%uBT_EE + (uhbt - BTC%uh_EE) / BTC%FA_u_EE
5028	0	elseif (uhbt < 0.0) then
5029		! Iterate to convergence with Newton's method (when bounded) and the
5030		! false position method otherwise. ubt will be negative.
5031	0	ubt_min = BTC%uBT_EE ; uherr_min = BTC%uh_EE - uhbt
5032	0	ubt_max = 0.0 ; uherr_max = -uhbt
5033		! Use a false-position method first guess.
5034	0	ubt = BTC%uBT_EE * (uhbt / BTC%uh_EE)
5035	0	do itt = 1, max_itt
5036	0	uhbt_err = ubt * (BTC%FA_u_E0 + BTC%uh_crvE * ubt**2) - uhbt
5037
5038	0	if (abs(uhbt_err) < tol*abs(uhbt)) exit
5039	0	if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
5040	0	if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
5041
5042	0	derr_du = BTC%FA_u_E0 + 3.0 * BTC%uh_crvE * ubt**2
5043		if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
5044	0	(-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
5045		! Use a false-position method guess.
5046	0	ubt = ubt_max + (ubt_min-ubt_max) * (uherr_max / (uherr_max-uherr_min))
5047		else ! Use Newton's method.
5048	0	ubt = ubt - uhbt_err / derr_du
5049	0	if (abs(uhbt_err) < (0.01tol)abs(ubt_min*derr_du)) exit
5050		endif
5051		enddo
5052	0	elseif (uhbt <= BTC%uh_WW) then
5053		! Iterate to convergence with Newton's method. ubt will be positive.
5054	0	ubt_min = 0.0 ; uherr_min = -uhbt
5055	0	ubt_max = BTC%uBT_WW ; uherr_max = BTC%uh_WW - uhbt
5056		! Use a false-position method first guess.
5057	0	ubt = BTC%uBT_WW * (uhbt / BTC%uh_WW)
5058	0	do itt = 1, max_itt
5059	0	uhbt_err = ubt * (BTC%FA_u_W0 + BTC%uh_crvW * ubt**2) - uhbt
5060
5061	0	if (abs(uhbt_err) < tol*abs(uhbt)) exit
5062	0	if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
5063	0	if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
5064
5065	0	derr_du = BTC%FA_u_W0 + 3.0 * BTC%uh_crvW * ubt**2
5066		if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
5067	0	(-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
5068		! Use a false-position method guess.
5069	0	ubt = ubt_min + (ubt_max-ubt_min) * (-uherr_min / (uherr_max-uherr_min))
5070		else ! Use Newton's method.
5071	0	ubt = ubt - uhbt_err / derr_du
5072	0	if (abs(uhbt_err) < (0.01tol)(ubt_max*derr_du)) exit
5073		endif
5074		enddo
5075		else ! (uhbt > BTC%uh_WW)
5076	0	ubt = BTC%uBT_WW + (uhbt - BTC%uh_WW) / BTC%FA_u_WW
5077		endif
5078
5079	0	end function uhbt_to_ubt
5080
5081		!> The function find_vhbt determines the meridional transport for a given velocity, or with
5082		!! INTEGRAL_BT_CONT=True it determines the time-integrated meridional transport for a given
5083		!! time-integrated velocity.
5084	4665876	pure function find_vhbt(v, BTC) result(vhbt)
5085		real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
5086		type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that
5087		!! allow the barotropic transports to be calculated consistently
5088		!! with the layers' continuity equations. The dimensions of some
5089		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5090		real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1] or time integrated transport [L2 H ~> m3]
5091
5092	4665876	if (v == 0.0) then
5093	1692574	vhbt = 0.0
5094	2973302	elseif (v < BTC%vBT_NN) then
5095	124915	vhbt = (v - BTC%vBT_NN) * BTC%FA_v_NN + BTC%vh_NN
5096	2848387	elseif (v < 0.0) then
5097	776713	vhbt = v * (BTC%FA_v_N0 + BTC%vh_crvN * v**2)
5098	2071674	elseif (v <= BTC%vBT_SS) then
5099	1734284	vhbt = v * (BTC%FA_v_S0 + BTC%vh_crvS * v**2)
5100		else ! (v > BTC%vBT_SS)
5101	337390	vhbt = (v - BTC%vBT_SS) * BTC%FA_v_SS + BTC%vh_SS
5102		endif
5103
5104	4665876	end function find_vhbt
5105
5106		!> The function find_dvhbt_dv determines the marginal meridional face area for a given velocity, or
5107		!! with INTEGRAL_BT_CONT=True for a given time-integrated velocity.
5108	0	pure function find_dvhbt_dv(v, BTC) result(dvhbt_dv)
5109		real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
5110		type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that
5111		!! allow the barotropic transports to be calculated consistently
5112		!! with the layers' continuity equations. The dimensions of some
5113		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5114		real :: dvhbt_dv !< The meridional barotropic face area [L H ~> m2 or kg m-1]
5115
5116	0	if (v == 0.0) then
5117	0	dvhbt_dv = 0.5*(BTC%FA_v_N0 + BTC%FA_v_S0) ! Note the potential discontinuity here.
5118	0	elseif (v < BTC%vBT_NN) then
5119	0	dvhbt_dv = BTC%FA_v_NN
5120	0	elseif (v < 0.0) then
5121	0	dvhbt_dv = BTC%FA_v_N0 + 3.0BTC%vh_crvN v**2
5122	0	elseif (v <= BTC%vBT_SS) then
5123	0	dvhbt_dv = BTC%FA_v_S0 + 3.0BTC%vh_crvS v**2
5124		else ! (v > BTC%vBT_SS)
5125	0	dvhbt_dv = BTC%FA_v_SS
5126		endif
5127
5128	0	end function find_dvhbt_dv
5129
5130		!> This function inverts the transport function to determine the barotopic
5131		!! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True
5132		!! this finds the time-integrated velocity that is consistent with a time-integrated transport.
5133	0	function vhbt_to_vbt(vhbt, BTC) result(vbt)
5134		real, intent(in) :: vhbt !< The barotropic meridional transport that should be
5135		!! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1] or the
5136		!! time-integrated transport [H L2 ~> m3 or kg].
5137		type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the
5138		!! barotropic transports to be calculated consistently
5139		!! with the layers' continuity equations. The dimensions of some
5140		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5141		real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1]
5142		!! or the time-integrated velocity [L ~> m].
5143
5144		! Local variables
5145		real :: vbt_min, vbt_max ! Bounding values of vbt [L T-1 ~> m s-1] or [L ~> m]
5146		real :: vhbt_err ! The transport error [H L2 T-1 ~> m3 s-1 or kg s-1] or [H L2 ~> m3 or kg].
5147		real :: derr_dv ! The change in transport error with vbt, i.e. the face area [H L ~> m2 or kg m-1].
5148		real :: vherr_min, vherr_max ! The bounding values of the transport error [H L2 T-1 ~> m3 s-1 or kg s-1]
5149		! or [H L2 ~> m3 or kg].
5150		real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
5151		real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
5152		real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
5153		! maximum increase of vs2, both [nondim].
5154		integer :: itt, max_itt = 20
5155
5156		! Find the value of vbt that gives vhbt.
5157	0	if (vhbt == 0.0) then
5158	0	vbt = 0.0
5159	0	elseif (vhbt < BTC%vh_NN) then
5160	0	vbt = BTC%vBT_NN + (vhbt - BTC%vh_NN) / BTC%FA_v_NN
5161	0	elseif (vhbt < 0.0) then
5162		! Iterate to convergence with Newton's method (when bounded) and the
5163		! false position method otherwise. vbt will be negative.
5164	0	vbt_min = BTC%vBT_NN ; vherr_min = BTC%vh_NN - vhbt
5165	0	vbt_max = 0.0 ; vherr_max = -vhbt
5166		! Use a false-position method first guess.
5167	0	vbt = BTC%vBT_NN * (vhbt / BTC%vh_NN)
5168	0	do itt = 1, max_itt
5169	0	vhbt_err = vbt * (BTC%FA_v_N0 + BTC%vh_crvN * vbt**2) - vhbt
5170
5171	0	if (abs(vhbt_err) < tol*abs(vhbt)) exit
5172	0	if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
5173	0	if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
5174
5175	0	derr_dv = BTC%FA_v_N0 + 3.0 * BTC%vh_crvN * vbt**2
5176		if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
5177	0	(-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
5178		! Use a false-position method guess.
5179	0	vbt = vbt_max + (vbt_min-vbt_max) * (vherr_max / (vherr_max-vherr_min))
5180		else ! Use Newton's method.
5181	0	vbt = vbt - vhbt_err / derr_dv
5182	0	if (abs(vhbt_err) < (0.01tol)abs(derr_dv*vbt_min)) exit
5183		endif
5184		enddo
5185	0	elseif (vhbt <= BTC%vh_SS) then
5186		! Iterate to convergence with Newton's method. vbt will be positive.
5187	0	vbt_min = 0.0 ; vherr_min = -vhbt
5188	0	vbt_max = BTC%vBT_SS ; vherr_max = BTC%vh_SS - vhbt
5189		! Use a false-position method first guess.
5190	0	vbt = BTC%vBT_SS * (vhbt / BTC%vh_SS)
5191	0	do itt = 1, max_itt
5192	0	vhbt_err = vbt * (BTC%FA_v_S0 + BTC%vh_crvS * vbt**2) - vhbt
5193
5194	0	if (abs(vhbt_err) < tol*abs(vhbt)) exit
5195	0	if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
5196	0	if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
5197
5198	0	derr_dv = BTC%FA_v_S0 + 3.0 * BTC%vh_crvS * vbt**2
5199		if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
5200	0	(-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
5201		! Use a false-position method guess.
5202	0	vbt = vbt_min + (vbt_max-vbt_min) * (-vherr_min / (vherr_max-vherr_min))
5203		else ! Use Newton's method.
5204	0	vbt = vbt - vhbt_err / derr_dv
5205	0	if (abs(vhbt_err) < (0.01tol)(vbt_max*derr_dv)) exit
5206		endif
5207		enddo
5208		else ! (vhbt > BTC%vh_SS)
5209	0	vbt = BTC%vBT_SS + (vhbt - BTC%vh_SS) / BTC%FA_v_SS
5210		endif
5211
5212	0	end function vhbt_to_vbt
5213
5214		!> This subroutine sets up reordered versions of the BT_cont type in the
5215		!! local_BT_cont types, which have wide halos properly filled in.
5216	48	subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo, dt_baroclinic)
5217		type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the barotropic solver
5218		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
5219		!! the argument arrays
5220		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
5221		intent(out) :: BTCL_u !< A structure with the u information from BT_cont
5222		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
5223		intent(out) :: BTCL_v !< A structure with the v information from BT_cont
5224		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
5225		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5226		type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating the halos
5227		!! of wide arrays
5228		integer, intent(in) :: halo !< The extra halo size to use here
5229		real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which
5230		!! is provided if INTEGRAL_BT_CONTINUITY is true.
5231
5232		! Local variables
5233		real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
5234	96	u_polarity, & ! An array used to test for halo update polarity [nondim]
5235	96	uBT_EE, uBT_WW, & ! Zonal velocities at which the form of the fit changes [L T-1 ~> m s-1]
5236	96	FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW ! Zonal face areas [H L ~> m2 or kg m-1]
5237		real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
5238	96	v_polarity, & ! An array used to test for halo update polarity [nondim]
5239	96	vBT_NN, vBT_SS, & ! Meridional velocities at which the form of the fit changes [L T-1 ~> m s-1]
5240	96	FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS ! Meridional face areas [H L ~> m2 or kg m-1]
5241		real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim]
5242		real, parameter :: C1_3 = 1.0/3.0 ! [nondim]
5243		integer :: i, j, is, ie, js, je, hs
5244		real :: tmp
5245
5246	48	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5247	48	hs = max(halo,0)
5248	48	dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic
5249
5250		!$omp target enter data &
5251		!$omp map(alloc: u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW, &
5252		!$omp v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS)
5253
5254		! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays.
5255	6240	do concurrent (j=js-hs:je+hs, i=is-hs-1:ie+hs)
5256	421056	u_polarity(i,j) = 1.0
5257	421056	uBT_EE(i,j) = 0.0 ; uBT_WW(i,j) = 0.0
5258	427296	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
5259		enddo
5260	6192	do concurrent (j=js-hs-1:je+hs, i=is-hs:ie+hs)
5261	423936	v_polarity(i,j) = 1.0
5262	423936	vBT_NN(i,j) = 0.0 ; vBT_SS(i,j) = 0.0
5263	430128	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
5264		enddo
5265	48	do concurrent (j=js:je, I=is-1:ie)
5266	348480	uBT_EE(I,j) = BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = BT_cont%uBT_WW(I,j)
5267	348480	FA_u_EE(I,j) = BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = BT_cont%FA_u_E0(I,j)
5268	354336	FA_u_W0(I,j) = BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = BT_cont%FA_u_WW(I,j)
5269		enddo
5270	48	do concurrent (J=js-1:je, i=is:ie)
5271	351360	vBT_NN(i,J) = BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = BT_cont%vBT_SS(i,J)
5272	351360	FA_v_NN(i,J) = BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = BT_cont%FA_v_N0(i,J)
5273	357168	FA_v_S0(i,J) = BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = BT_cont%FA_v_SS(i,J)
5274		enddo
5275
5276	48	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
5277	48	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
5278		!--- begin setup for group halo update
5279	48	call create_group_pass(BT_cont%pass_polarity_BT, u_polarity, v_polarity, BT_Domain)
5280	48	call create_group_pass(BT_cont%pass_polarity_BT, uBT_EE, vBT_NN, BT_Domain)
5281	48	call create_group_pass(BT_cont%pass_polarity_BT, uBT_WW, vBT_SS, BT_Domain)
5282
5283	48	call create_group_pass(BT_cont%pass_FA_uv, FA_u_EE, FA_v_NN, BT_Domain, To_All+Scalar_Pair)
5284	48	call create_group_pass(BT_cont%pass_FA_uv, FA_u_E0, FA_v_N0, BT_Domain, To_All+Scalar_Pair)
5285	48	call create_group_pass(BT_cont%pass_FA_uv, FA_u_W0, FA_v_S0, BT_Domain, To_All+Scalar_Pair)
5286	48	call create_group_pass(BT_cont%pass_FA_uv, FA_u_WW, FA_v_SS, BT_Domain, To_All+Scalar_Pair)
5287		!--- end setup for group halo update
5288		! Do halo updates on BT_cont.
5289		! data update directives for MPI transfers (via CPU) needed even for serial
5290	48	call do_group_pass(BT_cont%pass_polarity_BT, BT_Domain, omp_offload=.true.)
5291	48	call do_group_pass(BT_cont%pass_FA_uv, BT_Domain, omp_offload=.true.)
5292	48	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
5293	48	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
5294
5295	6240	do concurrent (j=js-hs:je+hs, I=is-hs-1:ie+hs)
5296	421056	BTCL_u(I,j)%FA_u_EE = FA_u_EE(I,j) ; BTCL_u(I,j)%FA_u_E0 = FA_u_E0(I,j)
5297	421056	BTCL_u(I,j)%FA_u_W0 = FA_u_W0(I,j) ; BTCL_u(I,j)%FA_u_WW = FA_u_WW(I,j)
5298	421056	BTCL_u(I,j)%uBT_EE = dtuBT_EE(I,j) ; BTCL_u(I,j)%uBT_WW = dtuBT_WW(I,j)
5299		! Check for reversed polarity in the tripolar halo regions.
5300	421056	if (u_polarity(I,j) < 0.0) then
5301	0	tmp = BTCL_u(I,j)%FA_u_EE
5302	0	BTCL_u(I,j)%FA_u_EE = BTCL_u(I,j)%FA_u_WW
5303	0	BTCL_u(I,j)%FA_u_WW = tmp
5304
5305	0	tmp = BTCL_u(I,j)%FA_u_E0
5306	0	BTCL_u(I,j)%FA_u_E0 = BTCL_u(I,j)%FA_u_W0
5307	0	BTCL_u(I,j)%FA_u_W0 = tmp
5308
5309	0	tmp = BTCL_u(I,j)%uBT_EE
5310	0	BTCL_u(I,j)%uBT_EE = BTCL_u(I,j)%uBT_WW
5311	0	BTCL_u(I,j)%uBT_WW = tmp
5312		endif
5313
5314		BTCL_u(I,j)%uh_EE = BTCL_u(I,j)%uBT_EE * &
5315	421056	(C1_3 * (2.0*BTCL_u(I,j)%FA_u_E0 + BTCL_u(I,j)%FA_u_EE))
5316		BTCL_u(I,j)%uh_WW = BTCL_u(I,j)%uBT_WW * &
5317	421056	(C1_3 * (2.0*BTCL_u(I,j)%FA_u_W0 + BTCL_u(I,j)%FA_u_WW))
5318
5319	421056	BTCL_u(I,j)%uh_crvE = 0.0 ; BTCL_u(I,j)%uh_crvW = 0.0
5320	421056	if (abs(BTCL_u(I,j)%uBT_WW) > 0.0) BTCL_u(I,j)%uh_crvW = &
5321	244200	(C1_3 * (BTCL_u(I,j)%FA_u_WW - BTCL_u(I,j)%FA_u_W0)) / BTCL_u(I,j)%uBT_WW**2
5322	421056	if (abs(BTCL_u(I,j)%uBT_EE) > 0.0) BTCL_u(I,j)%uh_crvE = &
5323	427296	(C1_3 * (BTCL_u(I,j)%FA_u_EE - BTCL_u(I,j)%FA_u_E0)) / BTCL_u(I,j)%uBT_EE**2
5324		enddo
5325
5326	6192	do concurrent (J=js-hs-1:je+hs, i=is-hs:ie+hs)
5327	423936	BTCL_v(i,J)%FA_v_NN = FA_v_NN(i,J) ; BTCL_v(i,J)%FA_v_N0 = FA_v_N0(i,J)
5328	423936	BTCL_v(i,J)%FA_v_S0 = FA_v_S0(i,J) ; BTCL_v(i,J)%FA_v_SS = FA_v_SS(i,J)
5329	423936	BTCL_v(i,J)%vBT_NN = dtvBT_NN(i,J) ; BTCL_v(i,J)%vBT_SS = dtvBT_SS(i,J)
5330		! Check for reversed polarity in the tripolar halo regions.
5331	423936	if (v_polarity(i,J) < 0.0) then
5332	0	tmp = BTCL_v(i,J)%FA_v_NN
5333	0	BTCL_v(i,J)%FA_v_NN = BTCL_v(i,J)%FA_v_SS
5334	0	BTCL_v(i,J)%FA_v_SS = tmp
5335
5336	0	tmp = BTCL_v(i,J)%FA_v_N0
5337	0	BTCL_v(i,J)%FA_v_N0 = BTCL_v(i,J)%FA_v_S0
5338	0	BTCL_v(i,J)%FA_v_S0 = tmp
5339
5340	0	tmp = BTCL_v(i,J)%vBT_NN
5341	0	BTCL_v(i,J)%vBT_NN = BTCL_v(i,J)%vBT_SS
5342	0	BTCL_v(i,J)%vBT_SS = tmp
5343		endif
5344
5345		BTCL_v(i,J)%vh_NN = BTCL_v(i,J)%vBT_NN * &
5346	423936	(C1_3 * (2.0*BTCL_v(i,J)%FA_v_N0 + BTCL_v(i,J)%FA_v_NN))
5347		BTCL_v(i,J)%vh_SS = BTCL_v(i,J)%vBT_SS * &
5348	423936	(C1_3 * (2.0*BTCL_v(i,J)%FA_v_S0 + BTCL_v(i,J)%FA_v_SS))
5349
5350	423936	BTCL_v(i,J)%vh_crvN = 0.0 ; BTCL_v(i,J)%vh_crvS = 0.0
5351	423936	if (abs(BTCL_v(i,J)%vBT_SS) > 0.0) BTCL_v(i,J)%vh_crvS = &
5352	241995	(C1_3 * (BTCL_v(i,J)%FA_v_SS - BTCL_v(i,J)%FA_v_S0)) / BTCL_v(i,J)%vBT_SS**2
5353	423936	if (abs(BTCL_v(i,J)%vBT_NN) > 0.0) BTCL_v(i,J)%vh_crvN = &
5354	430128	(C1_3 * (BTCL_v(i,J)%FA_v_NN - BTCL_v(i,J)%FA_v_N0)) / BTCL_v(i,J)%vBT_NN**2
5355		enddo
5356
5357		!$omp target exit data &
5358		!$omp map(release: u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW, &
5359		!$omp v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS)
5360	48	end subroutine set_local_BT_cont_types
5361
5362
5363		!> Adjust_local_BT_cont_types expands the range of velocities with a cubic curve
5364		!! translating velocities into transports to match the initial values of velocities and
5365		!! summed transports when the velocities are larger than the first guesses of the cubic
5366		!! transition velocities used to set up the local_BT_cont types.
5367	0	subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
5368		G, US, MS, halo, dt_baroclinic)
5369		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
5370		real, dimension(SZIBW_(MS),SZJW_(MS)), &
5371		intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1].
5372		real, dimension(SZIBW_(MS),SZJW_(MS)), &
5373		intent(in) :: uhbt !< The linearization zonal barotropic transport
5374		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
5375		real, dimension(SZIW_(MS),SZJBW_(MS)), &
5376		intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1].
5377		real, dimension(SZIW_(MS),SZJBW_(MS)), &
5378		intent(in) :: vhbt !< The linearization meridional barotropic transport
5379		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
5380		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
5381		intent(out) :: BTCL_u !< A structure with the u information from BT_cont.
5382		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
5383		intent(out) :: BTCL_v !< A structure with the v information from BT_cont.
5384		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5385		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5386		integer, intent(in) :: halo !< The extra halo size to use here.
5387		real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which is
5388		!! provided if INTEGRAL_BT_CONTINUITY is true.
5389
5390		! Local variables
5391		real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim]
5392		real, parameter :: C1_3 = 1.0/3.0 ! [nondim]
5393		integer :: i, j, is, ie, js, je, hs
5394
5395	0	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5396	0	hs = max(halo,0)
5397	0	dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic
5398
5399		!$OMP parallel do default(shared)
5400	0	do j=js-hs,je+hs ; do I=is-hs-1,ie+hs
5401	0	if ((dtubt(I,j) > BTCL_u(I,j)%uBT_WW) .and. (dtuhbt(I,j) > BTCL_u(I,j)%uh_WW)) then
5402		! Expand the cubic fit to use this new point. ubt is negative.
5403	0	BTCL_u(I,j)%ubt_WW = dt * ubt(I,j)
5404	0	if (3.0uhbt(I,j) < 2.0ubt(I,j) * BTCL_u(I,j)%FA_u_W0) then
5405		! No further bounding is needed.
5406	0	BTCL_u(I,j)%uh_crvW = (uhbt(I,j) - ubt(I,j) * BTCL_u(I,j)%FA_u_W0) / (dt*2 ubt(I,j)**3)
5407		else ! This should not happen often!
5408	0	BTCL_u(I,j)%FA_u_W0 = 1.5*uhbt(I,j) / ubt(I,j)
5409	0	BTCL_u(I,j)%uh_crvW = -0.5uhbt(I,j) / (dt2 ubt(I,j)**3)
5410		endif
5411	0	BTCL_u(I,j)%uh_WW = dt * uhbt(I,j)
5412		! I don't know whether this is helpful.
5413		! BTCL_u(I,j)%FA_u_WW = min(BTCL_u(I,j)%FA_u_WW, uhbt(I,j) / ubt(I,j))
5414	0	elseif ((dtubt(I,j) < BTCL_u(I,j)%uBT_EE) .and. (dtuhbt(I,j) < BTCL_u(I,j)%uh_EE)) then
5415		! Expand the cubic fit to use this new point. ubt is negative.
5416	0	BTCL_u(I,j)%ubt_EE = dt * ubt(I,j)
5417	0	if (3.0uhbt(I,j) < 2.0ubt(I,j) * BTCL_u(I,j)%FA_u_E0) then
5418		! No further bounding is needed.
5419	0	BTCL_u(I,j)%uh_crvE = (uhbt(I,j) - ubt(I,j) * BTCL_u(I,j)%FA_u_E0) / (dt*2 ubt(I,j)**3)
5420		else ! This should not happen often!
5421	0	BTCL_u(I,j)%FA_u_E0 = 1.5*uhbt(I,j) / ubt(I,j)
5422	0	BTCL_u(I,j)%uh_crvE = -0.5uhbt(I,j) / (dt2 ubt(I,j)**3)
5423		endif
5424	0	BTCL_u(I,j)%uh_EE = dt * uhbt(I,j)
5425		! I don't know whether this is helpful.
5426		! BTCL_u(I,j)%FA_u_EE = min(BTCL_u(I,j)%FA_u_EE, uhbt(I,j) / ubt(I,j))
5427		endif
5428		enddo ; enddo
5429		!$OMP parallel do default(shared)
5430	0	do J=js-hs-1,je+hs ; do i=is-hs,ie+hs
5431	0	if ((dtvbt(i,J) > BTCL_v(i,J)%vBT_SS) .and. (dtvhbt(i,J) > BTCL_v(i,J)%vh_SS)) then
5432		! Expand the cubic fit to use this new point. vbt is negative.
5433	0	BTCL_v(i,J)%vbt_SS = dt * vbt(i,J)
5434	0	if (3.0vhbt(i,J) < 2.0vbt(i,J) * BTCL_v(i,J)%FA_v_S0) then
5435		! No further bounding is needed.
5436	0	BTCL_v(i,J)%vh_crvS = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_S0) / (dt*2 vbt(i,J)**3)
5437		else ! This should not happen often!
5438	0	BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / (vbt(i,J))
5439	0	BTCL_v(i,J)%vh_crvS = -0.5vhbt(i,J) / (dt2 vbt(i,J)**3)
5440		endif
5441	0	BTCL_v(i,J)%vh_SS = dt * vhbt(i,J)
5442		! I don't know whether this is helpful.
5443		! BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J))
5444	0	elseif ((dtvbt(i,J) < BTCL_v(i,J)%vBT_NN) .and. (dtvhbt(i,J) < BTCL_v(i,J)%vh_NN)) then
5445		! Expand the cubic fit to use this new point. vbt is negative.
5446	0	BTCL_v(i,J)%vbt_NN = dt * vbt(i,J)
5447	0	if (3.0vhbt(i,J) < 2.0vbt(i,J) * BTCL_v(i,J)%FA_v_N0) then
5448		! No further bounding is needed.
5449	0	BTCL_v(i,J)%vh_crvN = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_N0) / (dt*2 vbt(i,J)**3)
5450		else ! This should not happen often!
5451	0	BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / (vbt(i,J))
5452	0	BTCL_v(i,J)%vh_crvN = -0.5vhbt(i,J) / (dt2 vbt(i,J)**3)
5453		endif
5454	0	BTCL_v(i,J)%vh_NN = dt * vhbt(i,J)
5455		! I don't know whether this is helpful.
5456		! BTCL_v(i,J)%FA_v_NN = min(BTCL_v(i,J)%FA_v_NN, vhbt(i,J) / vbt(i,J))
5457		endif
5458		enddo ; enddo
5459
5460	0	end subroutine adjust_local_BT_cont_types
5461
5462		!> This subroutine uses the BT_cont_type to find the maximum face
5463		!! areas, which can then be used for finding wave speeds, etc.
5464	0	subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo)
5465		type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the
5466		!! barotropic solver.
5467		type(memory_size_type), intent(in) :: MS !< A type that describes the memory
5468		!! sizes of the argument arrays.
5469		real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
5470		intent(out) :: Datu !< The effective zonal face area [H L ~> m2 or kg m-1].
5471		real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
5472		intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1].
5473		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5474		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5475		integer, optional, intent(in) :: halo !< The extra halo size to use here.
5476
5477		! Local variables
5478		integer :: i, j, is, ie, js, je, hs
5479	0	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5480	0	hs = 1 ; if (present(halo)) hs = max(halo,0)
5481
5482	0	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5483		Datu(I,j) = max(BT_cont%FA_u_EE(I,j), BT_cont%FA_u_E0(I,j), &
5484	0	BT_cont%FA_u_W0(I,j), BT_cont%FA_u_WW(I,j))
5485		enddo
5486	0	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5487		Datv(i,J) = max(BT_cont%FA_v_NN(i,J), BT_cont%FA_v_N0(i,J), &
5488	0	BT_cont%FA_v_S0(i,J), BT_cont%FA_v_SS(i,J))
5489		enddo
5490
5491	0	end subroutine BT_cont_to_face_areas
5492
5493		!> Swap the values of two real variables
5494	0	pure subroutine swap(a,b)
5495		real, intent(inout) :: a !< The first variable to be swapped [arbitrary units]
5496		real, intent(inout) :: b !< The second variable to be swapped [arbitrary units]
5497		real :: tmp ! A temporary variable [arbitrary units]
5498	0	tmp = a ; a = b ; b = tmp
5499	0	end subroutine swap
5500
5501		!> This subroutine determines the open face areas of cells for calculating
5502		!! the barotropic transport.
5503	0	subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max)
5504		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
5505		real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
5506		intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1].
5507		real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
5508		intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1].
5509		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5510		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
5511		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5512		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
5513		integer, intent(in) :: halo !< The halo size to use, default = 1.
5514		real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), &
5515		optional, intent(in) :: eta !< The barotropic free surface height anomaly
5516		!! or column mass anomaly [H ~> m or kg m-2].
5517		real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used
5518		!! to overestimate the external wave speed) [Z ~> m].
5519
5520		! Local variables
5521		real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2].
5522		real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3]
5523		integer :: i, j, is, ie, js, je, hs
5524	15	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5525	15	hs = max(halo,0)
5526
5527	15	if (present(eta)) then
5528		! The use of harmonic mean thicknesses ensure positive definiteness.
5529	0	if (GV%Boussinesq) then
5530	0	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5531	0	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)
5532	0	Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
5533	0	Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
5534		! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
5535		enddo
5536
5537	0	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5538	0	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)
5539	0	Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
5540	0	Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2)
5541		! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
5542		enddo
5543		else
5544	0	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5545	0	Datu(I,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) &
5546		Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * eta(i,j) * eta(i+1,j)) / &
5547	0	(eta(i,j) + eta(i+1,j))
5548		! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))
5549		enddo
5550
5551	0	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5552	0	Datv(i,J) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) &
5553		Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * eta(i,j) * eta(i,j+1)) / &
5554	0	(eta(i,j) + eta(i,j+1))
5555		! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (eta(i,j) + eta(i,j+1))
5556		enddo
5557		endif
5558	15	elseif (present(add_max)) then
5559	14	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
5560
5561	1708	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5562	101640	H1 = max((G%meanSL(i+1,j) + add_max) + G%bathyT(i+1,j), 0.0)
5563	101640	H2 = max((G%meanSL(i,j) + add_max) + G%bathyT(i,j), 0.0)
5564	103348	Datu(I,j) = CS%dy_Cu(I,j) * Z_to_H * max(H1, H2)
5565		enddo
5566
5567	1694	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5568	102480	H1 = max((G%meanSL(i,j+1) + add_max) + G%bathyT(i,j+1), 0.0)
5569	102480	H2 = max((G%meanSL(i,j) + add_max) + G%bathyT(i,j), 0.0)
5570	104174	Datv(i,J) = CS%dx_Cv(i,J) * Z_to_H * max(H1, H2)
5571		enddo
5572		else
5573	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
5574
5575	124	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5576	7626	H1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
5577	7626	H2 = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) * Z_to_H
5578	7626	Datu(I,j) = 0.0
5579	7626	if ((H1 > 0.0) .and. (H2 > 0.0)) &
5580	7750	Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
5581		enddo
5582
5583	123	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5584	7686	H1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
5585	7686	H2 = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) * Z_to_H
5586	7686	Datv(i,J) = 0.0
5587	7686	if ((H1 > 0.0) .and. (H2 > 0.0)) &
5588	7809	Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2)
5589		enddo
5590		endif
5591	15	end subroutine find_face_areas
5592
5593		!> bt_mass_source determines the appropriately limited mass source for
5594		!! the barotropic solver, along with a corrective fictitious mass source that
5595		!! will drive the barotropic estimate of the free surface height toward the
5596		!! baroclinic estimate.
5597	48	subroutine bt_mass_source(h, eta, set_cor, G, GV, CS)
5598		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5599		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
5600		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
5601		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be
5602		!! corrected [H ~> m or kg m-2].
5603		logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective
5604		!! fluxes (and update the slowly varying part of eta_cor)
5605		!! (.true.) or whether to incrementally update the
5606		!! corrective fluxes.
5607		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
5608
5609		! Local variables
5610	48	real :: eta_h(SZI_(G),SZJ_(G)) ! The free surface height determined from
5611		! the sum of the layer thicknesses [H ~> m or kg m-2].
5612		real :: d_eta ! The difference between estimates of the total
5613		! thicknesses [H ~> m or kg m-2].
5614		integer :: is, ie, js, je, nz, i, j, k
5615
5616	48	if (.not.CS%module_is_initialized) call MOM_error(FATAL, "bt_mass_source: "// &
5617	0	"Module MOM_barotropic must be initialized before it is used.")
5618
5619	48	if (.not.CS%split) return
5620
5621	48	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
5622
5623		!$omp target data map(alloc: eta_h)
5624
5625	48	do concurrent (j=js:je)
5626	2880	if (GV%Boussinesq) then
5627	2880	do concurrent (i=is:ie)
5628	348480	eta_h(i,j) = h(i,j,1) - G%bathyT(i,j)*GV%Z_to_H
5629		enddo
5630		else
5631	0	do concurrent (i=is:ie)
5632	0	eta_h(i,j) = h(i,j,1)
5633		enddo
5634		endif
5635	216000	do k=2,nz
5636	2880	do concurrent (i=is:ie)
5637	25787520	eta_h(i,j) = eta_h(i,j) + h(i,j,k)
5638		enddo
5639		enddo
5640	5808	if (set_cor) then
5641	1440	do concurrent (i=is:ie)
5642	172800	d_eta = eta_h(i,j) - eta(i,j)
5643	174240	CS%eta_cor(i,j) = d_eta
5644		enddo
5645		else
5646	1440	do concurrent (i=is:ie)
5647	172800	d_eta = eta_h(i,j) - eta(i,j)
5648	174240	CS%eta_cor(i,j) = CS%eta_cor(i,j) + d_eta
5649		enddo
5650		endif
5651		enddo
5652
5653		!$omp end target data
5654
5655		end subroutine bt_mass_source
5656
5657		!> barotropic_init initializes a number of time-invariant fields used in the
5658		!! barotropic calculation and initializes any barotropic fields that have not
5659		!! already been initialized.
5660	1	subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, &
5661		restart_CS, calc_dtbt, BT_cont, OBC, SAL_CSp, HA_CSp)
5662		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
5663		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
5664		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5665		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
5666		intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
5667		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
5668		intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
5669		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
5670		intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
5671		type(time_type), target, intent(in) :: Time !< The current model time.
5672		type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
5673		type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
5674		!! output.
5675		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
5676		type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure
5677		logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must
5678		!! be recalculated before stepping.
5679		type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the
5680		!! effective open face areas as a function of
5681		!! barotropic flow.
5682		type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure.
5683		type(SAL_CS), target, optional :: SAL_CSp !< A pointer to the control structure of the
5684		!! SAL module.
5685		type(harmonic_analysis_CS), target, optional :: HA_CSp !< A pointer to the control structure of the
5686		!! harmonic analysis module
5687
5688		! This include declares and sets the variable "version".
5689		# include "version_variable.h"
5690		! Local variables
5691		character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
5692	1	real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1].
5693	1	real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1].
5694		real :: gtot_estimate ! Summed GV%g_prime [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2], to give an
5695		! upper-bound estimate for pbce.
5696		real :: SSH_extra ! An estimate of how much higher SSH might get, for use
5697		! in calculating the safe external wave speed [Z ~> m].
5698		real :: dtbt_input ! The input value of DTBT, [nondim] if negative or [s] if positive.
5699		real :: dtbt_restart ! A temporary copy of CS%dtbt read from a restart file [T ~> s]
5700		real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag
5701		! piston velocities [nondim].
5702		character(len=200) :: inputdir ! The directory in which to find input files.
5703		character(len=200) :: wave_drag_file ! The file from which to read the wave
5704		! drag piston velocity.
5705		character(len=80) :: wave_drag_var ! The wave drag piston velocity variable
5706		! name in wave_drag_file.
5707		character(len=80) :: wave_drag_u ! The wave drag piston velocity variable
5708		! name in wave_drag_file.
5709		character(len=80) :: wave_drag_v ! The wave drag piston velocity variable
5710		! name in wave_drag_file.
5711		real :: htot ! Total column thickness used when BT_NONLIN_STRESS is false [Z ~> m].
5712		real :: Z_to_H ! A local unit conversion factor [H Z-1 ~> nondim or kg m-3]
5713		real :: H_to_Z ! A local unit conversion factor [Z H-1 ~> nondim or m3 kg-1]
5714		real :: det_de ! The partial derivative due to self-attraction and loading of the reference
5715		! geopotential with the sea surface height when scalar SAL are enabled [nondim].
5716		! This is typically ~0.09 or less.
5717		real :: h_a_neglect ! A cell volume or mass that is so small it is usually lost
5718		! in roundoff and can be neglected [H L2 ~> m3 or kg]
5719	1	real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points
5720		! that acts on the barotropic flow [H T-1 ~> m s-1 or kg m-2 s-1].
5721
5722		type(memory_size_type) :: MS
5723		type(group_pass_type) :: pass_static_data, pass_q_D_Cor
5724		type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity
5725		integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
5726		logical :: use_BT_cont_type
5727		logical :: mask_coastal_pressure_force ! If true, apply masks to some stored inverse grid spacings
5728		! so that diagnosed barotropic pressure gradient forces are zero at
5729		! land, coastal or OBC points.
5730		logical :: use_tides
5731		logical :: OBC_projection_bug
5732		logical :: enable_bugs ! If true, the defaults for recently added bug-fix flags are set to
5733		! recreate the bugs, or if false bugs are only used if actively selected.
5734		logical :: visc_rem_bug ! Stores the value of runtime paramter VISC_REM_BUG.
5735		character(len=48) :: thickness_units, flux_units
5736		character*(40) :: hvel_str
5737		integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
5738		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
5739		integer :: isdw, iedw, jsdw, jedw
5740		integer :: i, j, k
5741		integer :: wd_halos(2), bt_halo_sz
5742	1	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
5743	1	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
5744	1	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
5745	1	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
5746	1	MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed
5747
5748	1	if (CS%module_is_initialized) then
5749		call MOM_error(WARNING, "barotropic_init called with a control structure "// &
5750	0	"that has already been initialized.")
5751	0	return
5752		endif
5753	1	CS%module_is_initialized = .true.
5754
5755	1	CS%diag => diag ; CS%Time => Time
5756	1	if (present(SAL_CSp)) then
5757	1	CS%SAL_CSp => SAL_CSp
5758		endif
5759
5760		! Read all relevant parameters and write them to the model log.
5761	1	call get_param(param_file, mdl, "SPLIT", CS%split, default=.true., do_not_log=.true.)
5762		call log_version(param_file, mdl, version, "", log_to_all=.true., layout=CS%split, &
5763	1	debugging=CS%split, all_default=.not.CS%split)
5764		call get_param(param_file, mdl, "SPLIT", CS%split, &
5765	1	"Use the split time stepping if true.", default=.true.)
5766	1	if (.not.CS%split) return
5767
5768		call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_BT_cont_type, &
5769		"If true, use a structure with elements that describe "//&
5770		"effective face areas from the summed continuity solver "//&
5771		"as a function the barotropic flow in coupling between "//&
5772		"the barotropic and baroclinic flow. This is only used "//&
5773	1	"if SPLIT is true.", default=.true.)
5774		call get_param(param_file, mdl, "INTEGRAL_BT_CONTINUITY", CS%integral_bt_cont, &
5775		"If true, use the time-integrated velocity over the barotropic steps "//&
5776		"to determine the integrated transports used to update the continuity "//&
5777		"equation. Otherwise the transports are the sum of the transports based on "//&
5778		"a series of instantaneous velocities and the BT_CONT_TYPE for transports. "//&
5779		"This is only valid if USE_BT_CONT_TYPE = True.", &
5780	1	default=.false., do_not_log=.not.use_BT_cont_type)
5781		call get_param(param_file, mdl, "BOUND_BT_CORRECTION", CS%bound_BT_corr, &
5782		"If true, the corrective pseudo mass-fluxes into the "//&
5783		"barotropic solver are limited to values that require "//&
5784	1	"less than maxCFL_BT_cont to be accommodated.",default=.false.)
5785		call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", CS%BT_cont_bounds, &
5786		"If true, and BOUND_BT_CORRECTION is true, use the "//&
5787		"BT_cont_type variables to set limits determined by "//&
5788		"MAXCFL_BT_CONT on the CFL number of the velocities "//&
5789		"that are likely to be driven by the corrective mass fluxes.", &
5790	1	default=.true., do_not_log=.not.CS%bound_BT_corr)
5791		call get_param(param_file, mdl, "ADJUST_BT_CONT", CS%adjust_BT_cont, &
5792		"If true, adjust the curve fit to the BT_cont type "//&
5793		"that is used by the barotropic solver to match the "//&
5794		"transport about which the flow is being linearized.", &
5795	1	default=.false., do_not_log=.not.use_BT_cont_type)
5796		call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, &
5797		"If true, adjust the initial conditions for the "//&
5798		"barotropic solver to the values from the layered "//&
5799		"solution over a whole timestep instead of instantly. "//&
5800		"This is a decent approximation to the inclusion of "//&
5801		"sum(u dh_dt) while also correcting for truncation errors.", &
5802	1	default=.false.)
5803		call get_param(param_file, mdl, "BT_ADJUST_SRC_FOR_FILTER", CS%bt_adjust_src_for_filter, &
5804		"If true, increases the rate at which BT mass sources are applied so "//&
5805		"that they are all used up before the filtering period starts. "//&
5806		"This option is only valid if INTEGRAL_BT_CONTINUITY = True.", &
5807	1	default=.false., do_not_log=.not.CS%integral_bt_cont)
5808		call get_param(param_file, mdl, "BT_LIMIT_INTEGRAL_TRANSPORT", CS%bt_limit_integral_transport, &
5809		"If true, limit the time-integrated transports by the initial volume "//&
5810		"accounting for sinks of mass. The limiter uses MAXCFL_BT_CONT. "//&
5811		"This option is only valid if INTEGRAL_BT_CONTINUITY = True.", &
5812	1	default=.false., do_not_log=.not.CS%integral_bt_cont)
5813		call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", CS%visc_rem_u_uh0, &
5814		"If true, use the viscous remnants when estimating the "//&
5815		"barotropic velocities that were used to calculate uh0 "//&
5816	1	"and vh0. False is probably the better choice.", default=.false.)
5817		call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", CS%use_wide_halos, &
5818		"If true, use wide halos and march in during the "//&
5819		"barotropic time stepping for efficiency.", default=.true., &
5820	1	layoutParam=.true.)
5821		call get_param(param_file, mdl, "BTHALO", bt_halo_sz, &
5822		"The minimum halo size for the barotropic solver.", default=0, &
5823	1	layoutParam=.true.)
5824		call get_param(param_file, mdl, "BT_WIDE_HALO_MIN_STENCIL", CS%min_stencil, &
5825		"The minimum stencil width to use with the wide halo iterations. "//&
5826		"A nonzero value may be useful for debugging purposes, but at the "//&
5827		"cost of reducing the efficiency gain from BT_USE_WIDE_HALOS.", &
5828	1	default=0, layoutParam=.true., do_not_log=.not.CS%use_wide_halos)
5829		#ifdef STATIC_MEMORY_
5830		if ((bt_halo_sz > 0) .and. (bt_halo_sz /= BTHALO_)) call MOM_error(FATAL, &
5831		"barotropic_init: Run-time values of BTHALO must agree with the "//&
5832		"macro BTHALO_ with STATIC_MEMORY_.")
5833		wd_halos(1) = WHALOI_+NIHALO_ ; wd_halos(2) = WHALOJ_+NJHALO_
5834		#else
5835	1	wd_halos(1) = bt_halo_sz ; wd_halos(2) = bt_halo_sz
5836		#endif
5837		call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", CS%Nonlinear_continuity, &
5838		"If true, use nonlinear transports in the barotropic "//&
5839		"continuity equation. This does not apply if "//&
5840	1	"USE_BT_CONT_TYPE is true.", default=.false., do_not_log=use_BT_cont_type)
5841		call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", CS%Nonlin_cont_update_period, &
5842		"If NONLINEAR_BT_CONTINUITY is true, this is the number "//&
5843		"of barotropic time steps between updates to the face "//&
5844		"areas, or 0 to update only before the barotropic stepping.", &
5845	1	default=1, do_not_log=.not.CS%Nonlinear_continuity)
5846
5847		call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,&
5848		"If true, step the barotropic velocity first and project "//&
5849		"out the velocity tendency by 1+BEBT when calculating the "//&
5850		"transport. The default (false) is to use a predictor "//&
5851		"continuity step to find the pressure field, and then "//&
5852		"to do a corrector continuity step using a weighted "//&
5853		"average of the old and new velocities, with weights "//&
5854	1	"of (1-BEBT) and BEBT.", default=.false.)
5855		call get_param(param_file, mdl, "BT_NONLIN_STRESS", CS%nonlin_stress, &
5856		"If true, use the full depth of the ocean at the start of the barotropic "//&
5857		"step when calculating the surface stress contribution to the barotropic "//&
5858	1	"acclerations. Otherwise use the depth based on bathyT.", default=.false.)
5859		call get_param(param_file, mdl, "BT_RHO_LINEARIZED", CS%Rho_BT_lin, &
5860		"A density that is used to convert total water column thicknesses into mass "//&
5861		"in non-Boussinesq mode with linearized options in the barotropic solver or "//&
5862		"when estimating the stable barotropic timestep without access to the full "//&
5863		"baroclinic model state.", &
5864		units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
5865	1	do_not_log=GV%Boussinesq)
5866
5867		call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, &
5868		"If true, add a dynamic pressure due to a viscous ice "//&
5869	1	"shelf, for instance.", default=.false.)
5870		call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, &
5871		"The length scale at which the Rayleigh damping rate due "//&
5872		"to the ice strength should be the same as if a Laplacian "//&
5873		"were applied, if DYNAMIC_SURFACE_PRESSURE is true.", &
5874	1	units="m", default=1.0e4, scale=US%m_to_L, do_not_log=.not.CS%dynamic_psurf)
5875		call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, &
5876		"The minimum depth to use in limiting the size of the "//&
5877		"dynamic surface pressure for stability, if "//&
5878		"DYNAMIC_SURFACE_PRESSURE is true..", &
5879	1	units="m", default=1.0e-6, scale=GV%m_to_H, do_not_log=.not.CS%dynamic_psurf)
5880		call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, &
5881		"The constant that scales the dynamic surface pressure, "//&
5882		"if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//&
5883	1	"are < ~1.0.", units="nondim", default=0.9, do_not_log=.not.CS%dynamic_psurf)
5884
5885		call get_param(param_file, mdl, "BT_CORIOLIS_SCALE", CS%BT_Coriolis_scale, &
5886		"A factor by which the barotropic Coriolis anomaly terms are scaled.", &
5887	1	units="nondim", default=1.0)
5888		call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
5889		"This sets the default value for the various _ANSWER_DATE parameters.", &
5890	1	default=99991231)
5891		call get_param(param_file, mdl, "BAROTROPIC_ANSWER_DATE", CS%answer_date, &
5892		"The vintage of the expressions in the barotropic solver. "//&
5893		"Values below 20190101 recover the answers from the end of 2018, "//&
5894		"while higher values use more efficient or general expressions.", &
5895	1	default=default_answer_date, do_not_log=.not.GV%Boussinesq)
5896	1	if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
5897
5898		call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, &
5899	1	default=.true., do_not_log=.true.) ! This is logged from MOM.F90.
5900	1	call get_param(param_file, mdl, "VISC_REM_BUG", visc_rem_bug, default=.false., do_not_log=.true.)
5901		call get_param(param_file, mdl, "VISC_REM_BT_WEIGHT_BUG", CS%wt_uv_bug, &
5902		"If true, recover a bug in barotropic solver that uses an unnormalized weight "//&
5903		"function for vertical averages of baroclinic velocity and forcing. Default "//&
5904	1	"of this flag is set by VISC_REM_BUG.", default=visc_rem_bug)
5905		call get_param(param_file, mdl, "EXTERIOR_OBC_BUG", CS%exterior_OBC_bug, &
5906		"If true, recover a bug in barotropic solver and other routines when "//&
5907		"boundary contitions interior to the domain are used.", &
5908	1	default=enable_bugs, do_not_log=.true.)
5909		call get_param(param_file, mdl, "OBC_PROJECTION_BUG", OBC_projection_bug, &
5910		"If false, use only interior ocean points at OBCs to specify several "//&
5911		"calculations at OBC points, and it avoids applying a land mask at the bay-like "//&
5912		"intersection of orthogonal OBC segments. Otherwise the calculation of terms "//&
5913		"like the potential vorticity used in the barotropic solver relies on bathymetry "//&
5914		"or other fields being projected outward across OBCs. This option changes "//&
5915		"answers for some configurations that use OBCs.", &
5916	1	default=enable_bugs, do_not_log=.true.)
5917	1	CS%interior_OBC_PV = .not.OBC_projection_bug
5918
5919		call get_param(param_file, mdl, "TIDES", use_tides, &
5920	1	"If true, apply tidal momentum forcing.", default=.false.)
5921	1	if (use_tides .and. present(HA_CSp)) CS%HA_CSp => HA_CSp
5922		call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
5923	1	"If true, calculate self-attraction and loading.", default=use_tides)
5924	1	det_de = 0.0
5925	1	if (CS%calculate_SAL .and. associated(CS%SAL_CSp)) &
5926	0	call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
5927		call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, &
5928		"If true, the tidal self-attraction and loading anomaly in the barotropic "//&
5929		"solver has the wrong sign, replicating a long-standing bug with a scalar "//&
5930		"self-attraction and loading term or the SAL term from a previous simulation.", &
5931	1	default=.false., do_not_log=(det_de==0.0))
5932		call get_param(param_file, mdl, "TIDAL_SAL_FLATHER", CS%tidal_sal_flather, &
5933		"If true, then apply adjustments to the external gravity "//&
5934		"wave speed used with the Flather OBC routine consistent "//&
5935		"with the barotropic solver. This applies to cases with "//&
5936		"tidal forcing using the scalar self-attraction approximation. "//&
5937		"The default is currently False in order to retain previous answers "//&
5938	1	"but should be set to True for new experiments", default=.false.)
5939
5940		call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, &
5941		"If true, the Coriolis terms are discretized with the "//&
5942		"Sadourny (1975) energy conserving scheme, otherwise "//&
5943		"the Arakawa & Hsu scheme is used. If the internal "//&
5944		"deformation radius is not resolved, the Sadourny scheme "//&
5945	1	"should probably be used.", default=.true.)
5946
5947		call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, &
5948		"A string describing the scheme that is used to set the "//&
5949		"open face areas used for barotropic transport and the "//&
5950		"relative weights of the accelerations. Valid values are:\n"//&
5951		"\t ARITHMETIC - arithmetic mean layer thicknesses \n"//&
5952		"\t HARMONIC - harmonic mean layer thicknesses \n"//&
5953		"\t HYBRID (the default) - use arithmetic means for \n"//&
5954		"\t layers above the shallowest bottom, the harmonic \n"//&
5955		"\t mean for layers below, and a weighted average for \n"//&
5956		"\t layers that straddle that depth \n"//&
5957		"\t FROM_BT_CONT - use the average thicknesses kept \n"//&
5958		"\t in the h_u and h_v fields of the BT_cont_type", &
5959	1	default=BT_CONT_STRING)
5960	0	select case (hvel_str)
5961	0	case (HYBRID_STRING) ; CS%hvel_scheme = HYBRID
5962	0	case (HARMONIC_STRING) ; CS%hvel_scheme = HARMONIC
5963	0	case (ARITHMETIC_STRING) ; CS%hvel_scheme = ARITHMETIC
5964	1	case (BT_CONT_STRING) ; CS%hvel_scheme = FROM_BT_CONT
5965		case default
5966	0	call MOM_mesg('barotropic_init: BT_THICK_SCHEME ="'//trim(hvel_str)//'"', 0)
5967		call MOM_error(FATAL, "barotropic_init: Unrecognized setting "// &
5968	1	"#define BT_THICK_SCHEME "//trim(hvel_str)//" found in input file.")
5969		end select
5970	1	if ((CS%hvel_scheme == FROM_BT_CONT) .and. .not.use_BT_cont_type) &
5971		call MOM_error(FATAL, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//&
5972	0	"can only be used if USE_BT_CONT_TYPE is defined.")
5973
5974		call get_param(param_file, mdl, "BT_STRONG_DRAG", CS%strong_drag, &
5975		"If true, use a stronger estimate of the retarding "//&
5976		"effects of strong bottom drag, by making it implicit "//&
5977		"with the barotropic time-step instead of implicit with "//&
5978		"the baroclinic time-step and dividing by the number of "//&
5979	1	"barotropic steps.", default=.false.)
5980		call get_param(param_file, mdl, "RESCALE_STRONG_DRAG", CS%rescale_strong_drag, &
5981		"If true, reduce the barotropic contribution to the layer accelerations "//&
5982		"to account for the difference between the forces that can be counteracted "//&
5983		"by the stronger drag with BT_STRONG_DRAG and the average of the layer "//&
5984		"viscous remnants after a baroclinic timestep.", &
5985	1	default=.false., do_not_log=.not.CS%strong_drag)
5986		call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", CS%linear_wave_drag, &
5987		"If true, apply a linear drag to the barotropic velocities, "//&
5988		"using rates set by lin_drag_u & _v divided by the depth of "//&
5989		"the ocean. This was introduced to facilitate tide modeling.", &
5990	1	default=.false.)
5991		call get_param(param_file, mdl, "BT_LINEAR_FREQ_DRAG", CS%linear_freq_drag, &
5992		"If true, apply frequency-dependent drag to the tidal velocities. "//&
5993	1	"The streaming band-pass filter must be turned on.", default=.false.)
5994		call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, &
5995		"The name of the file with the barotropic linear wave drag "//&
5996		"piston velocities.", default="", &
5997	1	do_not_log=(.not.CS%linear_wave_drag) .and. (.not.CS%linear_freq_drag))
5998		call get_param(param_file, mdl, "BT_WAVE_DRAG_VAR", wave_drag_var, &
5999		"The name of the variable in BT_WAVE_DRAG_FILE with the "//&
6000		"barotropic linear wave drag piston velocities at h points. "//&
6001		"It will not be used if both BT_WAVE_DRAG_U and BT_WAVE_DRAG_V are defined.", &
6002	1	default="rH", do_not_log=.not.CS%linear_wave_drag)
6003		call get_param(param_file, mdl, "BT_WAVE_DRAG_U", wave_drag_u, &
6004		"The name of the variable in BT_WAVE_DRAG_FILE with the "//&
6005		"barotropic linear wave drag piston velocities at u points.", &
6006	1	default="", do_not_log=.not.CS%linear_wave_drag)
6007		call get_param(param_file, mdl, "BT_WAVE_DRAG_V", wave_drag_v, &
6008		"The name of the variable in BT_WAVE_DRAG_FILE with the "//&
6009		"barotropic linear wave drag piston velocities at v points.", &
6010	1	default="", do_not_log=.not.CS%linear_wave_drag)
6011		call get_param(param_file, mdl, "BT_WAVE_DRAG_SCALE", wave_drag_scale, &
6012		"A scaling factor for the barotropic linear wave drag "//&
6013		"piston velocities.", default=1.0, units="nondim", &
6014	1	do_not_log=.not.CS%linear_wave_drag)
6015
6016		call get_param(param_file, mdl, "CLIP_BT_VELOCITY", CS%clip_velocity, &
6017		"If true, limit any velocity components that exceed "//&
6018		"CFL_TRUNCATE. This should only be used as a desperate "//&
6019	1	"debugging measure.", default=.false.)
6020		call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, &
6021		"The value of the CFL number that will cause velocity "//&
6022		"components to be truncated; instability can occur past 0.5.", &
6023	1	units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity)
6024		call get_param(param_file, mdl, "MAXVEL", CS%maxvel, &
6025		"The maximum velocity allowed before the velocity "//&
6026		"components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T, &
6027	1	do_not_log=.not.CS%clip_velocity)
6028		call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, &
6029		"The maximum permitted CFL number associated with the "//&
6030		"barotropic accelerations from the summed velocities "//&
6031		"times the time-derivatives of thicknesses.", units="nondim", &
6032	1	default=0.25)
6033		call get_param(param_file, mdl, "VEL_UNDERFLOW", CS%vel_underflow, &
6034		"A negligibly small velocity magnitude below which velocity "//&
6035		"components are set to 0. A reasonable value might be "//&
6036		"1e-30 m/s, which is less than an Angstrom divided by "//&
6037	1	"the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T)
6038
6039		call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, &
6040		"A time-scale over which the barotropic mode solutions "//&
6041		"are filtered, in seconds if positive, or as a fraction "//&
6042		"of DT if negative. When used this can never be taken to "//&
6043		"be longer than 2*dt. Set this to 0 to apply no filtering.", &
6044	1	units="sec or nondim", default=-0.25)
6045	1	if (CS%dt_bt_filter > 0.0) CS%dt_bt_filter = US%s_to_T*CS%dt_bt_filter
6046		call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, &
6047		"A nondimensional factor by which gtot is enhanced.", &
6048	1	units="nondim", default=0.0)
6049		call get_param(param_file, mdl, "SSH_EXTRA", SSH_extra, &
6050		"An estimate of how much higher SSH might get, for use "//&
6051		"in calculating the safe external wave speed. The "//&
6052		"default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", &
6053	1	units="m", default=min(10.0,0.05G%max_depthUS%Z_to_m), scale=US%m_to_Z)
6054
6055		call get_param(param_file, mdl, "DEBUG", CS%debug, &
6056		"If true, write out verbose debugging data.", &
6057	1	default=.false., debuggingParam=.true.)
6058		call get_param(param_file, mdl, "DEBUG_BT", CS%debug_bt, &
6059		"If true, write out verbose debugging data within the "//&
6060		"barotropic time-stepping loop. The data volume can be "//&
6061		"quite large if this is true.", default=CS%debug, &
6062	1	debuggingParam=.true.)
6063		call get_param(param_file, mdl, "DEBUG_BT_WIDE_HALOS", CS%debug_wide_halos, &
6064		"If true, write the checksums on the full wide halos. Otherwise only the "//&
6065		"output for the final computational domain is written. This can be valuable "//&
6066		"for debugging certain cases where the stencil used in the wide halo "//&
6067		"iterations depends on which opoen boundary conditions are in the halos.", &
6068	1	default=.true., do_not_log=.not.(CS%debug_bt.and.CS%use_wide_halos), debuggingParam=.true.)
6069
6070		call get_param(param_file, mdl, "LINEARIZED_BT_CORIOLIS", CS%linearized_BT_PV, &
6071		"If true use the bottom depth instead of the total water column thickness "//&
6072	1	"in the barotropic Coriolis term calculations.", default=.true.)
6073		call get_param(param_file, mdl, "BEBT", CS%bebt, &
6074		"BEBT determines whether the barotropic time stepping "//&
6075		"uses the forward-backward time-stepping scheme or a "//&
6076		"backward Euler scheme. BEBT is valid in the range from "//&
6077		"0 (for a forward-backward treatment of nonrotating "//&
6078		"gravity waves) to 1 (for a backward Euler treatment). "//&
6079		"In practice, BEBT must be greater than about 0.05.", &
6080	1	units="nondim", default=0.1)
6081		! Note that dtbt_input is not rescaled because it has different units for
6082		! positive [s] and negative [nondim] values.
6083		call get_param(param_file, mdl, "DTBT", dtbt_input, &
6084		"The barotropic time step, in s. DTBT is only used with "//&
6085		"the split explicit time stepping. To set the time step "//&
6086		"automatically based the maximum stable value use 0, or "//&
6087		"a negative value gives the fraction of the stable value. "//&
6088		"Setting DTBT to 0 is the same as setting it to -0.98. "//&
6089		"The value of DTBT that will actually be used is an "//&
6090		"integer fraction of DT, rounding down.", &
6091	1	units="s or nondim", default=-0.98)
6092		call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", CS%use_old_coriolis_bracket_bug, &
6093		"If True, use an order of operations that is not bitwise "//&
6094		"rotationally symmetric in the meridional Coriolis term of "//&
6095	1	"the barotropic solver.", default=.false.)
6096		call get_param(param_file, mdl, "MASK_COASTAL_PRESSURE_FORCE", mask_coastal_pressure_force, &
6097		"If true, use the land masks to zero out the diagnosed barotropic pressure "//&
6098		"gradient accelerations at coastal or land points. This changes diagnostics "//&
6099		"and improves the reproducibility of certain debugging checksums, but it "//&
6100	1	"does not alter the solutions themselves.", default=.false.)
6101		!### Change the default for MASK_COASTAL_PRESSURE_FORCE to true?
6102
6103		! Initialize a version of the MOM domain that is specific to the barotropic solver.
6104	1	call clone_MOM_domain(G%Domain, CS%BT_Domain, min_halo=wd_halos, symmetric=.true.)
6105		#ifdef STATIC_MEMORY_
6106		if (wd_halos(1) /= WHALOI_+NIHALO_) call MOM_error(FATAL, "barotropic_init: "//&
6107		"Barotropic x-halo sizes are incorrectly resized with STATIC_MEMORY_.")
6108		if (wd_halos(2) /= WHALOJ_+NJHALO_) call MOM_error(FATAL, "barotropic_init: "//&
6109		"Barotropic y-halo sizes are incorrectly resized with STATIC_MEMORY_.")
6110		#else
6111	1	if (bt_halo_sz > 0) then
6112	0	if (wd_halos(1) > bt_halo_sz) &
6113	0	call MOM_mesg("barotropic_init: barotropic x-halo size increased.", 3)
6114	0	if (wd_halos(2) > bt_halo_sz) &
6115	0	call MOM_mesg("barotropic_init: barotropic y-halo size increased.", 3)
6116		endif
6117		#endif
6118		call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), &
6119		"The barotropic x-halo size that is actually used.", &
6120	1	layoutParam=.true.)
6121		call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), &
6122		"The barotropic y-halo size that is actually used.", &
6123	1	layoutParam=.true.)
6124
6125	1	CS%isdw = G%isc-wd_halos(1) ; CS%iedw = G%iec+wd_halos(1)
6126	1	CS%jsdw = G%jsc-wd_halos(2) ; CS%jedw = G%jec+wd_halos(2)
6127	1	isdw = CS%isdw ; iedw = CS%iedw ; jsdw = CS%jsdw ; jedw = CS%jedw
6128
6129	1	ALLOC_(CS%frhatu(IsdB:IedB,jsd:jed,nz)) ; ALLOC_(CS%frhatv(isd:ied,JsdB:JedB,nz))
6130	1	ALLOC_(CS%eta_cor(isd:ied,jsd:jed))
6131	1	if (CS%bound_BT_corr) &
6132	8773	allocate(CS%eta_cor_bound(isd:ied,jsd:jed), source=0.0)
6133	1	ALLOC_(CS%IDatu(IsdB:IedB,jsd:jed)) ; ALLOC_(CS%IDatv(isd:ied,JsdB:JedB))
6134
6135	1	ALLOC_(CS%ua_polarity(isdw:iedw,jsdw:jedw))
6136	1	ALLOC_(CS%va_polarity(isdw:iedw,jsdw:jedw))
6137
6138	1330726	CS%frhatu(:,:,:) = 0.0 ; CS%frhatv(:,:,:) = 0.0
6139	8773	CS%eta_cor(:,:) = 0.0
6140	17742	CS%IDatu(:,:) = 0.0 ; CS%IDatv(:,:) = 0.0
6141
6142	17545	CS%ua_polarity(:,:) = 1.0 ; CS%va_polarity(:,:) = 1.0
6143	1	call create_group_pass(pass_a_polarity, CS%ua_polarity, CS%va_polarity, CS%BT_domain, To_All, AGRID)
6144	1	call do_group_pass(pass_a_polarity, CS%BT_domain)
6145
6146	1	if (use_BT_cont_type) &
6147	1	call alloc_BT_cont_type(BT_cont, G, GV, (CS%hvel_scheme == FROM_BT_CONT))
6148
6149	1	if (CS%debug) then ! Make a local copy of loop ranges for chksum calls
6150	0	allocate(CS%debug_BT_HI)
6151	0	CS%debug_BT_HI%isc = G%isc
6152	0	CS%debug_BT_HI%iec = G%iec
6153	0	CS%debug_BT_HI%jsc = G%jsc
6154	0	CS%debug_BT_HI%jec = G%jec
6155	0	CS%debug_BT_HI%IscB = G%isc-1
6156	0	CS%debug_BT_HI%IecB = G%iec
6157	0	CS%debug_BT_HI%JscB = G%jsc-1
6158	0	CS%debug_BT_HI%JecB = G%jec
6159	0	CS%debug_BT_HI%isd = CS%isdw
6160	0	CS%debug_BT_HI%ied = CS%iedw
6161	0	CS%debug_BT_HI%jsd = CS%jsdw
6162	0	CS%debug_BT_HI%jed = CS%jedw
6163	0	CS%debug_BT_HI%IsdB = CS%isdw-1
6164	0	CS%debug_BT_HI%IedB = CS%iedw
6165	0	CS%debug_BT_HI%JsdB = CS%jsdw-1
6166	0	CS%debug_BT_HI%JedB = CS%jedw
6167	0	CS%debug_BT_HI%turns = G%HI%turns
6168		endif
6169
6170		! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.
6171	8773	ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0
6172	8773	ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = 0.0
6173	8841	ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0
6174	8902	ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0
6175	8841	ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0
6176	8902	ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0
6177	8773	allocate(CS%IareaT_OBCmask(isdw:iedw,jsdw:jedw), source=0.0)
6178	8841	ALLOC_(CS%OBCmask_u(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%OBCmask_u(:,:) = 0.0
6179	8902	ALLOC_(CS%OBCmask_v(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%OBCmask_v(:,:) = 0.0
6180	8773	do j=G%jsd,G%jed ; do i=G%isd,G%ied
6181	8704	CS%IareaT(i,j) = G%IareaT(i,j)
6182	8704	CS%bathyT(i,j) = G%bathyT(i,j)
6183	8772	CS%IareaT_OBCmask(i,j) = CS%IareaT(i,j)
6184		enddo ; enddo
6185
6186		! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without
6187		! wide halos.
6188	8841	do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB
6189	8772	CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j)
6190	8840	CS%OBCmask_u(I,j) = G%OBCmaskCu(I,j)
6191		enddo ; enddo
6192	8902	do J=G%JsdB,G%JedB ; do i=G%isd,G%ied
6193	8832	CS%IdyCv(i,J) = G%IdyCv(i,J) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J)
6194	8901	CS%OBCmask_v(i,J) = G%OBCmaskCv(i,J)
6195		enddo ; enddo
6196
6197		! This sets pressure force diagnostics on land, at coastlines and at OBC points to zero.
6198	1	if (mask_coastal_pressure_force) then
6199	0	do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB
6200	0	CS%IdxCu(I,j) = G%IdxCu_OBCmask(I,j)
6201		enddo ; enddo
6202	0	do J=G%JsdB,G%JedB ; do i=G%isd,G%ied
6203	0	CS%IdyCv(i,J) = G%IdyCv_OBCmask(i,J)
6204		enddo ; enddo
6205		endif
6206
6207	1	if (associated(OBC)) then
6208		! Set up information about the location and nature of the open boundary condition points.
6209	0	call initialize_BT_OBC(OBC, CS%BT_OBC, G, CS)
6210
6211		! Update IareaT_OBCmask so that nothing changes outside of the OBC (problem for interior OBCs only)
6212	0	if (.not.CS%exterior_OBC_bug) then
6213	0	if (CS%BT_OBC%u_OBCs_on_PE) then
6214	0	do j=jsd,jed ; do i=isd,ied
6215	0	if (CS%BT_OBC%u_OBC_type(I-1,j) > 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_E
6216	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_W
6217		enddo ; enddo
6218		endif
6219	0	if (CS%BT_OBC%v_OBCs_on_PE) then
6220	0	do j=jsd,jed ; do i=isd,ied
6221	0	if (CS%BT_OBC%v_OBC_type(i,J-1) > 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_N
6222	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_S
6223		enddo ; enddo
6224		endif
6225		endif
6226
6227		! Set masks to avoid changing velocities at OBC points.
6228	0	if (CS%BT_OBC%u_OBCs_on_PE) then
6229	0	do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB ; if (CS%BT_OBC%u_OBC_type(I,j) /= 0) then
6230	0	CS%OBCmask_u(I,j) = 0.0 ; CS%IdxCu(I,j) = 0.0
6231		endif ; enddo ; enddo
6232		endif
6233	0	if (CS%BT_OBC%v_OBCs_on_PE) then
6234	0	do J=G%JsdB,G%JedB ; do i=G%isd,G%ied ; if (CS%BT_OBC%v_OBC_type(i,J) /= 0) then
6235	0	CS%OBCmask_v(i,J) = 0.0 ; CS%IdyCv(i,J) = 0.0
6236		endif ; enddo ; enddo
6237		endif
6238
6239	0	CS%integral_OBCs = CS%integral_BT_cont .and. open_boundary_query(OBC, apply_open_OBC=.true.)
6240		else ! There are no OBC points anywhere.
6241	1	CS%BT_OBC%u_OBCs_on_PE = .false.
6242	1	CS%BT_OBC%v_OBCs_on_PE = .false.
6243	1	CS%integral_OBCs = .false.
6244		endif
6245
6246	1	call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All)
6247	1	call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All)
6248	1	call create_group_pass(pass_static_data, CS%IareaT_OBCmask, CS%BT_domain, To_All)
6249	1	call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, To_All+Scalar_Pair)
6250	1	call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, To_All+Scalar_Pair)
6251	1	call create_group_pass(pass_static_data, CS%OBCmask_u, CS%OBCmask_v, CS%BT_domain, To_All+Scalar_Pair)
6252	1	call do_group_pass(pass_static_data, CS%BT_domain)
6253
6254		! Determine the weights to use for the thicknesses when calculating PV for use in the Coriolis terms
6255	44575	allocate(CS%q_wt(4,CS%isdw-1:CS%iedw,CS%jsdw-1:CS%jedw), source=0.0)
6256	7443	do J=js-1,je ; do I=is-1,ie
6257	7442	if (G%mask2dT(i,j) + G%mask2dT(i,j+1) + G%mask2dT(i+1,j) + G%mask2dT(i+1,j+1) > 0.) then
6258	5237	CS%q_wt(1,I,J) = G%areaT(i,j) ; CS%q_wt(2,I,J) = G%areaT(i+1,j)
6259	5237	CS%q_wt(3,I,J) = G%areaT(i,j+1) ; CS%q_wt(4,I,J) = G%areaT(i+1,j+1)
6260		else
6261	10720	CS%q_wt(1:4,I,J) = 0.0
6262		endif
6263		enddo ; enddo
6264
6265	1	if (CS%interior_OBC_PV .and. (CS%BT_OBC%u_OBCs_on_PE .or. CS%BT_OBC%v_OBCs_on_PE)) then
6266		! Reset the potential vorticity at OBC vertices as a masked weighted average.
6267	0	do J=js-1,je ; do I=is-1,ie
6268	0	if ((G%mask2dT(i,j) + G%mask2dT(i,j+1) + G%mask2dT(i+1,j) + G%mask2dT(i+1,j+1) > 0.) .and. &
6269		((abs(CS%BT_OBC%u_OBC_type(I,j)) > 0) .or. (abs(CS%BT_OBC%u_OBC_type(I,j+1)) > 0) .or. &
6270	0	(abs(CS%BT_OBC%v_OBC_type(i,J)) > 0) .or. (abs(CS%BT_OBC%v_OBC_type(i+1,J)) > 0)) ) then
6271		! This is an OBC vertex, so use an area weighted masked average and avoid external values.
6272	0	CS%q_wt(1,I,J) = G%mask2dT(i,j) * G%areaT(i,j)
6273	0	CS%q_wt(2,I,J) = G%mask2dT(i+1,j) * G%areaT(i+1,j)
6274	0	CS%q_wt(3,I,J) = G%mask2dT(i,j+1) * G%areaT(i,j+1)
6275	0	CS%q_wt(4,I,J) = G%mask2dT(i+1,j+1) * G%areaT(i+1,j+1)
6276
6277		! The following block is the equivalent of shifting weights inward across OBC points. With
6278		! two OBCs in a line, it gives weights of about 1/2 and 1/2 to the interior points. At a
6279		! peninsula-like corner between two OBCs it gives weights of about 3/8, 1/4 and 3/8 for the
6280		! 3 interior points. At a bay-liek corner there is only one interior point with a weight of 1.
6281		! The masking above zeros out the weights for exterior points.
6282	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) then ! Eastern OBC in the u-point to the south
6283	0	CS%q_wt(1,I,J) = CS%q_wt(1,I,J) + 0.5G%mask2dT(i,j)G%areaT(i,j) ! already CS%q_wt(2,I,J) = 0.0
6284	0	elseif (CS%BT_OBC%u_OBC_type(I,j) < 0) then ! Western OBC in the u-point to the south
6285	0	CS%q_wt(2,I,J) = CS%q_wt(2,I,J) + 0.5G%mask2dT(i+1,j)G%areaT(i+1,j) ! already CS%q_wt(1,I,J) = 0.0
6286		endif
6287	0	if (CS%BT_OBC%u_OBC_type(I,j+1) > 0) then ! Eastern OBC in the u-point to the north
6288	0	CS%q_wt(3,I,J) = CS%q_wt(3,I,J) + 0.5G%mask2dT(i,j+1)G%areaT(i,j+1) ! already CS%q_wt(4,I,J) = 0.0
6289	0	elseif (CS%BT_OBC%u_OBC_type(I,j+1) < 0) then ! Western OBC in the u-point to the north
6290	0	CS%q_wt(4,I,J) = CS%q_wt(4,I,J) + 0.5G%mask2dT(i+1,j+1)G%areaT(i+1,j+1) ! already CS%q_wt(3,I,J) = 0.0
6291		endif
6292	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) then ! Northern OBC in the v-point to the west
6293	0	CS%q_wt(1,I,J) = CS%q_wt(1,I,J) + 0.5G%mask2dT(i,j)G%areaT(i,j) ! already CS%q_wt(3,I,J) = 0.0
6294	0	elseif (CS%BT_OBC%v_OBC_type(i,J) < 0) then ! Southern OBC in the v-point to the west
6295	0	CS%q_wt(3,I,J) = CS%q_wt(3,I,J) + 0.5G%mask2dT(i,j+1)G%areaT(i,j+1) ! already CS%q_wt(1,I,J) = 0.0
6296		endif
6297	0	if (CS%BT_OBC%v_OBC_type(i+1,J) > 0) then ! Northern OBC in the v-point to the west
6298	0	CS%q_wt(2,I,J) = CS%q_wt(2,I,J) + 0.5G%mask2dT(i+1,j)G%areaT(i+1,j) ! already CS%q_wt(4,I,J) = 0.0
6299	0	elseif (CS%BT_OBC%v_OBC_type(i+1,J) < 0) then ! Southern OBC in the v-point to the west
6300	0	CS%q_wt(4,I,J) = CS%q_wt(4,I,J) + 0.5G%mask2dT(i+1,j+1)G%areaT(i+1,j+1) ! already CS%q_wt(2,I,J) = 0.0
6301		endif
6302		endif
6303		enddo ; enddo
6304		endif
6305
6306	1	if (CS%linearized_BT_PV) then
6307	8971	allocate(CS%q_D(CS%isdw-1:CS%iedw,CS%jsdw-1:CS%jedw), source=0.0)
6308	8841	allocate(CS%D_u_Cor(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw), source=0.0)
6309	8902	allocate(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw), source=0.0)
6310
6311	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
6312
6313	7321	do j=js,je ; do I=is-1,ie
6314		CS%D_u_Cor(I,j) = 0.5 * ( max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) &
6315	7320	+ max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) ) * Z_to_H
6316		enddo ; enddo
6317	1	if (CS%interior_OBC_PV .and. CS%BT_OBC%u_OBCs_on_PE) then ; do j=js,je ; do I=is-1,ie
6318	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) & ! Western boundary condition
6319	0	CS%D_u_Cor(I,j) = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) * Z_to_H
6320	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) & ! Eastern boundary condition
6321	0	CS%D_u_Cor(I,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
6322		enddo ; enddo ; endif
6323
6324	7382	do J=js-1,je ; do i=is,ie
6325		CS%D_v_Cor(i,J) = 0.5 * ( max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) &
6326	7381	+ max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) ) * Z_to_H
6327		enddo ; enddo
6328	1	if (CS%interior_OBC_PV .and. CS%BT_OBC%v_OBCs_on_PE) then ; do J=js-1,je ; do i=is,ie
6329	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) & ! Southern boundary condition
6330	0	CS%D_v_Cor(i,J) = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) * Z_to_H
6331	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) & ! Northern boundary condition
6332	0	CS%D_v_Cor(i,J) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
6333		enddo ; enddo ; endif
6334
6335	1	h_a_neglect = GV%H_subroundoff * 1.0 * US%m_to_L**2
6336	7443	do J=js-1,je ; do I=is-1,ie
6337	7442	if ((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J)) > 0.) then
6338		CS%q_D(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
6339		((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J))) / &
6340		max(Z_to_H * (((CS%q_wt(1,I,J) * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0)) + &
6341		(CS%q_wt(4,I,J) * max(G%meanSL(i+1,j+1) + G%bathyT(i+1,j+1), 0.0))) + &
6342		((CS%q_wt(2,I,J) * max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0)) + &
6343		(CS%q_wt(3,I,J) * max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0)))), &
6344	5237	h_a_neglect)
6345		else ! All four h points are masked out so q_D(I,J) is meaningless
6346	2144	CS%q_D(I,J) = 0.
6347		endif
6348		enddo ; enddo
6349
6350		! With very wide halos, q and D need to be calculated on the available data
6351		! domain and then updated onto the full computational domain.
6352	1	call create_group_pass(pass_q_D_Cor, CS%q_D, CS%BT_Domain, To_All, position=CORNER)
6353		call create_group_pass(pass_q_D_Cor, CS%D_u_Cor, CS%D_v_Cor, CS%BT_Domain, &
6354	1	To_All+Scalar_Pair)
6355	1	call do_group_pass(pass_q_D_Cor, CS%BT_Domain)
6356		endif
6357
6358	1	if (CS%linear_wave_drag) then
6359	0	allocate(CS%lin_drag_u(IsdB:IedB,jsd:jed), source=0.0)
6360	0	allocate(CS%lin_drag_v(isd:ied,JsdB:JedB), source=0.0)
6361
6362	0	if (len_trim(wave_drag_file) > 0) then
6363	0	inputdir = "." ; call get_param(param_file, mdl, "INPUTDIR", inputdir)
6364	0	wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
6365	0	call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
6366
6367	0	if (len_trim(wave_drag_u) > 0 .and. len_trim(wave_drag_v) > 0) then
6368		call MOM_read_data(wave_drag_file, wave_drag_u, CS%lin_drag_u, G%Domain, &
6369	0	position=EAST_FACE, scale=wave_drag_scaleGV%m_to_HUS%T_to_s)
6370		call MOM_read_data(wave_drag_file, wave_drag_v, CS%lin_drag_v, G%Domain, &
6371	0	position=NORTH_FACE, scale=wave_drag_scaleGV%m_to_HUS%T_to_s)
6372	0	call pass_vector(CS%lin_drag_u, CS%lin_drag_v, G%domain, direction=To_All+SCALAR_PAIR)
6373		else
6374	0	allocate(lin_drag_h(isd:ied,jsd:jed), source=0.0)
6375
6376	0	call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=GV%m_to_H*US%T_to_s)
6377	0	call pass_var(lin_drag_h, G%Domain)
6378	0	do j=js,je ; do I=is-1,ie
6379	0	CS%lin_drag_u(I,j) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
6380		enddo ; enddo
6381	0	do J=js-1,je ; do i=is,ie
6382	0	CS%lin_drag_v(i,J) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
6383		enddo ; enddo
6384	0	deallocate(lin_drag_h)
6385		endif ! len_trim(wave_drag_u) > 0 .and. len_trim(wave_drag_v) > 0
6386		endif ! len_trim(wave_drag_file) > 0
6387		endif ! CS%linear_wave_drag
6388
6389		! Initialize streaming band-pass filters and frequency-dependent drag
6390	1	if (CS%use_filter) then
6391	0	call Filt_init(param_file, US, CS%Filt_CS_u, restart_CS)
6392	0	call Filt_init(param_file, US, CS%Filt_CS_v, restart_CS)
6393		endif
6394
6395	1	if (CS%use_filter .and. CS%linear_freq_drag) then
6396	0	if (.not.CS%linear_wave_drag .and. len_trim(wave_drag_file) > 0) then
6397	0	inputdir = "." ; call get_param(param_file, mdl, "INPUTDIR", inputdir)
6398	0	wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
6399	0	call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
6400		endif
6401	0	call wave_drag_init(param_file, wave_drag_file, G, GV, US, CS%Drag_CS)
6402		endif
6403
6404	1	CS%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) CS%dtbt_fraction = -dtbt_input
6405
6406	1	dtbt_restart = -1.0
6407	1	if (query_initialized(CS%dtbt, "DTBT", restart_CS)) then
6408	0	dtbt_restart = CS%dtbt
6409		endif
6410
6411		! Estimate the maximum stable barotropic time step.
6412	1	gtot_estimate = 0.0
6413	1	if (GV%Boussinesq) then
6414	76	do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%H_to_Z*GV%g_prime(K) ; enddo
6415		else
6416	0	H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin
6417	0	do k=1,GV%ke ; gtot_estimate = gtot_estimate + H_to_Z*GV%g_prime(K) ; enddo
6418		endif
6419
6420		! ubtav and vbtav, and perhaps ubt_IC and vbt_IC, are allocated and
6421		! initialized in register_barotropic_restarts.
6422
6423	1	if (GV%Boussinesq) then
6424	1	thickness_units = "m" ; flux_units = "m3 s-1"
6425		else
6426	0	thickness_units = "kg m-2" ; flux_units = "kg s-1"
6427		endif
6428
6429		CS%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, Time, &
6430	1	'Zonal Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6431		CS%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, Time, &
6432	1	'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6433		CS%id_etaPF_anom = register_diag_field('ocean_model', 'etaPF_anom', diag%axesT1, Time, &
6434		'Eta anomalies used for pressure forces averaged over a baroclinic timestep', &
6435	1	thickness_units, conversion=GV%H_to_MKS)
6436	1	if (CS%linear_wave_drag .or. (CS%use_filter .and. CS%linear_freq_drag)) then
6437		CS%id_LDu_bt = register_diag_field('ocean_model', 'WaveDraguBT', diag%axesCu1, Time, &
6438	0	'Zonal Barotropic Linear Wave Drag Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6439		CS%id_LDv_bt = register_diag_field('ocean_model', 'WaveDragvBT', diag%axesCv1, Time, &
6440	0	'Meridional Barotropic Linear Wave Drag Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6441		endif
6442		CS%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, Time, &
6443	1	'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6444		CS%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, Time, &
6445	1	'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6446		CS%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, Time, &
6447	1	'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6448		CS%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, Time, &
6449	1	'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6450		CS%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, Time, &
6451	1	'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2)
6452		CS%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, Time, &
6453	1	'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2)
6454		CS%id_ubtdt = register_diag_field('ocean_model', 'ubt_dt', diag%axesCu1, Time, &
6455	1	'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6456		CS%id_vbtdt = register_diag_field('ocean_model', 'vbt_dt', diag%axesCv1, Time, &
6457	1	'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6458
6459		CS%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, Time, &
6460	1	'Barotropic end SSH', thickness_units, conversion=GV%H_to_MKS)
6461		CS%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, Time, &
6462	1	'Barotropic end zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6463		CS%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, Time, &
6464	1	'Barotropic end meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6465		CS%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, Time, &
6466	1	'Barotropic start SSH', thickness_units, conversion=GV%H_to_MKS)
6467		CS%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, Time, &
6468	1	'Barotropic start zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6469		CS%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, Time, &
6470	1	'Barotropic start meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6471		CS%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, Time, &
6472	1	'Barotropic time-average zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6473		CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, &
6474	1	'Barotropic time-average meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6475		CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, &
6476	1	'Corrective mass or volume flux within a timestep', thickness_units, conversion=GV%H_to_MKS)
6477		CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, &
6478	1	'Viscous remnant at u', 'nondim')
6479		CS%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, Time, &
6480	1	'Viscous remnant at v', 'nondim')
6481		CS%id_bt_rem_u = register_diag_field('ocean_model', 'bt_rem_u', diag%axesCu1, Time, &
6482	1	'Barotropic viscous remnant per barotropic step at u', 'nondim')
6483		CS%id_bt_rem_v = register_diag_field('ocean_model', 'bt_rem_v', diag%axesCv1, Time, &
6484	1	'Barotropic viscous remnant per barotropic step at v', 'nondim')
6485		CS%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, Time, &
6486	1	'gtot to North', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6487		CS%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, Time, &
6488	1	'gtot to South', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6489		CS%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, Time, &
6490	1	'gtot to East', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6491		CS%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, Time, &
6492	1	'gtot to West', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6493		CS%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, Time, &
6494	1	'High Frequency Barotropic SSH', thickness_units, conversion=GV%H_to_MKS)
6495		CS%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, Time, &
6496	1	'High Frequency Barotropic zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6497		CS%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, Time, &
6498	1	'High Frequency Barotropic meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6499		! if (.not.CS%BT_project_velocity) & ! The following diagnostic is redundant with BT_project_velocity.
6500		CS%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, Time, &
6501	1	'High Frequency Predictor Barotropic SSH', thickness_units, conversion=GV%H_to_MKS)
6502		CS%id_etaPF_hifreq = register_diag_field('ocean_model', 'etaPF_hifreq', diag%axesT1, Time, &
6503	1	'High Frequency Barotropic SSH anomalies used for pressure forces', thickness_units, conversion=GV%H_to_MKS)
6504		CS%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, Time, &
6505		'High Frequency Barotropic zonal transport', &
6506	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6507		CS%id_vhbt_hifreq = register_diag_field('ocean_model', 'vhbt_hifreq', diag%axesCv1, Time, &
6508		'High Frequency Barotropic meridional transport', &
6509	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6510		CS%id_frhatu = register_diag_field('ocean_model', 'frhatu', diag%axesCuL, Time, &
6511	1	'Fractional thickness of layers in u-columns', 'nondim')
6512		CS%id_frhatv = register_diag_field('ocean_model', 'frhatv', diag%axesCvL, Time, &
6513	1	'Fractional thickness of layers in v-columns', 'nondim')
6514		CS%id_frhatu1 = register_diag_field('ocean_model', 'frhatu1', diag%axesCuL, Time, &
6515	1	'Predictor Fractional thickness of layers in u-columns', 'nondim')
6516		CS%id_frhatv1 = register_diag_field('ocean_model', 'frhatv1', diag%axesCvL, Time, &
6517	1	'Predictor Fractional thickness of layers in v-columns', 'nondim')
6518		CS%id_uhbt = register_diag_field('ocean_model', 'uhbt', diag%axesCu1, Time, &
6519		'Barotropic zonal transport averaged over a baroclinic step', &
6520	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6521		CS%id_vhbt = register_diag_field('ocean_model', 'vhbt', diag%axesCv1, Time, &
6522		'Barotropic meridional transport averaged over a baroclinic step', &
6523	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6524
6525	1	if (use_BT_cont_type) then
6526		CS%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, Time, &
6527	1	'BTCont type far east face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6528		CS%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, Time, &
6529	1	'BTCont type near east face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6530		CS%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, Time, &
6531	1	'BTCont type far west face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6532		CS%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, Time, &
6533	1	'BTCont type near west face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6534		CS%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, Time, &
6535	1	'BTCont type far east velocity', 'm s-1', conversion=US%L_T_to_m_s)
6536		CS%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, Time, &
6537	1	'BTCont type far west velocity', 'm s-1', conversion=US%L_T_to_m_s)
6538		! This is a specialized diagnostic that is not being made widely available (yet).
6539		! CS%id_BTC_FA_u_rat0 = register_diag_field('ocean_model', 'BTC_FA_u_rat0', diag%axesCu1, Time, &
6540		! 'BTCont type ratio of near east and west face areas', 'nondim')
6541		CS%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, Time, &
6542	1	'BTCont type far north face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6543		CS%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, Time, &
6544	1	'BTCont type near north face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6545		CS%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, Time, &
6546	1	'BTCont type far south face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6547		CS%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, Time, &
6548	1	'BTCont type near south face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6549		CS%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, Time, &
6550	1	'BTCont type far north velocity', 'm s-1', conversion=US%L_T_to_m_s)
6551		CS%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, Time, &
6552	1	'BTCont type far south velocity', 'm s-1', conversion=US%L_T_to_m_s)
6553		! This is a specialized diagnostic that is not being made widely available (yet).
6554		! CS%id_BTC_FA_v_rat0 = register_diag_field('ocean_model', 'BTC_FA_v_rat0', diag%axesCv1, Time, &
6555		! 'BTCont type ratio of near north and south face areas', 'nondim')
6556		! CS%id_BTC_FA_h_rat0 = register_diag_field('ocean_model', 'BTC_FA_h_rat0', diag%axesT1, Time, &
6557		! 'BTCont type maximum ratios of near face areas around cells', 'nondim')
6558		endif
6559		CS%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, Time, &
6560	1	'Barotropic zonal transport difference', 'm3 s-1', conversion=GV%H_to_mUS%L_to_m2US%s_to_T)
6561		CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, &
6562	1	'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_mUS%L_to_m2US%s_to_T)
6563	1	if (associated(OBC)) then
6564	0	if (OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally) then
6565		CS%id_SSH_u_OBC = register_diag_field('ocean_model', 'SSH_u_OBC', diag%axesCu1, Time, &
6566	0	'Outer sea surface height at u OBC points', 'm', conversion=US%Z_to_m)
6567		CS%id_SSH_v_OBC = register_diag_field('ocean_model', 'SSH_v_OBC', diag%axesCv1, Time, &
6568	0	'Outer sea surface height at v OBC points', 'm', conversion=US%Z_to_m)
6569		CS%id_ubt_OBC = register_diag_field('ocean_model', 'ubt_OBC', diag%axesCu1, Time, &
6570	0	'Outer u velocity at OBC points', 'm', conversion=US%L_T_to_m_s)
6571		CS%id_vbt_OBC = register_diag_field('ocean_model', 'vbt_OBC', diag%axesCv1, Time, &
6572	0	'Outer v velocity at OBC points', 'm', conversion=US%L_T_to_m_s)
6573		endif
6574		endif
6575
6576		!$omp target update to (CS)
6577
6578		! CS%dtbt calculated here by set_dtbt is only used when dtbt is not reset during the run, i.e. DTBT_RESET_PERIOD<0.
6579		!$omp target enter data map (to: CS%frhatu, CS%frhatv)
6580		!$omp target enter data map (to: CS%eta_cor)
6581	1	call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra)
6582
6583	1	if (dtbt_input > 0.0) then
6584	0	CS%dtbt = US%s_to_T * dtbt_input
6585	1	elseif (dtbt_restart > 0.0) then
6586	0	CS%dtbt = dtbt_restart
6587		endif
6588		!$omp target update to (CS%dtbt)
6589
6590	1	calc_dtbt = .true. ; if ((dtbt_restart > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false.
6591
6592	1	call log_param(param_file, mdl, "DTBT as used", CS%dtbt, units="s", unscale=US%T_to_s)
6593	1	call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max, units="s", unscale=US%T_to_s)
6594
6595	1	if (CS%id_frhatu1 > 0) allocate(CS%frhatu1(IsdB:IedB,jsd:jed,nz), source=0.)
6596	1	if (CS%id_frhatv1 > 0) allocate(CS%frhatv1(isd:ied,JsdB:JedB,nz), source=0.)
6597
6598	1	if (.NOT.query_initialized(CS%ubtav,"ubtav",restart_CS) .or. &
6599		.NOT.query_initialized(CS%vbtav,"vbtav",restart_CS)) then
6600		!$omp target update to(h)
6601	1	call btcalc(h, G, GV, CS, may_use_default=.true.)
6602	17742	CS%ubtav(:,:) = 0.0 ; CS%vbtav(:,:) = 0.0
6603	549076	do k=1,nz ; do j=js,je ; do I=is-1,ie
6604	549000	CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * u(I,j,k)
6605		enddo ; enddo ; enddo
6606	553651	do k=1,nz ; do J=js-1,je ; do i=is,ie
6607	553575	CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k)
6608		enddo ; enddo ; enddo
6609		endif
6610
6611	1	if (CS%gradual_BT_ICs) then
6612	0	if (.NOT.query_initialized(CS%ubt_IC,"ubt_IC",restart_CS) .or. &
6613		.NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then
6614	0	do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo
6615	0	do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo
6616		endif
6617		endif
6618		! Calculate other constants which are used for btstep.
6619
6620	1	if (.not.CS%nonlin_stress) then
6621	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
6622	7321	do j=js,je ; do I=is-1,ie
6623	7260	htot = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) + max(G%meanSL(i,j) + G%bathyT(i,j), 0.0)
6624	7320	if (G%OBCmaskCu(I,j) * htot > 0.) then
6625	4948	CS%IDatu(I,j) = G%OBCmaskCu(I,j) * 2.0 / (Z_to_H * htot)
6626		else ! Both neighboring H points are masked out or this is an OBC face so IDatu(I,j) is unused
6627	2312	CS%IDatu(I,j) = 0.
6628		endif
6629		enddo ; enddo
6630	7382	do J=js-1,je ; do i=is,ie
6631	7320	htot = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) + max(G%meanSL(i,j) + G%bathyT(i,j), 0.0)
6632	7381	if (G%OBCmaskCv(i,J) * htot > 0.) then
6633	4894	CS%IDatv(i,J) = G%OBCmaskCv(i,J) * 2.0 / (Z_to_H * htot)
6634		else ! Both neighboring H points are masked out or this is an OBC face so IDatv(i,J) is unused
6635	2426	CS%IDatv(i,J) = 0.
6636		endif
6637		enddo ; enddo
6638		endif
6639
6640	1	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1)
6641	1	if ((CS%bound_BT_corr) .and. .not.(use_BT_Cont_type .and. CS%BT_cont_bounds)) then
6642		! This is not used in most test cases. Were it ever to become more widely used, consider
6643		! replacing maxvel with min(G%dxT(i,j),G%dyT(i,j)) * (CS%maxCFL_BT_cont*Idt) .
6644	0	do j=js,je ; do i=is,ie
6645		CS%eta_cor_bound(i,j) = G%IareaT(i,j) * 0.1 * CS%maxvel * &
6646	0	((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1)))
6647		enddo ; enddo
6648		endif
6649		!$omp target enter data map(to: CS%eta_cor_bound)
6650
6651	1	if (CS%gradual_BT_ICs) &
6652	0	call create_group_pass(pass_bt_hbt_btav, CS%ubt_IC, CS%vbt_IC, G%Domain)
6653	1	call create_group_pass(pass_bt_hbt_btav, CS%ubtav, CS%vbtav, G%Domain)
6654	1	call do_group_pass(pass_bt_hbt_btav, G%Domain)
6655
6656		! id_clock_pass = cpu_clock_id('(Ocean BT halo updates)', grain=CLOCK_ROUTINE)
6657	1	id_clock_calc_pre = cpu_clock_id('(Ocean BT pre-calcs only)', grain=CLOCK_ROUTINE)
6658	1	id_clock_pass_pre = cpu_clock_id('(Ocean BT pre-step halo updates)', grain=CLOCK_ROUTINE)
6659	1	id_clock_calc = cpu_clock_id('(Ocean BT stepping calcs only)', grain=CLOCK_ROUTINE)
6660	1	id_clock_pass_step = cpu_clock_id('(Ocean BT stepping halo updates)', grain=CLOCK_ROUTINE)
6661	1	id_clock_calc_post = cpu_clock_id('(Ocean BT post-calcs only)', grain=CLOCK_ROUTINE)
6662	1	id_clock_pass_post = cpu_clock_id('(Ocean BT post-step halo updates)', grain=CLOCK_ROUTINE)
6663	1	if (dtbt_input <= 0.0) &
6664	1	id_clock_sync = cpu_clock_id('(Ocean BT global synch)', grain=CLOCK_ROUTINE)
6665
6666		! send initialized data to GPU
6667		!$omp target enter data map(to: CS%bathyT)
6668		!$omp target enter data map(to: CS%D_u_Cor, CS%D_v_Cor)
6669		!$omp target enter data map(to: CS%dx_Cv, CS%dy_Cu)
6670		!$omp target enter data map(to: CS%IareaT, CS%IareaT_OBCmask)
6671		!$omp target enter data map(to: CS%IDatu, CS%IDatv)
6672		!$omp target enter data map(to: CS%IdxCu, CS%IdyCv)
6673		!$omp target enter data map(to: CS%OBCmask_u, CS%OBCmask_v)
6674		!$omp target enter data map(to: CS%q_d)
6675		!$omp target enter data map(to: CS%ua_polarity, CS%va_polarity)
6676		!$omp target enter data map(to: CS%ubtav, CS%vbtav)
6677
6678	2	end subroutine barotropic_init
6679
6680		!> Copies ubtav and vbtav from private type into arrays
6681	0	subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US)
6682		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
6683		type(ocean_grid_type), intent(in) :: G !< Grid structure
6684		real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged
6685		!! over a baroclinic timestep [L T-1 ~> m s-1]
6686		real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged
6687		!! over a baroclinic timestep [L T-1 ~> m s-1]
6688		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
6689		! Local variables
6690		integer :: i,j
6691
6692	0	do j=G%jsc,G%jec ; do I=G%isc-1,G%iec
6693	0	ubtav(I,j) = CS%ubtav(I,j)
6694		enddo ; enddo
6695
6696	0	do J=G%jsc-1,G%jec ; do i=G%isc,G%iec
6697	0	vbtav(i,J) = CS%vbtav(i,J)
6698		enddo ; enddo
6699
6700	0	end subroutine barotropic_get_tav
6701
6702
6703		!> Clean up the barotropic control structure.
6704	1	subroutine barotropic_end(CS)
6705		type(barotropic_CS), intent(inout) :: CS !< Control structure to clear out.
6706
6707	1	call destroy_BT_OBC(CS%BT_OBC)
6708
6709		! Allocated in barotropic_init, called in timestep initialization
6710	1	DEALLOC_(CS%ua_polarity) ; DEALLOC_(CS%va_polarity)
6711	1	DEALLOC_(CS%IDatu) ; DEALLOC_(CS%IDatv)
6712	1	if (allocated(CS%eta_cor_bound)) deallocate(CS%eta_cor_bound)
6713	1	DEALLOC_(CS%eta_cor)
6714	1	DEALLOC_(CS%bathyT) ; DEALLOC_(CS%IareaT)
6715	1	DEALLOC_(CS%frhatu) ; DEALLOC_(CS%frhatv)
6716	1	DEALLOC_(CS%OBCmask_u) ; DEALLOC_(CS%OBCmask_v)
6717	1	DEALLOC_(CS%IdxCu) ; DEALLOC_(CS%IdyCv)
6718	1	DEALLOC_(CS%dy_Cu) ; DEALLOC_(CS%dx_Cv)
6719
6720	1	if (allocated(CS%frhatu1)) deallocate(CS%frhatu1)
6721	1	if (allocated(CS%frhatv1)) deallocate(CS%frhatv1)
6722	1	if (allocated(CS%IareaT_OBCmask)) deallocate(CS%IareaT_OBCmask)
6723
6724	1	if (allocated(CS%q_D)) deallocate(CS%q_D)
6725	1	if (allocated(CS%D_u_Cor)) deallocate(CS%D_u_Cor)
6726	1	if (allocated(CS%D_v_Cor)) deallocate(CS%D_v_Cor)
6727	1	if (allocated(CS%ubt_IC)) deallocate(CS%ubt_IC)
6728	1	if (allocated(CS%vbt_IC)) deallocate(CS%vbt_IC)
6729	1	if (allocated(CS%lin_drag_u)) deallocate(CS%lin_drag_u)
6730	1	if (allocated(CS%lin_drag_v)) deallocate(CS%lin_drag_v)
6731
6732	1	if (associated(CS%debug_BT_HI)) deallocate(CS%debug_BT_HI)
6733	1	call deallocate_MOM_domain(CS%BT_domain)
6734
6735		! Allocated in restart registration, prior to timestep initialization
6736	1	DEALLOC_(CS%ubtav) ; DEALLOC_(CS%vbtav)
6737	1	end subroutine barotropic_end
6738
6739		!> This subroutine is used to register any fields from MOM_barotropic.F90
6740		!! that should be written to or read from the restart file.
6741	1	subroutine register_barotropic_restarts(HI, GV, US, param_file, CS, restart_CS)
6742		type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
6743		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
6744		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
6745		type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
6746		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
6747		type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure
6748
6749		! Local variables
6750	58	type(vardesc) :: vd(3)
6751		character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
6752		integer :: n_filters !< Number of streaming band-pass filters to be used in the simulation.
6753		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
6754
6755	1	isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed
6756	1	IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB
6757
6758		call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, &
6759		"If true, adjust the initial conditions for the "//&
6760		"barotropic solver to the values from the layered "//&
6761		"solution over a whole timestep instead of instantly. "//&
6762		"This is a decent approximation to the inclusion of "//&
6763		"sum(u dh_dt) while also correcting for truncation errors.", &
6764	1	default=.false., do_not_log=.true.)
6765
6766	8841	ALLOC_(CS%ubtav(IsdB:IedB,jsd:jed)) ; CS%ubtav(:,:) = 0.0
6767	8902	ALLOC_(CS%vbtav(isd:ied,JsdB:JedB)) ; CS%vbtav(:,:) = 0.0
6768	1	if (CS%gradual_BT_ICs) then
6769	0	allocate(CS%ubt_IC(IsdB:IedB,jsd:jed), source=0.0)
6770	0	allocate(CS%vbt_IC(isd:ied,JsdB:JedB), source=0.0)
6771		endif
6772
6773		vd(2) = var_desc("ubtav","m s-1","Time mean barotropic zonal velocity", &
6774	6	hor_grid='u', z_grid='1')
6775		vd(3) = var_desc("vbtav","m s-1","Time mean barotropic meridional velocity",&
6776	6	hor_grid='v', z_grid='1')
6777		call register_restart_pair(CS%ubtav, CS%vbtav, vd(2), vd(3), .false., restart_CS, &
6778	1	conversion=US%L_T_to_m_s)
6779
6780	1	if (CS%gradual_BT_ICs) then
6781		vd(2) = var_desc("ubt_IC", "m s-1", &
6782		longname="Next initial condition for the barotropic zonal velocity", &
6783	0	hor_grid='u', z_grid='1')
6784		vd(3) = var_desc("vbt_IC", "m s-1", &
6785		longname="Next initial condition for the barotropic meridional velocity",&
6786	0	hor_grid='v', z_grid='1')
6787		call register_restart_pair(CS%ubt_IC, CS%vbt_IC, vd(2), vd(3), .false., restart_CS, &
6788	0	conversion=US%L_T_to_m_s)
6789		endif
6790
6791		call register_restart_field(CS%dtbt, "DTBT", .false., restart_CS, &
6792	1	longname="Barotropic timestep", units="seconds", conversion=US%T_to_s)
6793
6794		! Register streaming band-pass filters
6795		call get_param(param_file, mdl, "USE_FILTER", CS%use_filter, &
6796		"If true, use streaming band-pass filters to detect the "//&
6797	1	"instantaneous tidal signals in the simulation.", default=.false.)
6798		call get_param(param_file, mdl, "N_FILTERS", n_filters, &
6799		"Number of streaming band-pass filters to be used in the simulation.", &
6800	1	default=0, do_not_log=.not.CS%use_filter)
6801	1	if (n_filters<=0) CS%use_filter = .false.
6802	1	if (CS%use_filter) then
6803	0	call Filt_register(n_filters, 'ubt', 'u', HI, CS%Filt_CS_u, restart_CS)
6804	0	call Filt_register(n_filters, 'vbt', 'v', HI, CS%Filt_CS_v, restart_CS)
6805		endif
6806
6807	33	end subroutine register_barotropic_restarts
6808
6809
6810		!> \namespace mom_barotropic
6811		!!
6812		!! By Robert Hallberg, April 1994 - January 2007
6813		!!
6814		!! This program contains the subroutines that time steps the
6815		!! linearized barotropic equations. btstep is used to actually
6816		!! time step the barotropic equations, and contains most of the
6817		!! substance of this module.
6818		!!
6819		!! btstep uses a forwards-backwards based scheme to time step
6820		!! the barotropic equations, returning the layers' accelerations due
6821		!! to the barotropic changes in the ocean state, the final free
6822		!! surface height (or column mass), and the volume (or mass) fluxes
6823		!! summed through the layers and averaged over the baroclinic time
6824		!! step. As input, btstep takes the initial 3-D velocities, the
6825		!! initial free surface height, the 3-D accelerations of the layers,
6826		!! and the external forcing. Everything in btstep is cast in terms
6827		!! of anomalies, so if everything is in balance, there is explicitly
6828		!! no acceleration due to btstep.
6829		!!
6830		!! The spatial discretization of the continuity equation is second
6831		!! order accurate. A flux conservative form is used to guarantee
6832		!! global conservation of volume. The spatial discretization of the
6833		!! momentum equation is second order accurate. The Coriolis force
6834		!! is written in a form which does not contribute to the energy
6835		!! tendency and which conserves linearized potential vorticity, f/D.
6836		!! These terms are exactly removed from the baroclinic momentum
6837		!! equations, so the linearization of vorticity advection will not
6838		!! degrade the overall solution.
6839		!!
6840		!! btcalc calculates the fractional thickness of each layer at the
6841		!! velocity points, for later use in calculating the barotropic
6842		!! velocities and the averaged accelerations. Harmonic mean
6843		!! thicknesses (i.e. 2h_Lh_R/(h_L + h_R)) are used to avoid overly
6844		!! strong weighting of overly thin layers. This may later be relaxed
6845		!! to use thicknesses determined from the continuity equations.
6846		!!
6847		!! bt_mass_source determines the real mass sources for the
6848		!! barotropic solver, along with the corrective pseudo-fluxes that
6849		!! keep the barotropic and baroclinic estimates of the free surface
6850		!! height close to each other. Given the layer thicknesses and the
6851		!! free surface height that correspond to each other, it calculates
6852		!! a corrective mass source that is added to the barotropic continuity*
6853		!! equation, and optionally adjusts a slowly varying correction rate.
6854		!! Newer algorithmic changes have deemphasized the need for this, but
6855		!! it is still here to add net water sources to the barotropic solver.*
6856		!!
6857		!! barotropic_init allocates and initializes any barotropic arrays
6858		!! that have not been read from a restart file, reads parameters from
6859		!! the inputfile, and sets up diagnostic fields.
6860		!!
6861		!! barotropic_end deallocates anything allocated in barotropic_init
6862		!! or register_barotropic_restarts.
6863		!!
6864		!! register_barotropic_restarts is used to indicate any fields that
6865		!! are private to the barotropic solver that need to be included in
6866		!! the restart files, and to ensure that they are read.
6867
6868	0	end module MOM_barotropic