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	2880	subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, &
481	1440	eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, &
482	1440	eta_out, uhbtav, vhbtav, G, GV, US, CS, &
483	1440	visc_rem_u, visc_rem_v, SpV_avg, ADp, OBC, BT_cont, eta_PF_start, &
484	720	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	2880	real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been
560	2880	real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis
561		! terms [L T-1 ~> m s-1].
562	2880	real :: wt_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! wt_u and wt_v are the
563	2880	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	2880	real :: Iwt_u_tot(SZIB_(G),SZJ_(G)) ! Iwt_u_tot and Iwt_v_tot are the
567	2880	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	4320	av_rem_u, & ! The weighted average of visc_rem_u [nondim]
571	2880	tmp_u, & ! A temporary array at u points [L T-2 ~> m s-2] or [nondim]
572	2880	ubt_st, & ! The zonal barotropic velocity at the start of timestep [L T-1 ~> m s-1].
573	2880	ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].
574	2880	PFu_avg, & ! The average zonal barotropic pressure gradient force [L T-2 ~> m s-2].
575	2880	Coru_avg, & ! The average zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
576	2880	LDu_avg, & ! The average zonal barotropic linear wave drag acceleration [L T-2 ~> m s-2].
577	2880	ubt_dt ! The zonal barotropic velocity tendency [L T-2 ~> m s-2].
578		real, dimension(SZI_(G),SZJB_(G)) :: &
579	2880	av_rem_v, & ! The weighted average of visc_rem_v [nondim]
580	2880	tmp_v, & ! A temporary array at v points [L T-2 ~> m s-2] or [nondim]
581	2880	vbt_st, & ! The meridional barotropic velocity at the start of timestep [L T-1 ~> m s-1].
582	2880	vbt_wtd, & ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].
583	2880	PFv_avg, & ! The average meridional barotropic pressure gradient force [L T-2 ~> m s-2].
584	2880	Corv_avg, & ! The average meridional barotropic Coriolis acceleration [L T-2 ~> m s-2].
585	2880	LDv_avg, & ! The average meridional barotropic linear wave drag acceleration [L T-2 ~> m s-2].
586	2880	vbt_dt ! The meridional barotropic velocity tendency [L T-2 ~> m s-2].
587		real, dimension(SZI_(G),SZJ_(G)) :: &
588	2880	tmp_h, & ! A temporary array at h points [nondim]
589	2880	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	2880	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	2880	ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1].
597	2880	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	2880	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	2880	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	2880	uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
605	2880	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	2880	Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due
609		! to the reference velocities [L T-2 ~> m s-2].
610	2880	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	2880	DCor_u, & ! An averaged total thickness at u points [H ~> m or kg m-2].
615	2880	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	2880	vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1].
619	2880	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	2880	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	2880	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	2880	vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
627	2880	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	2880	Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due
631		! to the reference velocities [L T-2 ~> m s-2].
632	2880	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	2880	DCor_v, & ! An averaged total thickness at v points [H ~> m or kg m-2].
637	2880	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	2880	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	2880	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	1440	real, dimension(:,:,:), pointer :: ufilt, vfilt
654		! Filtered velocities from the output of streaming filters [L T-1 ~> m s-1]
655	2880	real, dimension(SZIB_(G),SZJ_(G)) :: Drag_u
656		! The zonal acceleration due to frequency-dependent drag [L T-2 ~> m s-2]
657	2880	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	2880	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	2880	eta_sum, & ! eta summed across the timesteps [H ~> m or kg m-2].
664	2880	eta_wtd, & ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2].
665	2880	eta_IC, & ! A local copy of the initial 2-D eta field (eta_in) [H ~> m or kg m-2]
666	2880	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	2880	eta_PF_1, & ! The initial value of eta_PF, when interp_eta_PF is
670		! true [H ~> m or kg m-2].
671	2880	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	2880	gtot_E, & ! gtot_X is the effective total reduced gravity used to relate
674	2880	gtot_W, & ! free surface height deviations to pressure forces (including
675	2880	gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
676	2880	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	2880	eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2].
680	2880	SpV_col_avg, & ! The column average specific volume [R-1 ~> m3 kg-1]
681	2880	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	2880	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	1440	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	1440	real, allocatable :: wt_vel(:) ! The raw or relative weights of each of the barotropic timesteps
729		! in determining the average velocities [nondim]
730	1440	real, allocatable :: wt_eta(:) ! The raw or relative weights of each of the barotropic timesteps
731		! in determining the average eta [nondim]
732	1440	real, allocatable :: wt_accel(:) ! The raw or relative weights of each of the barotropic timesteps
733		! in determining the average accelerations [nondim]
734	1440	real, allocatable :: wt_trans(:) ! The raw or relative weights of each of the barotropic timesteps
735		! in determining the average transports [nondim]
736	1440	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	1440	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	1440	if (.not.CS%split) return
761	1440	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
762	1440	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
763	1440	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
764	1440	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
765	1440	MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw
766	1440	h_a_neglect = GV%H_subroundoff * (1.0 * US%m_to_L**2)
767
768	1440	Idt = 1.0 / dt
769	1440	accel_underflow = CS%vel_underflow * Idt
770
771	1440	use_BT_cont = associated(BT_cont)
772	1440	integral_BT_cont = use_BT_cont .and. CS%integral_BT_cont
773
774	1440	interp_eta_PF = associated(eta_PF_start)
775
776		! Figure out the fullest arrays that could be updated.
777	1440	stencil = max(1, CS%min_stencil)
778	1440	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	1440	find_etaav = present(etaav)
782
783	1440	add_uh0 = associated(uh0)
784	1440	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	1440	nonblock_setup = G%nonblocking_updates
790
791	1440	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
792
793	1440	apply_OBC_flather = .false.
794	1440	apply_OBCs = .false.
795	1440	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	1440	num_cycles = 1
802	1440	if (CS%use_wide_halos) &
803	1440	num_cycles = min((is-CS%isdw) / stencil, (js-CS%jsdw) / stencil)
804	1440	isvf = is - (num_cycles-1)stencil ; ievf = ie + (num_cycles-1)stencil
805	1440	jsvf = js - (num_cycles-1)stencil ; jevf = je + (num_cycles-1)stencil
806
807	1440	nstep = CEILING(dt/CS%dtbt - 0.0001)
808	1440	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	1440	CS%nstep_last = nstep
814
815		! Set the actual barotropic time step.
816	1440	Instep = 1.0 / real(nstep)
817	1440	dtbt = dt * Instep
818
819		!--- begin setup for group halo update
820	1440	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
821	1440	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	1440	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	1440	To_All+Scalar_Pair, AGRID)
830		call create_group_pass(CS%pass_gtot, gtot_W, gtot_S, CS%BT_Domain, &
831	1440	To_All+Scalar_Pair, AGRID)
832
833	1440	if (CS%dynamic_psurf) &
834	0	call create_group_pass(CS%pass_eta_bt_rem, dyn_coef_eta, CS%BT_Domain)
835	1440	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	1440	call create_group_pass(CS%pass_eta_bt_rem, eta_PF, CS%BT_Domain)
840		endif
841	1440	if (integral_BT_cont) &
842	0	call create_group_pass(CS%pass_eta_bt_rem, eta_IC, CS%BT_Domain)
843	1440	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	1440	CS%BT_Domain, To_All+Scalar_Pair)
847	1440	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	1440	if (((G%isd > CS%isdw) .or. (G%jsd > CS%jsdw)) .or. (Isq <= is-1) .or. (Jsq <= js-1)) &
853	1440	call create_group_pass(CS%pass_force_hbt0_Cor_ref, BT_force_u, BT_force_v, CS%BT_Domain)
854	1440	if (add_uh0) call create_group_pass(CS%pass_force_hbt0_Cor_ref, uhbt0, vhbt0, CS%BT_Domain)
855	1440	call create_group_pass(CS%pass_force_hbt0_Cor_ref, Cor_ref_u, Cor_ref_v, CS%BT_Domain)
856	1440	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	1440	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	1440	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	1440	if (find_etaav) then
866	720	call create_group_pass(CS%pass_etaav, etaav, G%Domain)
867		endif
868	1440	call create_group_pass(CS%pass_e_anom, e_anom, G%Domain)
869	1440	call create_group_pass(CS%pass_ubta_uhbta, CS%ubtav, CS%vbtav, G%Domain)
870	1440	call create_group_pass(CS%pass_ubta_uhbta, uhbtav, vhbtav, G%Domain)
871
872	1440	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	1440	if (CS%linearized_BT_PV) then
887	77760	do concurrent (J=jsvf-2:jevf+1, I=isvf-2:ievf+1)
888	3817440	q(I,J) = CS%q_D(I,j)
889		enddo
890	77760	do concurrent (j=jsvf-1:jevf+1, I=isvf-2:ievf+1)
891	3741120	DCor_u(I,j) = CS%D_u_Cor(I,j)
892		enddo
893	76320	do concurrent (J=jsvf-2:jevf+1, i=isvf-1:ievf+1)
894	3745440	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	76320	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw:CS%iedw)
1015	3594240	gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0
1016	3594240	gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0
1017	3594240	eta(i,j) = 0.0
1018	3594240	eta_PF(i,j) = 0.0
1019	3594240	if (interp_eta_PF) then
1020	0	eta_PF_1(i,j) = 0.0 ; d_eta_PF(i,j) = 0.0
1021		endif
1022	3594240	if (integral_BT_cont) then
1023	0	eta_IC(i,j) = 0.0
1024		endif
1025	3670560	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	77760	do concurrent (j=CS%jsdw:CS%jedw, I=CS%isdw-1:CS%iedw)
1031	3663360	Cor_ref_u(I,j) = 0.0 ; BT_force_u(I,j) = 0.0 ; ubt(I,j) = 0.0
1032	3741120	Datu(I,j) = 0.0 ; bt_rem_u(I,j) = 0.0 ; uhbt0(I,j) = 0.0
1033		enddo
1034	76320	do concurrent (J=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
1035	3669120	Cor_ref_v(i,J) = 0.0 ; BT_force_v(i,J) = 0.0 ; vbt(i,J) = 0.0
1036	3745440	Datv(i,J) = 0.0 ; bt_rem_v(i,J) = 0.0 ; vhbt0(i,J) = 0.0
1037		enddo
1038
1039	1440	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	1440	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	1440	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	76320	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	3594240	eta(i,j) = eta_in(i,j)
1078	3670560	eta_PF(i,j) = eta_PF_in(i,j)
1079		enddo
1080		endif
1081	1440	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	1440	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	1440	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	1440	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	66240	do concurrent (j=js-1:je+1, I=is-1:ie)
1138	2787840	ubt_Cor(I,j) = 0.0
1139		enddo
1140	1440	do concurrent (J=js-1:je, i=is-1:ie+1)
1141	2783520	vbt_Cor(i,J) = 0.0
1142		enddo
1143	1440	do concurrent (j=js:je)
1144	218928	do k=1,nz
1145	57600	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	1440	do concurrent (J=js-1:je)
1151	222576	do k=1,nz
1152	59040	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	1440	do concurrent (j=js:je)
1163	218928	do k=1,nz
1164	57600	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	1440	do concurrent (J=js-1:je)
1171	222576	do k=1,nz
1172	59040	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	1440	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	1440	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	1440	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	1440	dgeo_de = 1.0 + CS%G_extra
1205		endif
1206
1207	1440	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	1440	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	1440	elseif (use_BT_cont) then
1219	1440	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	1440	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	1440	if (add_uh0) then
1243	1440	do concurrent (j=js:je, I=is-1:ie)
1244	2658240	uhbt(I,j) = 0.0 ; ubt(I,j) = 0.0
1245		enddo
1246	1440	do concurrent (J=js-1:je, i=is:ie)
1247	2662560	vhbt(i,J) = 0.0 ; vbt(i,J) = 0.0
1248		enddo
1249	1440	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	1440	do concurrent (j=js:je)
1260	218928	do k=1,nz
1261	57600	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	1440	do concurrent (J=js-1:je)
1268	222576	do k=1,nz
1269	59040	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	1440	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	1440	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	1440	elseif (use_BT_cont) then
1307	1440	do concurrent (j=js:je, I=is-1:ie)
1308	2658240	uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j), BTCL_u(I,j))
1309		enddo
1310	1440	do concurrent (J=js-1:je, i=is:ie)
1311	2662560	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	1440	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	1440	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	1440	call btstep_ubt_from_layer(U_in, V_in, wt_u, wt_v, ubt, vbt, G, GV, CS)
1335
1336	77760	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw-1:CS%iedw)
1337	3741120	uhbt(i,j) = 0.0 ; u_accel_bt(i,j) = 0.0
1338		enddo
1339	76320	do concurrent (j=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
1340	3745440	vhbt(i,j) = 0.0 ; v_accel_bt(i,j) = 0.0
1341		enddo
1342
1343	1440	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	1440	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	2658240	do concurrent (j=js:je, I=is-1:ie) ; if (G%OBCmaskCu(I,j) > 0.0) then
1364	2476800	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	2476800	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	151304	BT_force_u(I,j) = 0.0
1387		endif ; enddo
1388
1389	2662560	do concurrent (J=js-1:je, i=is:ie) ; if (G%OBCmaskCv(i,J) > 0.0) then
1390	2471040	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	2471040	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	154160	BT_force_v(i,J) = 0.0
1413		endif ; enddo
1414
1415	1440	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	1440	do concurrent (j=js:je)
1427	218928	do k=1,nz
1428	57600	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	1440	do concurrent (J=Jsq:Jeq)
1434	222576	do k=1,nz
1435	59040	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1538	1440	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1539	1440	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	1440	call do_group_pass(CS%pass_gtot, CS%BT_Domain, omp_offload=.true.)
1551	1440	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	76320	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
1557	3594240	if (CS%ua_polarity(i,j) < 0.0) call swap(gtot_E(i,j), gtot_W(i,j))
1558	3670560	if (CS%va_polarity(i,j) < 0.0) call swap(gtot_N(i,j), gtot_S(i,j))
1559		enddo
1560
1561	1440	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	2658240	((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	1440	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	2662560	((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	1440	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	1440	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1585	1440	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1586	66240	do concurrent (j=js-1:je+1, I=is-1:ie)
1587	2787840	av_rem_u(I,j) = 0.0
1588		enddo
1589	1440	do concurrent (j=js:je)
1590	218928	do k=1,nz
1591	57600	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	1440	do concurrent (J=js-1:je)
1597	59040	do concurrent(i=is-1:ie+1)
1598	2774880	av_rem_v(i,J) = 0.0
1599		enddo
1600	237600	do k=1,nz
1601	59040	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	1440	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	1440	do concurrent (j=js:je, I=is-1:ie)
1619	2592000	bt_rem_u(I,j) = 0.0
1620	2592000	if (G%mask2dCu(I,j) * av_rem_u(I,j) > 0.0) &
1621	2658240	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	1440	do concurrent (J=js-1:je, i=is:ie)
1624	2597760	bt_rem_v(i,J) = 0.0
1625	2597760	if (G%mask2dCv(i,J) * av_rem_v(i,J) > 0.0) &
1626	2662560	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	1440	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	1440	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	1440	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	76320	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
1674	3670560	eta_src(i,j) = 0.0
1675		enddo
1676	1440	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	2599200	DO_LOCALITY(local(uint_cor, vint_cor, u_max_cor, v_max_cor))
1679	2599200	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	1265472	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	1265472	u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
1692	1265472	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	1265472	(find_vhbt(-v_max_cor, BTCL_v(i,J-1)) + vhbt0(i,J-1))) ))
1698		endif
1699	1265472	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	1268928	Htot = eta(i,j)
1703	1268928	if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j)
1704
1705	1268928	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	1440	do concurrent (j=js:je, i=is:ie)
1715	2599200	eta_src(i,j) = G%mask2dT(i,j) * (Instep * CS%eta_cor(i,j))
1716		enddo
1717
1718	1440	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	1440	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1762	1440	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1763	1440	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	1440	call do_group_pass(CS%pass_eta_bt_rem, CS%BT_Domain, omp_offload=.true.)
1773	1440	if (.not.use_BT_cont) call do_group_pass(CS%pass_Dat_uv, CS%BT_Domain, omp_offload=.true.)
1774	1440	call do_group_pass(CS%pass_force_hbt0_Cor_ref, CS%BT_Domain, omp_offload=.true.)
1775		endif
1776	1440	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1777	1440	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1778
1779		! Complete all of the outstanding halo updates.
1780	1440	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	1440	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	1440	if (query_averaging_enabled(CS%diag)) then
1871	720	if (CS%id_eta_st > 0) call post_data(CS%id_eta_st, eta(isd:ied,jsd:jed), CS%diag)
1872	720	if (CS%id_ubt_st > 0) call post_data(CS%id_ubt_st, ubt(IsdB:IedB,jsd:jed), CS%diag)
1873	720	if (CS%id_vbt_st > 0) call post_data(CS%id_vbt_st, vbt(isd:ied,JsdB:JedB), CS%diag)
1874		endif
1875
1876	1440	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1877	1440	if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
1878
1879	1440	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	1440	dt_filt = 0.5 * max(0.0, dt * min(-CS%dt_bt_filter, 2.0))
1883		endif
1884	1440	nfilter = ceiling(dt_filt / dtbt)
1885
1886	1440	if ( nstep+nfilter<=0 ) call MOM_error(FATAL, &
1887	0	"btstep: number of barotropic step (nstep+nfilter) is 0")
1888	1440	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		!@start noport
1891		! Set up the normalized weights for the filtered velocity.
1892	1440	sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
1893	1440	allocate(wt_vel(nstep+nfilter)) ; allocate(wt_eta(nstep+nfilter))
1894	1440	allocate(wt_trans(nstep+nfilter+1)) ; allocate(wt_accel(nstep+nfilter+1))
1895	1440	allocate(wt_accel2(nstep+nfilter+1))
1896	7200	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	7200	if ( (n==nstep) .or. (dt_filt - abs(n-nstep)*dtbt >= 0.0)) then
1901	1440	wt_vel(n) = 1.0 ; wt_eta(n) = 1.0
1902	4320	elseif (dtbt + dt_filt - abs(n-nstep)*dtbt > 0.0) then
1903	2880	wt_vel(n) = 1.0 + (dt_filt / dtbt) - abs(n-nstep) ; wt_eta(n) = wt_vel(n)
1904		else
1905	1440	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	7200	do n=1,nstep+nfilter
1915	7200	sum_wt_vel = sum_wt_vel + wt_vel(n) ; sum_wt_eta = sum_wt_eta + wt_eta(n)
1916		enddo
1917	1440	wt_trans(nstep+nfilter+1) = 0.0 ; wt_accel(nstep+nfilter+1) = 0.0
1918	7200	do n=nstep+nfilter,1,-1
1919	5760	wt_trans(n) = wt_trans(n+1) + wt_eta(n)
1920	5760	wt_accel(n) = wt_accel(n+1) + wt_vel(n)
1921	7200	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	1440	I_sum_wt_vel = 1.0 / sum_wt_vel ; I_sum_wt_accel = 1.0 / sum_wt_accel
1925	1440	I_sum_wt_eta = 1.0 / sum_wt_eta ; I_sum_wt_trans = 1.0 / sum_wt_trans
1926	7200	do n=1,nstep+nfilter
1927	5760	wt_vel(n) = wt_vel(n) * I_sum_wt_vel
1928	5760	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	5760	wt_accel2(n) = wt_accel(n) * I_sum_wt_accel
1933	5760	wt_trans(n) = wt_trans(n) * I_sum_wt_trans
1934		endif
1935	5760	wt_accel(n) = wt_accel(n) * I_sum_wt_accel
1936	7200	wt_eta(n) = wt_eta(n) * I_sum_wt_eta
1937		enddo
1938	1440	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	1440	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		!@end noport
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	1440	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	1440	if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
1967	1440	if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
1968
1969	1440	if (find_etaav) then ; do concurrent (j=js:je, i=is:ie)
1970	1299600	etaav(i,j) = eta_sum(i,j) * I_sum_wt_accel
1971		enddo ; endif
1972	67680	do concurrent (j=js-1:je+1, i=is-1:ie+1)
1973	2849760	e_anom(i,j) = 0.0
1974		enddo
1975	1440	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	1440	do concurrent (j=js:je, i=is:ie)
1982	2599200	e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - eta_PF(i,j))
1983		enddo
1984		endif
1985	1440	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	1440	do concurrent (j=js:je, i=is:ie)
2005	2599200	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	1440	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	1440	if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2016	1440	if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
2017	1440	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	1440	if (find_etaav) call do_group_pass(CS%pass_etaav, G%Domain)
2022	1440	call do_group_pass(CS%pass_e_anom, G%Domain, omp_offload=.true.)
2023		endif
2024	1440	if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
2025	1440	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	1440	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	1440	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	1440	if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2063	1440	if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
2064	1440	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	1440	call do_group_pass(CS%pass_ubta_uhbta, G%Domain, omp_offload=.true.)
2071		endif
2072	1440	if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
2073	1440	if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
2074
2075	1440	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	1440	e_anom, G, GV, CS, accel_layer_u, accel_layer_v)
2089
2090	1440	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	1440	if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2108
2109		! Calculate diagnostic quantities.
2110	1440	if (query_averaging_enabled(CS%diag)) then
2111
2112	720	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	720	if (CS%answer_date >= 20190101) then
2123	720	if (CS%id_PFu_bt > 0) call post_data(CS%id_PFu_bt, PFu_avg, CS%diag)
2124	720	if (CS%id_PFv_bt > 0) call post_data(CS%id_PFv_bt, PFv_avg, CS%diag)
2125	720	if (CS%id_Coru_bt > 0) call post_data(CS%id_Coru_bt, Coru_avg, CS%diag)
2126	720	if (CS%id_Corv_bt > 0) call post_data(CS%id_Corv_bt, Corv_avg, CS%diag)
2127	720	if (CS%id_LDu_bt > 0) call post_data(CS%id_LDu_bt, LDu_avg, CS%diag)
2128	720	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	720	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	720	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	720	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	720	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	720	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	720	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	720	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	720	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	720	if (CS%id_ubtforce > 0) call post_data(CS%id_ubtforce, BT_force_u(IsdB:IedB,jsd:jed), CS%diag)
2207	720	if (CS%id_vbtforce > 0) call post_data(CS%id_vbtforce, BT_force_v(isd:ied,JsdB:JedB), CS%diag)
2208	720	if (CS%id_uaccel > 0) call post_data(CS%id_uaccel, u_accel_bt(IsdB:IedB,jsd:jed), CS%diag)
2209	720	if (CS%id_vaccel > 0) call post_data(CS%id_vaccel, v_accel_bt(isd:ied,JsdB:JedB), CS%diag)
2210
2211	720	if (CS%id_eta_cor > 0) call post_data(CS%id_eta_cor, CS%eta_cor, CS%diag)
2212	720	if (CS%id_eta_bt > 0) call post_data(CS%id_eta_bt, eta_out, CS%diag) ! - G%Z_ref?
2213	720	if (CS%id_gtotn > 0) call post_data(CS%id_gtotn, gtot_N(isd:ied,jsd:jed), CS%diag)
2214	720	if (CS%id_gtots > 0) call post_data(CS%id_gtots, gtot_S(isd:ied,jsd:jed), CS%diag)
2215	720	if (CS%id_gtote > 0) call post_data(CS%id_gtote, gtot_E(isd:ied,jsd:jed), CS%diag)
2216	720	if (CS%id_gtotw > 0) call post_data(CS%id_gtotw, gtot_W(isd:ied,jsd:jed), CS%diag)
2217	720	if (CS%id_ubt > 0) call post_data(CS%id_ubt, ubt_wtd(IsdB:IedB,jsd:jed), CS%diag)
2218	720	if (CS%id_vbt > 0) call post_data(CS%id_vbt, vbt_wtd(isd:ied,JsdB:JedB), CS%diag)
2219	720	if (CS%id_ubtav > 0) call post_data(CS%id_ubtav, CS%ubtav, CS%diag)
2220	720	if (CS%id_vbtav > 0) call post_data(CS%id_vbtav, CS%vbtav, CS%diag)
2221	720	if (CS%id_visc_rem_u > 0) call post_data(CS%id_visc_rem_u, visc_rem_u, CS%diag)
2222	720	if (CS%id_visc_rem_v > 0) call post_data(CS%id_visc_rem_v, visc_rem_v, CS%diag)
2223
2224	720	if (CS%id_frhatu > 0) call post_data(CS%id_frhatu, CS%frhatu, CS%diag)
2225	720	if (CS%id_uhbt > 0) call post_data(CS%id_uhbt, uhbtav, CS%diag)
2226	720	if (CS%id_frhatv > 0) call post_data(CS%id_frhatv, CS%frhatv, CS%diag)
2227	720	if (CS%id_vhbt > 0) call post_data(CS%id_vhbt, vhbtav, CS%diag)
2228	720	if (CS%id_uhbt0 > 0) call post_data(CS%id_uhbt0, uhbt0(IsdB:IedB,jsd:jed), CS%diag)
2229	720	if (CS%id_vhbt0 > 0) call post_data(CS%id_vhbt0, vhbt0(isd:ied,JsdB:JedB), CS%diag)
2230
2231	720	if (CS%id_frhatu1 > 0) call post_data(CS%id_frhatu1, CS%frhatu1, CS%diag)
2232	720	if (CS%id_frhatv1 > 0) call post_data(CS%id_frhatv1, CS%frhatv1, CS%diag)
2233
2234	720	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	720	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	720	if (CS%id_etaPF_anom > 0) call post_data(CS%id_etaPF_anom, e_anom(isd:ied,jsd:jed), CS%diag)
2237
2238	720	if (use_BT_cont) then
2239	720	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	720	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	720	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	720	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	720	if (CS%id_BTC_uBT_EE > 0) call post_data(CS%id_BTC_uBT_EE, BT_cont%uBT_EE, CS%diag)
2244	720	if (CS%id_BTC_uBT_WW > 0) call post_data(CS%id_BTC_uBT_WW, BT_cont%uBT_WW, CS%diag)
2245	720	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	720	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	720	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	720	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	720	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	720	if (CS%id_BTC_vBT_NN > 0) call post_data(CS%id_BTC_vBT_NN, BT_cont%vBT_NN, CS%diag)
2261	720	if (CS%id_BTC_vBT_SS > 0) call post_data(CS%id_BTC_vBT_SS, BT_cont%vBT_SS, CS%diag)
2262	720	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	720	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	720	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	720	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	720	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	720	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	720	if (CS%id_frhatu1 > 0) then
2316		!$omp target update from(CS%frhatu)
2317	0	CS%frhatu1(:,:,:) = CS%frhatu(:,:,:)
2318		endif
2319	720	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	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	1440	deallocate(wt_vel, wt_eta, wt_trans, wt_accel, wt_accel2)
2372
2373	3600	end subroutine btstep
2374
2375		!> Update the barotropic solver through multiple time steps.
2376	1440	subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL_v, eta_IC, &
2377	1440	eta_PF_1, d_eta_PF, eta_src, dyn_coef_eta, uhbtav, vhbtav, u_accel_bt, v_accel_bt, &
2378	1440	f_4_u, f_4_v, bt_rem_u, bt_rem_v, &
2379	1440	BT_force_u, BT_force_v, Cor_ref_u, Cor_ref_v, Rayleigh_u, Rayleigh_v, &
2380	1440	eta_PF, gtot_E, gtot_W, gtot_N, gtot_S, SpV_col_avg, dgeo_de, &
2381	1440	eta_sum, eta_wtd, ubt_wtd, vbt_wtd, Coru_avg, PFu_avg, LDu_avg, Corv_avg, PFv_avg, &
2382	1440	LDv_avg, use_BT_cont, interp_eta_PF, find_etaav, dt, dtbt, nstep, nfilter, &
2383	1440	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	2880	uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]
2557	2880	ubt_prev, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1]
2558	2880	ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]
2559	2880	PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2]
2560	2880	Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]
2561	2880	ubt_int, & ! The running time integral of ubt over the time steps [L ~> m]
2562	2880	uhbt_int, & ! The running time integral of uhbt over the time steps [H L2 ~> m3 or kg]
2563	2880	ubt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m]
2564	2880	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	2880	vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]
2567	2880	vbt_prev, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1]
2568	2880	vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1]
2569	2880	PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2]
2570	2880	Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2]
2571	2880	vbt_int, & ! The running time integral of vbt over the time steps [L ~> m]
2572	2880	vhbt_int, & ! The running time integral of vhbt over the time steps [H L2 ~> m3 or kg]
2573	2880	vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m]
2574	2880	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	2880	eta_pred ! A predictor value of eta [H ~> m or kg m-2] like eta
2577		real, dimension(SZIW_(CS),SZJW_(CS)) :: &
2578	2880	p_surf_dyn, & !< A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2]
2579	2880	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	2880	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	2880	logical :: submerged(SZIW_(CS),SZJW_(CS)), eta_is_submerged
2615
2616	1440	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
2617	1440	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
2618	1440	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
2619	1440	err_count = 0
2620
2621		! Figure out the fullest arrays that could be updated.
2622	1440	stencil = max(1, CS%min_stencil)
2623	1440	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	1440	num_cycles = 1
2627	1440	if (CS%use_wide_halos) &
2628	1440	num_cycles = min((is-CS%isdw) / stencil, (js-CS%jsdw) / stencil)
2629	1440	isvf = is - (num_cycles-1)stencil ; ievf = ie + (num_cycles-1)stencil
2630	1440	jsvf = js - (num_cycles-1)stencil ; jevf = je + (num_cycles-1)stencil
2631
2632	1440	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	1440	(CS%Nonlin_cont_update_period > 0)
2635	1440	Instep = 1.0 / real(nstep)
2636	1440	Idtbt = 1.0 / dtbt
2637
2638		!--- setup the weight when computing vbt_trans and ubt_trans
2639	1440	if (CS%BT_project_velocity) then
2640	1440	be_proj = CS%bebt
2641	1440	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	1440	associated(ADp%bt_pgf_v) .or. associated(ADp%bt_cor_v) .or. associated(ADp%bt_lwd_v))
2652
2653	1440	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	1440	(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	1440	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	1440	if (find_etaav) then
2669	38160	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
2670	1835280	eta_sum(i,j) = 0.0 ; eta_wtd(i,j) = 0.0
2671		enddo
2672		else
2673	38160	do concurrent (j=jsvf-1:jevf+1, i=isvf-1:ievf+1)
2674	1835280	eta_wtd(i,j) = 0.0
2675		enddo
2676		endif
2677	1440	do concurrent (j=js:je, I=is-1:ie)
2678	2592000	CS%ubtav(I,j) = 0.0 ; uhbtav(I,j) = 0.0
2679	2592000	PFu_avg(I,j) = 0.0 ; Coru_avg(I,j) = 0.0
2680	2658240	LDu_avg(I,j) = 0.0 ; ubt_wtd(I,j) = 0.0
2681		enddo
2682	74880	do concurrent (j=jsvf-1:jevf+1, I=isvf-1:ievf)
2683	3600000	ubt_trans(I,j) = 0.0
2684		enddo
2685	1440	do concurrent (J=js-1:je, i=is:ie)
2686	2597760	CS%vbtav(i,J) = 0.0 ; vhbtav(i,J) = 0.0
2687	2597760	PFv_avg(i,J) = 0.0 ; Corv_avg(i,J) = 0.0
2688	2662560	LDv_avg(i,J) = 0.0 ; vbt_wtd(i,J) = 0.0
2689		enddo
2690	1440	do concurrent (J=jsvf-1:jevf, i=isvf-1:ievf+1)
2691	3595680	vbt_trans(i,J) = 0.0
2692		enddo
2693
2694	1440	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	76320	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw:CS%iedw)
2713	3670560	p_surf_dyn(i,j) = 0.0
2714		enddo
2715
2716	1440	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	1440	call create_group_pass(CS%pass_eta_ubt, eta, CS%BT_Domain)
2741	1440	call create_group_pass(CS%pass_eta_ubt, ubt, vbt, CS%BT_Domain)
2742	1440	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		!@start noport
2749		! The following loop contains all of the time steps.
2750	1440	isv = is ; iev = ie ; jsv = js ; jev = je
2751	7200	do n=1,nstep+nfilter
2752	5760	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	5760	if ((iev - stencil < ie) .or. (jev - stencil < je)) then
2756	1440	if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
2757	1440	call do_group_pass(CS%pass_eta_ubt, CS%BT_Domain, clock=id_clock_pass_step, omp_offload=.true.)
2758	1440	isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf
2759	1440	if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
2760		else
2761	4320	isv = isv+stencil ; iev = iev-stencil
2762	4320	jsv = jsv+stencil ; jev = jev-stencil
2763		endif
2764		!@end noport
2765		! Store the previous velocities for time-filtered transports and OBCs.
2766	5760	do concurrent (j=jsv:jev, I=isv-2:iev+1)
2767	12706560	ubt_prev(I,j) = ubt(I,j)
2768		enddo
2769
2770	276480	do concurrent (J=jsv-2:jev+1, i=isv:iev)
2771	12758400	vbt_prev(i,J) = vbt(i,J)
2772		enddo
2773
2774	5760	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	5760	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	5760	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	5760	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		!@start noport
2804	5760	v_first = (MOD(n+G%first_direction,2)==1)
2805		!@end noport
2806		! Determine the pressure force accelerations due to the updated eta anomalies.
2807	5760	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	5760	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	5760	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	5760	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	2880	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	2880	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	2880	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	2880	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	5760	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	5760	elseif (use_BT_cont) then
2884	5760	do concurrent (j=jsv:jev, I=isv-1:iev)
2885	11917440	ubt_trans(I,j) = trans_wt1ubt(I,j) + trans_wt2ubt_prev(I,j)
2886	12199680	uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
2887		enddo
2888	276480	do concurrent (J=jsv-1:jev, i=isv:iev)
2889	11940480	vbt_trans(i,J) = trans_wt1vbt(i,J) + trans_wt2vbt_prev(i,J)
2890	12216960	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	5760	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	5760	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	5760	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	5760	do concurrent (j=js:je, I=is-1:ie)
2954	10368000	CS%ubtav(I,j) = CS%ubtav(I,j) + wt_trans(n) * ubt_trans(I,j)
2955	10368000	uhbtav(I,j) = uhbtav(I,j) + wt_trans(n) * uhbt(I,j)
2956	10632960	ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j)
2957		enddo
2958	5760	do concurrent (J=js-1:je, i=is:ie)
2959	10391040	CS%vbtav(i,J) = CS%vbtav(i,J) + wt_trans(n) * vbt_trans(i,J)
2960	10391040	vhbtav(i,J) = vhbtav(i,J) + wt_trans(n) * vhbt(i,J)
2961	10650240	vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J)
2962		enddo
2963
2964	5760	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	5760	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	5760	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	11669760	((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J)))
3015	11946240	eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n)
3016		enddo
3017		endif
3018
3019	5760	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		!@start noport
3031	5760	eta_is_submerged = .false.
3032		!@end noport
3033	5760	if (GV%Boussinesq) then
3034	5760	do concurrent (j=js:je, i=is:ie) DO_LOCALITY(reduce(.or.: eta_is_submerged))
3035	10137600	submerged(i,j) = eta(i,j) < -GV%Z_to_H*G%bathyT(i,j) .and. G%mask2dT(i,j) > 0.0
3036	10396800	eta_is_submerged = submerged(i,j)
3037		enddo
3038
3039	5760	if (eta_is_submerged) then
3040		!$omp target update from(submerged)
3041	0	do j=js,je ; do i=is,ie ; if (submerged(i,j)) then
3042		write(mesg,'(ES24.16, " vs. ", ES24.16, " at ", ES12.4, ES12.4, i7, i7)') &
3043	0	GV%H_to_meta(i,j), -US%Z_to_mG%bathyT(i,j), G%geoLonT(i,j), G%geoLatT(i,j), &
3044	0	i + G%HI%idg_offset, j + G%HI%jdg_offset
3045
3046	0	if (CS%bt_limit_integral_transport) &
3047	0	call MOM_error(FATAL, "btstep: eta has dropped below bathyT: "//trim(mesg))
3048
3049	0	if (err_count < 2) &
3050	0	call MOM_error(WARNING, "btstep: eta has dropped below bathyT: "//trim(mesg), all_print=.true.)
3051	0	err_count = err_count + 1
3052		endif ; enddo ; enddo
3053		endif
3054		else
3055	0	do concurrent (j=js:je, i=is:ie) DO_LOCALITY(reduce(.or.: eta_is_submerged))
3056	0	submerged(i,j) = eta(i,j) < 0.0 .and. G%mask2dT(i,j) > 0.0
3057	0	eta_is_submerged = submerged(i,j)
3058		enddo
3059
3060	0	if (eta_is_submerged) then
3061		!$omp target update from(submerged)
3062
3063	0	do j=js,je ; do i=is,ie ; if (submerged(i,j)) then
3064		write(mesg,'(" at ", ES12.4, ES12.4, i7, i7)') &
3065	0	G%geoLonT(i,j), G%geoLatT(i,j), i + G%HI%idg_offset, j + G%HI%jdg_offset
3066
3067	0	if (CS%bt_limit_integral_transport) &
3068	0	call MOM_error(FATAL, "btstep: negative eta in a non-Boussinesq barotropic solver "//trim(mesg))
3069
3070	0	if (err_count < 2) &
3071		call MOM_error(WARNING, "btstep: negative eta in a non-Boussinesq barotropic solver "//&
3072	0	trim(mesg), all_print=.true.)
3073
3074	0	err_count = err_count + 1
3075		endif ; enddo ; enddo
3076		endif
3077		endif
3078
3079		! Accumulate some diagnostics of time-averaged barotropic accelerations.
3080	5760	if (do_ave) then
3081	0	if ((CS%id_PFu_bt > 0) .or. associated(ADp%bt_pgf_u)) then
3082	0	do concurrent (j=js:je, I=is-1:ie)
3083	0	PFu_avg(I,j) = PFu_avg(I,j) + wt_accel2(n) * PFu(I,j)
3084		enddo
3085		endif
3086	0	if ((CS%id_PFv_bt > 0) .or. associated(ADp%bt_pgf_v)) then
3087	0	do concurrent (J=js-1:je, i=is:ie)
3088	0	PFv_avg(i,J) = PFv_avg(i,J) + wt_accel2(n) * PFv(i,J)
3089		enddo
3090		endif
3091	0	if ((CS%id_Coru_bt > 0) .or. associated(ADp%bt_cor_u)) then
3092	0	do concurrent (j=js:je, I=is-1:ie)
3093	0	Coru_avg(I,j) = Coru_avg(I,j) + wt_accel2(n) * Cor_u(I,j)
3094		enddo
3095		endif
3096	0	if ((CS%id_Corv_bt > 0) .or. associated(ADp%bt_cor_v)) then
3097	0	do concurrent (J=js-1:je, i=is:ie)
3098	0	Corv_avg(i,J) = Corv_avg(i,J) + wt_accel2(n) * Cor_v(i,J)
3099		enddo
3100		endif
3101
3102	0	if (CS%linear_wave_drag) then
3103	0	if ((CS%id_LDu_bt > 0) .or. (associated(ADp%bt_lwd_u))) then
3104	0	do concurrent (j=js:je, I=is-1:ie)
3105	0	LDu_avg(I,j) = LDu_avg(I,j) - wt_accel2(n) * (ubt(I,j) * Rayleigh_u(I,j))
3106		enddo
3107		endif
3108	0	if ((CS%id_LDv_bt > 0) .or. (associated(ADp%bt_lwd_v))) then
3109	0	do concurrent (J=js-1:je, i=is:ie)
3110	0	LDv_avg(i,J) = LDv_avg(i,J) - wt_accel2(n) * (vbt(i,J) * Rayleigh_v(i,J))
3111		enddo
3112		endif
3113		endif
3114		endif
3115
3116	7200	if (do_hifreq_output) then
3117		! Note that this compresses the time so that all of the timesteps, including those in the
3118		! extra timesteps for filtering, fit within dt.
3119	0	time_step_end = time_bt_start + real_to_time(n*dtbt_diag, unscale=US%T_to_s)
3120	0	call enable_averages(dtbt, time_step_end, CS%diag)
3121	0	if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag)
3122	0	if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag)
3123	0	if (CS%id_eta_hifreq > 0) call post_data(CS%id_eta_hifreq, eta(isd:ied,jsd:jed), CS%diag)
3124	0	if (CS%id_etaPF_hifreq > 0) then
3125	0	if (CS%BT_project_velocity) then
3126	0	do j=js,je ; do i=is,ie
3127	0	eta_anom_PF(i,j) = eta(i,j) - eta_PF(i,j)
3128		enddo ; enddo
3129		else
3130	0	do j=js,je ; do i=is,ie
3131	0	eta_anom_PF(i,j) = eta_pred(i,j) - eta_PF(i,j)
3132		enddo ; enddo
3133		endif
3134	0	call post_data(CS%id_etaPF_hifreq, eta_anom_PF(isd:ied,jsd:jed), CS%diag)
3135		endif
3136	0	if (CS%id_uhbt_hifreq > 0) call post_data(CS%id_uhbt_hifreq, uhbt(IsdB:IedB,jsd:jed), CS%diag)
3137	0	if (CS%id_vhbt_hifreq > 0) call post_data(CS%id_vhbt_hifreq, vhbt(isd:ied,JsdB:JedB), CS%diag)
3138	0	if (CS%BT_project_velocity) then
3139		! This diagnostic is redundant in this case and should probably be omitted.
3140	0	if (CS%id_eta_pred_hifreq > 0) call post_data(CS%id_eta_pred_hifreq, eta(isd:ied,jsd:jed), CS%diag)
3141		else
3142	0	if (CS%id_eta_pred_hifreq > 0) call post_data(CS%id_eta_pred_hifreq, eta_pred(isd:ied,jsd:jed), CS%diag)
3143		endif
3144		endif
3145		enddo ! end of do n=1,ntimestep
3146
3147		!$omp target exit data &
3148		!$omp map(release: uhbt, vhbt, ubt_prev, vbt_prev, ubt_trans, vbt_trans, PFu, PFv, Cor_u, Cor_v, &
3149		!$omp p_surf_dyn, submerged)
3150
3151		!$omp target exit data map(delete: ubt_int, uhbt_int, vbt_int, vhbt_int, cfl_ltd_vol) &
3152		!$omp if (integral_BT_cont)
3153
3154		! Reset the time information in the diag type.
3155	1440	if (do_hifreq_output) call enable_averaging(time_int_in, time_end_in, CS%diag)
3156
3157	1440	end subroutine btstep_timeloop
3158
3159
3160		!> Find the Coriolis force terms _zon and _mer.
3161	1440	subroutine btstep_find_Cor(q, DCor_u, DCor_v, f_4_u, f_4_v, isvf, ievf, jsvf, jevf, CS)
3162		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3163		real, intent(in) :: q(SZIBW_(CS),SZJBW_(CS)) !< A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1]
3164		!! or [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1]
3165		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3166		DCor_u !< An averaged depth or total thickness at u points [Z ~> m] or [H ~> m or kg m-2].
3167		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3168		DCor_v !< An averaged depth or total thickness at v points [Z ~> m] or [H ~> m or kg m-2].
3169		real, dimension(4,SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3170		f_4_u !< The terms giving the contribution to the Coriolis acceleration at a zonal
3171		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3172		!! These are the products of thicknesses at v points and appropriately staggered
3173		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3174		!! they are approximately f / 4. The 4 values on the innermost loop are for
3175		!! v-velocities to the southwest, southeast, northwest and northeast.
3176		real, dimension(4,SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3177		f_4_v !< The terms giving the contribution to the Coriolis acceleration at a meridional
3178		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3179		!! These are the products of thicknesses at u points and appropriately staggered
3180		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3181		!! they are approximately f / 4. The 4 values on the innermost loop are for
3182		!! u-velocities to the southwest, southeast, northwest and northeast.
3183		integer, intent(in) :: isvf !< The starting i-index of the largest valid range for tracer points
3184		integer, intent(in) :: ievf !< The ending i-index of the largest valid range for tracer points
3185		integer, intent(in) :: jsvf !< The starting j-index of the largest valid range for tracer points
3186		integer, intent(in) :: jevf !< The ending j-index of the largest valid range for tracer points
3187
3188		! real :: C1_3 ! One third [nondim]
3189		integer :: i, j
3190
3191	1440	if (CS%Sadourny) then
3192	76320	do concurrent (J=jsvf-1:jevf, i=isvf-1:ievf+1)
3193	3519360	f_4_v(1,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j) * q(I-1,J)
3194	3519360	f_4_v(2,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j) * q(I,J)
3195	3519360	f_4_v(4,i,J) = CS%OBCmask_v(i,J) * DCor_u(I,j+1) * q(I,J)
3196	3595680	f_4_v(3,i,J) = CS%OBCmask_v(i,J) * DCor_u(I-1,j+1) * q(I-1,J)
3197		enddo
3198	74880	do concurrent (j=jsvf-1:jevf+1, I=isvf-1:ievf)
3199	3525120	f_4_u(4,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J) * q(I,J)
3200	3525120	f_4_u(3,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J) * q(I,J)
3201	3525120	f_4_u(1,I,j) = CS%OBCmask_u(I,j) * DCor_v(i,J-1) * q(I,J-1)
3202	3600000	f_4_u(2,I,j) = CS%OBCmask_u(I,j) * DCor_v(i+1,J-1) * q(I,J-1)
3203		enddo
3204		else !### if (CS%answer_date < 20250601) then ! Uncomment this later.
3205	0	do concurrent (J=jsvf-1:jevf, i=isvf-1:ievf+1)
3206	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
3207	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
3208	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
3209	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
3210		enddo
3211	0	do concurrent (j=jsvf-1:jevf+1, I=isvf-1:ievf)
3212	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
3213	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
3214	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
3215	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
3216		enddo
3217		! else
3218		! C1_3 = 1.0 / 3.0
3219		! !$OMP parallel do default(shared)
3220		! do J=jsvf-1,jevf ; do i=isvf-1,ievf+1
3221		! 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
3222		! 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
3223		! 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
3224		! 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
3225		! enddo ; enddo
3226		! !$OMP parallel do default(shared)
3227		! do j=jsvf-1,jevf+1 ; do I=isvf-1,ievf
3228		! 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
3229		! 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
3230		! 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
3231		! 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
3232		! enddo ; enddo
3233		endif
3234
3235	1440	end subroutine btstep_find_Cor
3236
3237		!> Do a CFL-based truncation of any excessively large batotropic velocities.
3238		!! This should only be used as desperate debugging measure.
3239	0	subroutine truncate_velocities(ubt, vbt, dt, G, CS, isv, iev, jsv, jev)
3240		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3241		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3242		real, intent(inout) :: ubt(SZIBW_(CS),SZJW_(CS)) !< The zonal barotropic velocity [L T-1 ~> m s-1]
3243		real, intent(inout) :: vbt(SZIW_(CS),SZJBW_(CS)) !< The meridional barotropic velocity [L T-1 ~> m s-1]
3244		real, intent(in) :: dt !< The time increment to integrate over [T ~> s].
3245		integer, intent(in) :: isv !< The starting valid tracer array i-index that is being worked on
3246		integer, intent(in) :: iev !< The ending valid tracer array i-index that is being worked on
3247		integer, intent(in) :: jsv !< The starting valid tracer array j-index that is being worked on
3248		integer, intent(in) :: jev !< The ending valid tracer array j-index being that is worked on
3249
3250		integer :: i, j
3251
3252	0	if (CS%clip_velocity) then
3253	0	do concurrent (j=jsv:jev, I=isv-1:iev)
3254	0	if ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then
3255		! Add some error reporting later.
3256	0	ubt(I,j) = (-0.95CS%CFL_trunc) (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j)))
3257	0	elseif ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then
3258		! Add some error reporting later.
3259	0	ubt(I,j) = (0.95CS%CFL_trunc) (G%areaT(i,j) / (dt * G%dy_Cu(I,j)))
3260		endif
3261		enddo
3262	0	do concurrent (J=jsv-1:jev, i=isv:iev)
3263	0	if ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then
3264		! Add some error reporting later.
3265	0	vbt(i,J) = (-0.9CS%CFL_trunc) (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J)))
3266	0	elseif ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then
3267		! Add some error reporting later.
3268	0	vbt(i,J) = (0.9CS%CFL_trunc) (G%areaT(i,j) / (dt * G%dx_Cv(i,J)))
3269		endif
3270		enddo
3271		endif
3272
3273	0	end subroutine truncate_velocities
3274
3275
3276		!> A routine to set eta_pred and the running time integral of uhbt and vhbt.
3277	0	subroutine btloop_eta_predictor(n, dtbt, ubt, vbt, eta, ubt_int, vbt_int, uhbt, vhbt, uhbt0, vhbt0, &
3278	0	uhbt_int, vhbt_int, BTCL_u, BTCL_v, Datu, Datv, &
3279	0	eta_IC, eta_src, eta_pred, isv, iev, jsv, jev, &
3280		integral_BT_cont, use_BT_cont, G, US, CS)
3281		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
3282		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
3283		integer, intent(in) :: n !< The current step in loop of timesteps
3284		real, intent(in) :: dtbt !< The barotropic time step [T ~> s]
3285		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3286		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3287		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3288		vbt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3289		real, target, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3290		eta !< The barotropic free surface height anomaly or column mass
3291		!! anomaly [H ~> m or kg m-2]
3292		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3293		ubt_int !< The running time integral of ubt over the time steps [L ~> m].
3294		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3295		vbt_int !< The running time integral of vbt over the time steps [L ~> m].
3296		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3297		uhbt0 !< The difference between the sum of the layer zonal thickness
3298		!! fluxes and the barotropic thickness flux using the same
3299		!! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
3300		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3301		vhbt0 !< The difference between the sum of the layer meridional
3302		!! thickness fluxes and the barotropic thickness flux using
3303		!! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
3304		type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3305		BTCL_u !< A repackaged version of the u-point information in BT_cont.
3306		type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3307		BTCL_v !< A repackaged version of the v-point information in BT_cont.
3308		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3309		Datu !< Basin depth at u-velocity grid points times the y-grid
3310		!! spacing [H L ~> m2 or kg m-1].
3311		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3312		Datv !< Basin depth at v-velocity grid points times the x-grid
3313		!! spacing [H L ~> m2 or kg m-1].
3314		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3315		eta_IC !< A local copy of the initial 2-D eta field (eta_in) [H ~> m or kg m-2]
3316		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3317		eta_src !< The source of eta per barotropic timestep [H ~> m or kg m-2].
3318		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3319		uhbt !< The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
3320		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3321		vhbt !< The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
3322		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3323		uhbt_int !< The running time integral of uhbt over the time steps [H L2 ~> m3 or kg].
3324		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3325		vhbt_int !< The running time integral of vhbt over the time steps [H L2 ~> m3 or kg].
3326		real, target, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
3327		eta_pred !< A predictor value of eta [H ~> m or kg m-2] like eta.
3328		integer, intent(in) :: isv !< The starting i-index of eta_pred to calculate
3329		integer, intent(in) :: iev !< The ending i-index of eta_pred to calculate
3330		integer, intent(in) :: jsv !< The starting j-index of eta_pred to calculate
3331		integer, intent(in) :: jev !< The ending j-index of eta_pred to calculate
3332		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity equation directly
3333		!! from the initial condition using the time-integrated barotropic velocity.
3334		logical, intent(in) :: use_BT_cont !< If true, use the information in the BT_cont_type to determine
3335		!! barotropic transports as a function of the barotropic velocities.
3336		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3337
3338		integer :: i, j
3339
3340	0	if (integral_BT_cont) then
3341	0	do concurrent (j=jsv-1:jev+1, I=isv-2:iev+1)
3342	0	uhbt_int(I,j) = find_uhbt(ubt_int(I,j) + dtbtubt(I,j), BTCL_u(I,j)) + ndtbt*uhbt0(I,j)
3343		enddo
3344	0	do concurrent (J=jsv-2:jev+1, i=isv-1:iev+1)
3345	0	vhbt_int(i,J) = find_vhbt(vbt_int(i,J) + dtbtvbt(i,J), BTCL_v(i,J)) + ndtbt*vhbt0(i,J)
3346		enddo
3347	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3348		eta_pred(i,j) = (eta_IC(i,j) + neta_src(i,j)) + CS%IareaT_OBCmask(i,j) &
3349	0	((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J)))
3350		enddo
3351	0	elseif (use_BT_cont) then
3352	0	do concurrent (j=jsv-1:jev+1, I=isv-2:iev+1)
3353	0	uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j)) + uhbt0(I,j)
3354		enddo
3355	0	do concurrent (J=jsv-2:jev+1, i=isv-1:iev+1)
3356	0	vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J)) + vhbt0(i,J)
3357		enddo
3358	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3359		eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT_OBCmask(i,j)) * &
3360	0	((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J)))
3361		enddo
3362		else
3363	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3364		eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT_OBCmask(i,j)) * &
3365		(((Datu(I-1,j)*ubt(I-1,j) + uhbt0(I-1,j)) - &
3366		(Datu(I,j)*ubt(I,j) + uhbt0(I,j))) + &
3367		((Datv(i,J-1)*vbt(i,J-1) + vhbt0(i,J-1)) - &
3368	0	(Datv(i,J)*vbt(i,J) + vhbt0(i,J))))
3369		enddo
3370		endif
3371
3372	0	end subroutine btloop_eta_predictor
3373
3374	5760	subroutine btloop_find_PF(PFu, PFv, isv, iev, jsv, jev, eta_PF_BT, eta_PF, &
3375	5760	gtot_N, gtot_S, gtot_E, gtot_W, dgeo_de, find_etaav, &
3376	5760	wt_accel2_n, eta_sum, v_first, G, US, CS)
3377		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3378		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3379		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3380		PFu !< The anomalous zonal pressure force acceleration [L T-2 ~> m s-2].
3381		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3382		PFv !< The meridional pressure force acceleration [L T-2 ~> m s-2].
3383		integer, intent(in) :: isv !< The starting i-index of eta being set in ths loop
3384		integer, intent(in) :: iev !< The ending i-index of eta_pred being set in ths loop
3385		integer, intent(in) :: jsv !< The starting j-index of eta_pred being set in ths loop
3386		integer, intent(in) :: jev !< The ending j-index of eta_pred being set in ths loop
3387		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3388		eta_PF_BT !< The eta array (either the SSH anomaly or column mass anomaly) that
3389		!! determines the barotropic pressure force [H ~> m or kg m-2]
3390		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3391		eta_PF !< The input 2-D eta field (either SSH anomaly or column mass anomaly)
3392		!! that was used to calculate the input pressure gradient
3393		!! accelerations [H ~> m or kg m-2].
3394		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3395		gtot_N !< The effective total reduced gravity used to relate free surface height
3396		!! deviations to pressure forces (including GFS and baroclinic contributions)
3397		!! in the barotropic momentum equations half a grid-point to the north of a
3398		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3399		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3400		gtot_S !< The effective total reduced gravity used to relate free surface height
3401		!! deviations to pressure forces (including GFS and baroclinic contributions)
3402		!! in the barotropic momentum equations half a grid-point to the south of a
3403		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3404		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E and gtot_W.)
3405		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3406		gtot_E !< The effective total reduced gravity used to relate free surface height
3407		!! deviations to pressure forces (including GFS and baroclinic contributions)
3408		!! in the barotropic momentum equations half a grid-point to the east of a
3409		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3410		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3411		gtot_W !< The effective total reduced gravity used to relate free surface height
3412		!! deviations to pressure forces (including GFS and baroclinic contributions)
3413		!! in the barotropic momentum equations half a grid-point to the west of a
3414		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3415		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E and gtot_W.)
3416		real, intent(in) :: dgeo_de !< The constant of proportionality between geopotential and
3417		!! sea surface height [nondim]. It is of order 1, but for stability this
3418		!! may be made larger than the physical problem would suggest.
3419		logical, intent(in) :: find_etaav !< If true, diagnose the time mean value of eta
3420		real, intent(in) :: wt_accel2_n !< The weighting value of wt_accel2 at step n.
3421		real, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
3422		eta_sum !< A weighted running sum of eta summed across the timesteps [H ~> m or kg m-2]
3423		logical, intent(in) :: v_first !< If true, update the v-velocity first with the present loop iteration
3424		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3425
3426		! Local variables
3427		integer :: i, j, js_u, je_u, is_v, ie_v
3428
3429		! Ensure that the extra points used for the temporally staggered Coriolis terms are updated.
3430	5760	if (v_first) then
3431	2880	is_v = isv-1 ; ie_v = iev+1 ; js_u = jsv ; je_u = jev
3432		else
3433	2880	is_v = isv ; ie_v = iev ; js_u = jsv-1 ; je_u = jev+1
3434		endif
3435
3436	5760	do concurrent (j=js_u:je_u, I=isv-1:iev)
3437		PFu(I,j) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_E(i,j)) - &
3438		((eta_PF_BT(i+1,j)-eta_PF(i+1,j))gtot_W(i+1,j))) &
3439	12470400	dgeo_de * CS%IdxCu(I,j)
3440		enddo
3441
3442	282240	do concurrent (J=jsv-1:jev, i=is_v:ie_v)
3443		PFv(i,J) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j)) - &
3444		((eta_PF_BT(i,j+1)-eta_PF(i,j+1))gtot_S(i,j+1))) &
3445	12481920	dgeo_de * CS%IdyCv(i,J)
3446		enddo
3447
3448	5760	if (find_etaav .and. (abs(wt_accel2_n) > 0.0)) then
3449	129600	do concurrent (j=G%jsc:G%jec, i=G%isc:G%iec)
3450	5198400	eta_sum(i,j) = eta_sum(i,j) + wt_accel2_n * eta_PF_BT(i,j)
3451		enddo
3452		endif
3453
3454	5760	end subroutine btloop_find_PF
3455
3456		!> This routine adds a dynamic pressure force based on the temporal changes in the predicted value
3457		!! of eta, perhaps as an effective divergence damping to emulate the rigidity of an ice-sheet.
3458	0	subroutine btloop_add_dyn_PF(PFu, PFv, eta_pred, eta, dyn_coef_eta, p_surf_dyn, &
3459		isv, iev, jsv, jev, v_first, G, US, CS)
3460		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3461		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3462		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3463		PFu !< The anomalous zonal pressure force acceleration [L T-2 ~> m s-2].
3464		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3465		PFv !< The meridional pressure force acceleration [L T-2 ~> m s-2].
3466		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3467		eta_pred !< The updated eta field (either SSH anomaly or column mass anomaly) that is
3468		!! used to estimate the divergence that is to be damped [H ~> m or kg m-2].
3469		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3470		eta !< The previous eta field (either SSH anomaly or column mass anomaly) that is
3471		!! used to estimate the divergence that is to be damped [H ~> m or kg m-2].
3472		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3473		dyn_coef_eta !< The coefficient relating the changes in eta to the dynamic surface pressure
3474		!! under rigid ice [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
3475		real, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: &
3476		p_surf_dyn !< A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].
3477		integer, intent(in) :: isv !< The starting i-index of eta being set in ths loop
3478		integer, intent(in) :: iev !< The ending i-index of eta_pred being set in ths loop
3479		integer, intent(in) :: jsv !< The starting j-index of eta_pred being set in ths loop
3480		integer, intent(in) :: jev !< The ending j-index of eta_pred being set in ths loop
3481		logical, intent(in) :: v_first !< If true, update the v-velocity first with the present loop iteration
3482		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3483
3484		! Local variables
3485		integer :: i, j, js_u, je_u, is_v, ie_v
3486
3487		! Ensure that the extra points used for the temporally staggered Coriolis terms are updated.
3488	0	if (v_first) then
3489	0	is_v = isv-1 ; ie_v = iev+1 ; js_u = jsv ; je_u = jev
3490		else
3491	0	is_v = isv ; ie_v = iev ; js_u = jsv-1 ; je_u = jev+1
3492		endif
3493
3494		! Use the change in eta to estimate the flow divergence and dynamic pressure.
3495	0	do concurrent (j=jsv-1:jev+1, i=isv-1:iev+1)
3496	0	p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j))
3497		enddo
3498
3499	0	do concurrent (j=js_u:je_u, I=isv-1:iev)
3500	0	PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j)
3501		enddo
3502	0	do concurrent (J=jsv-1:jev, i=is_v:ie_v)
3503	0	PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J)
3504		enddo
3505
3506	0	end subroutine btloop_add_dyn_PF
3507
3508		!> Update meridional velocity.
3509	5760	subroutine btloop_update_v(dtbt, ubt, vbt, v_accel_bt, &
3510	5760	Cor_v, PFv, is_v, ie_v, Js_v, Je_v, f_4_v, &
3511	5760	bt_rem_v, BT_force_v, Cor_ref_v, Rayleigh_v, &
3512		wt_accel_n, G, US, CS, Cor_bracket_bug)
3513		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3514		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3515		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3516		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3517		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3518		vbt !< The meridional barotropic velocity [L T-1 ~> m s-1].
3519		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3520		v_accel_bt !< The difference between the meridional acceleration from the
3521		!! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
3522		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: &
3523		Cor_v !< The meridional Coriolis acceleration [L T-2 ~> m s-2]
3524		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3525		PFv !< The meridional pressure force acceleration [L T-2 ~> m s-2].
3526		real, dimension(4,SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3527		f_4_v !< The terms giving the contribution to the Coriolis acceleration at a meridional
3528		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3529		!! These are the products of thicknesses at u points and appropriately staggered
3530		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3531		!! they are approximately f / 4. The 4 values on the innermost loop are for
3532		!! u-velocities to the southwest, southeast, northwest and northeast.
3533		integer, intent(in) :: is_v !< The starting i-index of the range of v-point values to calculate
3534		integer, intent(in) :: ie_v !< The ending i-index of the range of v-point values to calculate
3535		integer, intent(in) :: Js_v !< The starting j-index of the range of v-point values to calculate
3536		integer, intent(in) :: Je_v !< The ending j-index of the range of v-point values to calculate
3537		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3538		bt_rem_v !< The fraction of the barotropic meridional velocity that
3539		!! remains after a time step, the rest being lost to bottom
3540		!! drag [nondim]. bt_rem_v is between 0 and 1.
3541		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3542		BT_force_v !< The vertical average of all of the v-accelerations that are
3543		!! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
3544		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3545		Cor_ref_v !< The meridional barotropic Coriolis acceleration due
3546		!! to the reference velocities [L T-2 ~> m s-2].
3547		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3548		Rayleigh_v !< A Rayleigh drag timescale operating at v-points for drag parameterizations
3549		!! that introduced directly into the barotropic solver rather than coming
3550		!! in via the visc_rem_v arrays from the layered equations [T-1 ~> s-1]
3551		real, intent(in) :: wt_accel_n !< The raw or relative weights of each of the barotropic timesteps
3552		!! in determining the average accelerations [nondim]
3553		real, intent(in) :: dtbt !< The barotropic time step [T ~> s].
3554		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3555		logical, optional, intent(in) :: Cor_bracket_bug !< If present and true, use an order of operations that is
3556		!! not bitwise rotationally symmetric in the meridional Coriolis term
3557
3558		! Local variables
3559		logical :: use_bracket_bug
3560		integer :: i, j
3561
3562	5760	use_bracket_bug = .false. ; if (present(Cor_bracket_bug)) use_bracket_bug = Cor_bracket_bug
3563
3564		! The bracket bug only applies if v is second, use ioff to check.
3565	5760	if (use_bracket_bug) then
3566	0	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3567		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))) + &
3568	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)
3569		enddo
3570		else
3571	282240	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3572		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))) + &
3573	12481920	((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)
3574		enddo
3575		endif
3576
3577		! This updates the v-velocity, except at OBC points.
3578	282240	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3579		vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + &
3580	12199680	dtbt * ((BT_force_v(i,J) + Cor_v(i,J)) + PFv(i,J)))
3581	12481920	if (abs(vbt(i,J)) < CS%vel_underflow) vbt(i,J) = 0.0
3582		enddo
3583
3584	5760	if (CS%linear_wave_drag) then
3585	0	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3586		v_accel_bt(i,J) = v_accel_bt(i,J) + wt_accel_n * &
3587	0	((Cor_v(i,J) + PFv(i,J)) - vbt(i,J)*Rayleigh_v(i,J))
3588		enddo
3589		else
3590	282240	do concurrent (J=Js_v:Je_v, i=is_v:ie_v)
3591	12481920	v_accel_bt(i,J) = v_accel_bt(i,J) + wt_accel_n * (Cor_v(i,J) + PFv(i,J))
3592		enddo
3593		endif
3594
3595	5760	end subroutine btloop_update_v
3596
3597		!> Update zonal velocity.
3598	5760	subroutine btloop_update_u(dtbt, ubt, vbt, u_accel_bt, &
3599	5760	Cor_u, PFu, Is_u, Ie_u, js_u, je_u, f_4_u, &
3600	5760	bt_rem_u, BT_force_u, Cor_ref_u, Rayleigh_u, &
3601		wt_accel_n, G, US, CS)
3602		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3603		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3604		real, intent(in) :: dtbt !< The barotropic time step [T ~> s].
3605		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3606		ubt !< The zonal barotropic velocity [L T-1 ~> m s-1].
3607		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3608		vbt !< The meridional barotropic velocity [L T-1 ~> m s-1].
3609		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3610		u_accel_bt !! The difference between the zonal acceleration from the
3611		!< barotropic calculation and BT_force_v [L T-2 ~> m s-2].
3612		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: &
3613		Cor_u !< The anomalous zonal Coriolis acceleration [L T-2 ~> m s-2]
3614		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3615		PFu !< The anomalous zonal pressure force acceleration [L T-2 ~> m s-2].
3616		integer, intent(in) :: Is_u !< The starting i-index of the range of u-point values to calculate
3617		integer, intent(in) :: Ie_u !< The ending i-index of the range of u-point values to calculate
3618		integer, intent(in) :: js_u !< The starting j-index of the range of u-point values to calculate
3619		integer, intent(in) :: je_u !< The ending j-index of the range of u-point values to calculate
3620		real, dimension(4,SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3621		f_4_u !< The terms giving the contribution to the Coriolis acceleration at a zonal
3622		!! velocity point from the neighboring meridional velocity anomalies [T-1 ~> s-1].
3623		!! These are the products of thicknesses at v points and appropriately staggered
3624		!! averaged pseudo potential vorticities, but with sufficiently smooth topography
3625		!! they are approximately f / 4. The 4 values on the innermost loop are for
3626		!! v-velocities to the southwest, southeast, northwest and northeast.
3627		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3628		bt_rem_u !< The fraction of the barotropic meridional velocity that
3629		!! remains after a time step, the rest being lost to bottom
3630		!! drag [nondim]. bt_rem_v is between 0 and 1.
3631		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3632		BT_force_u !< The vertical average of all of the v-accelerations that are
3633		!! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
3634		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3635		Cor_ref_u !< The meridional barotropic Coriolis acceleration due
3636		!! to the reference velocities [L T-2 ~> m s-2].
3637		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3638		Rayleigh_u !< A Rayleigh drag timescale operating at u-points for drag parameterizations
3639		!! that introduced directly into the barotropic solver rather than coming
3640		!! in via the visc_rem_u arrays from the layered equations [T-1 ~> s-1].
3641		real, intent(in) :: wt_accel_n !< The raw or relative weights of each of the barotropic timesteps
3642		!! in determining the average accelerations [nondim]
3643		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3644
3645		! Local variables
3646		integer :: i, j
3647
3648	282240	do concurrent (j=js_u:je_u, I=Is_u:Ie_u)
3649		Cor_u(I,j) = (((f_4_u(4,I,j) * vbt(i+1,J)) + (f_4_u(1,I,j) * vbt(i,J-1))) + &
3650		((f_4_u(3,I,j) * vbt(i,J)) + (f_4_u(2,I,j) * vbt(i+1,J-1)))) - &
3651	12188160	Cor_ref_u(I,j)
3652
3653		ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + &
3654	12188160	dtbt * ((BT_force_u(I,j) + Cor_u(I,j)) + PFu(I,j)))
3655	12470400	if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0
3656		enddo
3657
3658	5760	if (CS%linear_wave_drag) then
3659	0	do concurrent (j=js_u:je_u, I=Is_u:Ie_u)
3660		u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel_n * &
3661	0	((Cor_u(I,j) + PFu(I,j)) - ubt(I,j)*Rayleigh_u(I,j))
3662		enddo
3663		else
3664	282240	do concurrent (j=js_u:je_u, I=Is_u:Ie_u)
3665	12470400	u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel_n * (Cor_u(I,j) + PFu(I,j))
3666		enddo
3667		endif
3668
3669	5760	end subroutine btloop_update_u
3670
3671
3672		!> Calculate the zonal and meridional velocity from the 3-D velocity.
3673	1440	subroutine btstep_ubt_from_layer(U_in, V_in, wt_u, wt_v, ubt, vbt, G, GV, CS)
3674		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3675		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3676		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3677		real, intent(in) :: U_in(SZIB_(G),SZJ_(G),SZK_(GV)) !< The initial (3-D) zonal velocity [L T-1 ~> m s-1]
3678		real, intent(in) :: V_in(SZI_(G),SZJB_(G),SZK_(GV)) !< The initial (3-D) meridional velocity [L T-1 ~> m s-1]
3679		real, intent(in) :: wt_u(SZIB_(G),SZJ_(G),SZK_(GV)) !< The normalized weights to be used in calculating
3680		!! zonal barotropic velocities, possibly with sums
3681		!! less than one due to viscous losses [nondim]
3682		real, intent(in) :: wt_v(SZI_(G),SZJB_(G),SZK_(GV)) !< The normalized weights to be used in calculating
3683		!! meridional barotropic velocities, possibly with
3684		!! sums less than one due to viscous losses [nondim]
3685		real, intent(out) :: ubt(SZIBW_(CS),SZJW_(CS)) !< The zonal barotropic velocity [L T-1 ~> m s-1]
3686		real, intent(out) :: vbt(SZIW_(CS),SZJBW_(CS)) !< The meridional barotropic velocity [L T-1 ~> m s-1]
3687
3688		! Local variables
3689		integer :: i, j, k, is, ie, js, je, nz
3690
3691	1440	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
3692
3693	77760	do concurrent (j=CS%jsdw:CS%jedw, i=CS%isdw-1:CS%iedw)
3694	3741120	ubt(i,j) = 0.0
3695		enddo
3696	76320	do concurrent (j=CS%jsdw-1:CS%jedw, i=CS%isdw:CS%iedw)
3697	3745440	vbt(i,j) = 0.0
3698		enddo
3699
3700	1440	do concurrent (j=js:je)
3701	218880	do k=1,nz
3702	57600	do concurrent (I=is-1:ie)
3703	26352000	ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * U_in(I,j,k)
3704		enddo
3705		enddo
3706	59040	do concurrent (I=is-1:ie)
3707	2649600	if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0
3708		enddo
3709		enddo
3710	1440	do concurrent (J=js-1:je)
3711	222528	do k=1,nz
3712	59040	do concurrent (i=is:ie)
3713	26571600	vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k)
3714		enddo
3715		enddo
3716	60480	do concurrent (i=is:ie)
3717	2656800	if (abs(vbt(i,J)) < CS%vel_underflow) vbt(i,J) = 0.0
3718		enddo
3719		enddo
3720
3721	1440	end subroutine btstep_ubt_from_layer
3722
3723
3724		!> Calculate the zonal and meridional acceleration of each layer due to the barotropic calculation.
3725	1440	subroutine btstep_layer_accel(dt, u_accel_bt, v_accel_bt, pbce, gtot_E, gtot_W, gtot_N, gtot_S, &
3726	1440	e_anom, G, GV, CS, accel_layer_u, accel_layer_v)
3727		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3728		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3729		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3730		real, intent(in) :: dt !< The time increment to integrate over [T ~> s].
3731		real, dimension(SZIBW_(CS),SZJW_(CS)), intent(in) :: &
3732		u_accel_bt !< The difference between the zonal acceleration from the
3733		!! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
3734		real, dimension(SZIW_(CS),SZJBW_(CS)), intent(in) :: &
3735		v_accel_bt !< The difference between the meridional acceleration from the
3736		!! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
3737		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer
3738		!! due to free surface height anomalies
3739		!! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3740		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3741		gtot_E !< The effective total reduced gravity used to relate free surface height
3742		!! deviations to pressure forces (including GFS and baroclinic contributions)
3743		!! in the barotropic momentum equations half a grid-point to the east of a
3744		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3745		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3746		gtot_W !< The effective total reduced gravity used to relate free surface height
3747		!! deviations to pressure forces (including GFS and baroclinic contributions)
3748		!! in the barotropic momentum equations half a grid-point to the west of a
3749		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3750		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3751		gtot_N !< The effective total reduced gravity used to relate free surface height
3752		!! deviations to pressure forces (including GFS and baroclinic contributions)
3753		!! in the barotropic momentum equations half a grid-point to the north of a
3754		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3755		real, dimension(SZIW_(CS),SZJW_(CS)), intent(in) :: &
3756		gtot_S !< The effective total reduced gravity used to relate free surface height
3757		!! deviations to pressure forces (including GFS and baroclinic contributions)
3758		!! in the barotropic momentum equations half a grid-point to the south of a
3759		!! thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3760		!! (See Hallberg, J Comp Phys 1997 for a discussion of gtot_E, etc.)
3761		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: &
3762		e_anom !< The anomaly in the sea surface height or column mass
3763		!! averaged between the beginning and end of the time step,
3764		!! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
3765		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due
3766		!! to the barotropic calculation [L T-2 ~> m s-2].
3767		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer
3768		!! due to the barotropic calculation [L T-2 ~> m s-2].
3769
3770		! Local variables
3771		real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2].
3772		real :: Idt ! The inverse of dt [T-1 ~> s-1].
3773		integer :: i, j, k, is, ie, js, je, nz
3774
3775	1440	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
3776
3777	1440	Idt = 1.0 / dt
3778	1440	accel_underflow = CS%vel_underflow * Idt
3779
3780		! Now calculate each layer's accelerations.
3781	1440	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
3782		accel_layer_u(I,j,k) = (u_accel_bt(I,j) - &
3783		(((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j)) - &
3784	26136000	((pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j))) * CS%IdxCu(I,j) )
3785	26490336	if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0
3786		enddo
3787	1440	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
3788		accel_layer_v(i,J,k) = (v_accel_bt(i,J) - &
3789		(((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1)) - &
3790	26352000	((pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j))) * CS%IdyCv(i,J) )
3791	26709168	if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0
3792		enddo
3793
3794	1440	end subroutine btstep_layer_accel
3795
3796		!> This subroutine automatically determines an optimal value for dtbt based on some state of the ocean. Either pbce or
3797		!! gtot_est is required to calculate gravitational acceleration. Column thickness can be estimated using BT_cont, eta,
3798		!! and SSH_add (default=0), with priority given in that order. The subroutine sets CS%dtbt_max and CS%dtbt.
3799	26	subroutine set_dtbt(G, GV, US, CS, pbce, gtot_est, BT_cont, eta, SSH_add)
3800		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3801		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3802		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3803		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
3804		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
3805		optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer due to free
3806		!! surface height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3807		real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational acceleration
3808		!! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3809		type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the effective open
3810		!! face areas as a function of barotropic flow.
3811		real, dimension(SZI_(G),SZJ_(G)), &
3812		optional, intent(in) :: eta !< The barotropic free surface height anomaly or column mass
3813		!! anomaly [H ~> m or kg m-2].
3814		real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to provide a margin of
3815		!! error when calculating the external wave speed [Z ~> m].
3816
3817		! Local variables
3818		real, dimension(SZI_(G),SZJ_(G)) :: &
3819	28	gtot_E, & ! gtot_X is the effective total reduced gravity used to relate
3820	28	gtot_W, & ! free surface height deviations to pressure forces (including
3821	28	gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
3822	28	gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W)
3823		! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
3824		! (See Hallberg, J Comp Phys 1997 for a discussion.)
3825		real, dimension(SZIBS_(G),SZJ_(G)) :: &
3826	14	Datu ! Basin depth at u-velocity grid points times the y-grid
3827		! spacing [H L ~> m2 or kg m-1].
3828		real, dimension(SZI_(G),SZJBS_(G)) :: &
3829	14	Datv ! Basin depth at v-velocity grid points times the x-grid
3830		! spacing [H L ~> m2 or kg m-1].
3831		real :: det_de ! The partial derivative due to self-attraction and loading
3832		! of the reference geopotential with the sea surface height [nondim].
3833		! This is typically ~0.09 or less.
3834		real :: dgeo_de ! The constant of proportionality between geopotential and
3835		! sea surface height [nondim]. It is a nondimensional number of
3836		! order 1. For stability, this may be made larger
3837		! than physical problem would suggest.
3838		real :: add_SSH ! An additional contribution to SSH to provide a margin of error
3839		! when calculating the external wave speed [Z ~> m].
3840		real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic
3841		! timesteps [T2 ~> s2]
3842		real :: dtbt_max ! The maximum barotropic timestep [T ~> s]
3843		real :: Idt_max2 ! The squared inverse of the local maximum stable
3844		! barotropic time step [T-2 ~> s-2].
3845		logical :: use_BT_cont
3846		type(memory_size_type) :: MS
3847
3848		integer :: i, j, k, is, ie, js, je, nz
3849
3850	14	if (.not.CS%module_is_initialized) call MOM_error(FATAL, &
3851	0	"set_dtbt: Module MOM_barotropic must be initialized before it is used.")
3852
3853	14	if (.not.CS%split) return
3854	14	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
3855	14	MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed
3856
3857
3858	14	if (.not.(present(pbce) .or. present(gtot_est))) call MOM_error(FATAL, &
3859	0	"set_dtbt: Either pbce or gtot_est must be present.")
3860
3861	14	add_SSH = 0.0 ; if (present(SSH_add)) add_SSH = SSH_add
3862
3863	14	use_BT_cont = .false.
3864	14	if (present(BT_cont)) use_BT_cont = (associated(BT_cont))
3865
3866		!$omp target enter data map(alloc: gtot_E, gtot_W, gtot_N, gtot_S, Datu, Datv)
3867	14	if (use_BT_cont) then
3868	0	call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0)
3869	14	elseif (CS%Nonlinear_continuity .and. present(eta)) then
3870	4	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, eta=eta)
3871		else
3872	14	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 0, add_max=add_SSH)
3873		endif
3874
3875	14	det_de = 0.0
3876	14	if (CS%calculate_SAL) call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
3877	14	if (CS%tidal_sal_bug) then
3878	0	dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra)
3879		else
3880	14	dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de)
3881		endif
3882	14	if (present(pbce)) then
3883	13	do concurrent (j=js:je)
3884	780	do concurrent (i=is:ie)
3885	259200	gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0
3886	259920	gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0
3887		enddo
3888	60073	do k=1,nz
3889	780	do concurrent (i=is:ie)
3890	7020000	gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * CS%frhatu(I,j,k)
3891	7020000	gtot_W(i,j) = gtot_W(i,j) + pbce(i,j,k) * CS%frhatu(I-1,j,k)
3892	7020000	gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * CS%frhatv(i,J,k)
3893	7078500	gtot_S(i,j) = gtot_S(i,j) + pbce(i,j,k) * CS%frhatv(i,J-1,k)
3894		enddo
3895		enddo
3896		enddo
3897		else
3898	1	do concurrent (j=js:je, i=is:ie)
3899	64800	gtot_E(i,j) = gtot_est ; gtot_W(i,j) = gtot_est
3900	65161	gtot_N(i,j) = gtot_est ; gtot_S(i,j) = gtot_est
3901		enddo
3902		endif
3903
3904	14	min_max_dt2 = 1.0e38US%s_to_T*2 ! A huge value for the permissible timestep squared.
3905	14	do concurrent (j=js:je, i=is:ie) DO_LOCALITY(reduce(min:min_max_dt2))
3906		! This is pretty accurate for gravity waves, but it is a conservative
3907		! estimate since it ignores the stabilizing effect of the bottom drag.
3908		Idt_max2 = 0.5 * (1.0 + 2.0CS%bebt) (G%IareaT(i,j) * &
3909		(((gtot_E(i,j)Datu(I,j)G%IdxCu(I,j)) + (gtot_W(i,j)Datu(I-1,j)G%IdxCu(I-1,j))) + &
3910		((gtot_N(i,j)Datv(i,J)G%IdyCv(i,J)) + (gtot_S(i,j)Datv(i,J-1)G%IdyCv(i,J-1)))) + &
3911		((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
3912	324000	(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1))) * CS%BT_Coriolis_scale**2 )
3913	325805	if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2
3914		enddo
3915		!$omp target exit data map(release: gtot_E, gtot_W, gtot_N, gtot_S, Datu, Datv)
3916	14	dtbt_max = sqrt(min_max_dt2 / dgeo_de)
3917	14	if (id_clock_sync > 0) call cpu_clock_begin(id_clock_sync)
3918	14	call min_across_PEs(dtbt_max)
3919	14	if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync)
3920
3921	14	CS%dtbt = CS%dtbt_fraction * dtbt_max
3922	14	CS%dtbt_max = dtbt_max
3923
3924	14	if (CS%debug) then
3925	0	call chksum0(CS%dtbt, "End set_dtbt dtbt", unscale=US%T_to_s)
3926	0	call chksum0(CS%dtbt_max, "End set_dtbt dtbt_max", unscale=US%T_to_s)
3927		endif
3928	27	end subroutine set_dtbt
3929
3930		! The following 5 subroutines apply the open boundary conditions.
3931
3932		!> This subroutine applies the open boundary conditions on barotropic zonal
3933		!! velocities and mass transports, as developed by Mehmet Ilicak.
3934	0	subroutine apply_u_velocity_OBCs(ubt, uhbt, ubt_trans, eta, SpV_avg, ubt_old, BT_OBC, G, MS, &
3935		GV, US, CS, halo, dtbt, bebt, use_BT_cont, integral_BT_cont, dt_elapsed, &
3936	0	Datu, BTCL_u, uhbt0, ubt_int, ubt_int_prev, uhbt_int, uhbt_int_prev)
3937		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3938		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
3939		!! the argument arrays.
3940		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1].
3941		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport
3942		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
3943		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in
3944		!! transport [L T-1 ~> m s-1].
3945		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
3946		!! column mass anomaly [H ~> m or kg m-2].
3947		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
3948		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic
3949		!! step [L T-1 ~> m s-1].
3950		type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
3951		!! related to the open boundary conditions,
3952		!! set by set_up_BT_OBC.
3953		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3954		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3955		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
3956		integer, intent(in) :: halo !< The extra halo size to use here.
3957		real, intent(in) :: dtbt !< The time step [T ~> s].
3958		real, intent(in) :: bebt !< The fractional weighting of the future velocity
3959		!! in determining the transport [nondim]
3960		logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
3961		!! transports.
3962		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity
3963		!! equation directly from the initial condition
3964		!! using the time-integrated barotropic velocity.
3965		real, intent(in) :: dt_elapsed !< The amount of time in the barotropic stepping
3966		!! that will have elapsed [T ~> s].
3967		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
3968		!! [H L ~> m2 or kg m-1].
3969		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
3970		!! for a dynamic estimate of the face areas at
3971		!! u-points.
3972		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that
3973		!! the barotropic functions agree with the sum
3974		!! of the layer transports
3975		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
3976		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_int !< The time-integrated zonal barotropic
3977		!! velocity after this update [L T-1 ~> m s-1]
3978		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_int_prev !< The time-integrated zonal barotropic
3979		!! velocity before this update [L T-1 ~> m s-1]
3980		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt_int !< The time-integrated zonal barotropic transport
3981		!! after this update [H L2 T-1 ~> m3 s-1 or kg s-1]
3982		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt_int_prev !< The time-integrated zonal barotropic
3983		!! transport before this update
3984		!! [H L2 T-1 ~> m3 s-1 or kg s-1]
3985
3986		! Local variables
3987		real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
3988		real :: cfl ! The CFL number at the point in question [nondim]
3989		real :: u_inlet ! The zonal inflow velocity [L T-1 ~> m s-1]
3990		real :: uhbt_int_new ! The updated time-integrated zonal transport [H L2 ~> m3]
3991		real :: ssh_in ! The inflow sea surface height [Z ~> m]
3992		real :: ssh_1 ! The sea surface height in the interior cell adjacent to the an OBC face [Z ~> m]
3993		real :: ssh_2 ! The sea surface height in the next cell inward from the OBC face [Z ~> m]
3994		real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1]
3995		integer :: i, j, Is_u, Ie_u, js, je
3996
3997	0	if (.not.BT_OBC%u_OBCs_on_PE) return
3998
3999	0	Idtbt = 1.0 / dtbt
4000
4001		! Work on Eastern OBC points
4002	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)
4003	0	js = max(G%jsc-halo, BT_OBC%js_u_E_obc) ; je = min(G%jec+halo, BT_OBC%je_u_E_obc)
4004	0	do j=js,je ; do I=Is_u,Ie_u ; if (BT_OBC%u_OBC_type(I,j) > 0) then
4005	0	if (BT_OBC%u_OBC_type(I,j) == SPECIFIED_OBC) then ! Eastern specified OBC
4006	0	uhbt(I,j) = BT_OBC%uhbt(I,j)
4007	0	ubt(I,j) = BT_OBC%ubt_outer(I,j)
4008	0	ubt_trans(I,j) = ubt(I,j)
4009	0	if (integral_BT_cont) then
4010	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4011	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4012		endif
4013	0	elseif (BT_OBC%u_OBC_type(I,j) == FLATHER_OBC) then ! Eastern Flather OBC
4014	0	cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
4015	0	u_inlet = cflubt_old(I-1,j) + (1.0-cfl)ubt_old(I,j) ! Valid for cfl<1
4016	0	if (I <= MS%isdw) then
4017		! Do not apply an Eastern Flather OBC at the western halo points on a PE, as doing so would
4018		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4019	0	ssh_in = BT_OBC%SSH_outer_u(I,j)
4020	0	elseif (GV%Boussinesq) then
4021	0	ssh_in = GV%H_to_Z(eta(i,j) + (0.5-cfl)(eta(i,j)-eta(i-1,j))) ! internal
4022		else
4023	0	ssh_1 = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j) - (CS%bathyT(i,j) + G%Z_ref)
4024	0	ssh_2 = GV%H_to_RZ * eta(i-1,j) * SpV_avg(i-1,j) - (CS%bathyT(i-1,j) + G%Z_ref)
4025	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4026		endif
4027	0	if (BT_OBC%dZ_u(I,j) > 0.0) then
4028	0	vel_prev = ubt(I,j)
4029		ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
4030	0	(BT_OBC%Cg_u(I,j)/BT_OBC%dZ_u(I,j)) * (ssh_in-BT_OBC%SSH_outer_u(I,j)))
4031	0	ubt_trans(I,j) = (1.0-bebt)vel_prev + bebtubt(I,j)
4032		else ! This point is now dry.
4033	0	ubt(I,j) = 0.0
4034	0	ubt_trans(I,j) = 0.0
4035		endif
4036	0	elseif (BT_OBC%u_OBC_type(I,j) == GRADIENT_OBC) then ! Eastern gradient OBC
4037	0	ubt(I,j) = ubt(I-1,j)
4038	0	ubt_trans(I,j) = ubt(I,j)
4039		endif
4040
4041		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4042	0	if (BT_OBC%u_OBC_type(I,j) > SPECIFIED_OBC) then ! Eastern Flather or gradient OBC
4043	0	if (integral_BT_cont) then
4044	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4045	0	uhbt_int_new = find_uhbt(ubt_int(I,j), BTCL_u(I,j)) + dt_elapsed*uhbt0(I,j)
4046	0	uhbt(I,j) = (uhbt_int_new - uhbt_int_prev(I,j)) * Idtbt
4047	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4048		! The line above is equivalent to: uhbt_int(I,j) = uhbt_int_new
4049	0	elseif (use_BT_cont) then
4050	0	uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
4051		else
4052	0	uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
4053		endif
4054		endif
4055
4056		endif ; enddo ; enddo
4057
4058		! Work on Western OBC points
4059	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)
4060	0	js = max(G%jsc-halo, BT_OBC%js_u_W_obc) ; je = min(G%jec+halo, BT_OBC%je_u_W_obc)
4061	0	do j=js,je ; do I=Is_u,Ie_u ; if (BT_OBC%u_OBC_type(I,j) < 0) then
4062	0	if (BT_OBC%u_OBC_type(I,j) == -SPECIFIED_OBC) then ! Western specified OBC
4063	0	uhbt(I,j) = BT_OBC%uhbt(I,j)
4064	0	ubt(I,j) = BT_OBC%ubt_outer(I,j)
4065	0	ubt_trans(I,j) = ubt(I,j)
4066	0	if (integral_BT_cont) then
4067	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4068	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4069		endif
4070	0	elseif (BT_OBC%u_OBC_type(I,j) == -FLATHER_OBC) then ! Western Flather OBC
4071	0	cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
4072	0	u_inlet = cflubt_old(I+1,j) + (1.0-cfl)ubt_old(I,j) ! Valid for cfl<1
4073	0	if (I >= MS%iedw-1) then
4074		! Do not apply a Western Flather OBC at the eastern halo points on a PE, as doing so would
4075		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4076	0	ssh_in = BT_OBC%SSH_outer_u(I,j)
4077	0	elseif (GV%Boussinesq) then
4078	0	ssh_in = GV%H_to_Z(eta(i+1,j) + (0.5-cfl)(eta(i+1,j)-eta(i+2,j))) ! internal
4079		else
4080	0	ssh_1 = GV%H_to_RZ * eta(i+1,j) * SpV_avg(i+1,j) - (CS%bathyT(i+1,j) + G%Z_ref)
4081	0	ssh_2 = GV%H_to_RZ * eta(i+2,j) * SpV_avg(i+2,j) - (CS%bathyT(i+2,j) + G%Z_ref)
4082	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4083		endif
4084
4085	0	if (BT_OBC%dZ_u(I,j) > 0.0) then
4086	0	vel_prev = ubt(I,j)
4087		ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
4088	0	(BT_OBC%Cg_u(I,j)/BT_OBC%dZ_u(I,j)) * (BT_OBC%SSH_outer_u(I,j)-ssh_in))
4089	0	ubt_trans(I,j) = (1.0-bebt)vel_prev + bebtubt(I,j)
4090		else ! This point is now dry.
4091	0	ubt(I,j) = 0.0
4092	0	ubt_trans(I,j) = 0.0
4093		endif
4094	0	elseif (BT_OBC%u_OBC_type(I,j) == -GRADIENT_OBC) then ! Western gradient OBC
4095	0	ubt(I,j) = ubt(I+1,j)
4096	0	ubt_trans(I,j) = ubt(I,j)
4097		endif
4098
4099		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4100	0	if (BT_OBC%u_OBC_type(I,j) < -SPECIFIED_OBC) then ! Western Flather or gradient OBC
4101	0	if (integral_BT_cont) then
4102	0	ubt_int(I,j) = ubt_int_prev(I,j) + dtbt * ubt_trans(I,j)
4103	0	uhbt_int_new = find_uhbt(ubt_int(I,j), BTCL_u(I,j)) + dt_elapsed*uhbt0(I,j)
4104	0	uhbt(I,j) = (uhbt_int_new - uhbt_int_prev(I,j)) * Idtbt
4105	0	uhbt_int(I,j) = uhbt_int_prev(I,j) + dtbt * uhbt(I,j)
4106		! The line above is equivalent to: uhbt_int(I,j) = uhbt_int_new
4107	0	elseif (use_BT_cont) then
4108	0	uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j)
4109		else
4110	0	uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j)
4111		endif
4112		endif
4113
4114		endif ; enddo ; enddo
4115
4116		end subroutine apply_u_velocity_OBCs
4117
4118		!> This subroutine applies the open boundary conditions on barotropic meridional
4119		!! velocities and mass transports, as developed by Mehmet Ilicak.
4120	0	subroutine apply_v_velocity_OBCs(vbt, vhbt, vbt_trans, eta, SpV_avg, vbt_old, BT_OBC, &
4121		G, MS, GV, US, CS, halo, dtbt, bebt, use_BT_cont, integral_BT_cont, dt_elapsed, &
4122	0	Datv, BTCL_v, vhbt0, vbt_int, vbt_int_prev, vhbt_int, vhbt_int_prev)
4123		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
4124		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
4125		!! the argument arrays.
4126		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic velocity
4127		!! [L T-1 ~> m s-1].
4128		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport
4129		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
4130		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in
4131		!! transports [L T-1 ~> m s-1].
4132		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
4133		!! column mass anomaly [H ~> m or kg m-2].
4134		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
4135		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic
4136		!! step [L T-1 ~> m s-1].
4137		type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
4138		!! related to the open boundary conditions,
4139		!! set by set_up_BT_OBC.
4140		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4141		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
4142		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
4143		integer, intent(in) :: halo !< The extra halo size to use here.
4144		real, intent(in) :: dtbt !< The time step [T ~> s].
4145		real, intent(in) :: bebt !< The fractional weighting of the future velocity
4146		!! in determining the transport [nondim]
4147		logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
4148		!! transports.
4149		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity
4150		!! equation directly from the initial condition
4151		!! using the time-integrated barotropic velocity.
4152		real, intent(in) :: dt_elapsed !< The amount of time in the barotropic stepping
4153		!! that will have elapsed [T ~> s].
4154		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
4155		!! [H L ~> m2 or kg m-1].
4156		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
4157		!! for a dynamic estimate of the face areas at
4158		!! v-points.
4159		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that
4160		!! the barotropic functions agree with the sum
4161		!! of the layer transports
4162		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
4163		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_int !< The time-integrated meridional barotropic
4164		!! velocity after this update [L T-1 ~> m s-1].
4165		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_int_prev !< The time-integrated meridional barotropic
4166		!! velocity before this update [L T-1 ~> m s-1].
4167		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt_int !< The time-integrated meridional barotropic
4168		!! transport after this update
4169		!! [H L2 T-1 ~> m3 s-1 or kg s-1]
4170		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt_int_prev !< The time-integrated meridional barotropic
4171		!! transport before this update
4172		!! [H L2 T-1 ~> m3 s-1 or kg s-1]
4173
4174		! Local variables
4175		real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
4176		real :: cfl ! The CFL number at the point in question [nondim]
4177		real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1]
4178		real :: vhbt_int_new ! The updated time-integrated meridional transport [H L2 ~> m3]
4179		real :: ssh_in ! The inflow sea surface height [Z ~> m]
4180		real :: ssh_1 ! The sea surface height in the interior cell adjacent to the an OBC face [Z ~> m]
4181		real :: ssh_2 ! The sea surface height in the next cell inward from the OBC face [Z ~> m]
4182		real :: Idtbt ! The inverse of the barotropic time step [T-1 ~> s-1]
4183		integer :: i, j, is, ie, Js_v, Je_v
4184
4185	0	if (.not.BT_OBC%v_OBCs_on_PE) return
4186
4187	0	Idtbt = 1.0 / dtbt
4188
4189		! This routine uses separate blocks of code and loops for Northern and southern open boundary
4190		! condition points, despite this leading to some code duplication, because the OBCs almost always
4191		! occur at the edge of the domain, and in parallel appliations, most PEs will only have one or
4192		! the other.
4193
4194
4195		! Work on Northern OBC points
4196	0	is = max(G%isc-halo, BT_OBC%is_v_N_obc) ; ie = min(G%iec+halo, BT_OBC%ie_v_N_obc)
4197	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)
4198	0	do J=Js_v,Je_v ; do i=is,ie ; if (BT_OBC%v_OBC_type(i,J) > 0) then
4199	0	if (BT_OBC%v_OBC_type(i,J) == SPECIFIED_OBC) then ! Northern specified OBC
4200	0	vhbt(i,J) = BT_OBC%vhbt(i,J)
4201	0	vbt(i,J) = BT_OBC%vbt_outer(i,J)
4202	0	vbt_trans(i,J) = vbt(i,J)
4203	0	if (integral_BT_cont) then
4204	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt(i,J)
4205	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4206		endif
4207	0	elseif (BT_OBC%v_OBC_type(i,J) == FLATHER_OBC) then ! Northern Flather OBC
4208	0	cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! CFL
4209	0	v_inlet = cflvbt_old(i,J-1) + (1.0-cfl)vbt_old(i,J) ! Valid for cfl<1
4210	0	if (J <= MS%jsdw) then
4211		! Do not apply a Northern Flather OBC at the southern halo points on a PE, as doing so would
4212		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4213	0	ssh_in = BT_OBC%SSH_outer_v(i,J)
4214	0	elseif (GV%Boussinesq) then
4215	0	ssh_in = GV%H_to_Z(eta(i,j) + (0.5-cfl)(eta(i,j)-eta(i,j-1))) ! internal
4216		else
4217	0	ssh_1 = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j) - (CS%bathyT(i,j) + G%Z_ref)
4218	0	ssh_2 = GV%H_to_RZ * eta(i,j-1) * SpV_avg(i,j-1) - (CS%bathyT(i,j-1) + G%Z_ref)
4219	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4220		endif
4221
4222	0	if (BT_OBC%dZ_v(i,J) > 0.0) then
4223	0	vel_prev = vbt(i,J)
4224		vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
4225	0	(BT_OBC%Cg_v(i,J)/BT_OBC%dZ_v(i,J)) * (ssh_in-BT_OBC%SSH_outer_v(i,J)))
4226	0	vbt_trans(i,J) = (1.0-bebt)vel_prev + bebtvbt(i,J)
4227		else ! This point is now dry
4228	0	vbt(i,J) = 0.0
4229	0	vbt_trans(i,J) = 0.0
4230		endif
4231	0	elseif (BT_OBC%v_OBC_type(i,J) == GRADIENT_OBC) then ! Northern gradient OBC
4232	0	vbt(i,J) = vbt(i,J-1)
4233	0	vbt_trans(i,J) = vbt(i,J)
4234		endif
4235
4236		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4237	0	if (BT_OBC%v_OBC_type(i,J) > SPECIFIED_OBC) then ! Northern Flather or gradient OBC
4238	0	if (integral_BT_cont) then
4239	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt_trans(i,J)
4240	0	vhbt_int_new = find_vhbt(vbt_int(i,J), BTCL_v(i,J)) + dt_elapsed*vhbt0(i,J)
4241	0	vhbt(i,J) = (vhbt_int_new - vhbt_int_prev(i,J)) * Idtbt
4242	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4243		! The line above is equivalent to: vhbt_int(i,J) = vhbt_int_new
4244	0	elseif (use_BT_cont) then
4245	0	vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J)) + vhbt0(i,J)
4246		else
4247	0	vhbt(i,J) = vbt_trans(i,J)*Datv(i,J) + vhbt0(i,J)
4248		endif
4249		endif
4250
4251		endif ; enddo ; enddo
4252
4253		! Work on Southern OBC points
4254	0	is = max(G%isc-halo, BT_OBC%is_v_S_obc) ; ie = min(G%iec+halo, BT_OBC%ie_v_S_obc)
4255	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)
4256	0	do J=Js_v,Je_v ; do i=is,ie ; if (BT_OBC%v_OBC_type(i,J) < 0) then
4257	0	if (BT_OBC%v_OBC_type(i,J) == -SPECIFIED_OBC) then ! Southern specified OBC
4258	0	vhbt(i,J) = BT_OBC%vhbt(i,J)
4259	0	vbt(i,J) = BT_OBC%vbt_outer(i,J)
4260	0	vbt_trans(i,J) = vbt(i,J)
4261	0	if (integral_BT_cont) then
4262	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt(i,J)
4263	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4264		endif
4265	0	elseif (BT_OBC%v_OBC_type(i,J) == -FLATHER_OBC) then ! Southern Flather OBC
4266	0	cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! CFL
4267	0	v_inlet = cflvbt_old(i,J+1) + (1.0-cfl)vbt_old(i,J) ! Valid for cfl <1
4268	0	if (J >= MS%jedw-1) then
4269		! Do not apply a Southern Flather OBC at the northern halo points on a PE, as doing so would
4270		! create a segmentation fault and this velocity will not propagate through to the next iteration.
4271	0	ssh_in = BT_OBC%SSH_outer_v(i,J)
4272	0	elseif (GV%Boussinesq) then
4273	0	ssh_in = GV%H_to_Z(eta(i,j+1) + (0.5-cfl)(eta(i,j+1)-eta(i,j+2))) ! internal
4274		else
4275	0	ssh_1 = GV%H_to_RZ * eta(i,j+1) * SpV_avg(i,j+1) - (CS%bathyT(i,j+1) + G%Z_ref)
4276	0	ssh_2 = GV%H_to_RZ * eta(i,j+2) * SpV_avg(i,j+2) - (CS%bathyT(i,j+2) + G%Z_ref)
4277	0	ssh_in = ssh_1 + (0.5-cfl)*(ssh_1-ssh_2) ! internal
4278		endif
4279
4280	0	if (BT_OBC%dZ_v(i,J) > 0.0) then
4281	0	vel_prev = vbt(i,J)
4282		vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + &
4283	0	(BT_OBC%Cg_v(i,J)/BT_OBC%dZ_v(i,J)) * (BT_OBC%SSH_outer_v(i,J)-ssh_in))
4284	0	vbt_trans(i,J) = (1.0-bebt)vel_prev + bebtvbt(i,J)
4285		else ! This point is now dry
4286	0	vbt(i,J) = 0.0
4287	0	vbt_trans(i,J) = 0.0
4288		endif
4289	0	elseif (BT_OBC%v_OBC_type(i,J) == -GRADIENT_OBC) then ! Southern gradient OBC
4290	0	vbt(i,J) = vbt(i,J+1)
4291	0	vbt_trans(i,J) = vbt(i,J)
4292		endif
4293
4294		! Reset transports and related time-inetegrated velocities with non-specified OBCs
4295	0	if (BT_OBC%v_OBC_type(i,J) < -SPECIFIED_OBC) then ! Southern Flather or gradient OBC
4296	0	if (integral_BT_cont) then
4297	0	vbt_int(i,J) = vbt_int_prev(i,J) + dtbt * vbt_trans(i,J)
4298	0	vhbt_int_new = find_vhbt(vbt_int(i,J), BTCL_v(i,J)) + dt_elapsed*vhbt0(i,J)
4299	0	vhbt(i,J) = (vhbt_int_new - vhbt_int_prev(i,J)) * Idtbt
4300	0	vhbt_int(i,J) = vhbt_int_prev(i,J) + dtbt * vhbt(i,J)
4301		! The line above is equivalent to: vhbt_int(i,J) = vhbt_int_new
4302	0	elseif (use_BT_cont) then
4303	0	vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J)) + vhbt0(i,J)
4304		else
4305	0	vhbt(i,J) = vbt_trans(i,J)*Datv(i,J) + vhbt0(i,J)
4306		endif
4307		endif
4308
4309		endif ; enddo ; enddo
4310
4311		end subroutine apply_v_velocity_OBCs
4312
4313		!> This subroutine sets up the time-invariant control information about the open boundary
4314		!! conditions on the full wide halo domain used by the barotropic solver.
4315	0	subroutine initialize_BT_OBC(OBC, BT_OBC, G, CS)
4316		type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type.
4317		type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
4318		!! related to the open boundary conditions,
4319		!! set by set_up_BT_OBC.
4320		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
4321		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
4322
4323		! Local variables
4324		real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
4325	0	u_OBC ! A set of integers encoding the nature of the u-point open boundary conditions,
4326		! converted to real numbers to work with the MOM6 halo update code [nondim]
4327		real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
4328	0	v_OBC ! A set of integers encoding the nature of the v-point open boundary conditions,
4329		! converted to real numbers to work with the MOM6 halo update code [nondim]
4330		integer :: OBC_type ! The integer encoding the type of OBC being used at a point [nondim]
4331		logical :: reversed_OBCs ! True of there any OBCs in the opposite halo on this PE, e.g. points
4332		! with a southern OBC in a northern halo.
4333		logical :: any_reversed_OBCs
4334		integer :: i, j, isdw, iedw, jsdw, jedw
4335		integer :: l_seg, Flather_OBC_in_halo
4336
4337	0	isdw = CS%isdw ; iedw = CS%iedw ; jsdw = CS%jsdw ; jedw = CS%jedw
4338
4339	0	u_OBC(:,:) = 0.0
4340	0	v_OBC(:,:) = 0.0
4341
4342	0	do j=G%jsc,G%jec ; do I=G%isc-1,G%iec
4343
4344	0	OBC_type = 0
4345	0	if (OBC%segnum_u(I,j) /= 0) then
4346	0	l_seg = abs(OBC%segnum_u(I,j))
4347	0	if (OBC%segment(l_seg)%gradient) OBC_type = GRADIENT_OBC
4348	0	if (OBC%segment(l_seg)%Flather) OBC_type = FLATHER_OBC
4349	0	if (OBC%segment(l_seg)%specified) OBC_type = SPECIFIED_OBC
4350	0	u_OBC(I,j) = sign(OBC_type, OBC%segnum_u(I,j))
4351		endif
4352		enddo ; enddo
4353
4354	0	do J=G%jsc-1,G%jec ; do i=G%isc,G%iec
4355	0	OBC_type = 0
4356	0	if (OBC%segnum_v(i,J) /= 0) then
4357	0	l_seg = abs(OBC%segnum_v(i,J))
4358	0	if (OBC%segment(l_seg)%gradient) OBC_type = GRADIENT_OBC
4359	0	if (OBC%segment(l_seg)%Flather) OBC_type = FLATHER_OBC
4360	0	if (OBC%segment(l_seg)%specified) OBC_type = SPECIFIED_OBC
4361	0	v_OBC(i,J) = sign(OBC_type, OBC%segnum_v(i,J))
4362		endif
4363		enddo ; enddo
4364
4365	0	call pass_vector(u_OBC, v_OBC, CS%BT_Domain)
4366
4367	0	allocate(BT_OBC%u_OBC_type(isdw-1:iedw,jsdw:jedw), source=0)
4368	0	allocate(BT_OBC%v_OBC_type(isdw:iedw,jsdw-1:jedw), source=0)
4369
4370		! Determine the maximum and minimum index range for various directions of OBC points on this PE
4371		! by first setting these one point outside of the wrong side of the domain.
4372	0	BT_OBC%Is_u_W_obc = iedw + 1 ; BT_OBC%Ie_u_W_obc = isdw - 2
4373	0	BT_OBC%js_u_W_obc = jedw + 1 ; BT_OBC%je_u_W_obc = jsdw - 1
4374	0	BT_OBC%Is_u_E_obc = iedw + 1 ; BT_OBC%Ie_u_E_obc = isdw - 2
4375	0	BT_OBC%js_u_E_obc = jedw + 1 ; BT_OBC%je_u_E_obc = jsdw - 1
4376	0	BT_OBC%is_v_S_obc = iedw + 1 ; BT_OBC%ie_v_S_obc = isdw - 1
4377	0	BT_OBC%Js_v_S_obc = jedw + 1 ; BT_OBC%Je_v_S_obc = jsdw - 2
4378	0	BT_OBC%is_v_N_obc = iedw + 1 ; BT_OBC%ie_v_N_obc = isdw - 1
4379	0	BT_OBC%Js_v_N_obc = jedw + 1 ; BT_OBC%Je_v_N_obc = jsdw - 2
4380
4381	0	Flather_OBC_in_halo = 0
4382	0	do j=jsdw,jedw ; do I=isdw-1,iedw
4383	0	BT_OBC%u_OBC_type(I,j) = nint(u_OBC(I,j))
4384	0	if (BT_OBC%u_OBC_type(I,j) < 0) then ! This point has OBC_DIRECTION_W.
4385	0	if ((BT_OBC%u_OBC_type(I,j) == -FLATHER_OBC) .and. (I >= iedw-1)) then
4386		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4387	0	Flather_OBC_in_halo = 1
4388		else
4389	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)
4390	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)
4391		endif
4392		endif
4393	0	if (BT_OBC%u_OBC_type(I,j) > 0) then ! This point has OBC_DIRECTION_E.
4394	0	if ((BT_OBC%u_OBC_type(I,j) == FLATHER_OBC) .and. (I <= isdw)) then
4395		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4396	0	Flather_OBC_in_halo = 1
4397		else
4398	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)
4399	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)
4400		endif
4401		endif
4402		enddo ; enddo
4403
4404	0	do J=jsdw-1,jedw ; do i=isdw,iedw
4405	0	BT_OBC%v_OBC_type(i,J) = nint(v_OBC(i,J))
4406	0	if (BT_OBC%v_OBC_type(i,J) < 0) then ! This point has OBC_DIRECTION_S.
4407	0	if ((BT_OBC%v_OBC_type(i,J) == -FLATHER_OBC) .and. (J >= jedw-1)) then
4408		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4409	0	Flather_OBC_in_halo = 1
4410		else
4411	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)
4412	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)
4413		endif
4414		endif
4415	0	if (BT_OBC%v_OBC_type(i,J) > 0) then ! This point has OBC_DIRECTION_N.
4416	0	if ((BT_OBC%v_OBC_type(i,J) == FLATHER_OBC) .and. (J <= jsdw)) then
4417		! There is no need to specify the OBC at this point, but the stencil might need to be increased.
4418	0	Flather_OBC_in_halo = 1
4419		else
4420	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)
4421	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)
4422		endif
4423		endif
4424		enddo ; enddo
4425
4426	0	BT_OBC%u_OBCs_on_PE = ((BT_OBC%Is_u_E_obc <= iedw) .or. (BT_OBC%Is_u_W_obc <= iedw))
4427	0	BT_OBC%v_OBCs_on_PE = ((BT_OBC%is_v_N_obc <= iedw) .or. (BT_OBC%is_v_S_obc <= iedw))
4428
4429
4430		! Determine whether there are any OBCs in the opposite halo on any processors in the domain, e.g.,
4431		! points with OBC_DIRECTION_S in a northern halo.
4432		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. &
4433	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)))
4434	0	any_reversed_OBCs = any_across_PEs(reversed_OBCs)
4435	0	if (any_reversed_OBCs) call MOM_mesg("OBCs in an opposite halo require the use of a wider stencil.", 5)
4436	0	if (any_reversed_OBCs) CS%min_stencil = max(CS%min_stencil, 2)
4437
4438		! Allocate time-varying arrays that will be used for open boundary conditions.
4439
4440		! This pair is used with either Flather or specified OBCs.
4441	0	allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw), source=0.0)
4442	0	allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw), source=0.0)
4443	0	call create_group_pass(BT_OBC%pass_uv, BT_OBC%ubt_outer, BT_OBC%vbt_outer, CS%BT_Domain)
4444
4445		! This pair is only used with specified OBCs.
4446	0	allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw), source=0.0)
4447	0	allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw), source=0.0)
4448	0	call create_group_pass(BT_OBC%pass_uv, BT_OBC%uhbt, BT_OBC%vhbt, CS%BT_Domain)
4449
4450	0	if (OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally) then
4451		! These 3 pairs are only used with Flather OBCs.
4452	0	allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw), source=0.0)
4453	0	allocate(BT_OBC%dZ_u(isdw-1:iedw,jsdw:jedw), source=0.0)
4454	0	allocate(BT_OBC%SSH_outer_u(isdw-1:iedw,jsdw:jedw), source=0.0)
4455
4456	0	allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw), source=0.0)
4457	0	allocate(BT_OBC%dZ_v(isdw:iedw,jsdw-1:jedw), source=0.0)
4458	0	allocate(BT_OBC%SSH_outer_v(isdw:iedw,jsdw-1:jedw), source=0.0)
4459
4460	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)
4461	0	call create_group_pass(BT_OBC%scalar_pass, BT_OBC%dZ_u, BT_OBC%dZ_v, CS%BT_Domain, To_All+Scalar_Pair)
4462	0	call create_group_pass(BT_OBC%scalar_pass, BT_OBC%Cg_u, BT_OBC%Cg_v, CS%BT_Domain, To_All+Scalar_Pair)
4463		endif
4464
4465	0	end subroutine initialize_BT_OBC
4466
4467		!> This subroutine sets up the time-varying fields in the private structure used to apply the open
4468		!! boundary conditions, as developed by Mehmet Ilicak.
4469	0	subroutine set_up_BT_OBC(OBC, eta, SpV_avg, BT_OBC, BT_Domain, G, GV, US, CS, MS, halo, use_BT_cont, &
4470	0	integral_BT_cont, dt_baroclinic, Datu, Datv, BTCL_u, BTCL_v, dgeo_de)
4471		type(ocean_OBC_type), target, intent(inout) :: OBC !< An associated pointer to an OBC type.
4472		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the
4473		!! argument arrays.
4474		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
4475		!! column mass anomaly [H ~> m or kg m-2].
4476		real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: SpV_avg !< The column average specific volume [R-1 ~> m3 kg-1]
4477		type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
4478		!! related to the open boundary conditions,
4479		!! set by set_up_BT_OBC.
4480		type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
4481		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
4482		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4483		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
4484		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
4485		integer, intent(in) :: halo !< The extra halo size to use here.
4486		logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
4487		!! transports.
4488		logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity
4489		!! equation directly from the initial condition
4490		!! using the time-integrated barotropic velocity.
4491		real, intent(in) :: dt_baroclinic !< The baroclinic timestep for this cycle of
4492		!! updates to the barotropic solver [T ~> s]
4493		real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
4494		!! [H L ~> m2 or kg m-1].
4495		real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
4496		!! [H L ~> m2 or kg m-1].
4497		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
4498		!! for a dynamic estimate of the face areas at
4499		!! u-points.
4500		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
4501		!! for a dynamic estimate of the face areas at
4502		!! v-points.
4503		real, intent(in) :: dgeo_de !< The constant of proportionality between
4504		!! geopotential and sea surface height [nondim].
4505		! Local variables
4506		real :: I_dt ! The inverse of the time interval of this call [T-1 ~> s-1].
4507		integer :: i, j, k, is, ie, js, je, n, nz
4508		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
4509		integer :: isdw, iedw, jsdw, jedw
4510		type(OBC_segment_type), pointer :: segment !< Open boundary segment
4511
4512	0	is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo
4513	0	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke
4514	0	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
4515	0	isdw = MS%isdw ; iedw = MS%iedw ; jsdw = MS%jsdw ; jedw = MS%jedw
4516
4517	0	I_dt = 1.0 / dt_baroclinic
4518
4519	0	if (BT_OBC%u_OBCs_on_PE) then
4520	0	if (OBC%specified_u_BCs_exist_globally) then
4521	0	do n = 1, OBC%number_of_segments
4522	0	segment => OBC%segment(n)
4523	0	if (segment%is_E_or_W .and. segment%specified) then
4524	0	do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
4525	0	BT_OBC%uhbt(I,j) = 0.
4526		enddo ; enddo
4527	0	do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
4528	0	BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k)
4529		enddo ; enddo ; enddo
4530		endif
4531		enddo
4532		endif
4533	0	do j=js,je ; do I=is-1,ie ; if (BT_OBC%u_OBC_type(I,j) /= 0) then
4534	0	if (abs(BT_OBC%u_OBC_type(I,j)) == SPECIFIED_OBC) then ! Eastern or western specified OBC
4535	0	if (integral_BT_cont) then
4536	0	BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j)dt_baroclinic, BTCL_u(I,j)) I_dt
4537	0	elseif (use_BT_cont) then
4538	0	BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j), BTCL_u(I,j))
4539		else
4540	0	if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j)
4541		endif
4542	0	elseif (BT_OBC%u_OBC_type(I,j) == FLATHER_OBC) then ! Eastern Flather OBC
4543	0	if (GV%Boussinesq) then
4544	0	BT_OBC%dZ_u(I,j) = CS%bathyT(i,j) + GV%H_to_Z*eta(i,j)
4545		else
4546	0	BT_OBC%dZ_u(I,j) = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j)
4547		endif
4548	0	BT_OBC%Cg_u(I,j) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_u(I,j))
4549	0	elseif (BT_OBC%u_OBC_type(I,j) == -FLATHER_OBC) then ! Western Flather OBC
4550	0	if (GV%Boussinesq) then
4551	0	BT_OBC%dZ_u(I,j) = CS%bathyT(i+1,j) + GV%H_to_Z*eta(i+1,j)
4552		else
4553	0	BT_OBC%dZ_u(I,j) = GV%H_to_RZ * eta(i+1,j) * SpV_avg(i+1,j)
4554		endif
4555	0	BT_OBC%Cg_u(I,j) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_u(I,j))
4556		endif
4557		endif ; enddo ; enddo
4558
4559	0	if (OBC%Flather_u_BCs_exist_globally) then
4560	0	do n = 1, OBC%number_of_segments
4561	0	segment => OBC%segment(n)
4562	0	if (segment%is_E_or_W .and. segment%Flather) then
4563	0	do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
4564	0	BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j)
4565	0	BT_OBC%SSH_outer_u(I,j) = segment%SSH(I,j) + G%Z_ref
4566		enddo ; enddo
4567		endif
4568		enddo
4569		endif
4570		endif
4571
4572	0	if (BT_OBC%v_OBCs_on_PE) then
4573	0	if (OBC%specified_v_BCs_exist_globally) then
4574	0	do n = 1, OBC%number_of_segments
4575	0	segment => OBC%segment(n)
4576	0	if (segment%is_N_or_S .and. segment%specified) then
4577	0	do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
4578	0	BT_OBC%vhbt(i,J) = 0.
4579		enddo ; enddo
4580	0	do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
4581	0	BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k)
4582		enddo ; enddo ; enddo
4583		endif
4584		enddo
4585		endif
4586	0	do J=js-1,je ; do i=is,ie ; if (BT_OBC%v_OBC_type(i,J) /= 0) then
4587	0	if (abs(BT_OBC%v_OBC_type(i,J)) == SPECIFIED_OBC) then ! Northern or southern specified OBC
4588	0	if (integral_BT_cont) then
4589	0	BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J)dt_baroclinic, BTCL_v(i,J)) I_dt
4590	0	elseif (use_BT_cont) then
4591	0	BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J), BTCL_v(i,J))
4592		else
4593	0	if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J)
4594		endif
4595	0	elseif (BT_OBC%v_OBC_type(i,J) == FLATHER_OBC) then ! Northern Flather OBC
4596	0	if (GV%Boussinesq) then
4597	0	BT_OBC%dZ_v(i,J) = CS%bathyT(i,j) + GV%H_to_Z*eta(i,j)
4598		else
4599	0	BT_OBC%dZ_v(i,J) = GV%H_to_RZ * eta(i,j) * SpV_avg(i,j)
4600		endif
4601	0	BT_OBC%Cg_v(i,J) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_v(i,J))
4602	0	elseif (BT_OBC%v_OBC_type(i,J) == -FLATHER_OBC) then ! Southern Flather OBC
4603	0	if (GV%Boussinesq) then
4604	0	BT_OBC%dZ_v(i,J) = CS%bathyT(i,j+1) + GV%H_to_Z*eta(i,j+1)
4605		else
4606	0	BT_OBC%dZ_v(i,J) = GV%H_to_RZ * eta(i,j+1) * SpV_avg(i,j+1)
4607		endif
4608	0	BT_OBC%Cg_v(i,J) = SQRT(dgeo_de * GV%g_prime(1) * BT_OBC%dZ_v(i,J))
4609		endif
4610		endif ; enddo ; enddo
4611	0	if (OBC%Flather_v_BCs_exist_globally) then
4612	0	do n = 1, OBC%number_of_segments
4613	0	segment => OBC%segment(n)
4614	0	if (segment%is_N_or_S .and. segment%Flather) then
4615	0	do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
4616	0	BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J)
4617	0	BT_OBC%SSH_outer_v(i,J) = segment%SSH(i,J) + G%Z_ref
4618		enddo ; enddo
4619		endif
4620		enddo
4621		endif
4622		endif
4623
4624	0	call do_group_pass(BT_OBC%pass_uv, BT_Domain)
4625	0	if (OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally) &
4626	0	call do_group_pass(BT_OBC%scalar_pass, BT_Domain)
4627
4628	0	end subroutine set_up_BT_OBC
4629
4630		!> Clean up the BT_OBC memory.
4631	1	subroutine destroy_BT_OBC(BT_OBC)
4632		type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
4633		!! related to the open boundary conditions,
4634		!! set by set_up_BT_OBC.
4635
4636	1	if (allocated(BT_OBC%u_OBC_type)) deallocate(BT_OBC%u_OBC_type)
4637	1	if (allocated(BT_OBC%v_OBC_type)) deallocate(BT_OBC%v_OBC_type)
4638
4639	1	if (allocated(BT_OBC%Cg_u)) deallocate(BT_OBC%Cg_u)
4640	1	if (allocated(BT_OBC%dZ_u)) deallocate(BT_OBC%dZ_u)
4641	1	if (allocated(BT_OBC%uhbt)) deallocate(BT_OBC%uhbt)
4642	1	if (allocated(BT_OBC%ubt_outer)) deallocate(BT_OBC%ubt_outer)
4643	1	if (allocated(BT_OBC%SSH_outer_u)) deallocate(BT_OBC%SSH_outer_u)
4644
4645	1	if (allocated(BT_OBC%Cg_v)) deallocate(BT_OBC%Cg_v)
4646	1	if (allocated(BT_OBC%dZ_v)) deallocate(BT_OBC%dZ_v)
4647	1	if (allocated(BT_OBC%vhbt)) deallocate(BT_OBC%vhbt)
4648	1	if (allocated(BT_OBC%vbt_outer)) deallocate(BT_OBC%vbt_outer)
4649	1	if (allocated(BT_OBC%SSH_outer_v)) deallocate(BT_OBC%SSH_outer_v)
4650
4651	1	end subroutine destroy_BT_OBC
4652
4653		!> btcalc determines the fraction of the total water column in each
4654		!! layer at velocity points.
4655	2880	subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC)
4656		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
4657		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4658		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
4659		intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
4660		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
4661		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
4662		optional, intent(in) :: h_u !< The specified effective thicknesses at u-points,
4663		!! perhaps scaled down to account for viscosity and
4664		!! fractional open areas [H ~> m or kg m-2]. These
4665		!! are used here as non-normalized weights for each
4666		!! layer that are converted the normalized weights
4667		!! for determining the barotropic accelerations.
4668		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
4669		optional, intent(in) :: h_v !< The specified effective thicknesses at v-points,
4670		!! perhaps scaled down to account for viscosity and
4671		!! fractional open areas [H ~> m or kg m-2]. These
4672		!! are used here as non-normalized weights for each
4673		!! layer that are converted the normalized weights
4674		!! for determining the barotropic accelerations.
4675		logical, optional, intent(in) :: may_use_default !< An optional logical argument
4676		!! to indicate that the default velocity point
4677		!! thicknesses may be used for this particular
4678		!! calculation, even though the setting of
4679		!! CS%hvel_scheme would usually require that h_u
4680		!! and h_v be passed in.
4681		type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure.
4682
4683		! Local variables
4684	2882	real :: hatutot(SZIB_(G),SZJ_(G)) ! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2].
4685	2882	real :: hatvtot(SZI_(G),SZJB_(G)) ! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2].
4686	2882	real :: Ihatutot(SZIB_(G),SZJ_(G)) ! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1].
4687	2882	real :: Ihatvtot(SZI_(G),SZJB_(G)) ! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1].
4688		real :: h_arith ! The arithmetic mean thickness [H ~> m or kg m-2].
4689		real :: h_harm ! The harmonic mean thicknesses [H ~> m or kg m-2].
4690		real :: h_neglect ! A thickness that is so small it is usually lost
4691		! in roundoff and can be neglected [H ~> m or kg m-2].
4692		real :: wt_arith ! The weight for the arithmetic mean thickness [nondim].
4693		! The harmonic mean uses a weight of (1 - wt_arith).
4694	2882	real :: e_u(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! The interface heights at u-velocity points [H ~> m or kg m-2]
4695	2882	real :: e_v(SZI_(G),SZJB_(G),SZK_(GV)+1) ! The interface heights at v-velocity points [H ~> m or kg m-2]
4696	1441	real :: D_shallow_u(SZI_(G),SZJB_(G)) ! The height of the shallower of the adjacent bathymetric depths
4697		! around a u-point (positive upward) [H ~> m or kg m-2]
4698	1441	real :: D_shallow_v(SZIB_(G),SZJ_(G))! The height of the shallower of the adjacent bathymetric depths
4699		! around a v-point (positive upward) [H ~> m or kg m-2]
4700		real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3]
4701
4702		logical :: use_default, test_dflt
4703		integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k
4704
4705	1441	if (.not.CS%module_is_initialized) call MOM_error(FATAL, &
4706	0	"btcalc: Module MOM_barotropic must be initialized before it is used.")
4707
4708	1441	if (.not.CS%split) return
4709
4710	1441	use_default = .false.
4711	1441	test_dflt = .false. ; if (present(may_use_default)) test_dflt = may_use_default
4712
4713	1441	if (test_dflt) then
4714	1	if (.not.((present(h_u) .and. present(h_v)) .or. &
4715		(CS%hvel_scheme == HARMONIC) .or. (CS%hvel_scheme == HYBRID) .or.&
4716	1	(CS%hvel_scheme == ARITHMETIC))) use_default = .true.
4717		else
4718	1440	if (.not.((present(h_u) .and. present(h_v)) .or. &
4719		(CS%hvel_scheme == HARMONIC) .or. (CS%hvel_scheme == HYBRID) .or.&
4720		(CS%hvel_scheme == ARITHMETIC))) call MOM_error(FATAL, &
4721	0	"btcalc: Inconsistent settings of optional arguments and hvel_scheme.")
4722		endif
4723
4724	1441	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
4725	1441	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
4726	1441	h_neglect = GV%H_subroundoff
4727
4728		!$omp target enter data map(alloc: hatutot, hatvtot, Ihatutot, Ihatvtot)
4729
4730	1441	do concurrent (j=js:je, I=is-1:ie)
4731	2660086	hatutot(I,j) = 0.0
4732		enddo
4733
4734	1441	if (present(h_u)) then
4735	1440	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4736	26490336	CS%frhatu(I,j,k) = h_u(I,j,k)
4737		enddo
4738	1440	do concurrent (j=js:je, I=is-1:ie)
4739	26490336	do k=1,nz
4740	26484480	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4741		enddo
4742		enddo
4743	1	elseif (CS%hvel_scheme == ARITHMETIC) then
4744	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4745	0	CS%frhatu(I,j,k) = 0.5 * (h(i+1,j,k) + h(i,j,k))
4746		enddo
4747	0	do concurrent (j=js:je, I=is-1:ie)
4748	0	do k=1,nz
4749	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4750		enddo
4751		enddo
4752	1	elseif (CS%hvel_scheme == HYBRID .or. use_default) then
4753	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
4754		!$omp target data map(alloc: e_u, D_shallow_u)
4755	1	do concurrent (j=js:je, I=is-1:ie)
4756	64980	e_u(I,j,nz+1) = -0.5 * Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j))
4757	65342	D_shallow_u(I,j) = -Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j))
4758		enddo
4759	76	do k=nz,1,-1
4760	1	do concurrent (j=js:je, I=is-1:ie)
4761	1429560	e_u(I,j,K) = e_u(I,j,K+1) + 0.5 * (h(i+1,j,k) + h(i,j,k))
4762	1429560	h_arith = 0.5 * (h(i+1,j,k) + h(i,j,k))
4763	1429560	if (e_u(I,j,K+1) >= D_shallow_u(I,j)) then
4764	1306952	CS%frhatu(I,j,k) = h_arith
4765		else
4766	132962	h_harm = (h(i+1,j,k) * h(i,j,k)) / (h_arith + h_neglect)
4767	132962	if (e_u(I,j,K) <= D_shallow_u(I,j)) then
4768	127894	CS%frhatu(I,j,k) = h_harm
4769		else
4770	46348	wt_arith = (e_u(I,j,K) - D_shallow_u(I,j)) / (h_arith + h_neglect)
4771	46348	CS%frhatu(I,j,k) = wt_arithh_arith + (1.0-wt_arith)h_harm
4772		endif
4773		endif
4774	1437524	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4775		enddo
4776		enddo
4777		!$omp end target data
4778	0	elseif (CS%hvel_scheme == HARMONIC) then
4779		! Interpolates thicknesses onto u grid points with the
4780		! second order accurate estimate h = 2(h+ h-)/(h+ + h-).
4781	0	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4782		CS%frhatu(I,j,k) = 2.0(h(i+1,j,k) h(i,j,k)) / &
4783	0	((h(i+1,j,k) + h(i,j,k)) + h_neglect)
4784		enddo
4785	0	do concurrent (j=js:je, I=is-1:ie)
4786	0	do k=1,nz
4787	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4788		enddo
4789		enddo
4790		endif
4791
4792	1441	if (CS%BT_OBC%u_OBCs_on_PE) then
4793		! todo: put i,j iterations into single do concurrent
4794	0	do concurrent (j=js:je)
4795		! Reset velocity point thicknesses and their sums at OBC points
4796	0	if ((j >= CS%BT_OBC%js_u_E_obc) .and. (j <= CS%BT_OBC%je_u_E_obc)) then
4797		!$omp do
4798	0	do I = max(is-1,CS%BT_OBC%Is_u_E_obc), min(ie,CS%BT_OBC%Ie_u_E_obc)
4799	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) then ! Eastern boundary condition
4800	0	hatutot(I,j) = 0.0
4801	0	do k=1,nz
4802	0	CS%frhatu(I,j,k) = h(i,j,k)
4803	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4804		enddo
4805		endif
4806		enddo
4807		endif
4808	0	if ((j >= CS%BT_OBC%js_u_W_obc) .and. (j <= CS%BT_OBC%je_u_W_obc)) then
4809		!$omp do
4810	0	do I = max(is-1,CS%BT_OBC%Is_u_W_obc), min(ie,CS%BT_OBC%Ie_u_W_obc)
4811	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) then ! Western boundary condition
4812	0	hatutot(I,j) = 0.0
4813	0	do k=1,nz
4814	0	CS%frhatu(I,j,k) = h(i+1,j,k)
4815	0	hatutot(I,j) = hatutot(I,j) + CS%frhatu(I,j,k)
4816		enddo
4817		endif
4818		enddo
4819		endif
4820		enddo
4821		endif
4822
4823		! Determine the fractional thickness of each layer at the velocity points.
4824	1441	do concurrent (j=js:je, I=is-1:ie)
4825	2660086	Ihatutot(I,j) = G%mask2dCu(I,j) / (hatutot(I,j) + h_neglect)
4826		enddo
4827	1441	do concurrent (k=1:nz, j=js:je, I=is-1:ie)
4828	27042218	CS%frhatu(I,j,k) = CS%frhatu(I,j,k) * Ihatutot(I,j)
4829		enddo
4830
4831	1441	do concurrent (J=js-1:je, i=is:ie)
4832	2664409	hatvtot(i,J) = 0.0
4833		enddo
4834
4835	1441	if (present(h_v)) then
4836	1440	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4837	26709168	CS%frhatv(i,J,k) = h_v(i,J,k)
4838		enddo
4839	1440	do concurrent (J=js-1:je, i=is:ie)
4840	26709168	do k=1,nz
4841	26703360	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4842		enddo
4843		enddo
4844	1	elseif (CS%hvel_scheme == ARITHMETIC) then
4845	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4846	0	CS%frhatv(i,J,k) = 0.5 * (h(i,j+1,k) + h(i,j,k))
4847		enddo
4848	0	do concurrent (J=js-1:je, i=is:ie)
4849	0	do k=1,nz
4850	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4851		enddo
4852		enddo
4853	1	elseif (CS%hvel_scheme == HYBRID .or. use_default) then
4854	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
4855		!$omp target data map(alloc: e_v, D_shallow_v)
4856	1	do concurrent (J=js-1:je, i=is:ie)
4857	65160	e_v(i,J,nz+1) = -0.5 * Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j))
4858	65521	D_shallow_v(i,J) = -Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j))
4859		enddo
4860	76	do k=nz,1,-1
4861	1	do concurrent (J=js-1:je, i=is:ie)
4862	1433520	e_v(i,J,K) = e_v(i,J,K+1) + 0.5 * (h(i,j+1,k) + h(i,j,k))
4863	1433520	h_arith = 0.5 * (h(i,j+1,k) + h(i,j,k))
4864	1433520	if (e_v(i,J,K+1) >= D_shallow_v(i,J)) then
4865	1306304	CS%frhatv(i,J,k) = h_arith
4866		else
4867	137386	h_harm = (h(i,j+1,k) * h(i,j,k)) / (h_arith + h_neglect)
4868	137386	if (e_v(i,J,K) <= D_shallow_v(i,J)) then
4869	132252	CS%frhatv(i,J,k) = h_harm
4870		else
4871	46610	wt_arith = (e_v(i,J,K) - D_shallow_v(i,J)) / (h_arith + h_neglect)
4872	46610	CS%frhatv(i,J,k) = wt_arithh_arith + (1.0-wt_arith)h_harm
4873		endif
4874		endif
4875	1441462	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4876		enddo
4877		enddo
4878		!$omp end target data
4879	0	elseif (CS%hvel_scheme == HARMONIC) then
4880	0	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4881		CS%frhatv(i,J,k) = 2.0(h(i,j+1,k) h(i,j,k)) / &
4882	0	((h(i,j+1,k) + h(i,j,k)) + h_neglect)
4883		enddo
4884	0	do concurrent (J=js-1:je, i=is:ie)
4885	0	do k=1,nz
4886	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4887		enddo
4888		enddo
4889		endif
4890
4891	1441	if (CS%BT_OBC%v_OBCs_on_PE) then
4892		! todo: put i,j iterations into single do concurrent
4893	0	do concurrent (J=js-1:je)
4894		! Reset v-velocity point thicknesses and their sums at OBC points
4895	0	if ((J >= CS%BT_OBC%Js_v_N_obc) .and. (J <= CS%BT_OBC%Je_v_N_obc)) then
4896		!$omp do simd
4897	0	do i = max(is,CS%BT_OBC%is_v_N_obc), min(ie,CS%BT_OBC%ie_v_N_obc)
4898	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) then ! Northern boundary condition
4899	0	hatvtot(i,J) = 0.0
4900	0	do k=1,nz
4901	0	CS%frhatv(i,J,k) = h(i,j,k)
4902	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4903		enddo
4904		endif
4905		enddo
4906		endif
4907	0	if ((J >= CS%BT_OBC%Js_v_S_obc) .and. (J <= CS%BT_OBC%Je_v_S_obc)) then
4908		!$omp do simd
4909	0	do i = max(is,CS%BT_OBC%is_v_S_obc), min(ie,CS%BT_OBC%ie_v_S_obc)
4910	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) then ! Southern boundary condition
4911	0	hatvtot(i,J) = 0.0
4912	0	do k=1,nz
4913	0	CS%frhatv(i,J,k) = h(i,j+1,k)
4914	0	hatvtot(i,J) = hatvtot(i,J) + CS%frhatv(i,J,k)
4915		enddo
4916		endif
4917		enddo
4918		endif
4919		enddo
4920		endif
4921
4922		! Determine the fractional thickness of each layer at the velocity points.
4923	1441	do concurrent (J=js-1:je, i=is:ie)
4924	2664409	Ihatvtot(i,J) = G%mask2dCv(i,J) / (hatvtot(i,J) + h_neglect)
4925		enddo
4926	1441	do concurrent (k=1:nz, J=js-1:je, i=is:ie)
4927	27265609	CS%frhatv(i,J,k) = CS%frhatv(i,J,k) * Ihatvtot(i,J)
4928		enddo
4929
4930		!$omp target exit data map(delete: hatutot, hatvtot, Ihatutot, Ihatvtot)
4931
4932	1441	if (CS%debug) then
4933		!$omp target update from(CS%frhatu, CS%frhatv)
4934		call uvchksum("btcalc frhat[uv]", CS%frhatu, CS%frhatv, G%HI, &
4935		haloshift=0, symmetric=.true., omit_corners=.true., &
4936	0	scalar_pair=.true.)
4937
4938	0	if (present(h_u) .and. present(h_v)) then
4939		!$omp target update from(h_u, h_v)
4940		call uvchksum("btcalc h_[uv]", h_u, h_v, G%HI, haloshift=0, &
4941		symmetric=.true., omit_corners=.true., unscale=GV%H_to_MKS, &
4942	0	scalar_pair=.true.)
4943		endif
4944
4945	0	call hchksum(h, "btcalc h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
4946		endif
4947	2881	end subroutine btcalc
4948
4949		!> The function find_uhbt determines the zonal transport for a given velocity, or with
4950		!! INTEGRAL_BT_CONT=True it determines the time-integrated zonal transport for a given
4951		!! time-integrated velocity.
4952	17040384	pure function find_uhbt(u, BTC) result(uhbt)
4953		real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
4954		type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
4955		!! allow the barotropic transports to be calculated consistently
4956		!! with the layers' continuity equations. The dimensions of some
4957		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
4958
4959		real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1] or time integrated transport [L2 H ~> m3]
4960
4961	17040384	if (u == 0.0) then
4962	2979411	uhbt = 0.0
4963	14913224	elseif (u < BTC%uBT_EE) then
4964	6587044	uhbt = (u - BTC%uBT_EE) * BTC%FA_u_EE + BTC%uh_EE
4965	8326180	elseif (u < 0.0) then
4966	4827279	uhbt = u * (BTC%FA_u_E0 + BTC%uh_crvE * u**2)
4967	7921948	elseif (u <= BTC%uBT_WW) then
4968	2087697	uhbt = u * (BTC%FA_u_W0 + BTC%uh_crvW * u**2)
4969		else ! (u > BTC%uBT_WW)
4970	7340287	uhbt = (u - BTC%uBT_WW) * BTC%FA_u_WW + BTC%uh_WW
4971		endif
4972
4973	17040384	end function find_uhbt
4974
4975		!> The function find_duhbt_du determines the marginal zonal face area for a given velocity, or
4976		!! with INTEGRAL_BT_CONT=True for a given time-integrated velocity.
4977	0	pure function find_duhbt_du(u, BTC) result(duhbt_du)
4978		real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
4979		type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
4980		!! allow the barotropic transports to be calculated consistently
4981		!! with the layers' continuity equations. The dimensions of some
4982		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
4983		real :: duhbt_du !< The zonal barotropic face area [L H ~> m2 or kg m-1]
4984
4985	0	if (u == 0.0) then
4986	0	duhbt_du = 0.5*(BTC%FA_u_E0 + BTC%FA_u_W0) ! Note the potential discontinuity here.
4987	0	elseif (u < BTC%uBT_EE) then
4988	0	duhbt_du = BTC%FA_u_EE
4989	0	elseif (u < 0.0) then
4990	0	duhbt_du = (BTC%FA_u_E0 + 3.0BTC%uh_crvE u**2)
4991	0	elseif (u <= BTC%uBT_WW) then
4992	0	duhbt_du = (BTC%FA_u_W0 + 3.0BTC%uh_crvW u**2)
4993		else ! (u > BTC%uBT_WW)
4994	0	duhbt_du = BTC%FA_u_WW
4995		endif
4996
4997	0	end function find_duhbt_du
4998
4999		!> This function inverts the transport function to determine the barotopic
5000		!! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True
5001		!! this finds the time-integrated velocity that is consistent with a time-integrated transport.
5002	0	function uhbt_to_ubt(uhbt, BTC) result(ubt)
5003		real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for,
5004		!! [H L2 T-1 ~> m3 s-1 or kg s-1] or the time-integrated
5005		!! transport [H L2 ~> m3 or kg].
5006		type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the
5007		!! barotropic transports to be calculated consistently with the
5008		!! layers' continuity equations. The dimensions of some
5009		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5010		real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]
5011		!! or the time-integrated velocity [L ~> m].
5012
5013		! Local variables
5014		real :: ubt_min, ubt_max ! Bounding values of vbt [L T-1 ~> m s-1] or [L ~> m]
5015		real :: uhbt_err ! The transport error [H L2 T-1 ~> m3 s-1 or kg s-1] or [H L2 ~> m3 or kg].
5016		real :: derr_du ! The change in transport error with vbt, i.e. the face area [H L ~> m2 or kg m-1].
5017		real :: uherr_min, uherr_max ! The bounding values of the transport error [H L2 T-1 ~> m3 s-1 or kg s-1]
5018		! or [H L2 ~> m3 or kg].
5019		real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
5020		real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
5021		real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
5022		! maximum increase of vs2, both [nondim].
5023		integer :: itt, max_itt = 20
5024
5025		! Find the value of ubt that gives uhbt.
5026	0	if (uhbt == 0.0) then
5027	0	ubt = 0.0
5028	0	elseif (uhbt < BTC%uh_EE) then
5029	0	ubt = BTC%uBT_EE + (uhbt - BTC%uh_EE) / BTC%FA_u_EE
5030	0	elseif (uhbt < 0.0) then
5031		! Iterate to convergence with Newton's method (when bounded) and the
5032		! false position method otherwise. ubt will be negative.
5033	0	ubt_min = BTC%uBT_EE ; uherr_min = BTC%uh_EE - uhbt
5034	0	ubt_max = 0.0 ; uherr_max = -uhbt
5035		! Use a false-position method first guess.
5036	0	ubt = BTC%uBT_EE * (uhbt / BTC%uh_EE)
5037	0	do itt = 1, max_itt
5038	0	uhbt_err = ubt * (BTC%FA_u_E0 + BTC%uh_crvE * ubt**2) - uhbt
5039
5040	0	if (abs(uhbt_err) < tol*abs(uhbt)) exit
5041	0	if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
5042	0	if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
5043
5044	0	derr_du = BTC%FA_u_E0 + 3.0 * BTC%uh_crvE * ubt**2
5045		if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
5046	0	(-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
5047		! Use a false-position method guess.
5048	0	ubt = ubt_max + (ubt_min-ubt_max) * (uherr_max / (uherr_max-uherr_min))
5049		else ! Use Newton's method.
5050	0	ubt = ubt - uhbt_err / derr_du
5051	0	if (abs(uhbt_err) < (0.01tol)abs(ubt_min*derr_du)) exit
5052		endif
5053		enddo
5054	0	elseif (uhbt <= BTC%uh_WW) then
5055		! Iterate to convergence with Newton's method. ubt will be positive.
5056	0	ubt_min = 0.0 ; uherr_min = -uhbt
5057	0	ubt_max = BTC%uBT_WW ; uherr_max = BTC%uh_WW - uhbt
5058		! Use a false-position method first guess.
5059	0	ubt = BTC%uBT_WW * (uhbt / BTC%uh_WW)
5060	0	do itt = 1, max_itt
5061	0	uhbt_err = ubt * (BTC%FA_u_W0 + BTC%uh_crvW * ubt**2) - uhbt
5062
5063	0	if (abs(uhbt_err) < tol*abs(uhbt)) exit
5064	0	if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
5065	0	if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
5066
5067	0	derr_du = BTC%FA_u_W0 + 3.0 * BTC%uh_crvW * ubt**2
5068		if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
5069	0	(-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
5070		! Use a false-position method guess.
5071	0	ubt = ubt_min + (ubt_max-ubt_min) * (-uherr_min / (uherr_max-uherr_min))
5072		else ! Use Newton's method.
5073	0	ubt = ubt - uhbt_err / derr_du
5074	0	if (abs(uhbt_err) < (0.01tol)(ubt_max*derr_du)) exit
5075		endif
5076		enddo
5077		else ! (uhbt > BTC%uh_WW)
5078	0	ubt = BTC%uBT_WW + (uhbt - BTC%uh_WW) / BTC%FA_u_WW
5079		endif
5080
5081	0	end function uhbt_to_ubt
5082
5083		!> The function find_vhbt determines the meridional transport for a given velocity, or with
5084		!! INTEGRAL_BT_CONT=True it determines the time-integrated meridional transport for a given
5085		!! time-integrated velocity.
5086	17069184	pure function find_vhbt(v, BTC) result(vhbt)
5087		real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
5088		type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that
5089		!! allow the barotropic transports to be calculated consistently
5090		!! with the layers' continuity equations. The dimensions of some
5091		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5092		real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1] or time integrated transport [L2 H ~> m3]
5093
5094	17069184	if (v == 0.0) then
5095	3031074	vhbt = 0.0
5096	14884073	elseif (v < BTC%vBT_NN) then
5097	7636829	vhbt = (v - BTC%vBT_NN) * BTC%FA_v_NN + BTC%vh_NN
5098	7247244	elseif (v < 0.0) then
5099	986993	vhbt = v * (BTC%FA_v_N0 + BTC%vh_crvN * v**2)
5100	6772144	elseif (v <= BTC%vBT_SS) then
5101	1734284	vhbt = v * (BTC%FA_v_S0 + BTC%vh_crvS * v**2)
5102		else ! (v > BTC%vBT_SS)
5103	5918248	vhbt = (v - BTC%vBT_SS) * BTC%FA_v_SS + BTC%vh_SS
5104		endif
5105
5106	17069184	end function find_vhbt
5107
5108		!> The function find_dvhbt_dv determines the marginal meridional face area for a given velocity, or
5109		!! with INTEGRAL_BT_CONT=True for a given time-integrated velocity.
5110	0	pure function find_dvhbt_dv(v, BTC) result(dvhbt_dv)
5111		real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1] or time integrated velocity [L ~> m]
5112		type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that
5113		!! allow the barotropic transports to be calculated consistently
5114		!! with the layers' continuity equations. The dimensions of some
5115		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5116		real :: dvhbt_dv !< The meridional barotropic face area [L H ~> m2 or kg m-1]
5117
5118	0	if (v == 0.0) then
5119	0	dvhbt_dv = 0.5*(BTC%FA_v_N0 + BTC%FA_v_S0) ! Note the potential discontinuity here.
5120	0	elseif (v < BTC%vBT_NN) then
5121	0	dvhbt_dv = BTC%FA_v_NN
5122	0	elseif (v < 0.0) then
5123	0	dvhbt_dv = BTC%FA_v_N0 + 3.0BTC%vh_crvN v**2
5124	0	elseif (v <= BTC%vBT_SS) then
5125	0	dvhbt_dv = BTC%FA_v_S0 + 3.0BTC%vh_crvS v**2
5126		else ! (v > BTC%vBT_SS)
5127	0	dvhbt_dv = BTC%FA_v_SS
5128		endif
5129
5130	0	end function find_dvhbt_dv
5131
5132		!> This function inverts the transport function to determine the barotopic
5133		!! velocity that is consistent with a given transport, or if INTEGRAL_BT_CONT=True
5134		!! this finds the time-integrated velocity that is consistent with a time-integrated transport.
5135	0	function vhbt_to_vbt(vhbt, BTC) result(vbt)
5136		real, intent(in) :: vhbt !< The barotropic meridional transport that should be
5137		!! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1] or the
5138		!! time-integrated transport [H L2 ~> m3 or kg].
5139		type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the
5140		!! barotropic transports to be calculated consistently
5141		!! with the layers' continuity equations. The dimensions of some
5142		!! of the elements in this type vary depending on INTEGRAL_BT_CONT.
5143		real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1]
5144		!! or the time-integrated velocity [L ~> m].
5145
5146		! Local variables
5147		real :: vbt_min, vbt_max ! Bounding values of vbt [L T-1 ~> m s-1] or [L ~> m]
5148		real :: vhbt_err ! The transport error [H L2 T-1 ~> m3 s-1 or kg s-1] or [H L2 ~> m3 or kg].
5149		real :: derr_dv ! The change in transport error with vbt, i.e. the face area [H L ~> m2 or kg m-1].
5150		real :: vherr_min, vherr_max ! The bounding values of the transport error [H L2 T-1 ~> m3 s-1 or kg s-1]
5151		! or [H L2 ~> m3 or kg].
5152		real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
5153		real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
5154		real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
5155		! maximum increase of vs2, both [nondim].
5156		integer :: itt, max_itt = 20
5157
5158		! Find the value of vbt that gives vhbt.
5159	0	if (vhbt == 0.0) then
5160	0	vbt = 0.0
5161	0	elseif (vhbt < BTC%vh_NN) then
5162	0	vbt = BTC%vBT_NN + (vhbt - BTC%vh_NN) / BTC%FA_v_NN
5163	0	elseif (vhbt < 0.0) then
5164		! Iterate to convergence with Newton's method (when bounded) and the
5165		! false position method otherwise. vbt will be negative.
5166	0	vbt_min = BTC%vBT_NN ; vherr_min = BTC%vh_NN - vhbt
5167	0	vbt_max = 0.0 ; vherr_max = -vhbt
5168		! Use a false-position method first guess.
5169	0	vbt = BTC%vBT_NN * (vhbt / BTC%vh_NN)
5170	0	do itt = 1, max_itt
5171	0	vhbt_err = vbt * (BTC%FA_v_N0 + BTC%vh_crvN * vbt**2) - vhbt
5172
5173	0	if (abs(vhbt_err) < tol*abs(vhbt)) exit
5174	0	if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
5175	0	if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
5176
5177	0	derr_dv = BTC%FA_v_N0 + 3.0 * BTC%vh_crvN * vbt**2
5178		if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
5179	0	(-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
5180		! Use a false-position method guess.
5181	0	vbt = vbt_max + (vbt_min-vbt_max) * (vherr_max / (vherr_max-vherr_min))
5182		else ! Use Newton's method.
5183	0	vbt = vbt - vhbt_err / derr_dv
5184	0	if (abs(vhbt_err) < (0.01tol)abs(derr_dv*vbt_min)) exit
5185		endif
5186		enddo
5187	0	elseif (vhbt <= BTC%vh_SS) then
5188		! Iterate to convergence with Newton's method. vbt will be positive.
5189	0	vbt_min = 0.0 ; vherr_min = -vhbt
5190	0	vbt_max = BTC%vBT_SS ; vherr_max = BTC%vh_SS - vhbt
5191		! Use a false-position method first guess.
5192	0	vbt = BTC%vBT_SS * (vhbt / BTC%vh_SS)
5193	0	do itt = 1, max_itt
5194	0	vhbt_err = vbt * (BTC%FA_v_S0 + BTC%vh_crvS * vbt**2) - vhbt
5195
5196	0	if (abs(vhbt_err) < tol*abs(vhbt)) exit
5197	0	if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
5198	0	if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
5199
5200	0	derr_dv = BTC%FA_v_S0 + 3.0 * BTC%vh_crvS * vbt**2
5201		if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
5202	0	(-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
5203		! Use a false-position method guess.
5204	0	vbt = vbt_min + (vbt_max-vbt_min) * (-vherr_min / (vherr_max-vherr_min))
5205		else ! Use Newton's method.
5206	0	vbt = vbt - vhbt_err / derr_dv
5207	0	if (abs(vhbt_err) < (0.01tol)(vbt_max*derr_dv)) exit
5208		endif
5209		enddo
5210		else ! (vhbt > BTC%vh_SS)
5211	0	vbt = BTC%vBT_SS + (vhbt - BTC%vh_SS) / BTC%FA_v_SS
5212		endif
5213
5214	0	end function vhbt_to_vbt
5215
5216		!> This subroutine sets up reordered versions of the BT_cont type in the
5217		!! local_BT_cont types, which have wide halos properly filled in.
5218	1440	subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo, dt_baroclinic)
5219		type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the barotropic solver
5220		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
5221		!! the argument arrays
5222		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
5223		intent(out) :: BTCL_u !< A structure with the u information from BT_cont
5224		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
5225		intent(out) :: BTCL_v !< A structure with the v information from BT_cont
5226		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
5227		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5228		type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating the halos
5229		!! of wide arrays
5230		integer, intent(in) :: halo !< The extra halo size to use here
5231		real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which
5232		!! is provided if INTEGRAL_BT_CONTINUITY is true.
5233
5234		! Local variables
5235		real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
5236	2880	u_polarity, & ! An array used to test for halo update polarity [nondim]
5237	2880	uBT_EE, uBT_WW, & ! Zonal velocities at which the form of the fit changes [L T-1 ~> m s-1]
5238	2880	FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW ! Zonal face areas [H L ~> m2 or kg m-1]
5239		real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
5240	2880	v_polarity, & ! An array used to test for halo update polarity [nondim]
5241	2880	vBT_NN, vBT_SS, & ! Meridional velocities at which the form of the fit changes [L T-1 ~> m s-1]
5242	2880	FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS ! Meridional face areas [H L ~> m2 or kg m-1]
5243		real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim]
5244		real, parameter :: C1_3 = 1.0/3.0 ! [nondim]
5245		integer :: i, j, is, ie, js, je, hs
5246		real :: tmp
5247
5248	1440	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5249	1440	hs = max(halo,0)
5250	1440	dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic
5251
5252		!$omp target enter data &
5253		!$omp map(alloc: u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW, &
5254		!$omp v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS)
5255
5256		! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays.
5257	77760	do concurrent (j=js-hs:je+hs, i=is-hs-1:ie+hs)
5258	3663360	u_polarity(i,j) = 1.0
5259	3663360	uBT_EE(i,j) = 0.0 ; uBT_WW(i,j) = 0.0
5260	3741120	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
5261		enddo
5262	76320	do concurrent (j=js-hs-1:je+hs, i=is-hs:ie+hs)
5263	3669120	v_polarity(i,j) = 1.0
5264	3669120	vBT_NN(i,j) = 0.0 ; vBT_SS(i,j) = 0.0
5265	3745440	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
5266		enddo
5267	1440	do concurrent (j=js:je, I=is-1:ie)
5268	2592000	uBT_EE(I,j) = BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = BT_cont%uBT_WW(I,j)
5269	2592000	FA_u_EE(I,j) = BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = BT_cont%FA_u_E0(I,j)
5270	2658240	FA_u_W0(I,j) = BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = BT_cont%FA_u_WW(I,j)
5271		enddo
5272	1440	do concurrent (J=js-1:je, i=is:ie)
5273	2597760	vBT_NN(i,J) = BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = BT_cont%vBT_SS(i,J)
5274	2597760	FA_v_NN(i,J) = BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = BT_cont%FA_v_N0(i,J)
5275	2662560	FA_v_S0(i,J) = BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = BT_cont%FA_v_SS(i,J)
5276		enddo
5277
5278	1440	if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
5279	1440	if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
5280		!--- begin setup for group halo update
5281	1440	call create_group_pass(BT_cont%pass_polarity_BT, u_polarity, v_polarity, BT_Domain)
5282	1440	call create_group_pass(BT_cont%pass_polarity_BT, uBT_EE, vBT_NN, BT_Domain)
5283	1440	call create_group_pass(BT_cont%pass_polarity_BT, uBT_WW, vBT_SS, BT_Domain)
5284
5285	1440	call create_group_pass(BT_cont%pass_FA_uv, FA_u_EE, FA_v_NN, BT_Domain, To_All+Scalar_Pair)
5286	1440	call create_group_pass(BT_cont%pass_FA_uv, FA_u_E0, FA_v_N0, BT_Domain, To_All+Scalar_Pair)
5287	1440	call create_group_pass(BT_cont%pass_FA_uv, FA_u_W0, FA_v_S0, BT_Domain, To_All+Scalar_Pair)
5288	1440	call create_group_pass(BT_cont%pass_FA_uv, FA_u_WW, FA_v_SS, BT_Domain, To_All+Scalar_Pair)
5289		!--- end setup for group halo update
5290		! Do halo updates on BT_cont.
5291		! data update directives for MPI transfers (via CPU) needed even for serial
5292	1440	call do_group_pass(BT_cont%pass_polarity_BT, BT_Domain, omp_offload=.true.)
5293	1440	call do_group_pass(BT_cont%pass_FA_uv, BT_Domain, omp_offload=.true.)
5294	1440	if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
5295	1440	if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
5296
5297	77760	do concurrent (j=js-hs:je+hs, I=is-hs-1:ie+hs)
5298	3663360	BTCL_u(I,j)%FA_u_EE = FA_u_EE(I,j) ; BTCL_u(I,j)%FA_u_E0 = FA_u_E0(I,j)
5299	3663360	BTCL_u(I,j)%FA_u_W0 = FA_u_W0(I,j) ; BTCL_u(I,j)%FA_u_WW = FA_u_WW(I,j)
5300	3663360	BTCL_u(I,j)%uBT_EE = dtuBT_EE(I,j) ; BTCL_u(I,j)%uBT_WW = dtuBT_WW(I,j)
5301		! Check for reversed polarity in the tripolar halo regions.
5302	3663360	if (u_polarity(I,j) < 0.0) then
5303	0	tmp = BTCL_u(I,j)%FA_u_EE
5304	0	BTCL_u(I,j)%FA_u_EE = BTCL_u(I,j)%FA_u_WW
5305	0	BTCL_u(I,j)%FA_u_WW = tmp
5306
5307	0	tmp = BTCL_u(I,j)%FA_u_E0
5308	0	BTCL_u(I,j)%FA_u_E0 = BTCL_u(I,j)%FA_u_W0
5309	0	BTCL_u(I,j)%FA_u_W0 = tmp
5310
5311	0	tmp = BTCL_u(I,j)%uBT_EE
5312	0	BTCL_u(I,j)%uBT_EE = BTCL_u(I,j)%uBT_WW
5313	0	BTCL_u(I,j)%uBT_WW = tmp
5314		endif
5315
5316		BTCL_u(I,j)%uh_EE = BTCL_u(I,j)%uBT_EE * &
5317	3663360	(C1_3 * (2.0*BTCL_u(I,j)%FA_u_E0 + BTCL_u(I,j)%FA_u_EE))
5318		BTCL_u(I,j)%uh_WW = BTCL_u(I,j)%uBT_WW * &
5319	3663360	(C1_3 * (2.0*BTCL_u(I,j)%FA_u_W0 + BTCL_u(I,j)%FA_u_WW))
5320
5321	3663360	BTCL_u(I,j)%uh_crvE = 0.0 ; BTCL_u(I,j)%uh_crvW = 0.0
5322	3663360	if (abs(BTCL_u(I,j)%uBT_WW) > 0.0) BTCL_u(I,j)%uh_crvW = &
5323	2454777	(C1_3 * (BTCL_u(I,j)%FA_u_WW - BTCL_u(I,j)%FA_u_W0)) / BTCL_u(I,j)%uBT_WW**2
5324	3663360	if (abs(BTCL_u(I,j)%uBT_EE) > 0.0) BTCL_u(I,j)%uh_crvE = &
5325	3741120	(C1_3 * (BTCL_u(I,j)%FA_u_EE - BTCL_u(I,j)%FA_u_E0)) / BTCL_u(I,j)%uBT_EE**2
5326		enddo
5327
5328	76320	do concurrent (J=js-hs-1:je+hs, i=is-hs:ie+hs)
5329	3669120	BTCL_v(i,J)%FA_v_NN = FA_v_NN(i,J) ; BTCL_v(i,J)%FA_v_N0 = FA_v_N0(i,J)
5330	3669120	BTCL_v(i,J)%FA_v_S0 = FA_v_S0(i,J) ; BTCL_v(i,J)%FA_v_SS = FA_v_SS(i,J)
5331	3669120	BTCL_v(i,J)%vBT_NN = dtvBT_NN(i,J) ; BTCL_v(i,J)%vBT_SS = dtvBT_SS(i,J)
5332		! Check for reversed polarity in the tripolar halo regions.
5333	3669120	if (v_polarity(i,J) < 0.0) then
5334	0	tmp = BTCL_v(i,J)%FA_v_NN
5335	0	BTCL_v(i,J)%FA_v_NN = BTCL_v(i,J)%FA_v_SS
5336	0	BTCL_v(i,J)%FA_v_SS = tmp
5337
5338	0	tmp = BTCL_v(i,J)%FA_v_N0
5339	0	BTCL_v(i,J)%FA_v_N0 = BTCL_v(i,J)%FA_v_S0
5340	0	BTCL_v(i,J)%FA_v_S0 = tmp
5341
5342	0	tmp = BTCL_v(i,J)%vBT_NN
5343	0	BTCL_v(i,J)%vBT_NN = BTCL_v(i,J)%vBT_SS
5344	0	BTCL_v(i,J)%vBT_SS = tmp
5345		endif
5346
5347		BTCL_v(i,J)%vh_NN = BTCL_v(i,J)%vBT_NN * &
5348	3669120	(C1_3 * (2.0*BTCL_v(i,J)%FA_v_N0 + BTCL_v(i,J)%FA_v_NN))
5349		BTCL_v(i,J)%vh_SS = BTCL_v(i,J)%vBT_SS * &
5350	3669120	(C1_3 * (2.0*BTCL_v(i,J)%FA_v_S0 + BTCL_v(i,J)%FA_v_SS))
5351
5352	3669120	BTCL_v(i,J)%vh_crvN = 0.0 ; BTCL_v(i,J)%vh_crvS = 0.0
5353	3669120	if (abs(BTCL_v(i,J)%vBT_SS) > 0.0) BTCL_v(i,J)%vh_crvS = &
5354	2460098	(C1_3 * (BTCL_v(i,J)%FA_v_SS - BTCL_v(i,J)%FA_v_S0)) / BTCL_v(i,J)%vBT_SS**2
5355	3669120	if (abs(BTCL_v(i,J)%vBT_NN) > 0.0) BTCL_v(i,J)%vh_crvN = &
5356	3745440	(C1_3 * (BTCL_v(i,J)%FA_v_NN - BTCL_v(i,J)%FA_v_N0)) / BTCL_v(i,J)%vBT_NN**2
5357		enddo
5358
5359		!$omp target exit data &
5360		!$omp map(release: u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW, &
5361		!$omp v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS)
5362	1440	end subroutine set_local_BT_cont_types
5363
5364
5365		!> Adjust_local_BT_cont_types expands the range of velocities with a cubic curve
5366		!! translating velocities into transports to match the initial values of velocities and
5367		!! summed transports when the velocities are larger than the first guesses of the cubic
5368		!! transition velocities used to set up the local_BT_cont types.
5369	0	subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, &
5370		G, US, MS, halo, dt_baroclinic)
5371		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
5372		real, dimension(SZIBW_(MS),SZJW_(MS)), &
5373		intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1].
5374		real, dimension(SZIBW_(MS),SZJW_(MS)), &
5375		intent(in) :: uhbt !< The linearization zonal barotropic transport
5376		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
5377		real, dimension(SZIW_(MS),SZJBW_(MS)), &
5378		intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1].
5379		real, dimension(SZIW_(MS),SZJBW_(MS)), &
5380		intent(in) :: vhbt !< The linearization meridional barotropic transport
5381		!! [H L2 T-1 ~> m3 s-1 or kg s-1].
5382		type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
5383		intent(out) :: BTCL_u !< A structure with the u information from BT_cont.
5384		type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
5385		intent(out) :: BTCL_v !< A structure with the v information from BT_cont.
5386		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5387		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5388		integer, intent(in) :: halo !< The extra halo size to use here.
5389		real, optional, intent(in) :: dt_baroclinic !< The baroclinic time step [T ~> s], which is
5390		!! provided if INTEGRAL_BT_CONTINUITY is true.
5391
5392		! Local variables
5393		real :: dt ! The baroclinic timestep [T ~> s] or 1.0 [nondim]
5394		real, parameter :: C1_3 = 1.0/3.0 ! [nondim]
5395		integer :: i, j, is, ie, js, je, hs
5396
5397	0	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5398	0	hs = max(halo,0)
5399	0	dt = 1.0 ; if (present(dt_baroclinic)) dt = dt_baroclinic
5400
5401		!$OMP parallel do default(shared)
5402	0	do j=js-hs,je+hs ; do I=is-hs-1,ie+hs
5403	0	if ((dtubt(I,j) > BTCL_u(I,j)%uBT_WW) .and. (dtuhbt(I,j) > BTCL_u(I,j)%uh_WW)) then
5404		! Expand the cubic fit to use this new point. ubt is negative.
5405	0	BTCL_u(I,j)%ubt_WW = dt * ubt(I,j)
5406	0	if (3.0uhbt(I,j) < 2.0ubt(I,j) * BTCL_u(I,j)%FA_u_W0) then
5407		! No further bounding is needed.
5408	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)
5409		else ! This should not happen often!
5410	0	BTCL_u(I,j)%FA_u_W0 = 1.5*uhbt(I,j) / ubt(I,j)
5411	0	BTCL_u(I,j)%uh_crvW = -0.5uhbt(I,j) / (dt2 ubt(I,j)**3)
5412		endif
5413	0	BTCL_u(I,j)%uh_WW = dt * uhbt(I,j)
5414		! I don't know whether this is helpful.
5415		! BTCL_u(I,j)%FA_u_WW = min(BTCL_u(I,j)%FA_u_WW, uhbt(I,j) / ubt(I,j))
5416	0	elseif ((dtubt(I,j) < BTCL_u(I,j)%uBT_EE) .and. (dtuhbt(I,j) < BTCL_u(I,j)%uh_EE)) then
5417		! Expand the cubic fit to use this new point. ubt is negative.
5418	0	BTCL_u(I,j)%ubt_EE = dt * ubt(I,j)
5419	0	if (3.0uhbt(I,j) < 2.0ubt(I,j) * BTCL_u(I,j)%FA_u_E0) then
5420		! No further bounding is needed.
5421	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)
5422		else ! This should not happen often!
5423	0	BTCL_u(I,j)%FA_u_E0 = 1.5*uhbt(I,j) / ubt(I,j)
5424	0	BTCL_u(I,j)%uh_crvE = -0.5uhbt(I,j) / (dt2 ubt(I,j)**3)
5425		endif
5426	0	BTCL_u(I,j)%uh_EE = dt * uhbt(I,j)
5427		! I don't know whether this is helpful.
5428		! BTCL_u(I,j)%FA_u_EE = min(BTCL_u(I,j)%FA_u_EE, uhbt(I,j) / ubt(I,j))
5429		endif
5430		enddo ; enddo
5431		!$OMP parallel do default(shared)
5432	0	do J=js-hs-1,je+hs ; do i=is-hs,ie+hs
5433	0	if ((dtvbt(i,J) > BTCL_v(i,J)%vBT_SS) .and. (dtvhbt(i,J) > BTCL_v(i,J)%vh_SS)) then
5434		! Expand the cubic fit to use this new point. vbt is negative.
5435	0	BTCL_v(i,J)%vbt_SS = dt * vbt(i,J)
5436	0	if (3.0vhbt(i,J) < 2.0vbt(i,J) * BTCL_v(i,J)%FA_v_S0) then
5437		! No further bounding is needed.
5438	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)
5439		else ! This should not happen often!
5440	0	BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / (vbt(i,J))
5441	0	BTCL_v(i,J)%vh_crvS = -0.5vhbt(i,J) / (dt2 vbt(i,J)**3)
5442		endif
5443	0	BTCL_v(i,J)%vh_SS = dt * vhbt(i,J)
5444		! I don't know whether this is helpful.
5445		! BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J))
5446	0	elseif ((dtvbt(i,J) < BTCL_v(i,J)%vBT_NN) .and. (dtvhbt(i,J) < BTCL_v(i,J)%vh_NN)) then
5447		! Expand the cubic fit to use this new point. vbt is negative.
5448	0	BTCL_v(i,J)%vbt_NN = dt * vbt(i,J)
5449	0	if (3.0vhbt(i,J) < 2.0vbt(i,J) * BTCL_v(i,J)%FA_v_N0) then
5450		! No further bounding is needed.
5451	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)
5452		else ! This should not happen often!
5453	0	BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / (vbt(i,J))
5454	0	BTCL_v(i,J)%vh_crvN = -0.5vhbt(i,J) / (dt2 vbt(i,J)**3)
5455		endif
5456	0	BTCL_v(i,J)%vh_NN = dt * vhbt(i,J)
5457		! I don't know whether this is helpful.
5458		! BTCL_v(i,J)%FA_v_NN = min(BTCL_v(i,J)%FA_v_NN, vhbt(i,J) / vbt(i,J))
5459		endif
5460		enddo ; enddo
5461
5462	0	end subroutine adjust_local_BT_cont_types
5463
5464		!> This subroutine uses the BT_cont_type to find the maximum face
5465		!! areas, which can then be used for finding wave speeds, etc.
5466	0	subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo)
5467		type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the
5468		!! barotropic solver.
5469		type(memory_size_type), intent(in) :: MS !< A type that describes the memory
5470		!! sizes of the argument arrays.
5471		real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
5472		intent(out) :: Datu !< The effective zonal face area [H L ~> m2 or kg m-1].
5473		real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
5474		intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1].
5475		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5476		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5477		integer, optional, intent(in) :: halo !< The extra halo size to use here.
5478
5479		! Local variables
5480		integer :: i, j, is, ie, js, je, hs
5481	0	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5482	0	hs = 1 ; if (present(halo)) hs = max(halo,0)
5483
5484	0	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5485		Datu(I,j) = max(BT_cont%FA_u_EE(I,j), BT_cont%FA_u_E0(I,j), &
5486	0	BT_cont%FA_u_W0(I,j), BT_cont%FA_u_WW(I,j))
5487		enddo
5488	0	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5489		Datv(i,J) = max(BT_cont%FA_v_NN(i,J), BT_cont%FA_v_N0(i,J), &
5490	0	BT_cont%FA_v_S0(i,J), BT_cont%FA_v_SS(i,J))
5491		enddo
5492
5493	0	end subroutine BT_cont_to_face_areas
5494
5495		!> Swap the values of two real variables
5496	0	pure subroutine swap(a,b)
5497		real, intent(inout) :: a !< The first variable to be swapped [arbitrary units]
5498		real, intent(inout) :: b !< The second variable to be swapped [arbitrary units]
5499		real :: tmp ! A temporary variable [arbitrary units]
5500	0	tmp = a ; a = b ; b = tmp
5501	0	end subroutine swap
5502
5503		!> This subroutine determines the open face areas of cells for calculating
5504		!! the barotropic transport.
5505	4	subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max)
5506		type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
5507		real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
5508		intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1].
5509		real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
5510		intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1].
5511		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5512		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
5513		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5514		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
5515		integer, intent(in) :: halo !< The halo size to use, default = 1.
5516		real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), &
5517		optional, intent(in) :: eta !< The barotropic free surface height anomaly
5518		!! or column mass anomaly [H ~> m or kg m-2].
5519		real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used
5520		!! to overestimate the external wave speed) [Z ~> m].
5521
5522		! Local variables
5523		real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2].
5524		real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3]
5525		integer :: i, j, is, ie, js, je, hs
5526	15	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
5527	15	hs = max(halo,0)
5528
5529	15	if (present(eta)) then
5530		! The use of harmonic mean thicknesses ensure positive definiteness.
5531	4	if (GV%Boussinesq) then
5532	1448	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5533	259920	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)
5534	259920	Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
5535	261368	Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
5536		! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
5537		enddo
5538
5539	1444	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5540	260640	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)
5541	260640	Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) &
5542	262084	Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2)
5543		! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
5544		enddo
5545		else
5546	0	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5547	0	Datu(I,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) &
5548		Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * eta(i,j) * eta(i+1,j)) / &
5549	0	(eta(i,j) + eta(i+1,j))
5550		! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))
5551		enddo
5552
5553	0	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5554	0	Datv(i,J) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) &
5555		Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * eta(i,j) * eta(i,j+1)) / &
5556	0	(eta(i,j) + eta(i,j+1))
5557		! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (eta(i,j) + eta(i,j+1))
5558		enddo
5559		endif
5560	15	elseif (present(add_max)) then
5561	14	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
5562
5563	1708	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5564	101640	H1 = max((G%meanSL(i+1,j) + add_max) + G%bathyT(i+1,j), 0.0)
5565	101640	H2 = max((G%meanSL(i,j) + add_max) + G%bathyT(i,j), 0.0)
5566	103348	Datu(I,j) = CS%dy_Cu(I,j) * Z_to_H * max(H1, H2)
5567		enddo
5568
5569	1694	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5570	102480	H1 = max((G%meanSL(i,j+1) + add_max) + G%bathyT(i,j+1), 0.0)
5571	102480	H2 = max((G%meanSL(i,j) + add_max) + G%bathyT(i,j), 0.0)
5572	104174	Datv(i,J) = CS%dx_Cv(i,J) * Z_to_H * max(H1, H2)
5573		enddo
5574		else
5575	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
5576
5577	364	do concurrent (j=js-hs:je+hs, I=is-1-hs:ie+hs)
5578	66066	H1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
5579	66066	H2 = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) * Z_to_H
5580	66066	Datu(I,j) = 0.0
5581	66066	if ((H1 > 0.0) .and. (H2 > 0.0)) &
5582	66430	Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2)
5583		enddo
5584
5585	363	do concurrent (J=js-1-hs:je+hs, i=is-hs:ie+hs)
5586	66246	H1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
5587	66246	H2 = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) * Z_to_H
5588	66246	Datv(i,J) = 0.0
5589	66246	if ((H1 > 0.0) .and. (H2 > 0.0)) &
5590	66609	Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2)
5591		enddo
5592		endif
5593	15	end subroutine find_face_areas
5594
5595		!> bt_mass_source determines the appropriately limited mass source for
5596		!! the barotropic solver, along with a corrective fictitious mass source that
5597		!! will drive the barotropic estimate of the free surface height toward the
5598		!! baroclinic estimate.
5599	1440	subroutine bt_mass_source(h, eta, set_cor, G, GV, CS)
5600		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
5601		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
5602		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
5603		real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be
5604		!! corrected [H ~> m or kg m-2].
5605		logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective
5606		!! fluxes (and update the slowly varying part of eta_cor)
5607		!! (.true.) or whether to incrementally update the
5608		!! corrective fluxes.
5609		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
5610
5611		! Local variables
5612	1440	real :: eta_h(SZI_(G),SZJ_(G)) ! The free surface height determined from
5613		! the sum of the layer thicknesses [H ~> m or kg m-2].
5614		real :: d_eta ! The difference between estimates of the total
5615		! thicknesses [H ~> m or kg m-2].
5616		integer :: is, ie, js, je, nz, i, j, k
5617
5618	1440	if (.not.CS%module_is_initialized) call MOM_error(FATAL, "bt_mass_source: "// &
5619	0	"Module MOM_barotropic must be initialized before it is used.")
5620
5621	1440	if (.not.CS%split) return
5622
5623	1440	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
5624
5625		!$omp target data map(alloc: eta_h)
5626
5627	1440	do concurrent (j=js:je)
5628	57600	if (GV%Boussinesq) then
5629	57600	do concurrent (i=is:ie)
5630	2592000	eta_h(i,j) = h(i,j,1) - G%bathyT(i,j)*GV%Z_to_H
5631		enddo
5632		else
5633	0	do concurrent (i=is:ie)
5634	0	eta_h(i,j) = h(i,j,1)
5635		enddo
5636		endif
5637	216000	do k=2,nz
5638	57600	do concurrent (i=is:ie)
5639	25787520	eta_h(i,j) = eta_h(i,j) + h(i,j,k)
5640		enddo
5641		enddo
5642	116640	if (set_cor) then
5643	28800	do concurrent (i=is:ie)
5644	1267200	d_eta = eta_h(i,j) - eta(i,j)
5645	1296000	CS%eta_cor(i,j) = d_eta
5646		enddo
5647		else
5648	28800	do concurrent (i=is:ie)
5649	1267200	d_eta = eta_h(i,j) - eta(i,j)
5650	1296000	CS%eta_cor(i,j) = CS%eta_cor(i,j) + d_eta
5651		enddo
5652		endif
5653		enddo
5654
5655		!$omp end target data
5656
5657		end subroutine bt_mass_source
5658
5659		!> barotropic_init initializes a number of time-invariant fields used in the
5660		!! barotropic calculation and initializes any barotropic fields that have not
5661		!! already been initialized.
5662	1	subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, &
5663		restart_CS, calc_dtbt, BT_cont, OBC, SAL_CSp, HA_CSp)
5664		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
5665		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
5666		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
5667		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
5668		intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
5669		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
5670		intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
5671		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
5672		intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
5673		type(time_type), target, intent(in) :: Time !< The current model time.
5674		type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
5675		type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
5676		!! output.
5677		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
5678		type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure
5679		logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must
5680		!! be recalculated before stepping.
5681		type(BT_cont_type), pointer :: BT_cont !< A structure with elements that describe the
5682		!! effective open face areas as a function of
5683		!! barotropic flow.
5684		type(ocean_OBC_type), pointer :: OBC !< The open boundary condition structure.
5685		type(SAL_CS), target, optional :: SAL_CSp !< A pointer to the control structure of the
5686		!! SAL module.
5687		type(harmonic_analysis_CS), target, optional :: HA_CSp !< A pointer to the control structure of the
5688		!! harmonic analysis module
5689
5690		! This include declares and sets the variable "version".
5691		# include "version_variable.h"
5692		! Local variables
5693		character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
5694	1	real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1].
5695	1	real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1].
5696		real :: gtot_estimate ! Summed GV%g_prime [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2], to give an
5697		! upper-bound estimate for pbce.
5698		real :: SSH_extra ! An estimate of how much higher SSH might get, for use
5699		! in calculating the safe external wave speed [Z ~> m].
5700		real :: dtbt_input ! The input value of DTBT, [nondim] if negative or [s] if positive.
5701		real :: dtbt_restart ! A temporary copy of CS%dtbt read from a restart file [T ~> s]
5702		real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag
5703		! piston velocities [nondim].
5704		character(len=200) :: inputdir ! The directory in which to find input files.
5705		character(len=200) :: wave_drag_file ! The file from which to read the wave
5706		! drag piston velocity.
5707		character(len=80) :: wave_drag_var ! The wave drag piston velocity variable
5708		! name in wave_drag_file.
5709		character(len=80) :: wave_drag_u ! The wave drag piston velocity variable
5710		! name in wave_drag_file.
5711		character(len=80) :: wave_drag_v ! The wave drag piston velocity variable
5712		! name in wave_drag_file.
5713		real :: htot ! Total column thickness used when BT_NONLIN_STRESS is false [Z ~> m].
5714		real :: Z_to_H ! A local unit conversion factor [H Z-1 ~> nondim or kg m-3]
5715		real :: H_to_Z ! A local unit conversion factor [Z H-1 ~> nondim or m3 kg-1]
5716		real :: det_de ! The partial derivative due to self-attraction and loading of the reference
5717		! geopotential with the sea surface height when scalar SAL are enabled [nondim].
5718		! This is typically ~0.09 or less.
5719		real :: h_a_neglect ! A cell volume or mass that is so small it is usually lost
5720		! in roundoff and can be neglected [H L2 ~> m3 or kg]
5721	1	real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points
5722		! that acts on the barotropic flow [H T-1 ~> m s-1 or kg m-2 s-1].
5723
5724		type(memory_size_type) :: MS
5725		type(group_pass_type) :: pass_static_data, pass_q_D_Cor
5726		type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity
5727		integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
5728		logical :: use_BT_cont_type
5729		logical :: mask_coastal_pressure_force ! If true, apply masks to some stored inverse grid spacings
5730		! so that diagnosed barotropic pressure gradient forces are zero at
5731		! land, coastal or OBC points.
5732		logical :: use_tides
5733		logical :: OBC_projection_bug
5734		logical :: enable_bugs ! If true, the defaults for recently added bug-fix flags are set to
5735		! recreate the bugs, or if false bugs are only used if actively selected.
5736		logical :: visc_rem_bug ! Stores the value of runtime paramter VISC_REM_BUG.
5737		character(len=48) :: thickness_units, flux_units
5738		character*(40) :: hvel_str
5739		integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
5740		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
5741		integer :: isdw, iedw, jsdw, jedw
5742		integer :: i, j, k
5743		integer :: wd_halos(2), bt_halo_sz
5744	1	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
5745	1	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
5746	1	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
5747	1	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
5748	1	MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed
5749
5750	1	if (CS%module_is_initialized) then
5751		call MOM_error(WARNING, "barotropic_init called with a control structure "// &
5752	0	"that has already been initialized.")
5753	0	return
5754		endif
5755	1	CS%module_is_initialized = .true.
5756
5757	1	CS%diag => diag ; CS%Time => Time
5758	1	if (present(SAL_CSp)) then
5759	1	CS%SAL_CSp => SAL_CSp
5760		endif
5761
5762		! Read all relevant parameters and write them to the model log.
5763	1	call get_param(param_file, mdl, "SPLIT", CS%split, default=.true., do_not_log=.true.)
5764		call log_version(param_file, mdl, version, "", log_to_all=.true., layout=CS%split, &
5765	1	debugging=CS%split, all_default=.not.CS%split)
5766		call get_param(param_file, mdl, "SPLIT", CS%split, &
5767	1	"Use the split time stepping if true.", default=.true.)
5768	1	if (.not.CS%split) return
5769
5770		call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_BT_cont_type, &
5771		"If true, use a structure with elements that describe "//&
5772		"effective face areas from the summed continuity solver "//&
5773		"as a function the barotropic flow in coupling between "//&
5774		"the barotropic and baroclinic flow. This is only used "//&
5775	1	"if SPLIT is true.", default=.true.)
5776		call get_param(param_file, mdl, "INTEGRAL_BT_CONTINUITY", CS%integral_bt_cont, &
5777		"If true, use the time-integrated velocity over the barotropic steps "//&
5778		"to determine the integrated transports used to update the continuity "//&
5779		"equation. Otherwise the transports are the sum of the transports based on "//&
5780		"a series of instantaneous velocities and the BT_CONT_TYPE for transports. "//&
5781		"This is only valid if USE_BT_CONT_TYPE = True.", &
5782	1	default=.false., do_not_log=.not.use_BT_cont_type)
5783		call get_param(param_file, mdl, "BOUND_BT_CORRECTION", CS%bound_BT_corr, &
5784		"If true, the corrective pseudo mass-fluxes into the "//&
5785		"barotropic solver are limited to values that require "//&
5786	1	"less than maxCFL_BT_cont to be accommodated.",default=.false.)
5787		call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", CS%BT_cont_bounds, &
5788		"If true, and BOUND_BT_CORRECTION is true, use the "//&
5789		"BT_cont_type variables to set limits determined by "//&
5790		"MAXCFL_BT_CONT on the CFL number of the velocities "//&
5791		"that are likely to be driven by the corrective mass fluxes.", &
5792	1	default=.true., do_not_log=.not.CS%bound_BT_corr)
5793		call get_param(param_file, mdl, "ADJUST_BT_CONT", CS%adjust_BT_cont, &
5794		"If true, adjust the curve fit to the BT_cont type "//&
5795		"that is used by the barotropic solver to match the "//&
5796		"transport about which the flow is being linearized.", &
5797	1	default=.false., do_not_log=.not.use_BT_cont_type)
5798		call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, &
5799		"If true, adjust the initial conditions for the "//&
5800		"barotropic solver to the values from the layered "//&
5801		"solution over a whole timestep instead of instantly. "//&
5802		"This is a decent approximation to the inclusion of "//&
5803		"sum(u dh_dt) while also correcting for truncation errors.", &
5804	1	default=.false.)
5805		call get_param(param_file, mdl, "BT_ADJUST_SRC_FOR_FILTER", CS%bt_adjust_src_for_filter, &
5806		"If true, increases the rate at which BT mass sources are applied so "//&
5807		"that they are all used up before the filtering period starts. "//&
5808		"This option is only valid if INTEGRAL_BT_CONTINUITY = True.", &
5809	1	default=.false., do_not_log=.not.CS%integral_bt_cont)
5810		call get_param(param_file, mdl, "BT_LIMIT_INTEGRAL_TRANSPORT", CS%bt_limit_integral_transport, &
5811		"If true, limit the time-integrated transports by the initial volume "//&
5812		"accounting for sinks of mass. The limiter uses MAXCFL_BT_CONT. "//&
5813		"This option is only valid if INTEGRAL_BT_CONTINUITY = True.", &
5814	1	default=.false., do_not_log=.not.CS%integral_bt_cont)
5815		call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", CS%visc_rem_u_uh0, &
5816		"If true, use the viscous remnants when estimating the "//&
5817		"barotropic velocities that were used to calculate uh0 "//&
5818	1	"and vh0. False is probably the better choice.", default=.false.)
5819		call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", CS%use_wide_halos, &
5820		"If true, use wide halos and march in during the "//&
5821		"barotropic time stepping for efficiency.", default=.true., &
5822	1	layoutParam=.true.)
5823		call get_param(param_file, mdl, "BTHALO", bt_halo_sz, &
5824		"The minimum halo size for the barotropic solver.", default=0, &
5825	1	layoutParam=.true.)
5826		call get_param(param_file, mdl, "BT_WIDE_HALO_MIN_STENCIL", CS%min_stencil, &
5827		"The minimum stencil width to use with the wide halo iterations. "//&
5828		"A nonzero value may be useful for debugging purposes, but at the "//&
5829		"cost of reducing the efficiency gain from BT_USE_WIDE_HALOS.", &
5830	1	default=0, layoutParam=.true., do_not_log=.not.CS%use_wide_halos)
5831		#ifdef STATIC_MEMORY_
5832		if ((bt_halo_sz > 0) .and. (bt_halo_sz /= BTHALO_)) call MOM_error(FATAL, &
5833		"barotropic_init: Run-time values of BTHALO must agree with the "//&
5834		"macro BTHALO_ with STATIC_MEMORY_.")
5835		wd_halos(1) = WHALOI_+NIHALO_ ; wd_halos(2) = WHALOJ_+NJHALO_
5836		#else
5837	1	wd_halos(1) = bt_halo_sz ; wd_halos(2) = bt_halo_sz
5838		#endif
5839		call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", CS%Nonlinear_continuity, &
5840		"If true, use nonlinear transports in the barotropic "//&
5841		"continuity equation. This does not apply if "//&
5842	1	"USE_BT_CONT_TYPE is true.", default=.false., do_not_log=use_BT_cont_type)
5843		call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", CS%Nonlin_cont_update_period, &
5844		"If NONLINEAR_BT_CONTINUITY is true, this is the number "//&
5845		"of barotropic time steps between updates to the face "//&
5846		"areas, or 0 to update only before the barotropic stepping.", &
5847	1	default=1, do_not_log=.not.CS%Nonlinear_continuity)
5848
5849		call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,&
5850		"If true, step the barotropic velocity first and project "//&
5851		"out the velocity tendency by 1+BEBT when calculating the "//&
5852		"transport. The default (false) is to use a predictor "//&
5853		"continuity step to find the pressure field, and then "//&
5854		"to do a corrector continuity step using a weighted "//&
5855		"average of the old and new velocities, with weights "//&
5856	1	"of (1-BEBT) and BEBT.", default=.false.)
5857		call get_param(param_file, mdl, "BT_NONLIN_STRESS", CS%nonlin_stress, &
5858		"If true, use the full depth of the ocean at the start of the barotropic "//&
5859		"step when calculating the surface stress contribution to the barotropic "//&
5860	1	"acclerations. Otherwise use the depth based on bathyT.", default=.false.)
5861		call get_param(param_file, mdl, "BT_RHO_LINEARIZED", CS%Rho_BT_lin, &
5862		"A density that is used to convert total water column thicknesses into mass "//&
5863		"in non-Boussinesq mode with linearized options in the barotropic solver or "//&
5864		"when estimating the stable barotropic timestep without access to the full "//&
5865		"baroclinic model state.", &
5866		units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, &
5867	1	do_not_log=GV%Boussinesq)
5868
5869		call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, &
5870		"If true, add a dynamic pressure due to a viscous ice "//&
5871	1	"shelf, for instance.", default=.false.)
5872		call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, &
5873		"The length scale at which the Rayleigh damping rate due "//&
5874		"to the ice strength should be the same as if a Laplacian "//&
5875		"were applied, if DYNAMIC_SURFACE_PRESSURE is true.", &
5876	1	units="m", default=1.0e4, scale=US%m_to_L, do_not_log=.not.CS%dynamic_psurf)
5877		call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, &
5878		"The minimum depth to use in limiting the size of the "//&
5879		"dynamic surface pressure for stability, if "//&
5880		"DYNAMIC_SURFACE_PRESSURE is true..", &
5881	1	units="m", default=1.0e-6, scale=GV%m_to_H, do_not_log=.not.CS%dynamic_psurf)
5882		call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, &
5883		"The constant that scales the dynamic surface pressure, "//&
5884		"if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//&
5885	1	"are < ~1.0.", units="nondim", default=0.9, do_not_log=.not.CS%dynamic_psurf)
5886
5887		call get_param(param_file, mdl, "BT_CORIOLIS_SCALE", CS%BT_Coriolis_scale, &
5888		"A factor by which the barotropic Coriolis anomaly terms are scaled.", &
5889	1	units="nondim", default=1.0)
5890		call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
5891		"This sets the default value for the various _ANSWER_DATE parameters.", &
5892	1	default=99991231)
5893		call get_param(param_file, mdl, "BAROTROPIC_ANSWER_DATE", CS%answer_date, &
5894		"The vintage of the expressions in the barotropic solver. "//&
5895		"Values below 20190101 recover the answers from the end of 2018, "//&
5896		"while higher values use more efficient or general expressions.", &
5897	1	default=default_answer_date, do_not_log=.not.GV%Boussinesq)
5898	1	if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
5899
5900		call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, &
5901	1	default=.true., do_not_log=.true.) ! This is logged from MOM.F90.
5902	1	call get_param(param_file, mdl, "VISC_REM_BUG", visc_rem_bug, default=.false., do_not_log=.true.)
5903		call get_param(param_file, mdl, "VISC_REM_BT_WEIGHT_BUG", CS%wt_uv_bug, &
5904		"If true, recover a bug in barotropic solver that uses an unnormalized weight "//&
5905		"function for vertical averages of baroclinic velocity and forcing. Default "//&
5906	1	"of this flag is set by VISC_REM_BUG.", default=visc_rem_bug)
5907		call get_param(param_file, mdl, "EXTERIOR_OBC_BUG", CS%exterior_OBC_bug, &
5908		"If true, recover a bug in barotropic solver and other routines when "//&
5909		"boundary contitions interior to the domain are used.", &
5910	1	default=enable_bugs, do_not_log=.true.)
5911		call get_param(param_file, mdl, "OBC_PROJECTION_BUG", OBC_projection_bug, &
5912		"If false, use only interior ocean points at OBCs to specify several "//&
5913		"calculations at OBC points, and it avoids applying a land mask at the bay-like "//&
5914		"intersection of orthogonal OBC segments. Otherwise the calculation of terms "//&
5915		"like the potential vorticity used in the barotropic solver relies on bathymetry "//&
5916		"or other fields being projected outward across OBCs. This option changes "//&
5917		"answers for some configurations that use OBCs.", &
5918	1	default=enable_bugs, do_not_log=.true.)
5919	1	CS%interior_OBC_PV = .not.OBC_projection_bug
5920
5921		call get_param(param_file, mdl, "TIDES", use_tides, &
5922	1	"If true, apply tidal momentum forcing.", default=.false.)
5923	1	if (use_tides .and. present(HA_CSp)) CS%HA_CSp => HA_CSp
5924		call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, &
5925	1	"If true, calculate self-attraction and loading.", default=use_tides)
5926	1	det_de = 0.0
5927	1	if (CS%calculate_SAL .and. associated(CS%SAL_CSp)) &
5928	0	call scalar_SAL_sensitivity(CS%SAL_CSp, det_de)
5929		call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, &
5930		"If true, the tidal self-attraction and loading anomaly in the barotropic "//&
5931		"solver has the wrong sign, replicating a long-standing bug with a scalar "//&
5932		"self-attraction and loading term or the SAL term from a previous simulation.", &
5933	1	default=.false., do_not_log=(det_de==0.0))
5934		call get_param(param_file, mdl, "TIDAL_SAL_FLATHER", CS%tidal_sal_flather, &
5935		"If true, then apply adjustments to the external gravity "//&
5936		"wave speed used with the Flather OBC routine consistent "//&
5937		"with the barotropic solver. This applies to cases with "//&
5938		"tidal forcing using the scalar self-attraction approximation. "//&
5939		"The default is currently False in order to retain previous answers "//&
5940	1	"but should be set to True for new experiments", default=.false.)
5941
5942		call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, &
5943		"If true, the Coriolis terms are discretized with the "//&
5944		"Sadourny (1975) energy conserving scheme, otherwise "//&
5945		"the Arakawa & Hsu scheme is used. If the internal "//&
5946		"deformation radius is not resolved, the Sadourny scheme "//&
5947	1	"should probably be used.", default=.true.)
5948
5949		call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, &
5950		"A string describing the scheme that is used to set the "//&
5951		"open face areas used for barotropic transport and the "//&
5952		"relative weights of the accelerations. Valid values are:\n"//&
5953		"\t ARITHMETIC - arithmetic mean layer thicknesses \n"//&
5954		"\t HARMONIC - harmonic mean layer thicknesses \n"//&
5955		"\t HYBRID (the default) - use arithmetic means for \n"//&
5956		"\t layers above the shallowest bottom, the harmonic \n"//&
5957		"\t mean for layers below, and a weighted average for \n"//&
5958		"\t layers that straddle that depth \n"//&
5959		"\t FROM_BT_CONT - use the average thicknesses kept \n"//&
5960		"\t in the h_u and h_v fields of the BT_cont_type", &
5961	1	default=BT_CONT_STRING)
5962	0	select case (hvel_str)
5963	0	case (HYBRID_STRING) ; CS%hvel_scheme = HYBRID
5964	0	case (HARMONIC_STRING) ; CS%hvel_scheme = HARMONIC
5965	0	case (ARITHMETIC_STRING) ; CS%hvel_scheme = ARITHMETIC
5966	1	case (BT_CONT_STRING) ; CS%hvel_scheme = FROM_BT_CONT
5967		case default
5968	0	call MOM_mesg('barotropic_init: BT_THICK_SCHEME ="'//trim(hvel_str)//'"', 0)
5969		call MOM_error(FATAL, "barotropic_init: Unrecognized setting "// &
5970	1	"#define BT_THICK_SCHEME "//trim(hvel_str)//" found in input file.")
5971		end select
5972	1	if ((CS%hvel_scheme == FROM_BT_CONT) .and. .not.use_BT_cont_type) &
5973		call MOM_error(FATAL, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//&
5974	0	"can only be used if USE_BT_CONT_TYPE is defined.")
5975
5976		call get_param(param_file, mdl, "BT_STRONG_DRAG", CS%strong_drag, &
5977		"If true, use a stronger estimate of the retarding "//&
5978		"effects of strong bottom drag, by making it implicit "//&
5979		"with the barotropic time-step instead of implicit with "//&
5980		"the baroclinic time-step and dividing by the number of "//&
5981	1	"barotropic steps.", default=.false.)
5982		call get_param(param_file, mdl, "RESCALE_STRONG_DRAG", CS%rescale_strong_drag, &
5983		"If true, reduce the barotropic contribution to the layer accelerations "//&
5984		"to account for the difference between the forces that can be counteracted "//&
5985		"by the stronger drag with BT_STRONG_DRAG and the average of the layer "//&
5986		"viscous remnants after a baroclinic timestep.", &
5987	1	default=.false., do_not_log=.not.CS%strong_drag)
5988		call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", CS%linear_wave_drag, &
5989		"If true, apply a linear drag to the barotropic velocities, "//&
5990		"using rates set by lin_drag_u & _v divided by the depth of "//&
5991		"the ocean. This was introduced to facilitate tide modeling.", &
5992	1	default=.false.)
5993		call get_param(param_file, mdl, "BT_LINEAR_FREQ_DRAG", CS%linear_freq_drag, &
5994		"If true, apply frequency-dependent drag to the tidal velocities. "//&
5995	1	"The streaming band-pass filter must be turned on.", default=.false.)
5996		call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, &
5997		"The name of the file with the barotropic linear wave drag "//&
5998		"piston velocities.", default="", &
5999	1	do_not_log=(.not.CS%linear_wave_drag) .and. (.not.CS%linear_freq_drag))
6000		call get_param(param_file, mdl, "BT_WAVE_DRAG_VAR", wave_drag_var, &
6001		"The name of the variable in BT_WAVE_DRAG_FILE with the "//&
6002		"barotropic linear wave drag piston velocities at h points. "//&
6003		"It will not be used if both BT_WAVE_DRAG_U and BT_WAVE_DRAG_V are defined.", &
6004	1	default="rH", do_not_log=.not.CS%linear_wave_drag)
6005		call get_param(param_file, mdl, "BT_WAVE_DRAG_U", wave_drag_u, &
6006		"The name of the variable in BT_WAVE_DRAG_FILE with the "//&
6007		"barotropic linear wave drag piston velocities at u points.", &
6008	1	default="", do_not_log=.not.CS%linear_wave_drag)
6009		call get_param(param_file, mdl, "BT_WAVE_DRAG_V", wave_drag_v, &
6010		"The name of the variable in BT_WAVE_DRAG_FILE with the "//&
6011		"barotropic linear wave drag piston velocities at v points.", &
6012	1	default="", do_not_log=.not.CS%linear_wave_drag)
6013		call get_param(param_file, mdl, "BT_WAVE_DRAG_SCALE", wave_drag_scale, &
6014		"A scaling factor for the barotropic linear wave drag "//&
6015		"piston velocities.", default=1.0, units="nondim", &
6016	1	do_not_log=.not.CS%linear_wave_drag)
6017
6018		call get_param(param_file, mdl, "CLIP_BT_VELOCITY", CS%clip_velocity, &
6019		"If true, limit any velocity components that exceed "//&
6020		"CFL_TRUNCATE. This should only be used as a desperate "//&
6021	1	"debugging measure.", default=.false.)
6022		call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, &
6023		"The value of the CFL number that will cause velocity "//&
6024		"components to be truncated; instability can occur past 0.5.", &
6025	1	units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity)
6026		call get_param(param_file, mdl, "MAXVEL", CS%maxvel, &
6027		"The maximum velocity allowed before the velocity "//&
6028		"components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T, &
6029	1	do_not_log=.not.CS%clip_velocity)
6030		call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, &
6031		"The maximum permitted CFL number associated with the "//&
6032		"barotropic accelerations from the summed velocities "//&
6033		"times the time-derivatives of thicknesses.", units="nondim", &
6034	1	default=0.25)
6035		call get_param(param_file, mdl, "VEL_UNDERFLOW", CS%vel_underflow, &
6036		"A negligibly small velocity magnitude below which velocity "//&
6037		"components are set to 0. A reasonable value might be "//&
6038		"1e-30 m/s, which is less than an Angstrom divided by "//&
6039	1	"the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T)
6040
6041		call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, &
6042		"A time-scale over which the barotropic mode solutions "//&
6043		"are filtered, in seconds if positive, or as a fraction "//&
6044		"of DT if negative. When used this can never be taken to "//&
6045		"be longer than 2*dt. Set this to 0 to apply no filtering.", &
6046	1	units="sec or nondim", default=-0.25)
6047	1	if (CS%dt_bt_filter > 0.0) CS%dt_bt_filter = US%s_to_T*CS%dt_bt_filter
6048		call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, &
6049		"A nondimensional factor by which gtot is enhanced.", &
6050	1	units="nondim", default=0.0)
6051		call get_param(param_file, mdl, "SSH_EXTRA", SSH_extra, &
6052		"An estimate of how much higher SSH might get, for use "//&
6053		"in calculating the safe external wave speed. The "//&
6054		"default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", &
6055	1	units="m", default=min(10.0,0.05G%max_depthUS%Z_to_m), scale=US%m_to_Z)
6056
6057		call get_param(param_file, mdl, "DEBUG", CS%debug, &
6058		"If true, write out verbose debugging data.", &
6059	1	default=.false., debuggingParam=.true.)
6060		call get_param(param_file, mdl, "DEBUG_BT", CS%debug_bt, &
6061		"If true, write out verbose debugging data within the "//&
6062		"barotropic time-stepping loop. The data volume can be "//&
6063		"quite large if this is true.", default=CS%debug, &
6064	1	debuggingParam=.true.)
6065		call get_param(param_file, mdl, "DEBUG_BT_WIDE_HALOS", CS%debug_wide_halos, &
6066		"If true, write the checksums on the full wide halos. Otherwise only the "//&
6067		"output for the final computational domain is written. This can be valuable "//&
6068		"for debugging certain cases where the stencil used in the wide halo "//&
6069		"iterations depends on which opoen boundary conditions are in the halos.", &
6070	1	default=.true., do_not_log=.not.(CS%debug_bt.and.CS%use_wide_halos), debuggingParam=.true.)
6071
6072		call get_param(param_file, mdl, "LINEARIZED_BT_CORIOLIS", CS%linearized_BT_PV, &
6073		"If true use the bottom depth instead of the total water column thickness "//&
6074	1	"in the barotropic Coriolis term calculations.", default=.true.)
6075		call get_param(param_file, mdl, "BEBT", CS%bebt, &
6076		"BEBT determines whether the barotropic time stepping "//&
6077		"uses the forward-backward time-stepping scheme or a "//&
6078		"backward Euler scheme. BEBT is valid in the range from "//&
6079		"0 (for a forward-backward treatment of nonrotating "//&
6080		"gravity waves) to 1 (for a backward Euler treatment). "//&
6081		"In practice, BEBT must be greater than about 0.05.", &
6082	1	units="nondim", default=0.1)
6083		! Note that dtbt_input is not rescaled because it has different units for
6084		! positive [s] and negative [nondim] values.
6085		call get_param(param_file, mdl, "DTBT", dtbt_input, &
6086		"The barotropic time step, in s. DTBT is only used with "//&
6087		"the split explicit time stepping. To set the time step "//&
6088		"automatically based the maximum stable value use 0, or "//&
6089		"a negative value gives the fraction of the stable value. "//&
6090		"Setting DTBT to 0 is the same as setting it to -0.98. "//&
6091		"The value of DTBT that will actually be used is an "//&
6092		"integer fraction of DT, rounding down.", &
6093	1	units="s or nondim", default=-0.98)
6094		call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", CS%use_old_coriolis_bracket_bug, &
6095		"If True, use an order of operations that is not bitwise "//&
6096		"rotationally symmetric in the meridional Coriolis term of "//&
6097	1	"the barotropic solver.", default=.false.)
6098		call get_param(param_file, mdl, "MASK_COASTAL_PRESSURE_FORCE", mask_coastal_pressure_force, &
6099		"If true, use the land masks to zero out the diagnosed barotropic pressure "//&
6100		"gradient accelerations at coastal or land points. This changes diagnostics "//&
6101		"and improves the reproducibility of certain debugging checksums, but it "//&
6102	1	"does not alter the solutions themselves.", default=.false.)
6103		!### Change the default for MASK_COASTAL_PRESSURE_FORCE to true?
6104
6105		! Initialize a version of the MOM domain that is specific to the barotropic solver.
6106	1	call clone_MOM_domain(G%Domain, CS%BT_Domain, min_halo=wd_halos, symmetric=.true.)
6107		#ifdef STATIC_MEMORY_
6108		if (wd_halos(1) /= WHALOI_+NIHALO_) call MOM_error(FATAL, "barotropic_init: "//&
6109		"Barotropic x-halo sizes are incorrectly resized with STATIC_MEMORY_.")
6110		if (wd_halos(2) /= WHALOJ_+NJHALO_) call MOM_error(FATAL, "barotropic_init: "//&
6111		"Barotropic y-halo sizes are incorrectly resized with STATIC_MEMORY_.")
6112		#else
6113	1	if (bt_halo_sz > 0) then
6114	0	if (wd_halos(1) > bt_halo_sz) &
6115	0	call MOM_mesg("barotropic_init: barotropic x-halo size increased.", 3)
6116	0	if (wd_halos(2) > bt_halo_sz) &
6117	0	call MOM_mesg("barotropic_init: barotropic y-halo size increased.", 3)
6118		endif
6119		#endif
6120		call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), &
6121		"The barotropic x-halo size that is actually used.", &
6122	1	layoutParam=.true.)
6123		call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), &
6124		"The barotropic y-halo size that is actually used.", &
6125	1	layoutParam=.true.)
6126
6127	1	CS%isdw = G%isc-wd_halos(1) ; CS%iedw = G%iec+wd_halos(1)
6128	1	CS%jsdw = G%jsc-wd_halos(2) ; CS%jedw = G%jec+wd_halos(2)
6129	1	isdw = CS%isdw ; iedw = CS%iedw ; jsdw = CS%jsdw ; jedw = CS%jedw
6130
6131	1	ALLOC_(CS%frhatu(IsdB:IedB,jsd:jed,nz)) ; ALLOC_(CS%frhatv(isd:ied,JsdB:JedB,nz))
6132	1	ALLOC_(CS%eta_cor(isd:ied,jsd:jed))
6133	1	if (CS%bound_BT_corr) &
6134	69373	allocate(CS%eta_cor_bound(isd:ied,jsd:jed), source=0.0)
6135	1	ALLOC_(CS%IDatu(IsdB:IedB,jsd:jed)) ; ALLOC_(CS%IDatv(isd:ied,JsdB:JedB))
6136
6137	1	ALLOC_(CS%ua_polarity(isdw:iedw,jsdw:jedw))
6138	1	ALLOC_(CS%va_polarity(isdw:iedw,jsdw:jedw))
6139
6140	3064667	CS%frhatu(:,:,:) = 0.0 ; CS%frhatv(:,:,:) = 0.0
6141	69373	CS%eta_cor(:,:) = 0.0
6142	139302	CS%IDatu(:,:) = 0.0 ; CS%IDatv(:,:) = 0.0
6143
6144	138745	CS%ua_polarity(:,:) = 1.0 ; CS%va_polarity(:,:) = 1.0
6145	1	call create_group_pass(pass_a_polarity, CS%ua_polarity, CS%va_polarity, CS%BT_domain, To_All, AGRID)
6146	1	call do_group_pass(pass_a_polarity, CS%BT_domain)
6147
6148	1	if (use_BT_cont_type) &
6149	1	call alloc_BT_cont_type(BT_cont, G, GV, (CS%hvel_scheme == FROM_BT_CONT))
6150
6151	1	if (CS%debug) then ! Make a local copy of loop ranges for chksum calls
6152	0	allocate(CS%debug_BT_HI)
6153	0	CS%debug_BT_HI%isc = G%isc
6154	0	CS%debug_BT_HI%iec = G%iec
6155	0	CS%debug_BT_HI%jsc = G%jsc
6156	0	CS%debug_BT_HI%jec = G%jec
6157	0	CS%debug_BT_HI%IscB = G%isc-1
6158	0	CS%debug_BT_HI%IecB = G%iec
6159	0	CS%debug_BT_HI%JscB = G%jsc-1
6160	0	CS%debug_BT_HI%JecB = G%jec
6161	0	CS%debug_BT_HI%isd = CS%isdw
6162	0	CS%debug_BT_HI%ied = CS%iedw
6163	0	CS%debug_BT_HI%jsd = CS%jsdw
6164	0	CS%debug_BT_HI%jed = CS%jedw
6165	0	CS%debug_BT_HI%IsdB = CS%isdw-1
6166	0	CS%debug_BT_HI%IedB = CS%iedw
6167	0	CS%debug_BT_HI%JsdB = CS%jsdw-1
6168	0	CS%debug_BT_HI%JedB = CS%jedw
6169	0	CS%debug_BT_HI%turns = G%HI%turns
6170		endif
6171
6172		! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.
6173	69373	ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0
6174	69373	ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = 0.0
6175	69561	ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0
6176	69742	ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0
6177	69561	ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0
6178	69742	ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0
6179	69373	allocate(CS%IareaT_OBCmask(isdw:iedw,jsdw:jedw), source=0.0)
6180	69561	ALLOC_(CS%OBCmask_u(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%OBCmask_u(:,:) = 0.0
6181	69742	ALLOC_(CS%OBCmask_v(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%OBCmask_v(:,:) = 0.0
6182		!@start noport ! mapped at end of this routine
6183	69373	do j=G%jsd,G%jed ; do i=G%isd,G%ied
6184	69184	CS%IareaT(i,j) = G%IareaT(i,j)
6185	69184	CS%bathyT(i,j) = G%bathyT(i,j)
6186	69372	CS%IareaT_OBCmask(i,j) = CS%IareaT(i,j)
6187		enddo ; enddo
6188
6189		! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without
6190		! wide halos.
6191	69561	do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB
6192	69372	CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j)
6193	69560	CS%OBCmask_u(I,j) = G%OBCmaskCu(I,j)
6194		enddo ; enddo
6195	69742	do J=G%JsdB,G%JedB ; do i=G%isd,G%ied
6196	69552	CS%IdyCv(i,J) = G%IdyCv(i,J) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J)
6197	69741	CS%OBCmask_v(i,J) = G%OBCmaskCv(i,J)
6198		enddo ; enddo
6199
6200		! This sets pressure force diagnostics on land, at coastlines and at OBC points to zero.
6201	1	if (mask_coastal_pressure_force) then
6202	0	do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB
6203	0	CS%IdxCu(I,j) = G%IdxCu_OBCmask(I,j)
6204		enddo ; enddo
6205	0	do J=G%JsdB,G%JedB ; do i=G%isd,G%ied
6206	0	CS%IdyCv(i,J) = G%IdyCv_OBCmask(i,J)
6207		enddo ; enddo
6208		endif
6209
6210	1	if (associated(OBC)) then
6211		! Set up information about the location and nature of the open boundary condition points.
6212	0	call initialize_BT_OBC(OBC, CS%BT_OBC, G, CS)
6213
6214		! Update IareaT_OBCmask so that nothing changes outside of the OBC (problem for interior OBCs only)
6215	0	if (.not.CS%exterior_OBC_bug) then
6216	0	if (CS%BT_OBC%u_OBCs_on_PE) then
6217	0	do j=jsd,jed ; do i=isd,ied
6218	0	if (CS%BT_OBC%u_OBC_type(I-1,j) > 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_E
6219	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_W
6220		enddo ; enddo
6221		endif
6222	0	if (CS%BT_OBC%v_OBCs_on_PE) then
6223	0	do j=jsd,jed ; do i=isd,ied
6224	0	if (CS%BT_OBC%v_OBC_type(i,J-1) > 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_N
6225	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) CS%IareaT_OBCmask(i,j) = 0.0 ! OBC_DIRECTION_S
6226		enddo ; enddo
6227		endif
6228		endif
6229
6230		! Set masks to avoid changing velocities at OBC points.
6231	0	if (CS%BT_OBC%u_OBCs_on_PE) then
6232	0	do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB ; if (CS%BT_OBC%u_OBC_type(I,j) /= 0) then
6233	0	CS%OBCmask_u(I,j) = 0.0 ; CS%IdxCu(I,j) = 0.0
6234		endif ; enddo ; enddo
6235		endif
6236	0	if (CS%BT_OBC%v_OBCs_on_PE) then
6237	0	do J=G%JsdB,G%JedB ; do i=G%isd,G%ied ; if (CS%BT_OBC%v_OBC_type(i,J) /= 0) then
6238	0	CS%OBCmask_v(i,J) = 0.0 ; CS%IdyCv(i,J) = 0.0
6239		endif ; enddo ; enddo
6240		endif
6241
6242	0	CS%integral_OBCs = CS%integral_BT_cont .and. open_boundary_query(OBC, apply_open_OBC=.true.)
6243		else ! There are no OBC points anywhere.
6244	1	CS%BT_OBC%u_OBCs_on_PE = .false.
6245	1	CS%BT_OBC%v_OBCs_on_PE = .false.
6246	1	CS%integral_OBCs = .false.
6247		endif
6248
6249	1	call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All)
6250	1	call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All)
6251	1	call create_group_pass(pass_static_data, CS%IareaT_OBCmask, CS%BT_domain, To_All)
6252	1	call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, To_All+Scalar_Pair)
6253	1	call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, To_All+Scalar_Pair)
6254	1	call create_group_pass(pass_static_data, CS%OBCmask_u, CS%OBCmask_v, CS%BT_domain, To_All+Scalar_Pair)
6255	1	call do_group_pass(pass_static_data, CS%BT_domain)
6256
6257		! Determine the weights to use for the thicknesses when calculating PV for use in the Coriolis terms
6258	348895	allocate(CS%q_wt(4,CS%isdw-1:CS%iedw,CS%jsdw-1:CS%jedw), source=0.0)
6259	65523	do J=js-1,je ; do I=is-1,ie
6260	65522	if (G%mask2dT(i,j) + G%mask2dT(i,j+1) + G%mask2dT(i+1,j) + G%mask2dT(i+1,j+1) > 0.) then
6261	46914	CS%q_wt(1,I,J) = G%areaT(i,j) ; CS%q_wt(2,I,J) = G%areaT(i+1,j)
6262	46914	CS%q_wt(3,I,J) = G%areaT(i,j+1) ; CS%q_wt(4,I,J) = G%areaT(i+1,j+1)
6263		else
6264	92135	CS%q_wt(1:4,I,J) = 0.0
6265		endif
6266		enddo ; enddo
6267
6268	1	if (CS%interior_OBC_PV .and. (CS%BT_OBC%u_OBCs_on_PE .or. CS%BT_OBC%v_OBCs_on_PE)) then
6269		! Reset the potential vorticity at OBC vertices as a masked weighted average.
6270	0	do J=js-1,je ; do I=is-1,ie
6271	0	if ((G%mask2dT(i,j) + G%mask2dT(i,j+1) + G%mask2dT(i+1,j) + G%mask2dT(i+1,j+1) > 0.) .and. &
6272		((abs(CS%BT_OBC%u_OBC_type(I,j)) > 0) .or. (abs(CS%BT_OBC%u_OBC_type(I,j+1)) > 0) .or. &
6273	0	(abs(CS%BT_OBC%v_OBC_type(i,J)) > 0) .or. (abs(CS%BT_OBC%v_OBC_type(i+1,J)) > 0)) ) then
6274		! This is an OBC vertex, so use an area weighted masked average and avoid external values.
6275	0	CS%q_wt(1,I,J) = G%mask2dT(i,j) * G%areaT(i,j)
6276	0	CS%q_wt(2,I,J) = G%mask2dT(i+1,j) * G%areaT(i+1,j)
6277	0	CS%q_wt(3,I,J) = G%mask2dT(i,j+1) * G%areaT(i,j+1)
6278	0	CS%q_wt(4,I,J) = G%mask2dT(i+1,j+1) * G%areaT(i+1,j+1)
6279
6280		! The following block is the equivalent of shifting weights inward across OBC points. With
6281		! two OBCs in a line, it gives weights of about 1/2 and 1/2 to the interior points. At a
6282		! peninsula-like corner between two OBCs it gives weights of about 3/8, 1/4 and 3/8 for the
6283		! 3 interior points. At a bay-liek corner there is only one interior point with a weight of 1.
6284		! The masking above zeros out the weights for exterior points.
6285	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) then ! Eastern OBC in the u-point to the south
6286	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
6287	0	elseif (CS%BT_OBC%u_OBC_type(I,j) < 0) then ! Western OBC in the u-point to the south
6288	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
6289		endif
6290	0	if (CS%BT_OBC%u_OBC_type(I,j+1) > 0) then ! Eastern OBC in the u-point to the north
6291	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
6292	0	elseif (CS%BT_OBC%u_OBC_type(I,j+1) < 0) then ! Western OBC in the u-point to the north
6293	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
6294		endif
6295	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) then ! Northern OBC in the v-point to the west
6296	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
6297	0	elseif (CS%BT_OBC%v_OBC_type(i,J) < 0) then ! Southern OBC in the v-point to the west
6298	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
6299		endif
6300	0	if (CS%BT_OBC%v_OBC_type(i+1,J) > 0) then ! Northern OBC in the v-point to the west
6301	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
6302	0	elseif (CS%BT_OBC%v_OBC_type(i+1,J) < 0) then ! Southern OBC in the v-point to the west
6303	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
6304		endif
6305		endif
6306		enddo ; enddo
6307		endif
6308
6309	1	if (CS%linearized_BT_PV) then
6310	69931	allocate(CS%q_D(CS%isdw-1:CS%iedw,CS%jsdw-1:CS%jedw), source=0.0)
6311	69561	allocate(CS%D_u_Cor(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw), source=0.0)
6312	69742	allocate(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw), source=0.0)
6313
6314	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
6315
6316	65161	do j=js,je ; do I=is-1,ie
6317		CS%D_u_Cor(I,j) = 0.5 * ( max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) &
6318	65160	+ max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) ) * Z_to_H
6319		enddo ; enddo
6320	1	if (CS%interior_OBC_PV .and. CS%BT_OBC%u_OBCs_on_PE) then ; do j=js,je ; do I=is-1,ie
6321	0	if (CS%BT_OBC%u_OBC_type(I,j) < 0) & ! Western boundary condition
6322	0	CS%D_u_Cor(I,j) = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) * Z_to_H
6323	0	if (CS%BT_OBC%u_OBC_type(I,j) > 0) & ! Eastern boundary condition
6324	0	CS%D_u_Cor(I,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
6325		enddo ; enddo ; endif
6326
6327	65342	do J=js-1,je ; do i=is,ie
6328		CS%D_v_Cor(i,J) = 0.5 * ( max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) &
6329	65341	+ max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) ) * Z_to_H
6330		enddo ; enddo
6331	1	if (CS%interior_OBC_PV .and. CS%BT_OBC%v_OBCs_on_PE) then ; do J=js-1,je ; do i=is,ie
6332	0	if (CS%BT_OBC%v_OBC_type(i,J) < 0) & ! Southern boundary condition
6333	0	CS%D_v_Cor(i,J) = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) * Z_to_H
6334	0	if (CS%BT_OBC%v_OBC_type(i,J) > 0) & ! Northern boundary condition
6335	0	CS%D_v_Cor(i,J) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H
6336		enddo ; enddo ; endif
6337
6338	1	h_a_neglect = GV%H_subroundoff * 1.0 * US%m_to_L**2
6339	65523	do J=js-1,je ; do I=is-1,ie
6340	65522	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
6341		CS%q_D(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
6342		((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J))) / &
6343		max(Z_to_H * (((CS%q_wt(1,I,J) * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0)) + &
6344		(CS%q_wt(4,I,J) * max(G%meanSL(i+1,j+1) + G%bathyT(i+1,j+1), 0.0))) + &
6345		((CS%q_wt(2,I,J) * max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0)) + &
6346		(CS%q_wt(3,I,J) * max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0)))), &
6347	46914	h_a_neglect)
6348		else ! All four h points are masked out so q_D(I,J) is meaningless
6349	18427	CS%q_D(I,J) = 0.
6350		endif
6351		enddo ; enddo
6352
6353		! With very wide halos, q and D need to be calculated on the available data
6354		! domain and then updated onto the full computational domain.
6355	1	call create_group_pass(pass_q_D_Cor, CS%q_D, CS%BT_Domain, To_All, position=CORNER)
6356		call create_group_pass(pass_q_D_Cor, CS%D_u_Cor, CS%D_v_Cor, CS%BT_Domain, &
6357	1	To_All+Scalar_Pair)
6358	1	call do_group_pass(pass_q_D_Cor, CS%BT_Domain)
6359		endif
6360
6361	1	if (CS%linear_wave_drag) then
6362	0	allocate(CS%lin_drag_u(IsdB:IedB,jsd:jed), source=0.0)
6363	0	allocate(CS%lin_drag_v(isd:ied,JsdB:JedB), source=0.0)
6364
6365	0	if (len_trim(wave_drag_file) > 0) then
6366	0	inputdir = "." ; call get_param(param_file, mdl, "INPUTDIR", inputdir)
6367	0	wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
6368	0	call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
6369
6370	0	if (len_trim(wave_drag_u) > 0 .and. len_trim(wave_drag_v) > 0) then
6371		call MOM_read_data(wave_drag_file, wave_drag_u, CS%lin_drag_u, G%Domain, &
6372	0	position=EAST_FACE, scale=wave_drag_scaleGV%m_to_HUS%T_to_s)
6373		call MOM_read_data(wave_drag_file, wave_drag_v, CS%lin_drag_v, G%Domain, &
6374	0	position=NORTH_FACE, scale=wave_drag_scaleGV%m_to_HUS%T_to_s)
6375	0	call pass_vector(CS%lin_drag_u, CS%lin_drag_v, G%domain, direction=To_All+SCALAR_PAIR)
6376		else
6377	0	allocate(lin_drag_h(isd:ied,jsd:jed), source=0.0)
6378
6379	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)
6380	0	call pass_var(lin_drag_h, G%Domain)
6381	0	do j=js,je ; do I=is-1,ie
6382	0	CS%lin_drag_u(I,j) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
6383		enddo ; enddo
6384	0	do J=js-1,je ; do i=is,ie
6385	0	CS%lin_drag_v(i,J) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
6386		enddo ; enddo
6387	0	deallocate(lin_drag_h)
6388		endif ! len_trim(wave_drag_u) > 0 .and. len_trim(wave_drag_v) > 0
6389		endif ! len_trim(wave_drag_file) > 0
6390		endif ! CS%linear_wave_drag
6391
6392		! Initialize streaming band-pass filters and frequency-dependent drag
6393	1	if (CS%use_filter) then
6394	0	call Filt_init(param_file, US, CS%Filt_CS_u, restart_CS)
6395	0	call Filt_init(param_file, US, CS%Filt_CS_v, restart_CS)
6396		endif
6397
6398	1	if (CS%use_filter .and. CS%linear_freq_drag) then
6399	0	if (.not.CS%linear_wave_drag .and. len_trim(wave_drag_file) > 0) then
6400	0	inputdir = "." ; call get_param(param_file, mdl, "INPUTDIR", inputdir)
6401	0	wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
6402	0	call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
6403		endif
6404	0	call wave_drag_init(param_file, wave_drag_file, G, GV, US, CS%Drag_CS)
6405		endif
6406
6407	1	CS%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) CS%dtbt_fraction = -dtbt_input
6408
6409	1	dtbt_restart = -1.0
6410	1	if (query_initialized(CS%dtbt, "DTBT", restart_CS)) then
6411	0	dtbt_restart = CS%dtbt
6412		endif
6413
6414		! Estimate the maximum stable barotropic time step.
6415	1	gtot_estimate = 0.0
6416	1	if (GV%Boussinesq) then
6417	76	do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%H_to_Z*GV%g_prime(K) ; enddo
6418		else
6419	0	H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin
6420	0	do k=1,GV%ke ; gtot_estimate = gtot_estimate + H_to_Z*GV%g_prime(K) ; enddo
6421		endif
6422
6423		! ubtav and vbtav, and perhaps ubt_IC and vbt_IC, are allocated and
6424		! initialized in register_barotropic_restarts.
6425
6426	1	if (GV%Boussinesq) then
6427	1	thickness_units = "m" ; flux_units = "m3 s-1"
6428		else
6429	0	thickness_units = "kg m-2" ; flux_units = "kg s-1"
6430		endif
6431
6432		CS%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, Time, &
6433	1	'Zonal Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6434		CS%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, Time, &
6435	1	'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6436		CS%id_etaPF_anom = register_diag_field('ocean_model', 'etaPF_anom', diag%axesT1, Time, &
6437		'Eta anomalies used for pressure forces averaged over a baroclinic timestep', &
6438	1	thickness_units, conversion=GV%H_to_MKS)
6439	1	if (CS%linear_wave_drag .or. (CS%use_filter .and. CS%linear_freq_drag)) then
6440		CS%id_LDu_bt = register_diag_field('ocean_model', 'WaveDraguBT', diag%axesCu1, Time, &
6441	0	'Zonal Barotropic Linear Wave Drag Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6442		CS%id_LDv_bt = register_diag_field('ocean_model', 'WaveDragvBT', diag%axesCv1, Time, &
6443	0	'Meridional Barotropic Linear Wave Drag Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6444		endif
6445		CS%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, Time, &
6446	1	'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6447		CS%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, Time, &
6448	1	'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6449		CS%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, Time, &
6450	1	'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6451		CS%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, Time, &
6452	1	'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6453		CS%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, Time, &
6454	1	'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2)
6455		CS%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, Time, &
6456	1	'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2)
6457		CS%id_ubtdt = register_diag_field('ocean_model', 'ubt_dt', diag%axesCu1, Time, &
6458	1	'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6459		CS%id_vbtdt = register_diag_field('ocean_model', 'vbt_dt', diag%axesCv1, Time, &
6460	1	'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2)
6461
6462		CS%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, Time, &
6463	1	'Barotropic end SSH', thickness_units, conversion=GV%H_to_MKS)
6464		CS%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, Time, &
6465	1	'Barotropic end zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6466		CS%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, Time, &
6467	1	'Barotropic end meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6468		CS%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, Time, &
6469	1	'Barotropic start SSH', thickness_units, conversion=GV%H_to_MKS)
6470		CS%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, Time, &
6471	1	'Barotropic start zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6472		CS%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, Time, &
6473	1	'Barotropic start meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6474		CS%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, Time, &
6475	1	'Barotropic time-average zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6476		CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, &
6477	1	'Barotropic time-average meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6478		CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, &
6479	1	'Corrective mass or volume flux within a timestep', thickness_units, conversion=GV%H_to_MKS)
6480		CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, &
6481	1	'Viscous remnant at u', 'nondim')
6482		CS%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, Time, &
6483	1	'Viscous remnant at v', 'nondim')
6484		CS%id_bt_rem_u = register_diag_field('ocean_model', 'bt_rem_u', diag%axesCu1, Time, &
6485	1	'Barotropic viscous remnant per barotropic step at u', 'nondim')
6486		CS%id_bt_rem_v = register_diag_field('ocean_model', 'bt_rem_v', diag%axesCv1, Time, &
6487	1	'Barotropic viscous remnant per barotropic step at v', 'nondim')
6488		CS%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, Time, &
6489	1	'gtot to North', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6490		CS%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, Time, &
6491	1	'gtot to South', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6492		CS%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, Time, &
6493	1	'gtot to East', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6494		CS%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, Time, &
6495	1	'gtot to West', 'm s-2', conversion=GV%m_to_H(US%L_T_to_m_s*2))
6496		CS%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, Time, &
6497	1	'High Frequency Barotropic SSH', thickness_units, conversion=GV%H_to_MKS)
6498		CS%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, Time, &
6499	1	'High Frequency Barotropic zonal velocity', 'm s-1', conversion=US%L_T_to_m_s)
6500		CS%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, Time, &
6501	1	'High Frequency Barotropic meridional velocity', 'm s-1', conversion=US%L_T_to_m_s)
6502		! if (.not.CS%BT_project_velocity) & ! The following diagnostic is redundant with BT_project_velocity.
6503		CS%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, Time, &
6504	1	'High Frequency Predictor Barotropic SSH', thickness_units, conversion=GV%H_to_MKS)
6505		CS%id_etaPF_hifreq = register_diag_field('ocean_model', 'etaPF_hifreq', diag%axesT1, Time, &
6506	1	'High Frequency Barotropic SSH anomalies used for pressure forces', thickness_units, conversion=GV%H_to_MKS)
6507		CS%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, Time, &
6508		'High Frequency Barotropic zonal transport', &
6509	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6510		CS%id_vhbt_hifreq = register_diag_field('ocean_model', 'vhbt_hifreq', diag%axesCv1, Time, &
6511		'High Frequency Barotropic meridional transport', &
6512	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6513		CS%id_frhatu = register_diag_field('ocean_model', 'frhatu', diag%axesCuL, Time, &
6514	1	'Fractional thickness of layers in u-columns', 'nondim')
6515		CS%id_frhatv = register_diag_field('ocean_model', 'frhatv', diag%axesCvL, Time, &
6516	1	'Fractional thickness of layers in v-columns', 'nondim')
6517		CS%id_frhatu1 = register_diag_field('ocean_model', 'frhatu1', diag%axesCuL, Time, &
6518	1	'Predictor Fractional thickness of layers in u-columns', 'nondim')
6519		CS%id_frhatv1 = register_diag_field('ocean_model', 'frhatv1', diag%axesCvL, Time, &
6520	1	'Predictor Fractional thickness of layers in v-columns', 'nondim')
6521		CS%id_uhbt = register_diag_field('ocean_model', 'uhbt', diag%axesCu1, Time, &
6522		'Barotropic zonal 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		CS%id_vhbt = register_diag_field('ocean_model', 'vhbt', diag%axesCv1, Time, &
6525		'Barotropic meridional transport averaged over a baroclinic step', &
6526	1	'm3 s-1', conversion=GV%H_to_mUS%L_to_mUS%L_T_to_m_s)
6527
6528	1	if (use_BT_cont_type) then
6529		CS%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, Time, &
6530	1	'BTCont type far east face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6531		CS%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, Time, &
6532	1	'BTCont type near east face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6533		CS%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, Time, &
6534	1	'BTCont type far west face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6535		CS%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, Time, &
6536	1	'BTCont type near west face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6537		CS%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, Time, &
6538	1	'BTCont type far east velocity', 'm s-1', conversion=US%L_T_to_m_s)
6539		CS%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, Time, &
6540	1	'BTCont type far west velocity', 'm s-1', conversion=US%L_T_to_m_s)
6541		! This is a specialized diagnostic that is not being made widely available (yet).
6542		! CS%id_BTC_FA_u_rat0 = register_diag_field('ocean_model', 'BTC_FA_u_rat0', diag%axesCu1, Time, &
6543		! 'BTCont type ratio of near east and west face areas', 'nondim')
6544		CS%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, Time, &
6545	1	'BTCont type far north face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6546		CS%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, Time, &
6547	1	'BTCont type near north face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6548		CS%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, Time, &
6549	1	'BTCont type far south face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6550		CS%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, Time, &
6551	1	'BTCont type near south face area', 'm2', conversion=US%L_to_m*GV%H_to_m)
6552		CS%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, Time, &
6553	1	'BTCont type far north velocity', 'm s-1', conversion=US%L_T_to_m_s)
6554		CS%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, Time, &
6555	1	'BTCont type far south velocity', 'm s-1', conversion=US%L_T_to_m_s)
6556		! This is a specialized diagnostic that is not being made widely available (yet).
6557		! CS%id_BTC_FA_v_rat0 = register_diag_field('ocean_model', 'BTC_FA_v_rat0', diag%axesCv1, Time, &
6558		! 'BTCont type ratio of near north and south face areas', 'nondim')
6559		! CS%id_BTC_FA_h_rat0 = register_diag_field('ocean_model', 'BTC_FA_h_rat0', diag%axesT1, Time, &
6560		! 'BTCont type maximum ratios of near face areas around cells', 'nondim')
6561		endif
6562		CS%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, Time, &
6563	1	'Barotropic zonal transport difference', 'm3 s-1', conversion=GV%H_to_mUS%L_to_m2US%s_to_T)
6564		CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, &
6565	1	'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_mUS%L_to_m2US%s_to_T)
6566	1	if (associated(OBC)) then
6567	0	if (OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally) then
6568		CS%id_SSH_u_OBC = register_diag_field('ocean_model', 'SSH_u_OBC', diag%axesCu1, Time, &
6569	0	'Outer sea surface height at u OBC points', 'm', conversion=US%Z_to_m)
6570		CS%id_SSH_v_OBC = register_diag_field('ocean_model', 'SSH_v_OBC', diag%axesCv1, Time, &
6571	0	'Outer sea surface height at v OBC points', 'm', conversion=US%Z_to_m)
6572		CS%id_ubt_OBC = register_diag_field('ocean_model', 'ubt_OBC', diag%axesCu1, Time, &
6573	0	'Outer u velocity at OBC points', 'm', conversion=US%L_T_to_m_s)
6574		CS%id_vbt_OBC = register_diag_field('ocean_model', 'vbt_OBC', diag%axesCv1, Time, &
6575	0	'Outer v velocity at OBC points', 'm', conversion=US%L_T_to_m_s)
6576		endif
6577		endif
6578		!@end noport
6579		!$omp target update to (CS)
6580
6581		! CS%dtbt calculated here by set_dtbt is only used when dtbt is not reset during the run, i.e. DTBT_RESET_PERIOD<0.
6582		!$omp target enter data map (to: CS%frhatu, CS%frhatv)
6583		!$omp target enter data map (to: CS%eta_cor)
6584	1	call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra)
6585
6586	1	if (dtbt_input > 0.0) then
6587	0	CS%dtbt = US%s_to_T * dtbt_input
6588	1	elseif (dtbt_restart > 0.0) then
6589	0	CS%dtbt = dtbt_restart
6590		endif
6591		!$omp target update to (CS%dtbt)
6592
6593	1	calc_dtbt = .true. ; if ((dtbt_restart > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false.
6594
6595	1	call log_param(param_file, mdl, "DTBT as used", CS%dtbt, units="s", unscale=US%T_to_s)
6596	1	call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max, units="s", unscale=US%T_to_s)
6597
6598	1	if (CS%id_frhatu1 > 0) allocate(CS%frhatu1(IsdB:IedB,jsd:jed,nz), source=0.)
6599	1	if (CS%id_frhatv1 > 0) allocate(CS%frhatv1(isd:ied,JsdB:JedB,nz), source=0.)
6600
6601	1	if (.NOT.query_initialized(CS%ubtav,"ubtav",restart_CS) .or. &
6602		.NOT.query_initialized(CS%vbtav,"vbtav",restart_CS)) then
6603		!$omp target update to(h)
6604	1	call btcalc(h, G, GV, CS, may_use_default=.true.)
6605		!@start noport ! mapped at end of this routine
6606	139302	CS%ubtav(:,:) = 0.0 ; CS%vbtav(:,:) = 0.0
6607	1433543	do k=1,nz ; do j=js,je ; do I=is-1,ie
6608	1433520	CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * u(I,j,k)
6609		enddo ; enddo ; enddo
6610	1437525	do k=1,nz ; do J=js-1,je ; do i=is,ie
6611	1437502	CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k)
6612		enddo ; enddo ; enddo
6613		!@end noport
6614		endif
6615
6616	1	if (CS%gradual_BT_ICs) then
6617	0	if (.NOT.query_initialized(CS%ubt_IC,"ubt_IC",restart_CS) .or. &
6618		.NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then
6619	0	do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo
6620	0	do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo
6621		endif
6622		endif
6623		! Calculate other constants which are used for btstep.
6624
6625	1	if (.not.CS%nonlin_stress) then
6626	1	Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin
6627		!@start noport ! mapped at end of this routine
6628	65161	do j=js,je ; do I=is-1,ie
6629	64980	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)
6630	65160	if (G%OBCmaskCu(I,j) * htot > 0.) then
6631	46067	CS%IDatu(I,j) = G%OBCmaskCu(I,j) * 2.0 / (Z_to_H * htot)
6632		else ! Both neighboring H points are masked out or this is an OBC face so IDatu(I,j) is unused
6633	18913	CS%IDatu(I,j) = 0.
6634		endif
6635		enddo ; enddo
6636	65342	do J=js-1,je ; do i=is,ie
6637	65160	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)
6638	65341	if (G%OBCmaskCv(i,J) * htot > 0.) then
6639	45890	CS%IDatv(i,J) = G%OBCmaskCv(i,J) * 2.0 / (Z_to_H * htot)
6640		else ! Both neighboring H points are masked out or this is an OBC face so IDatv(i,J) is unused
6641	19270	CS%IDatv(i,J) = 0.
6642		endif
6643		enddo ; enddo
6644		!@end noport ! mapped at end of this routine
6645		endif
6646
6647	1	call find_face_areas(Datu, Datv, G, GV, US, CS, MS, 1)
6648	1	if ((CS%bound_BT_corr) .and. .not.(use_BT_Cont_type .and. CS%BT_cont_bounds)) then
6649		! This is not used in most test cases. Were it ever to become more widely used, consider
6650		! replacing maxvel with min(G%dxT(i,j),G%dyT(i,j)) * (CS%maxCFL_BT_cont*Idt) .
6651	0	do j=js,je ; do i=is,ie
6652		CS%eta_cor_bound(i,j) = G%IareaT(i,j) * 0.1 * CS%maxvel * &
6653	0	((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1)))
6654		enddo ; enddo
6655		endif
6656		!$omp target enter data map(to: CS%eta_cor_bound)
6657
6658	1	if (CS%gradual_BT_ICs) &
6659	0	call create_group_pass(pass_bt_hbt_btav, CS%ubt_IC, CS%vbt_IC, G%Domain)
6660	1	call create_group_pass(pass_bt_hbt_btav, CS%ubtav, CS%vbtav, G%Domain)
6661	1	call do_group_pass(pass_bt_hbt_btav, G%Domain)
6662
6663		! id_clock_pass = cpu_clock_id('(Ocean BT halo updates)', grain=CLOCK_ROUTINE)
6664	1	id_clock_calc_pre = cpu_clock_id('(Ocean BT pre-calcs only)', grain=CLOCK_ROUTINE)
6665	1	id_clock_pass_pre = cpu_clock_id('(Ocean BT pre-step halo updates)', grain=CLOCK_ROUTINE)
6666	1	id_clock_calc = cpu_clock_id('(Ocean BT stepping calcs only)', grain=CLOCK_ROUTINE)
6667	1	id_clock_pass_step = cpu_clock_id('(Ocean BT stepping halo updates)', grain=CLOCK_ROUTINE)
6668	1	id_clock_calc_post = cpu_clock_id('(Ocean BT post-calcs only)', grain=CLOCK_ROUTINE)
6669	1	id_clock_pass_post = cpu_clock_id('(Ocean BT post-step halo updates)', grain=CLOCK_ROUTINE)
6670	1	if (dtbt_input <= 0.0) &
6671	1	id_clock_sync = cpu_clock_id('(Ocean BT global synch)', grain=CLOCK_ROUTINE)
6672
6673		! send initialized data to GPU
6674		!$omp target enter data map(to: CS%bathyT)
6675		!$omp target enter data map(to: CS%D_u_Cor, CS%D_v_Cor)
6676		!$omp target enter data map(to: CS%dx_Cv, CS%dy_Cu)
6677		!$omp target enter data map(to: CS%IareaT, CS%IareaT_OBCmask)
6678		!$omp target enter data map(to: CS%IDatu, CS%IDatv)
6679		!$omp target enter data map(to: CS%IdxCu, CS%IdyCv)
6680		!$omp target enter data map(to: CS%OBCmask_u, CS%OBCmask_v)
6681		!$omp target enter data map(to: CS%q_d)
6682		!$omp target enter data map(to: CS%ua_polarity, CS%va_polarity)
6683		!$omp target enter data map(to: CS%ubtav, CS%vbtav)
6684
6685	2	end subroutine barotropic_init
6686
6687		!> Copies ubtav and vbtav from private type into arrays
6688	0	subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US)
6689		type(barotropic_CS), intent(in) :: CS !< Barotropic control structure
6690		type(ocean_grid_type), intent(in) :: G !< Grid structure
6691		real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged
6692		!! over a baroclinic timestep [L T-1 ~> m s-1]
6693		real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged
6694		!! over a baroclinic timestep [L T-1 ~> m s-1]
6695		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
6696		! Local variables
6697		integer :: i,j
6698
6699	0	do j=G%jsc,G%jec ; do I=G%isc-1,G%iec
6700	0	ubtav(I,j) = CS%ubtav(I,j)
6701		enddo ; enddo
6702
6703	0	do J=G%jsc-1,G%jec ; do i=G%isc,G%iec
6704	0	vbtav(i,J) = CS%vbtav(i,J)
6705		enddo ; enddo
6706
6707	0	end subroutine barotropic_get_tav
6708
6709
6710		!> Clean up the barotropic control structure.
6711	1	subroutine barotropic_end(CS)
6712		type(barotropic_CS), intent(inout) :: CS !< Control structure to clear out.
6713
6714	1	call destroy_BT_OBC(CS%BT_OBC)
6715
6716		! Allocated in barotropic_init, called in timestep initialization
6717	1	DEALLOC_(CS%ua_polarity) ; DEALLOC_(CS%va_polarity)
6718	1	DEALLOC_(CS%IDatu) ; DEALLOC_(CS%IDatv)
6719	1	if (allocated(CS%eta_cor_bound)) deallocate(CS%eta_cor_bound)
6720	1	DEALLOC_(CS%eta_cor)
6721	1	DEALLOC_(CS%bathyT) ; DEALLOC_(CS%IareaT)
6722	1	DEALLOC_(CS%frhatu) ; DEALLOC_(CS%frhatv)
6723	1	DEALLOC_(CS%OBCmask_u) ; DEALLOC_(CS%OBCmask_v)
6724	1	DEALLOC_(CS%IdxCu) ; DEALLOC_(CS%IdyCv)
6725	1	DEALLOC_(CS%dy_Cu) ; DEALLOC_(CS%dx_Cv)
6726
6727	1	if (allocated(CS%frhatu1)) deallocate(CS%frhatu1)
6728	1	if (allocated(CS%frhatv1)) deallocate(CS%frhatv1)
6729	1	if (allocated(CS%IareaT_OBCmask)) deallocate(CS%IareaT_OBCmask)
6730
6731	1	if (allocated(CS%q_D)) deallocate(CS%q_D)
6732	1	if (allocated(CS%D_u_Cor)) deallocate(CS%D_u_Cor)
6733	1	if (allocated(CS%D_v_Cor)) deallocate(CS%D_v_Cor)
6734	1	if (allocated(CS%ubt_IC)) deallocate(CS%ubt_IC)
6735	1	if (allocated(CS%vbt_IC)) deallocate(CS%vbt_IC)
6736	1	if (allocated(CS%lin_drag_u)) deallocate(CS%lin_drag_u)
6737	1	if (allocated(CS%lin_drag_v)) deallocate(CS%lin_drag_v)
6738
6739	1	if (associated(CS%debug_BT_HI)) deallocate(CS%debug_BT_HI)
6740	1	call deallocate_MOM_domain(CS%BT_domain)
6741
6742		! Allocated in restart registration, prior to timestep initialization
6743	1	DEALLOC_(CS%ubtav) ; DEALLOC_(CS%vbtav)
6744	1	end subroutine barotropic_end
6745
6746		!> This subroutine is used to register any fields from MOM_barotropic.F90
6747		!! that should be written to or read from the restart file.
6748	1	subroutine register_barotropic_restarts(HI, GV, US, param_file, CS, restart_CS)
6749		type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
6750		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
6751		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
6752		type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
6753		type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure
6754		type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure
6755
6756		! Local variables
6757	58	type(vardesc) :: vd(3)
6758		character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
6759		integer :: n_filters !< Number of streaming band-pass filters to be used in the simulation.
6760		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
6761
6762	1	isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed
6763	1	IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB
6764
6765		call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, &
6766		"If true, adjust the initial conditions for the "//&
6767		"barotropic solver to the values from the layered "//&
6768		"solution over a whole timestep instead of instantly. "//&
6769		"This is a decent approximation to the inclusion of "//&
6770		"sum(u dh_dt) while also correcting for truncation errors.", &
6771	1	default=.false., do_not_log=.true.)
6772
6773	69561	ALLOC_(CS%ubtav(IsdB:IedB,jsd:jed)) ; CS%ubtav(:,:) = 0.0
6774	69742	ALLOC_(CS%vbtav(isd:ied,JsdB:JedB)) ; CS%vbtav(:,:) = 0.0
6775	1	if (CS%gradual_BT_ICs) then
6776	0	allocate(CS%ubt_IC(IsdB:IedB,jsd:jed), source=0.0)
6777	0	allocate(CS%vbt_IC(isd:ied,JsdB:JedB), source=0.0)
6778		endif
6779
6780		vd(2) = var_desc("ubtav","m s-1","Time mean barotropic zonal velocity", &
6781	6	hor_grid='u', z_grid='1')
6782		vd(3) = var_desc("vbtav","m s-1","Time mean barotropic meridional velocity",&
6783	6	hor_grid='v', z_grid='1')
6784		call register_restart_pair(CS%ubtav, CS%vbtav, vd(2), vd(3), .false., restart_CS, &
6785	1	conversion=US%L_T_to_m_s)
6786
6787	1	if (CS%gradual_BT_ICs) then
6788		vd(2) = var_desc("ubt_IC", "m s-1", &
6789		longname="Next initial condition for the barotropic zonal velocity", &
6790	0	hor_grid='u', z_grid='1')
6791		vd(3) = var_desc("vbt_IC", "m s-1", &
6792		longname="Next initial condition for the barotropic meridional velocity",&
6793	0	hor_grid='v', z_grid='1')
6794		call register_restart_pair(CS%ubt_IC, CS%vbt_IC, vd(2), vd(3), .false., restart_CS, &
6795	0	conversion=US%L_T_to_m_s)
6796		endif
6797
6798		call register_restart_field(CS%dtbt, "DTBT", .false., restart_CS, &
6799	1	longname="Barotropic timestep", units="seconds", conversion=US%T_to_s)
6800
6801		! Register streaming band-pass filters
6802		call get_param(param_file, mdl, "USE_FILTER", CS%use_filter, &
6803		"If true, use streaming band-pass filters to detect the "//&
6804	1	"instantaneous tidal signals in the simulation.", default=.false.)
6805		call get_param(param_file, mdl, "N_FILTERS", n_filters, &
6806		"Number of streaming band-pass filters to be used in the simulation.", &
6807	1	default=0, do_not_log=.not.CS%use_filter)
6808	1	if (n_filters<=0) CS%use_filter = .false.
6809	1	if (CS%use_filter) then
6810	0	call Filt_register(n_filters, 'ubt', 'u', HI, CS%Filt_CS_u, restart_CS)
6811	0	call Filt_register(n_filters, 'vbt', 'v', HI, CS%Filt_CS_v, restart_CS)
6812		endif
6813
6814	33	end subroutine register_barotropic_restarts
6815
6816
6817		!> \namespace mom_barotropic
6818		!!
6819		!! By Robert Hallberg, April 1994 - January 2007
6820		!!
6821		!! This program contains the subroutines that time steps the
6822		!! linearized barotropic equations. btstep is used to actually
6823		!! time step the barotropic equations, and contains most of the
6824		!! substance of this module.
6825		!!
6826		!! btstep uses a forwards-backwards based scheme to time step
6827		!! the barotropic equations, returning the layers' accelerations due
6828		!! to the barotropic changes in the ocean state, the final free
6829		!! surface height (or column mass), and the volume (or mass) fluxes
6830		!! summed through the layers and averaged over the baroclinic time
6831		!! step. As input, btstep takes the initial 3-D velocities, the
6832		!! initial free surface height, the 3-D accelerations of the layers,
6833		!! and the external forcing. Everything in btstep is cast in terms
6834		!! of anomalies, so if everything is in balance, there is explicitly
6835		!! no acceleration due to btstep.
6836		!!
6837		!! The spatial discretization of the continuity equation is second
6838		!! order accurate. A flux conservative form is used to guarantee
6839		!! global conservation of volume. The spatial discretization of the
6840		!! momentum equation is second order accurate. The Coriolis force
6841		!! is written in a form which does not contribute to the energy
6842		!! tendency and which conserves linearized potential vorticity, f/D.
6843		!! These terms are exactly removed from the baroclinic momentum
6844		!! equations, so the linearization of vorticity advection will not
6845		!! degrade the overall solution.
6846		!!
6847		!! btcalc calculates the fractional thickness of each layer at the
6848		!! velocity points, for later use in calculating the barotropic
6849		!! velocities and the averaged accelerations. Harmonic mean
6850		!! thicknesses (i.e. 2h_Lh_R/(h_L + h_R)) are used to avoid overly
6851		!! strong weighting of overly thin layers. This may later be relaxed
6852		!! to use thicknesses determined from the continuity equations.
6853		!!
6854		!! bt_mass_source determines the real mass sources for the
6855		!! barotropic solver, along with the corrective pseudo-fluxes that
6856		!! keep the barotropic and baroclinic estimates of the free surface
6857		!! height close to each other. Given the layer thicknesses and the
6858		!! free surface height that correspond to each other, it calculates
6859		!! a corrective mass source that is added to the barotropic continuity*
6860		!! equation, and optionally adjusts a slowly varying correction rate.
6861		!! Newer algorithmic changes have deemphasized the need for this, but
6862		!! it is still here to add net water sources to the barotropic solver.*
6863		!!
6864		!! barotropic_init allocates and initializes any barotropic arrays
6865		!! that have not been read from a restart file, reads parameters from
6866		!! the inputfile, and sets up diagnostic fields.
6867		!!
6868		!! barotropic_end deallocates anything allocated in barotropic_init
6869		!! or register_barotropic_restarts.
6870		!!
6871		!! register_barotropic_restarts is used to indicate any fields that
6872		!! are private to the barotropic solver that need to be included in
6873		!! the restart files, and to ensure that they are read.
6874
6875	0	end module MOM_barotropic