mom_barotropic Module Reference

Detailed Description

Baropotric solver.

By Robert Hallberg, April 1994 - January 2007

This program contains the subroutines that time steps the linearized barotropic equations. btstep is used to actually time step the barotropic equations, and contains most of the substance of this module.

btstep uses a forwards-backwards based scheme to time step the barotropic equations, returning the layers' accelerations due to the barotropic changes in the ocean state, the final free surface height (or column mass), and the volume (or mass) fluxes summed through the layers and averaged over the baroclinic time step. As input, btstep takes the initial 3-D velocities, the inital free surface height, the 3-D accelerations of the layers, and the external forcing. Everything in btstep is cast in terms of anomalies, so if everything is in balance, there is explicitly no acceleration due to btstep.

The spatial discretization of the continuity equation is second order accurate. A flux conservative form is used to guarantee global conservation of volume. The spatial discretization of the momentum equation is second order accurate. The Coriolis force is written in a form which does not contribute to the energy tendency and which conserves linearized potential vorticity, f/D. These terms are exactly removed from the baroclinic momentum equations, so the linearization of vorticity advection will not degrade the overall solution.

btcalc calculates the fractional thickness of each layer at the velocity points, for later use in calculating the barotropic velocities and the averaged accelerations. Harmonic mean thicknesses (i.e. 2*h_L*h_R/(h_L + h_R)) are used to avoid overly strong weighting of overly thin layers. This may later be relaxed to use thicknesses determined from the continuity equations.

bt_mass_source determines the real mass sources for the barotropic solver, along with the corrective pseudo-fluxes that keep the barotropic and baroclinic estimates of the free surface height close to each other. Given the layer thicknesses and the free surface height that correspond to each other, it calculates a corrective mass source that is added to the barotropic continuity* equation, and optionally adjusts a slowly varying correction rate. Newer algorithmic changes have deemphasized the need for this, but it is still here to add net water sources to the barotropic solver.*

barotropic_init allocates and initializes any barotropic arrays that have not been read from a restart file, reads parameters from the inputfile, and sets up diagnostic fields.

barotropic_end deallocates anything allocated in barotropic_init or register_barotropic_restarts.

register_barotropic_restarts is used to indicate any fields that are private to the barotropic solver that need to be included in the restart files, and to ensure that they are read.

Data Types
type	barotropic_cs
	The barotropic stepping control stucture. More...
type	bt_obc_type
	The barotropic stepping open boundary condition type. More...
type	local_bt_cont_u_type
	A desciption of the functional dependence of transport at a u-point. More...
type	local_bt_cont_v_type
	A desciption of the functional dependence of transport at a v-point. More...
type	memory_size_type
	A container for passing around active tracer point memory limits. More...
integer	id_clock_sync =-1
	CPU time clock IDs. More...
integer	id_clock_calc =-1
	CPU time clock IDs. More...
integer	id_clock_calc_pre =-1
	CPU time clock IDs. More...
integer	id_clock_calc_post =-1
	CPU time clock IDs. More...
integer	id_clock_pass_step =-1
	CPU time clock IDs. More...
integer	id_clock_pass_pre =-1
	CPU time clock IDs. More...
integer	id_clock_pass_post =-1
	CPU time clock IDs. More...
integer, parameter	harmonic = 1
	Enumeration values for various schemes. More...
integer, parameter	arithmetic = 2
	CPU time clock IDs. More...
integer, parameter	hybrid = 3
	CPU time clock IDs. More...
integer, parameter	from_bt_cont = 4
	CPU time clock IDs. More...
integer, parameter	hybrid_bt_cont = 5
	CPU time clock IDs. More...
character *(20), parameter	hybrid_string = "HYBRID"
	CPU time clock IDs. More...
character *(20), parameter	harmonic_string = "HARMONIC"
	CPU time clock IDs. More...
character *(20), parameter	arithmetic_string = "ARITHMETIC"
	CPU time clock IDs. More...
character *(20), parameter	bt_cont_string = "FROM_BT_CONT"
	CPU time clock IDs. More...
subroutine, public	btstep (U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, eta_out, uhbtav, vhbtav, G, GV, US, CS, visc_rem_u, visc_rem_v, etaav, OBC, BT_cont, eta_PF_start, taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0)
	This subroutine time steps the barotropic equations explicitly. For gravity waves, anything between a forwards-backwards scheme and a simulated backwards Euler scheme is used, with bebt between 0.0 and 1.0 determining the scheme. In practice, bebt must be of order 0.2 or greater. A forwards-backwards treatment of the Coriolis terms is always used. More...
subroutine, public	set_dtbt (G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
	This subroutine automatically determines an optimal value for dtbt based on some state of the ocean. More...
subroutine	apply_velocity_obcs (OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, eta, ubt_old, vbt_old, BT_OBC, G, MS, US, halo, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, uhbt0, vhbt0)
	The following 4 subroutines apply the open boundary conditions. This subroutine applies the open boundary conditions on barotropic velocities and mass transports, as developed by Mehmet Ilicak. More...
subroutine	set_up_bt_obc (OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v)
	This subroutine sets up the private structure used to apply the open boundary conditions, as developed by Mehmet Ilicak. More...
subroutine	destroy_bt_obc (BT_OBC)
	Clean up the BT_OBC memory. More...
subroutine, public	btcalc (h, G, GV, CS, h_u, h_v, may_use_default, OBC)
	btcalc calculates the barotropic velocities from the full velocity and thickness fields, determines the fraction of the total water column in each layer at velocity points, and determines a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate. More...
real function	find_uhbt (u, BTC, US)
	The function find_uhbt determines the zonal transport for a given velocity. More...
real function	uhbt_to_ubt (uhbt, BTC, US, guess)
	This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport. More...
real function	find_vhbt (v, BTC, US)
	The function find_vhbt determines the meridional transport for a given velocity. More...
real function	vhbt_to_vbt (vhbt, BTC, US, guess)
	This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport. More...
subroutine	set_local_bt_cont_types (BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo)
	This subroutine sets up reordered versions of the BT_cont type in the local_BT_cont types, which have wide halos properly filled in. More...
subroutine	adjust_local_bt_cont_types (ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, G, US, MS, halo)
	Adjust_local_BT_cont_types sets up reordered versions of the BT_cont type in the local_BT_cont types, which have wide halos properly filled in. More...
subroutine	bt_cont_to_face_areas (BT_cont, Datu, Datv, G, US, MS, halo, maximize)
	This subroutine uses the BTCL types to find typical or maximum face areas, which can then be used for finding wave speeds, etc. More...
subroutine	swap (a, b)
	Swap the values of two real variables. More...
subroutine	find_face_areas (Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max)
	This subroutine determines the open face areas of cells for calculating the barotropic transport. More...
subroutine, public	bt_mass_source (h, eta, set_cor, G, GV, CS)
	bt_mass_source determines the appropriately limited mass source for the barotropic solver, along with a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate. More...
subroutine, public	barotropic_init (u, v, h, eta, Time, G, GV, US, param_file, diag, CS, restart_CS, calc_dtbt, BT_cont, tides_CSp)
	barotropic_init initializes a number of time-invariant fields used in the barotropic calculation and initializes any barotropic fields that have not already been initialized. More...
subroutine, public	barotropic_get_tav (CS, ubtav, vbtav, G, US)
	Copies ubtav and vbtav from private type into arrays. More...
subroutine, public	barotropic_end (CS)
	Clean up the barotropic control structure. More...
subroutine, public	register_barotropic_restarts (HI, GV, param_file, CS, restart_CS)
	This subroutine is used to register any fields from MOM_barotropic.F90 that should be written to or read from the restart file. More...

Function/Subroutine Documentation

adjust_local_bt_cont_types()

subroutine mom_barotropic::adjust_local_bt_cont_types ( real, dimension(szibw_(ms),szjw_(ms)), intent(in)  ubt, real, dimension(szibw_(ms),szjw_(ms)), intent(in)  uhbt, real, dimension(sziw_(ms),szjbw_(ms)), intent(in)  vbt, real, dimension(sziw_(ms),szjbw_(ms)), intent(in)  vhbt, type(local_bt_cont_u_type), dimension(szibw_(ms),szjw_(ms)), intent(out)  BTCL_u, type(local_bt_cont_v_type), dimension(sziw_(ms),szjbw_(ms)), intent(out)  BTCL_v, type(ocean_grid_type), intent(in)  G, type(unit_scale_type), intent(in)  US, type(memory_size_type), intent(in)  MS, integer, intent(in), optional  halo  )

private

Adjust_local_BT_cont_types sets up reordered versions of the BT_cont type in the local_BT_cont types, which have wide halos properly filled in.

Parameters

[in]	ms	A type that describes the memory sizes of the argument arrays.
[in]	ubt	The linearization zonal barotropic velocity [L T-1 ~> m s-1].
[in]	uhbt	The linearization zonal barotropic transport
[in]	vbt	The linearization meridional barotropic velocity [L T-1 ~> m s-1].
[in]	vhbt	The linearization meridional barotropic transport
[out]	btcl_u	A structure with the u information from BT_cont.
[out]	btcl_v	A structure with the v information from BT_cont.
[in]	g	The ocean's grid structure.
[in]	us	A dimensional unit scaling type
[in]	halo	The extra halo size to use here.

Definition at line 3398 of file MOM_barotropic.F90.

  type(memory_size_type), intent(in)  :: MS   !< A type that describes the memory sizes of the argument arrays.
  real, dimension(SZIBW_(MS),SZJW_(MS)), &
                          intent(in)  :: ubt  !< The linearization zonal barotropic velocity [L T-1 ~> m s-1].
  real, dimension(SZIBW_(MS),SZJW_(MS)), &
                          intent(in)  :: uhbt !< The linearization zonal barotropic transport
                                              !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), &
                          intent(in)  :: vbt  !< The linearization meridional barotropic velocity [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), &
                          intent(in)  :: vhbt !< The linearization meridional barotropic transport
                                              !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
                          intent(out) :: BTCL_u !< A structure with the u information from BT_cont.
  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
                          intent(out) :: BTCL_v !< A structure with the v information from BT_cont.
  type(ocean_grid_type),  intent(in)  :: G    !< The ocean's grid structure.
  type(unit_scale_type),  intent(in)  :: US   !< A dimensional unit scaling type
  integer,      optional, intent(in)  :: halo !< The extra halo size to use here.
 
  ! Local variables
  real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
    u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
  real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
    v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
  real, parameter :: C1_3 = 1.0/3.0
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
 
  !$OMP parallel do default(shared)
  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
    if ((ubt(i,j) > btcl_u(i,j)%uBT_WW) .and. (uhbt(i,j) > btcl_u(i,j)%uh_WW)) then
      ! Expand the cubic fit to use this new point.  ubt is negative.
      btcl_u(i,j)%ubt_WW = ubt(i,j)
      if (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl_u(i,j)%FA_u_W0) then
        ! No further bounding is needed.
        btcl_u(i,j)%uh_crvW = (uhbt(i,j) - ubt(i,j) * btcl_u(i,j)%FA_u_W0) / ubt(i,j)**3
      else ! This should not happen often!
        btcl_u(i,j)%FA_u_W0 = 1.5*uhbt(i,j) / ubt(i,j)
        btcl_u(i,j)%uh_crvW = -0.5*uhbt(i,j) / ubt(i,j)**3
      endif
      btcl_u(i,j)%uh_WW = uhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_u(I,j)%FA_u_WW = min(BTCL_u(I,j)%FA_u_WW, uhbt(I,j) / ubt(I,j))
    elseif ((ubt(i,j) < btcl_u(i,j)%uBT_EE) .and. (uhbt(i,j) < btcl_u(i,j)%uh_EE)) then
      ! Expand the cubic fit to use this new point.  ubt is negative.
      btcl_u(i,j)%ubt_EE = ubt(i,j)
      if (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl_u(i,j)%FA_u_E0) then
        ! No further bounding is needed.
        btcl_u(i,j)%uh_crvE = (uhbt(i,j) - ubt(i,j) * btcl_u(i,j)%FA_u_E0) / ubt(i,j)**3
      else ! This should not happen often!
        btcl_u(i,j)%FA_u_E0 = 1.5*uhbt(i,j) / ubt(i,j)
        btcl_u(i,j)%uh_crvE = -0.5*uhbt(i,j) / ubt(i,j)**3
      endif
      btcl_u(i,j)%uh_EE = uhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_u(I,j)%FA_u_EE = min(BTCL_u(I,j)%FA_u_EE, uhbt(I,j) / ubt(I,j))
    endif
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
    if ((vbt(i,j) > btcl_v(i,j)%vBT_SS) .and. (vhbt(i,j) > btcl_v(i,j)%vh_SS)) then
      ! Expand the cubic fit to use this new point.  vbt is negative.
      btcl_v(i,j)%vbt_SS = vbt(i,j)
      if (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl_v(i,j)%FA_v_S0) then
        ! No further bounding is needed.
        btcl_v(i,j)%vh_crvS = (vhbt(i,j) - vbt(i,j) * btcl_v(i,j)%FA_v_S0) / vbt(i,j)**3
      else ! This should not happen often!
        btcl_v(i,j)%FA_v_S0 = 1.5*vhbt(i,j) / (vbt(i,j))
        btcl_v(i,j)%vh_crvS = -0.5*vhbt(i,j) / vbt(i,j)**3
      endif
      btcl_v(i,j)%vh_SS = vhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J))
    elseif ((vbt(i,j) < btcl_v(i,j)%vBT_NN) .and. (vhbt(i,j) < btcl_v(i,j)%vh_NN)) then
      ! Expand the cubic fit to use this new point.  vbt is negative.
      btcl_v(i,j)%vbt_NN = vbt(i,j)
      if (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl_v(i,j)%FA_v_N0) then
        ! No further bounding is needed.
        btcl_v(i,j)%vh_crvN = (vhbt(i,j) - vbt(i,j) * btcl_v(i,j)%FA_v_N0) / vbt(i,j)**3
      else ! This should not happen often!
        btcl_v(i,j)%FA_v_N0 = 1.5*vhbt(i,j) / (vbt(i,j))
        btcl_v(i,j)%vh_crvN = -0.5*vhbt(i,j) / vbt(i,j)**3
      endif
      btcl_v(i,j)%vh_NN = vhbt(i,j)
      ! I don't know whether this is helpful.
!     BTCL_v(i,J)%FA_v_NN = min(BTCL_v(i,J)%FA_v_NN, vhbt(i,J) / vbt(i,J))
    endif
  enddo ; enddo
 

Referenced by btstep().

Here is the caller graph for this function:

apply_velocity_obcs()

subroutine mom_barotropic::apply_velocity_obcs ( type(ocean_obc_type), pointer  OBC, real, dimension(szibw_(ms),szjw_(ms)), intent(inout)  ubt, real, dimension(sziw_(ms),szjbw_(ms)), intent(inout)  vbt, real, dimension(szibw_(ms),szjw_(ms)), intent(inout)  uhbt, real, dimension(sziw_(ms),szjbw_(ms)), intent(inout)  vhbt, real, dimension(szibw_(ms),szjw_(ms)), intent(inout)  ubt_trans, real, dimension(sziw_(ms),szjbw_(ms)), intent(inout)  vbt_trans, real, dimension(sziw_(ms),szjw_(ms)), intent(in)  eta, real, dimension(szibw_(ms),szjw_(ms)), intent(in)  ubt_old, real, dimension(sziw_(ms),szjbw_(ms)), intent(in)  vbt_old, type(bt_obc_type), intent(in)  BT_OBC, type(ocean_grid_type), intent(inout)  G, type(memory_size_type), intent(in)  MS, type(unit_scale_type), intent(in)  US, integer, intent(in)  halo, real, intent(in)  dtbt, real, intent(in)  bebt, logical, intent(in)  use_BT_cont, real, dimension(szibw_(ms),szjw_(ms)), intent(in)  Datu, real, dimension(sziw_(ms),szjbw_(ms)), intent(in)  Datv, type(local_bt_cont_u_type), dimension(szibw_(ms),szjw_(ms)), intent(in)  BTCL_u, type(local_bt_cont_v_type), dimension(sziw_(ms),szjbw_(ms)), intent(in)  BTCL_v, real, dimension(szibw_(ms),szjw_(ms)), intent(in)  uhbt0, real, dimension(sziw_(ms),szjbw_(ms)), intent(in)  vhbt0  )

private

The following 4 subroutines apply the open boundary conditions. This subroutine applies the open boundary conditions on barotropic velocities and mass transports, as developed by Mehmet Ilicak.

Parameters

	obc	An associated pointer to an OBC type.
[in,out]	g	The ocean's grid structure.
[in]	ms	A type that describes the memory sizes of the argument arrays.
[in,out]	ubt	the zonal barotropic velocity [L T-1 ~> m s-1].
[in,out]	uhbt	the zonal barotropic transport [H L2 T-1 ~> m3 s-1 or kg s-1].
[in,out]	ubt_trans	The zonal barotropic velocity used in transport [L T-1 ~> m s-1].
[in,out]	vbt	The meridional barotropic velocity [L T-1 ~> m s-1].
[in,out]	vhbt	the meridional barotropic transport [H L2 T-1 ~> m3 s-1 or kg s-1].
[in,out]	vbt_trans	the meridional BT velocity used in transports [L T-1 ~> m s-1].
[in]	eta	The barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in]	ubt_old	The starting value of ubt in a barotropic step [L T-1 ~> m s-1].
[in]	vbt_old	The starting value of vbt in a barotropic step [L T-1 ~> m s-1].
[in]	bt_obc	A structure with the private barotropic arrays related to the open boundary conditions, set by set_up_BT_OBC.
[in]	us	A dimensional unit scaling type
[in]	halo	The extra halo size to use here.
[in]	dtbt	The time step [T ~> s].
[in]	bebt	The fractional weighting of the future velocity in determining the transport.
[in]	use_bt_cont	If true, use the BT_cont_types to calculate transports.
[in]	datu	A fixed estimate of the face areas at u points [H L ~> m2 or kg m-1].
[in]	datv	A fixed estimate of the face areas at v points [H L ~> m2 or kg m-1].
[in]	btcl_u	Structure of information used for a dynamic estimate of the face areas at u-points.
[in]	btcl_v	Structure of information used for a dynamic estimate of the face areas at v-points.
[in]	uhbt0	A correction to the zonal transport so that the barotropic functions agree with the sum of the layer transports [H L2 T-1 ~> m3 s-1 or kg s-1].
[in]	vhbt0	A correction to the meridional transport so that the barotropic functions agree with the sum of the layer transports [H L2 T-1 ~> m3 s-1 or kg s-1].

Definition at line 2381 of file MOM_barotropic.F90.

  type(ocean_OBC_type),                  pointer       :: OBC     !< An associated pointer to an OBC type.
  type(ocean_grid_type),                 intent(inout) :: G       !< The ocean's grid structure.
  type(memory_size_type),                intent(in)    :: MS      !< A type that describes the memory sizes of
                                                                  !! the argument arrays.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt     !< the zonal barotropic velocity [L T-1 ~> m s-1].
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt    !< the zonal barotropic transport
                                                                  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in
                                                                  !! transport [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt     !< The meridional barotropic velocity
                                                                  !! [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt    !< the meridional barotropic transport
                                                                  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in
                                                                  !! transports [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJW_(MS)),  intent(in)    :: eta     !< The barotropic free surface height anomaly or
                                                                  !! column mass anomaly [H ~> m or kg m-2].
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: ubt_old !< The starting value of ubt in a barotropic
                                                                  !! step [L T-1 ~> m s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: vbt_old !< The starting value of vbt in a barotropic
                                                                  !! step [L T-1 ~> m s-1].
  type(BT_OBC_type),                     intent(in)    :: BT_OBC  !< A structure with the private barotropic arrays
                                                                  !! related to the open boundary conditions,
                                                                  !! set by set_up_BT_OBC.
  type(unit_scale_type),                 intent(in)    :: US      !< A dimensional unit scaling type
  integer,                               intent(in)    :: halo    !< The extra halo size to use here.
  real,                                  intent(in)    :: dtbt    !< The time step [T ~> s].
  real,                                  intent(in)    :: bebt    !< The fractional weighting of the future velocity
                                                                  !! in determining the transport.
  logical,                               intent(in)    :: use_BT_cont !< If true, use the BT_cont_types to calculate
                                                                  !! transports.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: Datu    !< A fixed estimate of the face areas at u points
                                                                  !! [H L ~> m2 or kg m-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: Datv    !< A fixed estimate of the face areas at v points
                                                                  !! [H L ~> m2 or kg m-1].
  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
                                                                  !! for a dynamic estimate of the face areas at
                                                                  !! u-points.
  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
                                                                  !! for a dynamic estimate of the face areas at
                                                                  !! v-points.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: uhbt0   !< A correction to the zonal transport so that
                                                                  !! the barotropic functions agree with the sum
                                                                  !! of the layer transports
                                                                  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: vhbt0   !< A correction to the meridional transport so that
                                                                  !! the barotropic functions agree with the sum
                                                                  !! of the layer transports
                                                                  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
 
  ! Local variables
  real :: vel_prev    ! The previous velocity [L T-1 ~> m s-1].
  real :: vel_trans   ! The combination of the previous and current velocity
                      ! that does the mass transport [L T-1 ~> m s-1].
  real :: H_u         ! The total thickness at the u-point [H ~> m or kg m-2].
  real :: H_v         ! The total thickness at the v-point [H ~> m or kg m-2].
  real :: cfl         ! The CFL number at the point in question [nondim]
  real :: u_inlet     ! The zonal inflow velocity [L T-1 ~> m s-1]
  real :: v_inlet     ! The meridional inflow velocity [L T-1 ~> m s-1]
  real :: h_in
  real :: cff, Cx, Cy, tau
  real :: dhdt, dhdx, dhdy
  integer :: i, j, is, ie, js, je
  real, dimension(SZIB_(G),SZJB_(G)) :: grad
  real, parameter :: eps = 1.0e-20
  real :: rx_max, ry_max ! coefficients for radiation
  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
  rx_max = obc%rx_max ; ry_max = obc%rx_max
 
  if (bt_obc%apply_u_OBCs) then
    do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
      if (obc%segment(obc%segnum_u(i,j))%specified) then
        uhbt(i,j) = bt_obc%uhbt(i,j)
        ubt(i,j) = bt_obc%ubt_outer(i,j)
        vel_trans = ubt(i,j)
      elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
        if (obc%segment(obc%segnum_u(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_u(i,j) * g%IdxCu(i,j) ! CFL
          u_inlet = cfl*ubt_old(i-1,j) + (1.0-cfl)*ubt_old(i,j)  ! Valid for cfl<1
          h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j))      ! internal
          h_u = bt_obc%H_u(i,j)
          vel_prev = ubt(i,j)
          ubt(i,j) = 0.5*((u_inlet + bt_obc%ubt_outer(i,j)) + &
              (bt_obc%Cg_u(i,j)/h_u) * (h_in-bt_obc%eta_outer_u(i,j)))
          vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(i,j)
        elseif (obc%segment(obc%segnum_u(i,j))%gradient) then
          ubt(i,j) = ubt(i-1,j)
          vel_trans = ubt(i,j)
        endif
      elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
        if (obc%segment(obc%segnum_u(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_u(i,j) * g%IdxCu(i,j) ! CFL
          u_inlet = cfl*ubt_old(i+1,j) + (1.0-cfl)*ubt_old(i,j)  ! Valid for cfl<1
          h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j))  ! external
 
          h_u = bt_obc%H_u(i,j)
          vel_prev = ubt(i,j)
          ubt(i,j) = 0.5*((u_inlet + bt_obc%ubt_outer(i,j)) + &
              (bt_obc%Cg_u(i,j)/h_u) * (bt_obc%eta_outer_u(i,j)-h_in))
 
          vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(i,j)
        elseif (obc%segment(obc%segnum_u(i,j))%gradient) then
          ubt(i,j) = ubt(i+1,j)
          vel_trans = ubt(i,j)
        endif
      endif
 
      if (.not. obc%segment(obc%segnum_u(i,j))%specified) then
        if (use_bt_cont) then
          uhbt(i,j) = find_uhbt(vel_trans, btcl_u(i,j), us) + uhbt0(i,j)
        else
          uhbt(i,j) = datu(i,j)*vel_trans + uhbt0(i,j)
        endif
      endif
 
      ubt_trans(i,j) = vel_trans
    endif ; enddo ; enddo
  endif
 
  if (bt_obc%apply_v_OBCs) then
    do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
      if (obc%segment(obc%segnum_v(i,j))%specified) then
        vhbt(i,j) = bt_obc%vhbt(i,j)
        vbt(i,j) = bt_obc%vbt_outer(i,j)
        vel_trans = vbt(i,j)
      elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
        if (obc%segment(obc%segnum_v(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_v(i,j) * g%IdyCv(i,j) ! CFL
          v_inlet = cfl*vbt_old(i,j-1) + (1.0-cfl)*vbt_old(i,j)  ! Valid for cfl<1
          h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1))      ! internal
 
          h_v = bt_obc%H_v(i,j)
          vel_prev = vbt(i,j)
          vbt(i,j) = 0.5*((v_inlet + bt_obc%vbt_outer(i,j)) + &
              (bt_obc%Cg_v(i,j)/h_v) * (h_in-bt_obc%eta_outer_v(i,j)))
 
          vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,j)
        elseif (obc%segment(obc%segnum_v(i,j))%gradient) then
          vbt(i,j) = vbt(i,j-1)
          vel_trans = vbt(i,j)
        endif
      elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
        if (obc%segment(obc%segnum_v(i,j))%Flather) then
          cfl = dtbt * bt_obc%Cg_v(i,j) * g%IdyCv(i,j) ! CFL
          v_inlet = cfl*vbt_old(i,j+1) + (1.0-cfl)*vbt_old(i,j)  ! Valid for cfl <1
          h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2))  ! internal
 
          h_v = bt_obc%H_v(i,j)
          vel_prev = vbt(i,j)
          vbt(i,j) = 0.5*((v_inlet + bt_obc%vbt_outer(i,j)) + &
              (bt_obc%Cg_v(i,j)/h_v) * (bt_obc%eta_outer_v(i,j)-h_in))
 
          vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,j)
        elseif (obc%segment(obc%segnum_v(i,j))%gradient) then
          vbt(i,j) = vbt(i,j+1)
          vel_trans = vbt(i,j)
        endif
      endif
 
      if (.not. obc%segment(obc%segnum_v(i,j))%specified) then
        if (use_bt_cont) then
           vhbt(i,j) = find_vhbt(vel_trans, btcl_v(i,j), us) + vhbt0(i,j)
        else
           vhbt(i,j) = vel_trans*datv(i,j) + vhbt0(i,j)
        endif
      endif
 
      vbt_trans(i,j) = vel_trans
    endif ; enddo ; enddo
  endif
 

References find_uhbt(), find_vhbt(), mom_open_boundary::obc_direction_n, and mom_open_boundary::obc_direction_s.

Referenced by btstep().

Here is the call graph for this function:

Here is the caller graph for this function:

barotropic_end()

subroutine, public mom_barotropic::barotropic_end

(

type(barotropic_cs), pointer

CS

)

Clean up the barotropic control structure.

Parameters

cs	Control structure to clear out.

Definition at line 4412 of file MOM_barotropic.F90.

  type(barotropic_CS), pointer :: CS  !< Control structure to clear out.
  dealloc_(cs%frhatu)   ; dealloc_(cs%frhatv)
  dealloc_(cs%IDatu)    ; dealloc_(cs%IDatv)
  dealloc_(cs%ubtav)    ; dealloc_(cs%vbtav)
  dealloc_(cs%eta_cor)
  dealloc_(cs%ua_polarity) ; dealloc_(cs%va_polarity)
  if (cs%bound_BT_corr) then
    dealloc_(cs%eta_cor_bound)
  endif
 
  call destroy_bt_obc(cs%BT_OBC)
 
  deallocate(cs)

References destroy_bt_obc().

Here is the call graph for this function:

barotropic_get_tav()

subroutine, public mom_barotropic::barotropic_get_tav	(	type(barotropic_cs), pointer	CS,
		real, dimension( g %isdb: g %iedb, g %jsd: g %jed), intent(inout)	ubtav,
		real, dimension( g %isd: g %ied, g %jsdb: g %jedb), intent(inout)	vbtav,
		type(ocean_grid_type), intent(in)	G,
		type(unit_scale_type), intent(in)	US
	)

Copies ubtav and vbtav from private type into arrays.

Parameters

	cs	Control structure for this module
[in]	g	Grid structure
[in,out]	ubtav	Zonal barotropic velocity averaged over a baroclinic timestep [L T-1 ~> m s-1]
[in,out]	vbtav	Meridional barotropic velocity averaged over a baroclinic timestep [L T-1 ~> m s-1]
[in]	us	A dimensional unit scaling type

Definition at line 4389 of file MOM_barotropic.F90.

  type(barotropic_CS),               pointer       :: CS    !< Control structure for this module
  type(ocean_grid_type),             intent(in)    :: G     !< Grid structure
  real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged
                                                            !! over a baroclinic timestep [L T-1 ~> m s-1]
  real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged
                                                            !! over a baroclinic timestep [L T-1 ~> m s-1]
  type(unit_scale_type),             intent(in)    :: US    !< A dimensional unit scaling type
  ! Local variables
  integer :: i,j
 
  do j=g%jsc,g%jec ; do i=g%isc-1,g%iec
    ubtav(i,j) = cs%ubtav(i,j)
  enddo ; enddo
 
  do j=g%jsc-1,g%jec ; do i=g%isc,g%iec
    vbtav(i,j) = cs%vbtav(i,j)
  enddo ; enddo
 

Referenced by mom_hor_visc::horizontal_viscosity().

Here is the caller graph for this function:

barotropic_init()

subroutine, public mom_barotropic::barotropic_init	(	real, dimension(szib_(g),szj_(g),szk_(g)), intent(in)	u,
		real, dimension(szi_(g),szjb_(g),szk_(g)), intent(in)	v,
		real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	h,
		real, dimension(szi_(g),szj_(g)), intent(in)	eta,
		type(time_type), intent(in), target	Time,
		type(ocean_grid_type), intent(inout)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(unit_scale_type), intent(in)	US,
		type(param_file_type), intent(in)	param_file,
		type(diag_ctrl), intent(inout), target	diag,
		type(barotropic_cs), pointer	CS,
		type(mom_restart_cs), pointer	restart_CS,
		logical, intent(out)	calc_dtbt,
		type(bt_cont_type), optional, pointer	BT_cont,
		type(tidal_forcing_cs), optional, pointer	tides_CSp
	)

barotropic_init initializes a number of time-invariant fields used in the barotropic calculation and initializes any barotropic fields that have not already been initialized.

Parameters

[in,out]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	us	A dimensional unit scaling type
[in]	u	The zonal velocity [L T-1 ~> m s-1].
[in]	v	The meridional velocity [L T-1 ~> m s-1].
[in]	h	Layer thicknesses [H ~> m or kg m-2].
[in]	eta	Free surface height or column mass anomaly
[in]	time	The current model time.
[in]	param_file	A structure to parse for run-time parameters.
[in,out]	diag	A structure that is used to regulate diagnostic output.
	cs	A pointer to the control structure for this module that is set in register_barotropic_restarts.
	restart_cs	A pointer to the restart control structure.
[out]	calc_dtbt	If true, the barotropic time step must be recalculated before stepping.
	bt_cont	A structure with elements that describe the
	tides_csp	A pointer to the control structure of the

Definition at line 3704 of file MOM_barotropic.F90.

  type(ocean_grid_type),   intent(inout) :: G    !< The ocean's grid structure.
  type(verticalGrid_type), intent(in)    :: GV   !< The ocean's vertical grid structure.
  type(unit_scale_type),   intent(in)    :: US   !< A dimensional unit scaling type
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
                           intent(in)    :: u    !< The zonal velocity [L T-1 ~> m s-1].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
                           intent(in)    :: v    !< The meridional velocity [L T-1 ~> m s-1].
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
                           intent(in)    :: h    !< Layer thicknesses [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJ_(G)), &
                           intent(in)    :: eta  !< Free surface height or column mass anomaly
                                                 !! [Z ~> m] or [H ~> kg m-2].
  type(time_type), target, intent(in)    :: Time !< The current model time.
  type(param_file_type),   intent(in)    :: param_file !< A structure to parse for run-time parameters.
  type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
                                                 !! output.
  type(barotropic_CS),     pointer       :: CS   !< A pointer to the control structure for this module
                                                 !! that is set in register_barotropic_restarts.
  type(MOM_restart_CS),    pointer       :: restart_CS !< A pointer to the restart control structure.
  logical,                 intent(out)   :: calc_dtbt  !< If true, the barotropic time step must
                                                 !! be recalculated before stepping.
  type(BT_cont_type), optional, &
                           pointer       :: BT_cont    !< A structure with elements that describe the
                                                 !! effective open face areas as a function of
                                                 !! barotropic flow.
  type(tidal_forcing_CS), optional, &
                           pointer       :: tides_CSp  !< A pointer to the control structure of the
                                                 !! tide module.
 
! This include declares and sets the variable "version".
#include "version_variable.h"
  ! Local variables
  character(len=40)  :: mdl = "MOM_barotropic"  ! This module's name.
  real :: Datu(SZIBS_(G),SZJ_(G))   ! Zonal open face area [H L ~> m2 or kg m-1].
  real :: Datv(SZI_(G),SZJBS_(G))   ! Meridional open face area [H L ~> m2 or kg m-1].
  real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce.
  real :: SSH_extra     ! An estimate of how much higher SSH might get, for use
                        ! in calculating the safe external wave speed [Z ~> m].
  real :: dtbt_input    ! The input value of DTBT, [nondim] if negative or [s] if positive.
  real :: dtbt_tmp      ! A temporary copy of CS%dtbt read from a restart file [T ~> s]
  real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag
                          ! piston velocities.
  character(len=200) :: inputdir       ! The directory in which to find input files.
  character(len=200) :: wave_drag_file ! The file from which to read the wave
                                       ! drag piston velocity.
  character(len=80)  :: wave_drag_var  ! The wave drag piston velocity variable
                                       ! name in wave_drag_file.
  real :: vel_rescale ! A rescaling factor for horizontal velocity from the representation in
                      ! a restart file to the internal representation in this run.
  real :: uH_rescale  ! A rescaling factor for thickness transports from the representation in
                      ! a restart file to the internal representation in this run.
  real, allocatable, dimension(:,:) :: lin_drag_h
  type(memory_size_type) :: MS
  type(group_pass_type) :: pass_static_data, pass_q_D_Cor
  type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity
  logical :: apply_bt_drag, use_BT_cont_type
  character(len=48) :: thickness_units, flux_units
  character*(40) :: hvel_str
  integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
  integer :: isdw, iedw, jsdw, jedw
  integer :: i, j, k
  integer :: wd_halos(2), bt_halo_sz
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
  ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed
 
  if (cs%module_is_initialized) then
    call mom_error(warning, "barotropic_init called with a control structure "// &
                            "that has already been initialized.")
    return
  endif
  cs%module_is_initialized = .true.
 
  cs%diag => diag ; cs%Time => time
  if (present(tides_csp)) then
    if (associated(tides_csp)) cs%tides_CSp => tides_csp
  endif
 
  ! Read all relevant parameters and write them to the model log.
  call log_version(param_file, mdl, version, "")
  call get_param(param_file, mdl, "SPLIT", cs%split, &
                 "Use the split time stepping if true.", default=.true.)
  if (.not.cs%split) return
 
  call get_param(param_file, mdl, "BOUND_BT_CORRECTION", cs%bound_BT_corr, &
                 "If true, the corrective pseudo mass-fluxes into the "//&
                 "barotropic solver are limited to values that require "//&
                 "less than maxCFL_BT_cont to be accommodated.",default=.false.)
  call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", cs%BT_cont_bounds, &
                 "If true, and BOUND_BT_CORRECTION is true, use the "//&
                 "BT_cont_type variables to set limits determined by "//&
                 "MAXCFL_BT_CONT on the CFL number of the velocities "//&
                 "that are likely to be driven by the corrective mass fluxes.", &
                 default=.true.) !, do_not_log=.not.CS%bound_BT_corr)
  call get_param(param_file, mdl, "ADJUST_BT_CONT", cs%adjust_BT_cont, &
                 "If true, adjust the curve fit to the BT_cont type "//&
                 "that is used by the barotropic solver to match the "//&
                 "transport about which the flow is being linearized.", default=.false.)
  call get_param(param_file, mdl, "GRADUAL_BT_ICS", cs%gradual_BT_ICs, &
                 "If true, adjust the initial conditions for the "//&
                 "barotropic solver to the values from the layered "//&
                 "solution over a whole timestep instead of instantly. "//&
                 "This is a decent approximation to the inclusion of "//&
                 "sum(u dh_dt) while also correcting for truncation errors.", &
                 default=.false.)
  call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", cs%visc_rem_u_uh0, &
                 "If true, use the viscous remnants when estimating the "//&
                 "barotropic velocities that were used to calculate uh0 "//&
                 "and vh0.  False is probably the better choice.", default=.false.)
  call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", cs%use_wide_halos, &
                 "If true, use wide halos and march in during the "//&
                 "barotropic time stepping for efficiency.", default=.true., &
                 layoutparam=.true.)
  call get_param(param_file, mdl, "BTHALO", bt_halo_sz, &
                 "The minimum halo size for the barotropic solver.", default=0, &
                 layoutparam=.true.)
#ifdef STATIC_MEMORY_
  if ((bt_halo_sz > 0) .and. (bt_halo_sz /= bthalo_)) call mom_error(fatal, &
      "barotropic_init: Run-time values of BTHALO must agree with the "//&
      "macro BTHALO_ with STATIC_MEMORY_.")
  wd_halos(1) = whaloi_+nihalo_ ; wd_halos(2) = whaloj_+njhalo_
#else
  wd_halos(1) = bt_halo_sz; wd_halos(2) =  bt_halo_sz
#endif
  call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), &
                 "The barotropic x-halo size that is actually used.", &
                 layoutparam=.true.)
  call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), &
                 "The barotropic y-halo size that is actually used.", &
                 layoutparam=.true.)
 
  call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_bt_cont_type, &
               "If true, use a structure with elements that describe "//&
               "effective face areas from the summed continuity solver "//&
               "as a function the barotropic flow in coupling between "//&
               "the barotropic and baroclinic flow.  This is only used "//&
               "if SPLIT is true. \n", default=.true.)
  call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", &
                                cs%Nonlinear_continuity, &
                 "If true, use nonlinear transports in the barotropic "//&
                 "continuity equation.  This does not apply if "//&
                 "USE_BT_CONT_TYPE is true.", default=.false.)
  cs%Nonlin_cont_update_period = 1
  if (cs%Nonlinear_continuity) &
    call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", &
                                  cs%Nonlin_cont_update_period, &
                 "If NONLINEAR_BT_CONTINUITY is true, this is the number "//&
                 "of barotropic time steps between updates to the face "//&
                 "areas, or 0 to update only before the barotropic stepping.",&
                 units="nondim", default=1)
  call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", cs%BT_project_velocity,&
                 "If true, step the barotropic velocity first and project "//&
                 "out the velocity tendency by 1+BEBT when calculating the "//&
                 "transport.  The default (false) is to use a predictor "//&
                 "continuity step to find the pressure field, and then "//&
                 "to do a corrector continuity step using a weighted "//&
                 "average of the old and new velocities, with weights "//&
                 "of (1-BEBT) and BEBT.", default=.false.)
 
  call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", cs%dynamic_psurf, &
                 "If true, add a dynamic pressure due to a viscous ice "//&
                 "shelf, for instance.", default=.false.)
  if (cs%dynamic_psurf) then
    call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", cs%ice_strength_length, &
                 "The length scale at which the Rayleigh damping rate due "//&
                 "to the ice strength should be the same as if a Laplacian "//&
                 "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", &
                 units="m", default=1.0e4, scale=us%m_to_L)
    call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", cs%Dmin_dyn_psurf, &
                  "The minimum depth to use in limiting the size of the "//&
                  "dynamic surface pressure for stability, if "//&
                  "DYNAMIC_SURFACE_PRESSURE is true..", &
                  units="m", default=1.0e-6, scale=us%m_to_Z)
    call get_param(param_file, mdl, "CONST_DYN_PSURF", cs%const_dyn_psurf, &
                 "The constant that scales the dynamic surface pressure, "//&
                 "if DYNAMIC_SURFACE_PRESSURE is true.  Stable values "//&
                 "are < ~1.0.", units="nondim", default=0.9)
  endif
 
  call get_param(param_file, mdl, "TIDES", cs%tides, &
                 "If true, apply tidal momentum forcing.", default=.false.)
  call get_param(param_file, mdl, "SADOURNY", cs%Sadourny, &
                 "If true, the Coriolis terms are discretized with the "//&
                 "Sadourny (1975) energy conserving scheme, otherwise "//&
                 "the Arakawa & Hsu scheme is used.  If the internal "//&
                 "deformation radius is not resolved, the Sadourny scheme "//&
                 "should probably be used.", default=.true.)
 
  call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, &
                 "A string describing the scheme that is used to set the "//&
                 "open face areas used for barotropic transport and the "//&
                 "relative weights of the accelerations. Valid values are:\n"//&
                 "\t ARITHMETIC - arithmetic mean layer thicknesses \n"//&
                 "\t HARMONIC - harmonic mean layer thicknesses \n"//&
                 "\t HYBRID (the default) - use arithmetic means for \n"//&
                 "\t    layers above the shallowest bottom, the harmonic \n"//&
                 "\t    mean for layers below, and a weighted average for \n"//&
                 "\t    layers that straddle that depth \n"//&
                 "\t FROM_BT_CONT - use the average thicknesses kept \n"//&
                 "\t    in the h_u and h_v fields of the BT_cont_type", &
                 default=bt_cont_string)
  select case (hvel_str)
    case (hybrid_string) ; cs%hvel_scheme = hybrid
    case (harmonic_string) ; cs%hvel_scheme = harmonic
    case (arithmetic_string) ; cs%hvel_scheme = arithmetic
    case (bt_cont_string) ; cs%hvel_scheme = from_bt_cont
    case default
      call mom_mesg('barotropic_init: BT_THICK_SCHEME ="'//trim(hvel_str)//'"', 0)
      call mom_error(fatal, "barotropic_init: Unrecognized setting "// &
            "#define BT_THICK_SCHEME "//trim(hvel_str)//" found in input file.")
  end select
  if ((cs%hvel_scheme == from_bt_cont) .and. .not.use_bt_cont_type) &
    call mom_error(fatal, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//&
                           "can only be used if USE_BT_CONT_TYPE is defined.")
 
  call get_param(param_file, mdl, "BT_STRONG_DRAG", cs%strong_drag, &
                 "If true, use a stronger estimate of the retarding "//&
                 "effects of strong bottom drag, by making it implicit "//&
                 "with the barotropic time-step instead of implicit with "//&
                 "the baroclinic time-step and dividing by the number of "//&
                 "barotropic steps.", default=.false.)
  call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", cs%linear_wave_drag, &
                 "If true, apply a linear drag to the barotropic velocities, "//&
                 "using rates set by lin_drag_u & _v divided by the depth of "//&
                 "the ocean.  This was introduced to facilitate tide modeling.", &
                 default=.false.)
  call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, &
                 "The name of the file with the barotropic linear wave drag "//&
                 "piston velocities.", default="", do_not_log=.not.cs%linear_wave_drag)
  call get_param(param_file, mdl, "BT_WAVE_DRAG_VAR", wave_drag_var, &
                 "The name of the variable in BT_WAVE_DRAG_FILE with the "//&
                 "barotropic linear wave drag piston velocities at h points.", &
                 default="rH", do_not_log=.not.cs%linear_wave_drag)
  call get_param(param_file, mdl, "BT_WAVE_DRAG_SCALE", wave_drag_scale, &
                 "A scaling factor for the barotropic linear wave drag "//&
                 "piston velocities.", default=1.0, units="nondim", &
                 do_not_log=.not.cs%linear_wave_drag)
 
  call get_param(param_file, mdl, "CLIP_BT_VELOCITY", cs%clip_velocity, &
                 "If true, limit any velocity components that exceed "//&
                 "CFL_TRUNCATE.  This should only be used as a desperate "//&
                 "debugging measure.", default=.false.)
  call get_param(param_file, mdl, "CFL_TRUNCATE", cs%CFL_trunc, &
                 "The value of the CFL number that will cause velocity "//&
                 "components to be truncated; instability can occur past 0.5.", &
                 units="nondim", default=0.5, do_not_log=.not.cs%clip_velocity)
  call get_param(param_file, mdl, "MAXVEL", cs%maxvel, &
                 "The maximum velocity allowed before the velocity "//&
                 "components are truncated.", units="m s-1", default=3.0e8, scale=us%m_s_to_L_T, &
                 do_not_log=.not.cs%clip_velocity)
  call get_param(param_file, mdl, "MAXCFL_BT_CONT", cs%maxCFL_BT_cont, &
                 "The maximum permitted CFL number associated with the "//&
                 "barotropic accelerations from the summed velocities "//&
                 "times the time-derivatives of thicknesses.", units="nondim", &
                 default=0.25)
  call get_param(param_file, mdl, "VEL_UNDERFLOW", cs%vel_underflow, &
                 "A negligibly small velocity magnitude below which velocity "//&
                 "components are set to 0.  A reasonable value might be "//&
                 "1e-30 m/s, which is less than an Angstrom divided by "//&
                 "the age of the universe.", units="m s-1", default=0.0, scale=us%m_s_to_L_T)
 
  call get_param(param_file, mdl, "DT_BT_FILTER", cs%dt_bt_filter, &
                 "A time-scale over which the barotropic mode solutions "//&
                 "are filtered, in seconds if positive, or as a fraction "//&
                 "of DT if negative. When used this can never be taken to "//&
                 "be longer than 2*dt.  Set this to 0 to apply no filtering.", &
                 units="sec or nondim", default=-0.25)
  if (cs%dt_bt_filter > 0.0) cs%dt_bt_filter = us%s_to_T*cs%dt_bt_filter
  call get_param(param_file, mdl, "G_BT_EXTRA", cs%G_extra, &
                 "A nondimensional factor by which gtot is enhanced.", &
                 units="nondim", default=0.0)
  call get_param(param_file, mdl, "SSH_EXTRA", ssh_extra, &
                 "An estimate of how much higher SSH might get, for use "//&
                 "in calculating the safe external wave speed. The "//&
                 "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", &
                 units="m", default=min(10.0,0.05*g%max_depth*us%Z_to_m), scale=us%m_to_Z)
 
  call get_param(param_file, mdl, "DEBUG", cs%debug, &
                 "If true, write out verbose debugging data.", &
                 default=.false., debuggingparam=.true.)
  call get_param(param_file, mdl, "DEBUG_BT", cs%debug_bt, &
                 "If true, write out verbose debugging data within the "//&
                 "barotropic time-stepping loop. The data volume can be "//&
                 "quite large if this is true.", default=cs%debug, &
                 debuggingparam=.true.)
 
  cs%linearized_BT_PV = .true.
  call get_param(param_file, mdl, "BEBT", cs%bebt, &
                 "BEBT determines whether the barotropic time stepping "//&
                 "uses the forward-backward time-stepping scheme or a "//&
                 "backward Euler scheme. BEBT is valid in the range from "//&
                 "0 (for a forward-backward treatment of nonrotating "//&
                 "gravity waves) to 1 (for a backward Euler treatment). "//&
                 "In practice, BEBT must be greater than about 0.05.", &
                 units="nondim", default=0.1)
  call get_param(param_file, mdl, "DTBT", dtbt_input, &
                 "The barotropic time step, in s. DTBT is only used with "//&
                 "the split explicit time stepping. To set the time step "//&
                 "automatically based the maximum stable value use 0, or "//&
                 "a negative value gives the fraction of the stable value. "//&
                 "Setting DTBT to 0 is the same as setting it to -0.98. "//&
                 "The value of DTBT that will actually be used is an "//&
                 "integer fraction of DT, rounding down.", units="s or nondim",&
                 default = -0.98)
  call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", &
                 cs%use_old_coriolis_bracket_bug , &
                 "If True, use an order of operations that is not bitwise "//&
                 "rotationally symmetric in the meridional Coriolis term of "//&
                 "the barotropic solver.", default=.false.)
 
  ! Initialize a version of the MOM domain that is specific to the barotropic solver.
  call clone_mom_domain(g%Domain, cs%BT_Domain, min_halo=wd_halos, symmetric=.true.)
#ifdef STATIC_MEMORY_
  if (wd_halos(1) /= whaloi_+nihalo_) call mom_error(fatal, "barotropic_init: "//&
          "Barotropic x-halo sizes are incorrectly resized with STATIC_MEMORY_.")
  if (wd_halos(2) /= whaloj_+njhalo_) call mom_error(fatal, "barotropic_init: "//&
          "Barotropic y-halo sizes are incorrectly resized with STATIC_MEMORY_.")
#else
  if (bt_halo_sz > 0) then
    if (wd_halos(1) > bt_halo_sz) &
      call mom_mesg("barotropic_init: barotropic x-halo size increased.", 3)
    if (wd_halos(2) > bt_halo_sz) &
      call mom_mesg("barotropic_init: barotropic y-halo size increased.", 3)
  endif
#endif
 
  cs%isdw = g%isc-wd_halos(1) ; cs%iedw = g%iec+wd_halos(1)
  cs%jsdw = g%jsc-wd_halos(2) ; cs%jedw = g%jec+wd_halos(2)
  isdw = cs%isdw ; iedw = cs%iedw ; jsdw = cs%jsdw ; jedw = cs%jedw
 
  alloc_(cs%frhatu(isdb:iedb,jsd:jed,nz)) ; alloc_(cs%frhatv(isd:ied,jsdb:jedb,nz))
  alloc_(cs%eta_cor(isd:ied,jsd:jed))
  if (cs%bound_BT_corr) then
    alloc_(cs%eta_cor_bound(isd:ied,jsd:jed)) ; cs%eta_cor_bound(:,:) = 0.0
  endif
  alloc_(cs%IDatu(isdb:iedb,jsd:jed)) ; alloc_(cs%IDatv(isd:ied,jsdb:jedb))
 
  alloc_(cs%ua_polarity(isdw:iedw,jsdw:jedw))
  alloc_(cs%va_polarity(isdw:iedw,jsdw:jedw))
 
  cs%frhatu(:,:,:) = 0.0 ; cs%frhatv(:,:,:) = 0.0
  cs%eta_cor(:,:) = 0.0
  cs%IDatu(:,:) = 0.0 ; cs%IDatv(:,:) = 0.0
 
  cs%ua_polarity(:,:) = 1.0 ; cs%va_polarity(:,:) = 1.0
  call create_group_pass(pass_a_polarity, cs%ua_polarity, cs%va_polarity, cs%BT_domain, to_all, agrid)
  call do_group_pass(pass_a_polarity, cs%BT_domain)
 
  if (use_bt_cont_type) &
    call alloc_bt_cont_type(bt_cont, g, (cs%hvel_scheme == from_bt_cont))
 
  if (cs%debug) then ! Make a local copy of loop ranges for chksum calls
    allocate(cs%debug_BT_HI)
    cs%debug_BT_HI%isc=g%isc
    cs%debug_BT_HI%iec=g%iec
    cs%debug_BT_HI%jsc=g%jsc
    cs%debug_BT_HI%jec=g%jec
    cs%debug_BT_HI%IscB=g%isc-1
    cs%debug_BT_HI%IecB=g%iec
    cs%debug_BT_HI%JscB=g%jsc-1
    cs%debug_BT_HI%JecB=g%jec
    cs%debug_BT_HI%isd=cs%isdw
    cs%debug_BT_HI%ied=cs%iedw
    cs%debug_BT_HI%jsd=cs%jsdw
    cs%debug_BT_HI%jed=cs%jedw
    cs%debug_BT_HI%IsdB=cs%isdw-1
    cs%debug_BT_HI%IedB=cs%iedw
    cs%debug_BT_HI%JsdB=cs%jsdw-1
    cs%debug_BT_HI%JedB=cs%jedw
  endif
 
  ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.
  alloc_(cs%IareaT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IareaT(:,:) = 0.0
  alloc_(cs%bathyT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%bathyT(:,:) = gv%Angstrom_m !### Change to 0.0?
  alloc_(cs%IdxCu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IdxCu(:,:) = 0.0
  alloc_(cs%IdyCv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%IdyCv(:,:) = 0.0
  alloc_(cs%dy_Cu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%dy_Cu(:,:) = 0.0
  alloc_(cs%dx_Cv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%dx_Cv(:,:) = 0.0
  do j=g%jsd,g%jed ; do i=g%isd,g%ied
    cs%IareaT(i,j) = g%IareaT(i,j)
    cs%bathyT(i,j) = g%bathyT(i,j)
  enddo ; enddo
 
  ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without
  !   wide halos.
  do j=g%jsd,g%jed ; do i=g%IsdB,g%IedB
    cs%IdxCu(i,j) = g%IdxCu(i,j) ; cs%dy_Cu(i,j) = g%dy_Cu(i,j)
  enddo ; enddo
  do j=g%JsdB,g%JedB ; do i=g%isd,g%ied
    cs%IdyCv(i,j) = g%IdyCv(i,j) ; cs%dx_Cv(i,j) = g%dx_Cv(i,j)
  enddo ; enddo
  call create_group_pass(pass_static_data, cs%IareaT, cs%BT_domain, to_all)
  call create_group_pass(pass_static_data, cs%bathyT, cs%BT_domain, to_all)
  call create_group_pass(pass_static_data, cs%IdxCu, cs%IdyCv, cs%BT_domain, to_all+scalar_pair)
  call create_group_pass(pass_static_data, cs%dy_Cu, cs%dx_Cv, cs%BT_domain, to_all+scalar_pair)
  call do_group_pass(pass_static_data, cs%BT_domain)
 
  if (cs%linearized_BT_PV) then
    alloc_(cs%q_D(cs%isdw-1:cs%iedw,cs%jsdw-1:cs%jedw))
    alloc_(cs%D_u_Cor(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw))
    alloc_(cs%D_v_Cor(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw))
    cs%q_D(:,:) = 0.0 ; cs%D_u_Cor(:,:) = 0.0 ; cs%D_v_Cor(:,:) = 0.0
    do j=js,je ; do i=is-1,ie
      cs%D_u_Cor(i,j) = 0.5 * (g%bathyT(i+1,j) + g%bathyT(i,j))
    enddo ; enddo
    do j=js-1,je ; do i=is,ie
      cs%D_v_Cor(i,j) = 0.5 * (g%bathyT(i,j+1) + g%bathyT(i,j))
    enddo ; enddo
    do j=js-1,je ; do i=is-1,ie
      if (g%mask2dT(i,j)+g%mask2dT(i,j+1)+g%mask2dT(i+1,j)+g%mask2dT(i+1,j+1)>0.) then
        cs%q_D(i,j) = 0.25 * g%CoriolisBu(i,j) * &
           ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / &
           ((g%areaT(i,j) * g%bathyT(i,j) + g%areaT(i+1,j+1) * g%bathyT(i+1,j+1)) + &
            (g%areaT(i+1,j) * g%bathyT(i+1,j) + g%areaT(i,j+1) * g%bathyT(i,j+1)) )
      else ! All four h points are masked out so q_D(I,J) will is meaningless
        cs%q_D(i,j) = 0.
      endif
    enddo ; enddo
    ! With very wide halos, q and D need to be calculated on the available data
    ! domain and then updated onto the full computational domain.
    call create_group_pass(pass_q_d_cor, cs%q_D, cs%BT_Domain, to_all, position=corner)
    call create_group_pass(pass_q_d_cor, cs%D_u_Cor, cs%D_v_Cor, cs%BT_Domain, &
                           to_all+scalar_pair)
    call do_group_pass(pass_q_d_cor, cs%BT_Domain)
  endif
 
  if (cs%linear_wave_drag) then
    alloc_(cs%lin_drag_u(isdb:iedb,jsd:jed)) ; cs%lin_drag_u(:,:) = 0.0
    alloc_(cs%lin_drag_v(isd:ied,jsdb:jedb)) ; cs%lin_drag_v(:,:) = 0.0
 
    if (len_trim(wave_drag_file) > 0) then
      inputdir = "." ;  call get_param(param_file, mdl, "INPUTDIR", inputdir)
      wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
      call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
 
      allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0
 
      call mom_read_data(wave_drag_file, wave_drag_var, lin_drag_h, g%Domain, scale=us%m_to_Z*us%T_to_s)
      call pass_var(lin_drag_h, g%Domain)
      do j=js,je ; do i=is-1,ie
        cs%lin_drag_u(i,j) = (gv%Z_to_H * wave_drag_scale) * &
           0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        cs%lin_drag_v(i,j) = (gv%Z_to_H * wave_drag_scale) * &
            0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
      enddo ; enddo
      deallocate(lin_drag_h)
    endif
  endif
 
  cs%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) cs%dtbt_fraction = -dtbt_input
 
  dtbt_tmp = -1.0
  if (query_initialized(cs%dtbt, "DTBT", restart_cs)) then
    dtbt_tmp = cs%dtbt
    if ((us%s_to_T_restart /= 0.0) .and. (us%s_to_T_restart /= us%s_to_T)) &
      dtbt_tmp = (us%s_to_T / us%s_to_T_restart) * cs%dtbt
  endif
 
  ! Estimate the maximum stable barotropic time step.
  gtot_estimate = 0.0
  do k=1,g%ke ; gtot_estimate = gtot_estimate + gv%g_prime(k) ; enddo
  call set_dtbt(g, gv, us, cs, gtot_est=gtot_estimate, ssh_add=ssh_extra)
 
  if (dtbt_input > 0.0) then
    cs%dtbt = us%s_to_T * dtbt_input
  elseif (dtbt_tmp > 0.0) then
    cs%dtbt = dtbt_tmp
  endif
  if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false.
 
  call log_param(param_file, mdl, "DTBT as used", cs%dtbt*us%T_to_s)
  call log_param(param_file, mdl, "estimated maximum DTBT", cs%dtbt_max*us%T_to_s)
 
  ! ubtav, vbtav, ubt_IC, vbt_IC, uhbt_IC, and vhbt_IC are allocated and
  ! initialized in register_barotropic_restarts.
 
  if (gv%Boussinesq) then
    thickness_units = "m" ; flux_units = "m3 s-1"
  else
    thickness_units = "kg m-2" ; flux_units = "kg s-1"
  endif
 
  cs%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, time, &
      'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, time, &
      'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, time, &
      'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, time, &
      'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, time, &
      'Barotropic zonal acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, time, &
      'Barotropic meridional acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, time, &
      'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=us%L_T2_to_m_s2)
  cs%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, time, &
      'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=us%L_T2_to_m_s2)
 
  cs%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, time, &
      'Barotropic end SSH', thickness_units, conversion=gv%H_to_m)
  cs%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, time, &
      'Barotropic end zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, time, &
      'Barotropic end meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, time, &
      'Barotropic start SSH', thickness_units, conversion=gv%H_to_m)
  cs%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, time, &
      'Barotropic start zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, time, &
      'Barotropic start meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, time, &
      'Barotropic time-average zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, time, &
      'Barotropic time-average meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, time, &
      'Corrective mass flux', 'm s-1', conversion=gv%H_to_m)
  cs%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, time, &
      'Viscous remnant at u', 'nondim')
  cs%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, time, &
      'Viscous remnant at v', 'nondim')
  cs%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, time, &
      'gtot to North', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
  cs%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, time, &
      'gtot to South', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
  cs%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, time, &
      'gtot to East', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
  cs%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, time, &
      'gtot to West', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
  cs%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, time, &
      'High Frequency Barotropic SSH', thickness_units, conversion=gv%H_to_m)
  cs%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, time, &
      'High Frequency Barotropic zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, time, &
      'High Frequency Barotropic meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
  cs%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, time, &
      'High Frequency Predictor Barotropic SSH', thickness_units, &
      conversion=gv%H_to_m)
  cs%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, time, &
      'High Frequency Barotropic zonal transport', 'm3 s-1', &
      conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
  cs%id_vhbt_hifreq = register_diag_field('ocean_model', 'vhbt_hifreq', diag%axesCv1, time, &
      'High Frequency Barotropic meridional transport', 'm3 s-1', &
      conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
  cs%id_frhatu = register_diag_field('ocean_model', 'frhatu', diag%axesCuL, time, &
      'Fractional thickness of layers in u-columns', 'nondim')
  cs%id_frhatv = register_diag_field('ocean_model', 'frhatv', diag%axesCvL, time, &
      'Fractional thickness of layers in v-columns', 'nondim')
  cs%id_frhatu1 = register_diag_field('ocean_model', 'frhatu1', diag%axesCuL, time, &
      'Predictor Fractional thickness of layers in u-columns', 'nondim')
  cs%id_frhatv1 = register_diag_field('ocean_model', 'frhatv1', diag%axesCvL, time, &
      'Predictor Fractional thickness of layers in v-columns', 'nondim')
  cs%id_uhbt = register_diag_field('ocean_model', 'uhbt', diag%axesCu1, time, &
      'Barotropic zonal transport averaged over a baroclinic step', 'm3 s-1', &
      conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
  cs%id_vhbt = register_diag_field('ocean_model', 'vhbt', diag%axesCv1, time, &
      'Barotropic meridional transport averaged over a baroclinic step', 'm3 s-1', &
      conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
 
  if (use_bt_cont_type) then
    cs%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, time, &
        'BTCont type far east face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, time, &
        'BTCont type near east face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, time, &
        'BTCont type far west face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, time, &
        'BTCont type near west face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, time, &
        'BTCont type far east velocity', 'm s-1', conversion=us%L_T_to_m_s)
    cs%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, time, &
        'BTCont type far west velocity', 'm s-1', conversion=us%L_T_to_m_s)
    cs%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, time, &
        'BTCont type far north face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, time, &
        'BTCont type near north face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, time, &
        'BTCont type far south face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, time, &
        'BTCont type near south face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
    cs%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, time, &
        'BTCont type far north velocity', 'm s-1', conversion=us%L_T_to_m_s)
    cs%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, time, &
        'BTCont type far south velocity', 'm s-1', conversion=us%L_T_to_m_s)
  endif
  cs%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, time, &
      'Barotropic zonal transport difference', 'm3 s-1', conversion=gv%H_to_m*us%L_to_m**2*us%s_to_T)
  cs%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, time, &
      'Barotropic meridional transport difference', 'm3 s-1', conversion=gv%H_to_m*us%L_to_m**2*us%s_to_T)
 
  if (cs%id_frhatu1 > 0) call safe_alloc_ptr(cs%frhatu1, isdb,iedb,jsd,jed,nz)
  if (cs%id_frhatv1 > 0) call safe_alloc_ptr(cs%frhatv1, isd,ied,jsdb,jedb,nz)
 
  if (.NOT.query_initialized(cs%ubtav,"ubtav",restart_cs) .or. &
      .NOT.query_initialized(cs%vbtav,"vbtav",restart_cs)) then
    call btcalc(h, g, gv, cs, may_use_default=.true.)
    cs%ubtav(:,:) = 0.0 ; cs%vbtav(:,:) = 0.0
    do k=1,nz ; do j=js,je ; do i=is-1,ie
      cs%ubtav(i,j) = cs%ubtav(i,j) + cs%frhatu(i,j,k) * u(i,j,k)
    enddo ; enddo ; enddo
    do k=1,nz ; do j=js-1,je ; do i=is,ie
      cs%vbtav(i,j) = cs%vbtav(i,j) + cs%frhatv(i,j,k) * v(i,j,k)
    enddo ; enddo ; enddo
  elseif ((us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
          (us%m_to_L*us%s_to_T_restart) /= (us%m_to_L_restart*us%s_to_T)) then
    vel_rescale = (us%m_to_L*us%s_to_T_restart) / (us%m_to_L_restart*us%s_to_T)
    do j=js,je ; do i=is-1,ie ; cs%ubtav(i,j) = vel_rescale * cs%ubtav(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbtav(i,j) = vel_rescale * cs%vbtav(i,j) ; enddo ; enddo
  endif
 
  if (.NOT.query_initialized(cs%ubt_IC,"ubt_IC",restart_cs) .or. &
      .NOT.query_initialized(cs%vbt_IC,"vbt_IC",restart_cs)) then
    do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = cs%ubtav(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = cs%vbtav(i,j) ; enddo ; enddo
  elseif ((us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
          (us%m_to_L*us%s_to_T_restart) /= (us%m_to_L_restart*us%s_to_T)) then
    vel_rescale = (us%m_to_L*us%s_to_T_restart) / (us%m_to_L_restart*us%s_to_T)
    do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = vel_rescale * cs%ubt_IC(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = vel_rescale * cs%vbt_IC(i,j) ; enddo ; enddo
  endif
 
!   Calculate other constants which are used for btstep.
 
  do j=js,je ; do i=is-1,ie
    if (g%mask2dCu(i,j)>0.) then
      cs%IDatu(i,j) = g%mask2dCu(i,j) * 2.0 / (g%bathyT(i+1,j) + g%bathyT(i,j))
    else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless
      cs%IDatu(i,j) = 0.
    endif
  enddo ; enddo
  do j=js-1,je ; do i=is,ie
    if (g%mask2dCv(i,j)>0.) then
      cs%IDatv(i,j) = g%mask2dCv(i,j) * 2.0 / (g%bathyT(i,j+1) + g%bathyT(i,j))
    else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless
      cs%IDatv(i,j) = 0.
    endif
  enddo ; enddo
 
  call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=1)
  if (cs%bound_BT_corr) then
    ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
    ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
    do j=js,je ; do i=is,ie
      cs%eta_cor_bound(i,j) = gv%m_to_H * g%IareaT(i,j) * 0.1 * cs%maxvel * &
         ((datu(i-1,j) + datu(i,j)) + (datv(i,j) + datv(i,j-1)))
    enddo ; enddo
  endif
 
  if (.NOT.query_initialized(cs%uhbt_IC,"uhbt_IC",restart_cs) .or. &
      .NOT.query_initialized(cs%vhbt_IC,"vhbt_IC",restart_cs)) then
    do j=js,je ; do i=is-1,ie ; cs%uhbt_IC(i,j) = cs%ubtav(i,j) * datu(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vhbt_IC(i,j) = cs%vbtav(i,j) * datv(i,j) ; enddo ; enddo
  elseif ((us%s_to_T_restart * us%m_to_L_restart * gv%m_to_H_restart /= 0.0) .and. &
          ((us%s_to_T_restart * us%m_to_L**2 * gv%m_to_H) /= &
           (us%s_to_T * us%m_to_L_restart**2 * gv%m_to_H_restart))) then
    uh_rescale = (us%s_to_T_restart * us%m_to_L**2 * gv%m_to_H) / &
                 (us%s_to_T * us%m_to_L_restart**2 * gv%m_to_H_restart)
    do j=js,je ; do i=is-1,ie ; cs%uhbt_IC(i,j) = uh_rescale * cs%uhbt_IC(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vhbt_IC(i,j) = uh_rescale * cs%vhbt_IC(i,j) ; enddo ; enddo
  endif
 
  call create_group_pass(pass_bt_hbt_btav, cs%ubt_IC, cs%vbt_IC, g%Domain)
  call create_group_pass(pass_bt_hbt_btav, cs%uhbt_IC, cs%vhbt_IC, g%Domain)
  call create_group_pass(pass_bt_hbt_btav, cs%ubtav, cs%vbtav, g%Domain)
  call do_group_pass(pass_bt_hbt_btav, g%Domain)
 
!  id_clock_pass = cpu_clock_id('(Ocean BT halo updates)', grain=CLOCK_ROUTINE)
  id_clock_calc_pre  = cpu_clock_id('(Ocean BT pre-calcs only)', grain=clock_routine)
  id_clock_pass_pre = cpu_clock_id('(Ocean BT pre-step halo updates)', grain=clock_routine)
  id_clock_calc = cpu_clock_id('(Ocean BT stepping calcs only)', grain=clock_routine)
  id_clock_pass_step = cpu_clock_id('(Ocean BT stepping halo updates)', grain=clock_routine)
  id_clock_calc_post = cpu_clock_id('(Ocean BT post-calcs only)', grain=clock_routine)
  id_clock_pass_post = cpu_clock_id('(Ocean BT post-step halo updates)', grain=clock_routine)
  if (dtbt_input <= 0.0) &
    id_clock_sync = cpu_clock_id('(Ocean BT global synch)', grain=clock_routine)
 

References mom_variables::alloc_bt_cont_type(), arithmetic, arithmetic_string, bt_cont_string, btcalc(), find_face_areas(), from_bt_cont, harmonic, harmonic_string, hybrid, hybrid_string, id_clock_calc, id_clock_calc_post, id_clock_calc_pre, id_clock_pass_post, id_clock_pass_pre, id_clock_pass_step, id_clock_sync, mom_error_handler::mom_error(), mom_error_handler::mom_mesg(), and set_dtbt().

Here is the call graph for this function:

bt_cont_to_face_areas()

subroutine mom_barotropic::bt_cont_to_face_areas ( type(bt_cont_type), intent(inout)  BT_cont, real, dimension(ms%isdw-1:ms%iedw,ms%jsdw:ms%jedw), intent(out)  Datu, real, dimension(ms%isdw:ms%iedw,ms%jsdw-1:ms%jedw), intent(out)  Datv, type(ocean_grid_type), intent(in)  G, type(unit_scale_type), intent(in)  US, type(memory_size_type), intent(in)  MS, integer, intent(in), optional  halo, logical, intent(in), optional  maximize  )

private

This subroutine uses the BTCL types to find typical or maximum face areas, which can then be used for finding wave speeds, etc.

Parameters

[in,out]	bt_cont	The BT_cont_type input to the barotropic solver.
[in]	ms	A type that describes the memory sizes of the argument arrays.
[out]	datu	The effective zonal face area [H L ~> m2 or kg m-1].
[out]	datv	The effective meridional face area [H L ~> m2 or kg m-1].
[in]	g	The ocean's grid structure.
[in]	us	A dimensional unit scaling type
[in]	halo	The extra halo size to use here.
[in]	maximize	If present and true, find the maximum face area for any velocity.

Definition at line 3493 of file MOM_barotropic.F90.

  type(BT_cont_type),     intent(inout) :: BT_cont    !< The BT_cont_type input to the
                                                      !! barotropic solver.
  type(memory_size_type), intent(in)    :: MS         !< A type that describes the memory
                                                      !! sizes of the argument arrays.
  real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
                          intent(out)   :: Datu       !< The effective zonal face area [H L ~> m2 or kg m-1].
  real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
                          intent(out)   :: Datv       !< The effective meridional face area [H L ~> m2 or kg m-1].
  type(ocean_grid_type),  intent(in)    :: G          !< The ocean's grid structure.
  type(unit_scale_type),  intent(in)    :: US   !< A dimensional unit scaling type
  integer,      optional, intent(in)    :: halo       !< The extra halo size to use here.
  logical,      optional, intent(in)    :: maximize   !< If present and true, find the
                                                      !! maximum face area for any velocity.
 
  ! Local variables
  logical :: find_max
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
  find_max = .false. ; if (present(maximize)) find_max = maximize
 
  if (find_max) then
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i,j) = max(bt_cont%FA_u_EE(i,j), bt_cont%FA_u_E0(i,j), &
                      bt_cont%FA_u_W0(i,j), bt_cont%FA_u_WW(i,j))
    enddo ; enddo
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i,j) = max(bt_cont%FA_v_NN(i,j), bt_cont%FA_v_N0(i,j), &
                      bt_cont%FA_v_S0(i,j), bt_cont%FA_v_SS(i,j))
    enddo ; enddo
  else
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i,j) = 0.5 * (bt_cont%FA_u_E0(i,j) + bt_cont%FA_u_W0(i,j))
    enddo ; enddo
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i,j) = 0.5 * (bt_cont%FA_v_N0(i,j) + bt_cont%FA_v_S0(i,j))
    enddo ; enddo
  endif
 

Referenced by btstep(), and set_dtbt().

Here is the caller graph for this function:

bt_mass_source()

subroutine, public mom_barotropic::bt_mass_source	(	real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	h,
		real, dimension(szi_(g),szj_(g)), intent(in)	eta,
		logical, intent(in)	set_cor,
		type(ocean_grid_type), intent(in)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(barotropic_cs), pointer	CS
	)

bt_mass_source determines the appropriately limited mass source for the barotropic solver, along with a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate.

Parameters

[in]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	h	Layer thicknesses [H ~> m or kg m-2].
[in]	eta	The free surface height that is to be corrected [H ~> m or kg m-2].
[in]	set_cor	A flag to indicate whether to set the corrective fluxes (and update the slowly varying part of eta_cor) (.true.) or whether to incrementally update the corrective fluxes.
	cs	The control structure returned by a previous call to barotropic_init.

Definition at line 3643 of file MOM_barotropic.F90.

  type(ocean_grid_type),              intent(in) :: G        !< The ocean's grid structure.
  type(verticalGrid_type),            intent(in) :: GV       !< The ocean's vertical grid structure.
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h  !< Layer thicknesses [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJ_(G)),   intent(in) :: eta      !< The free surface height that is to be
                                                             !! corrected [H ~> m or kg m-2].
  logical,                            intent(in) :: set_cor  !< A flag to indicate whether to set the corrective
                                                             !! fluxes (and update the slowly varying part of eta_cor)
                                                             !! (.true.) or whether to incrementally update the
                                                             !! corrective fluxes.
  type(barotropic_CS),                pointer    :: CS       !< The control structure returned by a previous call
                                                             !! to barotropic_init.
 
  ! Local variables
  real :: h_tot(SZI_(G))      ! The sum of the layer thicknesses [H ~> m or kg m-2].
  real :: eta_h(SZI_(G))      ! The free surface height determined from
                              ! the sum of the layer thicknesses [H ~> m or kg m-2].
  real :: d_eta               ! The difference between estimates of the total
                              ! thicknesses [H ~> m or kg m-2].
  integer :: is, ie, js, je, nz, i, j, k
  real, parameter :: frac_cor = 0.25
  real, parameter :: slow_rate = 0.125
 
  if (.not.associated(cs)) call mom_error(fatal, "bt_mass_source: "// &
        "Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
 
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
 
  !$OMP parallel do default(shared) private(eta_h,h_tot,d_eta)
  do j=js,je
    do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo
    if (gv%Boussinesq) then
      do i=is,ie ; eta_h(i) = h(i,j,1) - g%bathyT(i,j)*gv%Z_to_H ; enddo
    else
      do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo
    endif
    do k=2,nz ; do i=is,ie
      eta_h(i) = eta_h(i) + h(i,j,k)
      h_tot(i) = h_tot(i) + h(i,j,k)
    enddo ; enddo
 
    if (set_cor) then
      do i=is,ie
        d_eta = eta_h(i) - eta(i,j)
        cs%eta_cor(i,j) = d_eta
      enddo
    else
      do i=is,ie
        d_eta = eta_h(i) - eta(i,j)
        cs%eta_cor(i,j) = cs%eta_cor(i,j) + d_eta
      enddo
    endif
  enddo
 

References mom_error_handler::mom_error().

Here is the call graph for this function:

btcalc()

subroutine, public mom_barotropic::btcalc	(	real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)	h,
		type(ocean_grid_type), intent(inout)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(barotropic_cs), pointer	CS,
		real, dimension(szib_(g),szj_(g),szk_(g)), intent(in), optional	h_u,
		real, dimension(szi_(g),szjb_(g),szk_(g)), intent(in), optional	h_v,
		logical, intent(in), optional	may_use_default,
		type(ocean_obc_type), optional, pointer	OBC
	)

btcalc calculates the barotropic velocities from the full velocity and thickness fields, determines the fraction of the total water column in each layer at velocity points, and determines a corrective fictitious mass source that will drive the barotropic estimate of the free surface height toward the baroclinic estimate.

Parameters

[in,out]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	h	Layer thicknesses [H ~> m or kg m-2].
	cs	The control structure returned by a previous call to barotropic_init.
[in]	h_u	The specified thicknesses at u-points [H ~> m or kg m-2].
[in]	h_v	The specified thicknesses at v-points [H ~> m or kg m-2].
[in]	may_use_default	An optional logical argument to indicate that the default velocity point thicknesses may be used for this particular calculation, even though the setting of CShvel_scheme would usually require that h_u and h_v be passed in.
	obc	Open boundary control structure.

Definition at line 2762 of file MOM_barotropic.F90.

  type(ocean_grid_type),   intent(inout) :: G    !< The ocean's grid structure.
  type(verticalGrid_type), intent(in)    :: GV   !< The ocean's vertical grid structure.
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
                           intent(in)    :: h    !< Layer thicknesses [H ~> m or kg m-2].
  type(barotropic_CS),     pointer       :: CS   !< The control structure returned by a previous
                                                 !! call to barotropic_init.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
                 optional, intent(in)    :: h_u  !< The specified thicknesses at u-points [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
                 optional, intent(in)    :: h_v  !< The specified thicknesses at v-points [H ~> m or kg m-2].
  logical,       optional, intent(in)    :: may_use_default !< An optional logical argument
                                                 !! to indicate that the default velocity point
                                                 !! thicknesses may be used for this particular
                                                 !! calculation, even though the setting of
                                                 !! CS%hvel_scheme would usually require that h_u
                                                 !! and h_v be passed in.
  type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure.
 
  ! Local variables
  real :: hatutot(SZIB_(G))    ! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2].
  real :: hatvtot(SZI_(G))     ! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2].
  real :: Ihatutot(SZIB_(G))   ! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1].
  real :: Ihatvtot(SZI_(G))    ! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1].
  real :: h_arith              ! The arithmetic mean thickness [H ~> m or kg m-2].
  real :: h_harm               ! The harmonic mean thicknesses [H ~> m or kg m-2].
  real :: h_neglect            ! A thickness that is so small it is usually lost
                               ! in roundoff and can be neglected [H ~> m or kg m-2].
  real :: wt_arith             ! The nondimensional weight for the arithmetic mean thickness.
                               ! The harmonic mean uses a weight of (1 - wt_arith).
  real :: Rh                   ! A ratio of summed thicknesses, nondim.
  real :: e_u(SZIB_(G),SZK_(G)+1) !   The interface heights at u-velocity and
  real :: e_v(SZI_(G),SZK_(G)+1)  ! v-velocity points [H ~> m or kg m-2].
  real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths [H ~> m or kg m-2].
  real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths [H ~> m or kg m-2].
  real :: htot                 ! The sum of the layer thicknesses [H ~> m or kg m-2].
  real :: Ihtot                ! The inverse of htot [H-1 ~> m-1 or m2 kg-1].
 
  logical :: use_default, test_dflt, apply_OBCs
  integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k
  integer :: iss, ies, n
 
!    This section interpolates thicknesses onto u & v grid points with the
! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-).
  if (.not.associated(cs)) call mom_error(fatal, &
      "btcalc: Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
 
  use_default = .false.
  test_dflt = .false. ; if (present(may_use_default)) test_dflt = may_use_default
 
  if (test_dflt) then
    if (.not.((present(h_u) .and. present(h_v)) .or. &
              (cs%hvel_scheme == harmonic) .or. (cs%hvel_scheme == hybrid) .or.&
              (cs%hvel_scheme == arithmetic))) use_default = .true.
  else
    if (.not.((present(h_u) .and. present(h_v)) .or. &
              (cs%hvel_scheme == harmonic) .or. (cs%hvel_scheme == hybrid) .or.&
              (cs%hvel_scheme == arithmetic))) call mom_error(fatal, &
        "btcalc: Inconsistent settings of optional arguments and hvel_scheme.")
  endif
 
  apply_obcs = .false.
  if (present(obc)) then ; if (associated(obc)) then ; if (obc%OBC_pe) then
    ! Some open boundary condition points might be in this processor's symmetric
    ! computational domain.
    apply_obcs = (obc%number_of_segments > 0)
  endif ; endif ; endif
 
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
  h_neglect = gv%H_subroundoff
 
  !   This estimates the fractional thickness of each layer at the velocity
  ! points, using a harmonic mean estimate.
!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) &
!$OMP                          private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith)
 
  do j=js,je
    if (present(h_u)) then
      do i=is-1,ie ; hatutot(i) = h_u(i,j,1) ; enddo
      do k=2,nz ; do i=is-1,ie
        hatutot(i) = hatutot(i) + h_u(i,j,k)
      enddo ; enddo
      do i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is-1,ie
        cs%frhatu(i,j,k) = h_u(i,j,k) * ihatutot(i)
      enddo ; enddo
    else
      if (cs%hvel_scheme == arithmetic) then
        do i=is-1,ie
          cs%frhatu(i,j,1) = 0.5 * (h(i+1,j,1) + h(i,j,1))
          hatutot(i) = cs%frhatu(i,j,1)
        enddo
        do k=2,nz ; do i=is-1,ie
          cs%frhatu(i,j,k) = 0.5 * (h(i+1,j,k) + h(i,j,k))
          hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == hybrid .or. use_default) then
        do i=is-1,ie
          e_u(i,nz+1) = -0.5 * gv%Z_to_H * (g%bathyT(i+1,j) + g%bathyT(i,j))
          d_shallow_u(i) = -gv%Z_to_H * min(g%bathyT(i+1,j), g%bathyT(i,j))
          hatutot(i) = 0.0
        enddo
        do k=nz,1,-1 ; do i=is-1,ie
          e_u(i,k) = e_u(i,k+1) + 0.5 * (h(i+1,j,k) + h(i,j,k))
          h_arith = 0.5 * (h(i+1,j,k) + h(i,j,k))
          if (e_u(i,k+1) >= d_shallow_u(i)) then
            cs%frhatu(i,j,k) = h_arith
          else
            h_harm = (h(i+1,j,k) * h(i,j,k)) / (h_arith + h_neglect)
            if (e_u(i,k) <= d_shallow_u(i)) then
              cs%frhatu(i,j,k) = h_harm
            else
              wt_arith = (e_u(i,k) - d_shallow_u(i)) / (h_arith + h_neglect)
              cs%frhatu(i,j,k) = wt_arith*h_arith + (1.0-wt_arith)*h_harm
            endif
          endif
          hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == harmonic) then
        do i=is-1,ie
          cs%frhatu(i,j,1) = 2.0*(h(i+1,j,1) * h(i,j,1)) / &
                             ((h(i+1,j,1) + h(i,j,1)) + h_neglect)
          hatutot(i) = cs%frhatu(i,j,1)
        enddo
        do k=2,nz ; do i=is-1,ie
          cs%frhatu(i,j,k) = 2.0*(h(i+1,j,k) * h(i,j,k)) / &
                             ((h(i+1,j,k) + h(i,j,k)) + h_neglect)
          hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
        enddo ; enddo
      endif
      do i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is-1,ie
        cs%frhatu(i,j,k) = cs%frhatu(i,j,k) * ihatutot(i)
      enddo ; enddo
    endif
  enddo
 
!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) &
!$OMP                          private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith)
  do j=js-1,je
    if (present(h_v)) then
      do i=is,ie ; hatvtot(i) = h_v(i,j,1) ; enddo
      do k=2,nz ; do i=is,ie
        hatvtot(i) = hatvtot(i) + h_v(i,j,k)
      enddo ; enddo
      do i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is,ie
        cs%frhatv(i,j,k) = h_v(i,j,k) * ihatvtot(i)
      enddo ; enddo
    else
      if (cs%hvel_scheme == arithmetic) then
        do i=is,ie
          cs%frhatv(i,j,1) = 0.5 * (h(i,j+1,1) + h(i,j,1))
          hatvtot(i) = cs%frhatv(i,j,1)
        enddo
        do k=2,nz ; do i=is,ie
          cs%frhatv(i,j,k) = 0.5 * (h(i,j+1,k) + h(i,j,k))
          hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == hybrid .or. use_default) then
        do i=is,ie
          e_v(i,nz+1) = -0.5 * gv%Z_to_H * (g%bathyT(i,j+1) + g%bathyT(i,j))
          d_shallow_v(i) = -gv%Z_to_H * min(g%bathyT(i,j+1), g%bathyT(i,j))
          hatvtot(i) = 0.0
        enddo
        do k=nz,1,-1 ; do i=is,ie
          e_v(i,k) = e_v(i,k+1) + 0.5 * (h(i,j+1,k) + h(i,j,k))
          h_arith = 0.5 * (h(i,j+1,k) + h(i,j,k))
          if (e_v(i,k+1) >= d_shallow_v(i)) then
            cs%frhatv(i,j,k) = h_arith
          else
            h_harm = (h(i,j+1,k) * h(i,j,k)) / (h_arith + h_neglect)
            if (e_v(i,k) <= d_shallow_v(i)) then
              cs%frhatv(i,j,k) = h_harm
            else
              wt_arith = (e_v(i,k) - d_shallow_v(i)) / (h_arith + h_neglect)
              cs%frhatv(i,j,k) = wt_arith*h_arith + (1.0-wt_arith)*h_harm
            endif
          endif
          hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
        enddo ; enddo
      elseif (cs%hvel_scheme == harmonic) then
        do i=is,ie
          cs%frhatv(i,j,1) = 2.0*(h(i,j+1,1) * h(i,j,1)) / &
                             ((h(i,j+1,1) + h(i,j,1)) + h_neglect)
          hatvtot(i) = cs%frhatv(i,j,1)
        enddo
        do k=2,nz ; do i=is,ie
          cs%frhatv(i,j,k) = 2.0*(h(i,j+1,k) * h(i,j,k)) / &
                             ((h(i,j+1,k) + h(i,j,k)) + h_neglect)
          hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
        enddo ; enddo
      endif
      do i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect) ; enddo
      do k=1,nz ; do i=is,ie
        cs%frhatv(i,j,k) = cs%frhatv(i,j,k) * ihatvtot(i)
      enddo ; enddo
    endif
  enddo
 
  if (apply_obcs) then ; do n=1,obc%number_of_segments ! Test for segment type?
    if (.not. obc%segment(n)%on_pe) cycle
    if (obc%segment(n)%direction == obc_direction_n) then
      j = obc%segment(n)%HI%JsdB
      if ((j >= js-1) .and. (j <= je)) then
        iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied)
        do i=iss,ies ; hatvtot(i) = h(i,j,1) ; enddo
        do k=2,nz ; do i=iss,ies
          hatvtot(i) = hatvtot(i) + h(i,j,k)
        enddo ; enddo
        do i=iss,ies
          ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect)
        enddo
        do k=1,nz ; do i=iss,ies
          cs%frhatv(i,j,k) = h(i,j,k) * ihatvtot(i)
        enddo ; enddo
      endif
    elseif (obc%segment(n)%direction == obc_direction_s) then
      j = obc%segment(n)%HI%JsdB
      if ((j >= js-1) .and. (j <= je)) then
        iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied)
        do i=iss,ies ; hatvtot(i) = h(i,j+1,1) ; enddo
        do k=2,nz ; do i=iss,ies
          hatvtot(i) = hatvtot(i) + h(i,j+1,k)
        enddo ; enddo
        do i=iss,ies
          ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect)
        enddo
        do k=1,nz ; do i=iss,ies
          cs%frhatv(i,j,k) = h(i,j+1,k) * ihatvtot(i)
        enddo ; enddo
      endif
    elseif (obc%segment(n)%direction == obc_direction_e) then
      i = obc%segment(n)%HI%IsdB
      if ((i >= is-1) .and. (i <= ie)) then
        do j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed)
          htot = h(i,j,1)
          do k=2,nz ; htot = htot + h(i,j,k) ; enddo
          ihtot = g%mask2dCu(i,j) / (htot + h_neglect)
          do k=1,nz ; cs%frhatu(i,j,k) = h(i,j,k) * ihtot ; enddo
        enddo
      endif
    elseif (obc%segment(n)%direction == obc_direction_w) then
      i = obc%segment(n)%HI%IsdB
      if ((i >= is-1) .and. (i <= ie)) then
        do j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed)
          htot = h(i+1,j,1)
          do k=2,nz ; htot = htot + h(i+1,j,k) ; enddo
          ihtot = g%mask2dCu(i,j) / (htot + h_neglect)
          do k=1,nz ; cs%frhatu(i,j,k) = h(i+1,j,k) * ihtot ; enddo
        enddo
      endif
    else
      call mom_error(fatal, "btcalc encountered and OBC segment of indeterminate direction.")
    endif
  enddo ; endif
 
  if (cs%debug) then
    call uvchksum("btcalc frhat[uv]", cs%frhatu, cs%frhatv, g%HI, 0, .true., .true.)
    if (present(h_u) .and. present(h_v)) &
      call uvchksum("btcalc h_[uv]", h_u, h_v, g%HI, 0, .true., .true., scale=gv%H_to_m)
    call hchksum(h, "btcalc h",g%HI, haloshift=1, scale=gv%H_to_m)
  endif
 

References arithmetic, harmonic, hybrid, mom_error_handler::mom_error(), mom_open_boundary::obc_direction_n, and mom_open_boundary::obc_direction_s.

Referenced by barotropic_init().

Here is the call graph for this function:

Here is the caller graph for this function:

btstep()

subroutine, public mom_barotropic::btstep	(	real, dimension( g %isdb: g %iedb, g %jsd: g %jed, g %ke), intent(in)	U_in,
		real, dimension( g %isd: g %ied, g %jsdb: g %jedb, g %ke), intent(in)	V_in,
		real, dimension( g %isd: g %ied, g %jsd: g %jed), intent(in)	eta_in,
		real, intent(in)	dt,
		real, dimension( g %isdb: g %iedb, g %jsd: g %jed, g %ke), intent(in)	bc_accel_u,
		real, dimension( g %isd: g %ied, g %jsdb: g %jedb, g %ke), intent(in)	bc_accel_v,
		type(mech_forcing), intent(in)	forces,
		real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)	pbce,
		real, dimension( g %isd: g %ied, g %jsd: g %jed), intent(in)	eta_PF_in,
		real, dimension( g %isdb: g %iedb, g %jsd: g %jed, g %ke), intent(in)	U_Cor,
		real, dimension( g %isd: g %ied, g %jsdb: g %jedb, g %ke), intent(in)	V_Cor,
		real, dimension( g %isdb: g %iedb, g %jsd: g %jed, g %ke), intent(out)	accel_layer_u,
		real, dimension( g %isd: g %ied, g %jsdb: g %jedb, g %ke), intent(out)	accel_layer_v,
		real, dimension( g %isd: g %ied, g %jsd: g %jed), intent(out)	eta_out,
		real, dimension( g %isdb: g %iedb, g %jsd: g %jed), intent(out)	uhbtav,
		real, dimension( g %isd: g %ied, g %jsdb: g %jedb), intent(out)	vhbtav,
		type(ocean_grid_type), intent(inout)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(unit_scale_type), intent(in)	US,
		type(barotropic_cs), pointer	CS,
		real, dimension( g %isdb: g %iedb, g %jsd: g %jed, g %ke), intent(in)	visc_rem_u,
		real, dimension(szi_(g),szjb_(g),szk_(g)), intent(in)	visc_rem_v,
		real, dimension(szi_(g),szj_(g)), intent(out), optional	etaav,
		type(ocean_obc_type), optional, pointer	OBC,
		type(bt_cont_type), optional, pointer	BT_cont,
		real, dimension(:,:), optional, pointer	eta_PF_start,
		real, dimension(:,:), optional, pointer	taux_bot,
		real, dimension(:,:), optional, pointer	tauy_bot,
		real, dimension(:,:,:), optional, pointer	uh0,
		real, dimension(:,:,:), optional, pointer	vh0,
		real, dimension(:,:,:), optional, pointer	u_uh0,
		real, dimension(:,:,:), optional, pointer	v_vh0
	)

This subroutine time steps the barotropic equations explicitly. For gravity waves, anything between a forwards-backwards scheme and a simulated backwards Euler scheme is used, with bebt between 0.0 and 1.0 determining the scheme. In practice, bebt must be of order 0.2 or greater. A forwards-backwards treatment of the Coriolis terms is always used.

Parameters

[in,out]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	us	A dimensional unit scaling type
[in]	u_in	The initial (3-D) zonal velocity [L T-1 ~> m s-1].
[in]	v_in	The initial (3-D) meridional velocity [L T-1 ~> m s-1].
[in]	eta_in	The initial barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in]	dt	The time increment to integrate over [T ~> s].
[in]	bc_accel_u	The zonal baroclinic accelerations, [L T-2 ~> m s-2].
[in]	bc_accel_v	The meridional baroclinic accelerations, [L T-2 ~> m s-2].
[in]	forces	A structure with the driving mechanical forces
[in]	pbce	The baroclinic pressure anomaly in each layer due to free surface height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
[in]	eta_pf_in	The 2-D eta field (either SSH anomaly or column mass anomaly) that was used to calculate the input pressure gradient accelerations (or its final value if eta_PF_start is provided [H ~> m or kg m-2]. Note: eta_in, pbce, and eta_PF_in must have up-to-date values in the first point of their halos.
[in]	u_cor	The (3-D) zonal velocities used to calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
[in]	v_cor	The (3-D) meridional velocities used to calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
[out]	accel_layer_u	The zonal acceleration of each layer due to the barotropic calculation [L T-2 ~> m s-2].
[out]	accel_layer_v	The meridional acceleration of each layer due to the barotropic calculation [L T-2 ~> m s-2].
[out]	eta_out	The final barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[out]	uhbtav	the barotropic zonal volume or mass fluxes averaged through the barotropic steps [H L2 T-1 ~> m3 or kg s-1].
[out]	vhbtav	the barotropic meridional volume or mass fluxes averaged through the barotropic steps [H L2 T-1 ~> m3 or kg s-1].
	cs	The control structure returned by a previous call to barotropic_init.
[in]	visc_rem_u	Both the fraction of the momentum originally in a layer that remains after a time-step of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that a layer experiences after viscosity is applied, in the zonal direction. Nondimensional between 0 (at the bottom) and 1 (far above the bottom).
[in]	visc_rem_v	Ditto for meridional direction [nondim].
[out]	etaav	The free surface height or column mass averaged over the barotropic integration [H ~> m or kg m-2].
	obc	The open boundary condition structure.
	bt_cont	A structure with elements that describe the effective open face areas as a function of barotropic flow.
	eta_pf_start	The eta field consistent with the pressure gradient at the start of the barotropic stepping [H ~> m or kg m-2].
	taux_bot	The zonal bottom frictional stress from ocean to the seafloor [R L Z T-2 ~> Pa].
	tauy_bot	The meridional bottom frictional stress from ocean to the seafloor [R L Z T-2 ~> Pa].
	uh0	The zonal layer transports at reference velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
	u_uh0	The velocities used to calculate uh0 [L T-1 ~> m s-1]
	vh0	The zonal layer transports at reference velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
	v_vh0	The velocities used to calculate vh0 [L T-1 ~> m s-1]

Definition at line 388 of file MOM_barotropic.F90.

  type(ocean_grid_type),                   intent(inout) :: G       !< The ocean's grid structure.
  type(verticalGrid_type),                   intent(in)  :: GV      !< The ocean's vertical grid structure.
  type(unit_scale_type),                     intent(in)  :: US      !< A dimensional unit scaling type
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: U_in    !< The initial (3-D) zonal
                                                                    !! velocity [L T-1 ~> m s-1].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: V_in    !< The initial (3-D) meridional
                                                                    !! velocity [L T-1 ~> m s-1].
  real, dimension(SZI_(G),SZJ_(G)),          intent(in)  :: eta_in  !< The initial barotropic free surface height
                                                         !! anomaly or column mass anomaly [H ~> m or kg m-2].
  real,                                      intent(in)  :: dt      !< The time increment to integrate over [T ~> s].
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: bc_accel_u !< The zonal baroclinic accelerations,
                                                                       !! [L T-2 ~> m s-2].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: bc_accel_v !< The meridional baroclinic accelerations,
                                                                       !! [L T-2 ~> m s-2].
  type(mech_forcing),                        intent(in)  :: forces     !< A structure with the driving mechanical forces
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)),  intent(in)  :: pbce       !< The baroclinic pressure anomaly in each layer
                                                         !! due to free surface height anomalies
                                                         !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
  real, dimension(SZI_(G),SZJ_(G)),          intent(in)  :: eta_PF_in  !< The 2-D eta field (either SSH anomaly or
                                                         !! column mass anomaly) that was used to calculate the input
                                                         !! pressure gradient accelerations (or its final value if
                                                         !! eta_PF_start is provided [H ~> m or kg m-2].
                                                         !! Note: eta_in, pbce, and eta_PF_in must have up-to-date
                                                         !! values in the first point of their halos.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: U_Cor      !< The (3-D) zonal velocities used to
                                                         !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: V_Cor      !< The (3-D) meridional velocities used to
                                                         !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due
                                                         !! to the barotropic calculation [L T-2 ~> m s-2].
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer
                                                         !! due to the barotropic calculation [L T-2 ~> m s-2].
  real, dimension(SZI_(G),SZJ_(G)),          intent(out) :: eta_out       !< The final barotropic free surface
                                                         !! height anomaly or column mass anomaly [H ~> m or kg m-2].
  real, dimension(SZIB_(G),SZJ_(G)),         intent(out) :: uhbtav        !< the barotropic zonal volume or mass
                                                         !! fluxes averaged through the barotropic steps
                                                         !! [H L2 T-1 ~> m3 or kg s-1].
  real, dimension(SZI_(G),SZJB_(G)),         intent(out) :: vhbtav        !< the barotropic meridional volume or mass
                                                         !! fluxes averaged through the barotropic steps
                                                         !! [H L2 T-1 ~> m3 or kg s-1].
  type(barotropic_CS),                       pointer     :: CS            !< The control structure returned by a
                                                         !! previous call to barotropic_init.
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in)  :: visc_rem_u    !< Both the fraction of the momentum
                                                         !! originally in a layer that remains after a time-step of
                                                         !! viscosity, and the fraction of a time-step's worth of a
                                                         !! barotropic acceleration that a layer experiences after
                                                         !! viscosity is applied, in the zonal direction. Nondimensional
                                                         !! between 0 (at the bottom) and 1 (far above the bottom).
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in)  :: visc_rem_v    !< Ditto for meridional direction [nondim].
  real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav        !< The free surface height or column mass
                                                         !! averaged over the barotropic integration [H ~> m or kg m-2].
  type(ocean_OBC_type),                optional, pointer :: OBC          !< The open boundary condition structure.
  type(BT_cont_type),                  optional, pointer :: BT_cont      !< A structure with elements that describe
                                                         !! the effective open face areas as a function of barotropic
                                                         !! flow.
  real, dimension(:,:),                optional, pointer :: eta_PF_start !< The eta field consistent with the pressure
                                                         !! gradient at the start of the barotropic stepping
                                                         !! [H ~> m or kg m-2].
  real, dimension(:,:),                optional, pointer :: taux_bot     !< The zonal bottom frictional stress from
                                                         !! ocean to the seafloor [R L Z T-2 ~> Pa].
  real, dimension(:,:),                optional, pointer :: tauy_bot     !< The meridional bottom frictional stress
                                                         !! from ocean to the seafloor [R L Z T-2 ~> Pa].
  real, dimension(:,:,:),              optional, pointer :: uh0     !< The zonal layer transports at reference
                                                                    !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(:,:,:),              optional, pointer :: u_uh0   !< The velocities used to calculate
                                                                    !! uh0 [L T-1 ~> m s-1]
  real, dimension(:,:,:),              optional, pointer :: vh0     !< The zonal layer transports at reference
                                                                    !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
  real, dimension(:,:,:),              optional, pointer :: v_vh0   !< The velocities used to calculate
                                                                    !! vh0 [L T-1 ~> m s-1]
 
  ! Local variables
  real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been
  real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis
                                    ! terms [L T-1 ~> m s-1].
  real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the
  real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to
                ! be used in calculating barotropic velocities, possibly with
                ! sums less than one due to viscous losses.  Nondimensional.
  real, dimension(SZIB_(G),SZJ_(G)) :: &
    av_rem_u, &   ! The weighted average of visc_rem_u, nondimensional.
    tmp_u         ! A temporary array at u points.
  real, dimension(SZI_(G),SZJB_(G)) :: &
    av_rem_v, &   ! The weighted average of visc_rem_v, nondimensional.
    tmp_v         ! A temporary array at v points.
  real, dimension(SZI_(G),SZJ_(G)) :: &
    e_anom        ! The anomaly in the sea surface height or column mass
                  ! averaged between the beginning and end of the time step,
                  ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
 
  ! These are always allocated with symmetric memory and wide halos.
  real :: q(SZIBW_(CS),SZJBW_(CS))  ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1].
  real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
    ubt, &        ! The zonal barotropic velocity [L T-1 ~> m s-1].
    bt_rem_u, &   ! The fraction of the barotropic zonal velocity that remains
                  ! after a time step, the remainder being lost to bottom drag.
                  ! bt_rem_u is a nondimensional number between 0 and 1.
    bt_force_u, & ! The vertical average of all of the u-accelerations that are
                  ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
    u_accel_bt, & ! The difference between the zonal acceleration from the
                  ! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
    uhbt, &       ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
    uhbt0, &      ! The difference between the sum of the layer zonal thickness
                  ! fluxes and the barotropic thickness flux using the same
                  ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
    ubt_old, &    ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1].
    ubt_first, &  ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
    ubt_sum, &    ! The sum of ubt over the time steps [L T-1 ~> m s-1].
    uhbt_sum, &   ! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
    ubt_wtd, &    ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].
    ubt_trans, &  ! The latest value of ubt used for a transport [L T-1 ~> m s-1].
    azon, bzon, & ! _zon & _mer are the values of the Coriolis force which
    czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav,
    amer, bmer, & ! respectively to get the barotropic inertial rotation
    cmer, dmer, & ! [T-1 ~> s-1].
    cor_u, &      ! The zonal Coriolis acceleration [L T-2 ~> m s-2].
    cor_ref_u, &  ! The zonal barotropic Coriolis acceleration due
                  ! to the reference velocities [L T-2 ~> m s-2].
    pfu, &        ! The zonal pressure force acceleration [L T-2 ~> m s-2].
    rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1].
    pfu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2].
    coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
    dcor_u, &     ! A simply averaged depth at u points [Z ~> m].
    datu          ! Basin depth at u-velocity grid points times the y-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
    vbt, &        ! The meridional barotropic velocity [L T-1 ~> m s-1].
    bt_rem_v, &   ! The fraction of the barotropic meridional velocity that
                  ! remains after a time step, the rest being lost to bottom
                  ! drag.  bt_rem_v is a nondimensional number between 0 and 1.
    bt_force_v, & ! The vertical average of all of the v-accelerations that are
                  ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
    v_accel_bt, & ! The difference between the meridional acceleration from the
                  ! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
    vhbt, &       ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
    vhbt0, &      ! The difference between the sum of the layer meridional
                  ! thickness fluxes and the barotropic thickness flux using
                  ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
    vbt_old, &    ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1].
    vbt_first, &  ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
    vbt_sum, &    ! The sum of vbt over the time steps [L T-1 ~> m s-1].
    vhbt_sum, &   ! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
    vbt_wtd, &    ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].
    vbt_trans, &  ! The latest value of vbt used for a transport [L T-1 ~> m s-1].
    cor_v, &      ! The meridional Coriolis acceleration [L T-2 ~> m s-2].
    cor_ref_v, &  ! The meridional barotropic Coriolis acceleration due
                  ! to the reference velocities [L T-2 ~> m s-2].
    pfv, &        ! The meridional pressure force acceleration [L T-2 ~> m s-2].
    rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1].
    pfv_bt_sum, & ! The summed meridional barotropic pressure gradient force,
                  ! [L T-2 ~> m s-2].
    corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration,
                  ! [L T-2 ~> m s-2].
    dcor_v, &     ! A simply averaged depth at v points [Z ~> m].
    datv          ! Basin depth at v-velocity grid points times the x-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
    eta, &        ! The barotropic free surface height anomaly or column mass
                  ! anomaly [H ~> m or kg m-2]
    eta_pred      ! A predictor value of eta [H ~> m or kg m-2] like eta.
  real, dimension(:,:), pointer :: &
    eta_PF_BT     ! A pointer to the eta array (either eta or eta_pred) that
                  ! determines the barotropic pressure force [H ~> m or kg m-2]
  real, dimension(SZIW_(CS),SZJW_(CS)) :: &
    eta_sum, &    ! eta summed across the timesteps [H ~> m or kg m-2].
    eta_wtd, &    ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2].
    eta_PF, &     ! A local copy of the 2-D eta field (either SSH anomaly or
                  ! column mass anomaly) that was used to calculate the input
                  ! pressure gradient accelerations [H ~> m or kg m-2].
    eta_pf_1, &   ! The initial value of eta_PF, when interp_eta_PF is
                  ! true [H ~> m or kg m-2].
    d_eta_pf, &   ! The change in eta_PF over the barotropic time stepping when
                  ! interp_eta_PF is true [H ~> m or kg m-2].
    gtot_e, &     ! gtot_X is the effective total reduced gravity used to relate
    gtot_w, &     ! free surface height deviations to pressure forces (including
    gtot_n, &     ! GFS and baroclinic  contributions) in the barotropic momentum
    gtot_s, &     ! equations half a grid-point in the X-direction (X is N, S, E, or W)
                  ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
                  ! (See Hallberg, J Comp Phys 1997 for a discussion.)
    eta_src, &    ! The source of eta per barotropic timestep [H ~> m or kg m-2].
    dyn_coef_eta, & ! The coefficient relating the changes in eta to the
                  ! dynamic surface pressure under rigid ice
                  ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
    p_surf_dyn    ! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].
  type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: &
    BTCL_u        ! A repackaged version of the u-point information in BT_cont.
  type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: &
    BTCL_v        ! A repackaged version of the v-point information in BT_cont.
  ! End of wide-sized variables.
 
  real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
    ubt_prev, uhbt_prev, ubt_sum_prev, uhbt_sum_prev, ubt_wtd_prev  ! for OBC
  real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
    vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev  ! for OBC
 
  real :: mass_to_Z   ! The depth unit converison divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1].
  real :: mass_accel_to_Z ! The inverse of the mean density (Rho0) [R-1 ~> m3 kg-1].
  real :: visc_rem    ! A work variable that may equal visc_rem_[uv].  Nondim.
  real :: vel_prev    ! The previous velocity [L T-1 ~> m s-1].
  real :: dtbt        ! The barotropic time step [T ~> s].
  real :: bebt        ! A copy of CS%bebt [nondim].
  real :: be_proj     ! The fractional amount by which velocities are projected
                      ! when project_velocity is true. For now be_proj is set
                      ! to equal bebt, as they have similar roles and meanings.
  real :: Idt         ! The inverse of dt [T-1 ~> s-1].
  real :: det_de      ! The partial derivative due to self-attraction and loading
                      ! of the reference geopotential with the sea surface height.
                      ! This is typically ~0.09 or less.
  real :: dgeo_de     ! The constant of proportionality between geopotential and
                      ! sea surface height.  It is a nondimensional number of
                      ! order 1.  For stability, this may be made larger
                      ! than physical problem would suggest.
  real :: Instep      ! The inverse of the number of barotropic time steps
                      ! to take.
  real :: wt_end      ! The weighting of the final value of eta_PF [nondim]
  integer :: nstep    ! The number of barotropic time steps to take.
  type(time_type) :: &
    time_bt_start, &  ! The starting time of the barotropic steps.
    time_step_end, &  ! The end time of a barotropic step.
    time_end_in       ! The end time for diagnostics when this routine started.
  real :: time_int_in ! The diagnostics' time interval when this routine started.
  logical :: do_hifreq_output  ! If true, output occurs every barotropic step.
  logical :: use_BT_cont, do_ave, find_etaav, find_PF, find_Cor
  logical :: ice_is_rigid, nonblock_setup, interp_eta_PF
  logical :: project_velocity, add_uh0
 
  real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta
                      ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
  real :: ice_strength = 0.0  ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].
  real :: Idt_max2    ! The squared inverse of the local maximum stable
                      ! barotropic time step [T-2 ~> s-2].
  real :: H_min_dyn   ! The minimum depth to use in limiting the size of the
                      ! dynamic surface pressure for stability [H ~> m or kg m-2].
  real :: H_eff_dx2   ! The effective total thickness divided by the grid spacing
                      ! squared [H L-2 ~> m-1 or kg m-4].
  real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1].
  real :: Htot        ! The total thickness [H ~> m or kg m-2].
  real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2].
  real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2].
 
  real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2
  real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans
  real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans
  real :: dt_filt     ! The half-width of the barotropic filter [T ~> s].
  real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans
  integer :: nfilter
 
  logical :: apply_OBCs, apply_OBC_flather, apply_OBC_open
  type(memory_size_type) :: MS
  character(len=200) :: mesg
  integer :: isv, iev, jsv, jev ! The valid array size at the end of a step.
  integer :: stencil  ! The stencil size of the algorithm, often 1 or 2.
  integer :: isvf, ievf, jsvf, jevf, num_cycles
  integer :: i, j, k, n
  integer :: is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq
  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
  integer :: ioff, joff
 
  if (.not.associated(cs)) call mom_error(fatal, &
      "btstep: Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  ms%isdw = cs%isdw ; ms%iedw = cs%iedw ; ms%jsdw = cs%jsdw ; ms%jedw = cs%jedw
 
  idt = 1.0 / dt
  accel_underflow = cs%vel_underflow * idt
 
  use_bt_cont = .false.
  if (present(bt_cont)) use_bt_cont = (associated(bt_cont))
 
  interp_eta_pf = .false.
  if (present(eta_pf_start)) interp_eta_pf = (associated(eta_pf_start))
 
  project_velocity = cs%BT_project_velocity
 
  ! Figure out the fullest arrays that could be updated.
  stencil = 1
  if ((.not.use_bt_cont) .and. cs%Nonlinear_continuity .and. &
      (cs%Nonlin_cont_update_period > 0)) stencil = 2
 
  do_ave = query_averaging_enabled(cs%diag)
  find_etaav = present(etaav)
  find_pf = (do_ave .and. ((cs%id_PFu_bt > 0) .or. (cs%id_PFv_bt > 0)))
  find_cor = (do_ave .and. ((cs%id_Coru_bt > 0) .or. (cs%id_Corv_bt > 0)))
 
  add_uh0 = .false.
  if (present(uh0)) add_uh0 = associated(uh0)
  if (add_uh0 .and. .not.(present(vh0) .and. present(u_uh0) .and. &
                          present(v_vh0))) call mom_error(fatal, &
      "btstep: vh0, u_uh0, and v_vh0 must be present if uh0 is used.")
  if (add_uh0 .and. .not.(associated(vh0) .and. associated(u_uh0) .and. &
                          associated(v_vh0))) call mom_error(fatal, &
      "btstep: vh0, u_uh0, and v_vh0 must be associated if uh0 is used.")
 
  ! This can be changed to try to optimize the performance.
  nonblock_setup = g%nonblocking_updates
 
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
  apply_obcs = .false. ; cs%BT_OBC%apply_u_OBCs = .false. ; cs%BT_OBC%apply_v_OBCs = .false.
  apply_obc_open = .false.
  apply_obc_flather = .false.
  if (present(obc)) then ; if (associated(obc)) then
    cs%BT_OBC%apply_u_OBCs = obc%open_u_BCs_exist_globally .or. obc%specified_u_BCs_exist_globally
    cs%BT_OBC%apply_v_OBCs = obc%open_v_BCs_exist_globally .or. obc%specified_v_BCs_exist_globally
    apply_obc_flather = open_boundary_query(obc, apply_flather_obc=.true.)
    apply_obc_open = open_boundary_query(obc, apply_open_obc=.true.)
    apply_obcs = open_boundary_query(obc, apply_specified_obc=.true.) .or. &
           apply_obc_flather .or. apply_obc_open
 
    if (apply_obc_flather .and. .not.gv%Boussinesq) call mom_error(fatal, &
      "btstep: Flather open boundary conditions have not yet been "// &
      "implemented for a non-Boussinesq model.")
  endif ; endif
 
  num_cycles = 1
  if (cs%use_wide_halos) &
    num_cycles = min((is-cs%isdw) / stencil, (js-cs%jsdw) / stencil)
  isvf = is - (num_cycles-1)*stencil ; ievf = ie + (num_cycles-1)*stencil
  jsvf = js - (num_cycles-1)*stencil ; jevf = je + (num_cycles-1)*stencil
 
  nstep = ceiling(dt/cs%dtbt - 0.0001)
  if (is_root_pe() .and. (nstep /= cs%nstep_last)) then
    write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, &
               & " seconds, max ", ES12.6, ".")') (us%T_to_s*dt/nstep), us%T_to_s*cs%dtbt_max
    call mom_mesg(mesg, 3)
  endif
  cs%nstep_last = nstep
 
  ! Set the actual barotropic time step.
  instep = 1.0 / real(nstep)
  dtbt = dt * instep
  bebt = cs%bebt
  be_proj = cs%bebt
  mass_accel_to_z = 1.0 / gv%Rho0
  mass_to_z = us%m_to_Z / gv%Rho0
 
  !--- setup the weight when computing vbt_trans and ubt_trans
  if (project_velocity) then
    trans_wt1 = (1.0 + be_proj); trans_wt2 = -be_proj
  else
    trans_wt1 = bebt ;           trans_wt2 = (1.0-bebt)
  endif
 
  do_hifreq_output = .false.
  if ((cs%id_ubt_hifreq > 0) .or. (cs%id_vbt_hifreq > 0) .or. &
      (cs%id_eta_hifreq > 0) .or. (cs%id_eta_pred_hifreq > 0) .or. &
      (cs%id_uhbt_hifreq > 0) .or. (cs%id_vhbt_hifreq > 0)) then
    do_hifreq_output = query_averaging_enabled(cs%diag, time_int_in, time_end_in)
    if (do_hifreq_output) &
      time_bt_start = time_end_in - real_to_time(us%T_to_s*dt)
  endif
 
!--- begin setup for group halo update
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
  if (.not. cs%linearized_BT_PV) then
    call create_group_pass(cs%pass_q_DCor, q, cs%BT_Domain, to_all, position=corner)
    call create_group_pass(cs%pass_q_DCor, dcor_u, dcor_v, cs%BT_Domain, &
         to_all+scalar_pair)
  endif
  if ((isq > is-1) .or. (jsq > js-1)) &
    call create_group_pass(cs%pass_tmp_uv, tmp_u, tmp_v, g%Domain)
  call create_group_pass(cs%pass_gtot, gtot_e, gtot_n, cs%BT_Domain, &
       to_all+scalar_pair, agrid)
  call create_group_pass(cs%pass_gtot, gtot_w, gtot_s, cs%BT_Domain, &
       to_all+scalar_pair, agrid)
 
  if (cs%dynamic_psurf) &
    call create_group_pass(cs%pass_eta_bt_rem, dyn_coef_eta, cs%BT_Domain)
  if (interp_eta_pf) then
    call create_group_pass(cs%pass_eta_bt_rem, eta_pf_1, cs%BT_Domain)
    call create_group_pass(cs%pass_eta_bt_rem, d_eta_pf, cs%BT_Domain)
  else
    call create_group_pass(cs%pass_eta_bt_rem, eta_pf, cs%BT_Domain)
  endif
  call create_group_pass(cs%pass_eta_bt_rem, eta_src, cs%BT_Domain)
  ! The following halo updates are not needed without wide halos.  RWH
  ! We do need them after all.
! if (ievf > ie) then
    call create_group_pass(cs%pass_eta_bt_rem, bt_rem_u, bt_rem_v, &
                      cs%BT_Domain, to_all+scalar_pair)
    if (cs%linear_wave_drag) &
      call create_group_pass(cs%pass_eta_bt_rem, rayleigh_u, rayleigh_v, &
                      cs%BT_Domain, to_all+scalar_pair)
! endif
  ! The following halo update is not needed without wide halos.  RWH
  if (((g%isd > cs%isdw) .or. (g%jsd > cs%jsdw)) .or. (isq <= is-1) .or. (jsq <= js-1)) &
    call create_group_pass(cs%pass_force_hbt0_Cor_ref, bt_force_u, bt_force_v, cs%BT_Domain)
  if (add_uh0) call create_group_pass(cs%pass_force_hbt0_Cor_ref, uhbt0, vhbt0, cs%BT_Domain)
  call create_group_pass(cs%pass_force_hbt0_Cor_ref, cor_ref_u, cor_ref_v, cs%BT_Domain)
  if (.not. use_bt_cont) then
    call create_group_pass(cs%pass_Dat_uv, datu, datv, cs%BT_Domain, to_all+scalar_pair)
  endif
  call create_group_pass(cs%pass_eta_ubt, eta, cs%BT_Domain)
  call create_group_pass(cs%pass_eta_ubt, ubt, vbt, cs%BT_Domain)
 
  call create_group_pass(cs%pass_ubt_Cor, ubt_cor, vbt_cor, g%Domain)
  ! These passes occur at the end of the routine, as data is being readied to
  ! share with the main part of the MOM6 code.
  if (find_etaav) then
    call create_group_pass(cs%pass_etaav, etaav, g%Domain)
  endif
  call create_group_pass(cs%pass_e_anom, e_anom, g%Domain)
  call create_group_pass(cs%pass_ubta_uhbta, cs%ubtav, cs%vbtav, g%Domain)
  call create_group_pass(cs%pass_ubta_uhbta, uhbtav, vhbtav, g%Domain)
 
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
!--- end setup for group halo update
 
!   Calculate the constant coefficients for the Coriolis force terms in the
! barotropic momentum equations.  This has to be done quite early to start
! the halo update that needs to be completed before the next calculations.
  if (cs%linearized_BT_PV) then
    !$OMP parallel do default(shared)
    do j=jsvf-2,jevf+1 ; do i=isvf-2,ievf+1
      q(i,j) = cs%q_D(i,j)
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=jsvf-1,jevf+1 ; do i=isvf-2,ievf+1
      dcor_u(i,j) = cs%D_u_Cor(i,j)
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=jsvf-2,jevf+1 ; do i=isvf-1,ievf+1
      dcor_v(i,j) = cs%D_v_Cor(i,j)
    enddo ; enddo
  else
    q(:,:) = 0.0 ; dcor_u(:,:) = 0.0 ; dcor_v(:,:) = 0.0
    !  This option has not yet been written properly.
    !  ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous).
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie
      dcor_u(i,j) = 0.5 * (g%bathyT(i+1,j) + g%bathyT(i,j))
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie
      dcor_v(i,j) = 0.5 * (g%bathyT(i,j+1) + g%bathyT(i,j))
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is-1,ie
      q(i,j) = 0.25 * g%CoriolisBu(i,j) * &
           ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / &
           ((g%areaT(i,j) * g%bathyT(i,j) + g%areaT(i+1,j+1) * g%bathyT(i+1,j+1)) + &
            (g%areaT(i+1,j) * g%bathyT(i+1,j) + g%areaT(i,j+1) * g%bathyT(i,j+1)) )
    enddo ; enddo
 
    ! With very wide halos, q and D need to be calculated on the available data
    ! domain and then updated onto the full computational domain.
    ! These calculations can be done almost immediately, but the halo updates
    ! must be done before the [abcd]mer and [abcd]zon are calculated.
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (nonblock_setup) then
      call start_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
    else
      call do_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
    endif
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  ! Zero out various wide-halo arrays.
  !$OMP parallel do default(shared)
  do j=cs%jsdw,cs%jedw ; do i=cs%isdw,cs%iedw
    gtot_e(i,j) = 0.0 ; gtot_w(i,j) = 0.0
    gtot_n(i,j) = 0.0 ; gtot_s(i,j) = 0.0
    eta(i,j) = 0.0
    eta_pf(i,j) = 0.0
    if (interp_eta_pf) then
      eta_pf_1(i,j) = 0.0 ; d_eta_pf(i,j) = 0.0
    endif
    p_surf_dyn(i,j) = 0.0
    if (cs%dynamic_psurf) dyn_coef_eta(i,j) = 0.0
  enddo ; enddo
  !   The halo regions of various arrays need to be initialized to
  ! non-NaNs in case the neighboring domains are not part of the ocean.
  ! Otherwise a halo update later on fills in the correct values.
  !$OMP parallel do default(shared)
  do j=cs%jsdw,cs%jedw ; do i=cs%isdw-1,cs%iedw
    cor_ref_u(i,j) = 0.0 ; bt_force_u(i,j) = 0.0 ; ubt(i,j) = 0.0
    datu(i,j) = 0.0 ; bt_rem_u(i,j) = 0.0 ; uhbt0(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=cs%jsdw-1,cs%jedw ; do i=cs%isdw,cs%iedw
    cor_ref_v(i,j) = 0.0 ; bt_force_v(i,j) = 0.0 ; vbt(i,j) = 0.0
    datv(i,j) = 0.0 ; bt_rem_v(i,j) = 0.0 ; vhbt0(i,j) = 0.0
  enddo ; enddo
 
  ! Copy input arrays into their wide-halo counterparts.
  if (interp_eta_pf) then
    !$OMP parallel do default(shared)
    do j=g%jsd,g%jed ; do i=g%isd,g%ied ! Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?
      eta(i,j) = eta_in(i,j)
      eta_pf_1(i,j) = eta_pf_start(i,j)
      d_eta_pf(i,j) = eta_pf_in(i,j) - eta_pf_start(i,j)
    enddo ; enddo
  else
    !$OMP parallel do default(shared)
    do j=g%jsd,g%jed ; do i=g%isd,g%ied !: Was "do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1" but doing so breaks OBC. Not sure why?
      eta(i,j) = eta_in(i,j)
      eta_pf(i,j) = eta_pf_in(i,j)
    enddo ; enddo
  endif
 
  !$OMP parallel do default(shared) private(visc_rem)
  do k=1,nz ; do j=js,je ; do i=is-1,ie
    ! rem needs greater than visc_rem_u and 1-Instep/visc_rem_u.
    ! The 0.5 below is just for safety.
    if (visc_rem_u(i,j,k) <= 0.0) then ; visc_rem = 0.0
    elseif (visc_rem_u(i,j,k) >= 1.0) then ; visc_rem = 1.0
    elseif (visc_rem_u(i,j,k)**2 > visc_rem_u(i,j,k) - 0.5*instep) then
      visc_rem = visc_rem_u(i,j,k)
    else ; visc_rem = 1.0 - 0.5*instep/visc_rem_u(i,j,k) ; endif
    wt_u(i,j,k) = cs%frhatu(i,j,k) * visc_rem
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared) private(visc_rem)
  do k=1,nz ; do j=js-1,je ; do i=is,ie
    ! rem needs greater than visc_rem_v and 1-Instep/visc_rem_v.
    if (visc_rem_v(i,j,k) <= 0.0) then ; visc_rem = 0.0
    elseif (visc_rem_v(i,j,k) >= 1.0) then ; visc_rem = 1.0
    elseif (visc_rem_v(i,j,k)**2 > visc_rem_v(i,j,k) - 0.5*instep) then
      visc_rem = visc_rem_v(i,j,k)
    else ; visc_rem = 1.0 - 0.5*instep/visc_rem_v(i,j,k) ; endif
    wt_v(i,j,k) = cs%frhatv(i,j,k) * visc_rem
  enddo ; enddo ; enddo
 
  !   Use u_Cor and v_Cor as the reference values for the Coriolis terms,
  ! including the viscous remnant.
  !$OMP parallel do default(shared)
  do j=js-1,je+1 ; do i=is-1,ie ; ubt_cor(i,j) = 0.0 ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is-1,ie+1 ; vbt_cor(i,j) = 0.0 ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js,je ; do k=1,nz ; do i=is-1,ie
    ubt_cor(i,j) = ubt_cor(i,j) + wt_u(i,j,k) * u_cor(i,j,k)
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do k=1,nz ; do i=is,ie
    vbt_cor(i,j) = vbt_cor(i,j) + wt_v(i,j,k) * v_cor(i,j,k)
  enddo ; enddo ; enddo
 
  ! The gtot arrays are the effective layer-weighted reduced gravities for
  ! accelerations across the various faces, with names for the relative
  ! locations of the faces to the pressure point.  They will have their halos
  ! updated later on.
  !$OMP parallel do default(shared)
  do j=js,je
    do k=1,nz ; do i=is-1,ie
      gtot_e(i,j)   = gtot_e(i,j)   + pbce(i,j,k)   * wt_u(i,j,k)
      gtot_w(i+1,j) = gtot_w(i+1,j) + pbce(i+1,j,k) * wt_u(i,j,k)
    enddo ; enddo
  enddo
  !$OMP parallel do default(shared)
  do j=js-1,je
     do k=1,nz ; do i=is,ie
      gtot_n(i,j)   = gtot_n(i,j)   + pbce(i,j,k)   * wt_v(i,j,k)
      gtot_s(i,j+1) = gtot_s(i,j+1) + pbce(i,j+1,k) * wt_v(i,j,k)
    enddo ; enddo
  enddo
 
  if (cs%tides) then
    call tidal_forcing_sensitivity(g, cs%tides_CSp, det_de)
    dgeo_de = 1.0 + det_de + cs%G_extra
  else
    dgeo_de = 1.0 + cs%G_extra
  endif
 
  if (nonblock_setup .and. .not.cs%linearized_BT_PV) then
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    call complete_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  ! Calculate the open areas at the velocity points.
  ! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor.
  if (use_bt_cont) then
    call set_local_bt_cont_types(bt_cont, btcl_u, btcl_v, g, us, ms, cs%BT_Domain, 1+ievf-ie)
  else
    if (cs%Nonlinear_continuity) then
      call find_face_areas(datu, datv, g, gv, us, cs, ms, eta, 1)
    else
      call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=1)
    endif
  endif
 
  ! Set up fields related to the open boundary conditions.
  if (apply_obcs) then
    call set_up_bt_obc(obc, eta, cs%BT_OBC, cs%BT_Domain, g, gv, us, ms, ievf-ie, use_bt_cont, &
                       datu, datv, btcl_u, btcl_v)
  endif
 
!   Here the vertical average accelerations due to the Coriolis, advective,
! pressure gradient and horizontal viscous terms in the layer momentum
! equations are calculated.  These will be used to determine the difference
! between the accelerations due to the average of the layer equations and the
! barotropic calculation.
 
  !$OMP parallel do default(shared)
  do j=js,je ; do i=is-1,ie
    ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
    ! ### although with BT_cont_types IDatu should be replaced by
    ! ###   CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds).
    bt_force_u(i,j) = forces%taux(i,j) * mass_accel_to_z * cs%IDatu(i,j)*visc_rem_u(i,j,1)
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is,ie
    ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
    ! ### although with BT_cont_types IDatv should be replaced by
    ! ###   CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds).
    bt_force_v(i,j) = forces%tauy(i,j) * mass_accel_to_z * cs%IDatv(i,j)*visc_rem_v(i,j,1)
  enddo ; enddo
  if (present(taux_bot) .and. present(tauy_bot)) then
    if (associated(taux_bot) .and. associated(tauy_bot)) then
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        bt_force_u(i,j) = bt_force_u(i,j) - taux_bot(i,j) * mass_to_z  * cs%IDatu(i,j)
      enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        bt_force_v(i,j) = bt_force_v(i,j) - tauy_bot(i,j) * mass_to_z  * cs%IDatv(i,j)
      enddo ; enddo
    endif
  endif
 
  ! bc_accel_u & bc_accel_v are only available on the potentially
  ! non-symmetric computational domain.
  !$OMP parallel do default(shared)
  do j=js,je ; do k=1,nz ; do i=isq,ieq
    bt_force_u(i,j) = bt_force_u(i,j) + wt_u(i,j,k) * bc_accel_u(i,j,k)
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=jsq,jeq ; do k=1,nz ; do i=is,ie
    bt_force_v(i,j) = bt_force_v(i,j) + wt_v(i,j,k) * bc_accel_v(i,j,k)
  enddo ; enddo ; enddo
 
  ! Determine the difference between the sum of the layer fluxes and the
  ! barotropic fluxes found from the same input velocities.
  if (add_uh0) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie ; uhbt(i,j) = 0.0 ; ubt(i,j) = 0.0 ; enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie ; vhbt(i,j) = 0.0 ; vbt(i,j) = 0.0 ; enddo ; enddo
    if (cs%visc_rem_u_uh0) then
      !$OMP parallel do default(shared)
      do j=js,je ; do k=1,nz ; do i=is-1,ie
        uhbt(i,j) = uhbt(i,j) + uh0(i,j,k)
        ubt(i,j) = ubt(i,j) + wt_u(i,j,k) * u_uh0(i,j,k)
      enddo ; enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do k=1,nz ; do i=is,ie
        vhbt(i,j) = vhbt(i,j) + vh0(i,j,k)
        vbt(i,j) = vbt(i,j) + wt_v(i,j,k) * v_vh0(i,j,k)
      enddo ; enddo ; enddo
    else
      !$OMP parallel do default(shared)
      do j=js,je ; do k=1,nz ; do i=is-1,ie
        uhbt(i,j) = uhbt(i,j) + uh0(i,j,k)
        ubt(i,j) = ubt(i,j) + cs%frhatu(i,j,k) * u_uh0(i,j,k)
      enddo ; enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do k=1,nz ; do i=is,ie
        vhbt(i,j) = vhbt(i,j) + vh0(i,j,k)
        vbt(i,j) = vbt(i,j) + cs%frhatv(i,j,k) * v_vh0(i,j,k)
      enddo ; enddo ; enddo
    endif
    if (use_bt_cont) then
      if (cs%adjust_BT_cont) then
        ! Use the additional input transports to broaden the fits
        ! over which the bt_cont_type applies.
 
        ! Fill in the halo data for ubt, vbt, uhbt, and vhbt.
        if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
        if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
        call pass_vector(ubt, vbt, cs%BT_Domain, complete=.false., halo=1+ievf-ie)
        call pass_vector(uhbt, vhbt, cs%BT_Domain, complete=.true., halo=1+ievf-ie)
        if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
        if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
        call adjust_local_bt_cont_types(ubt, uhbt, vbt, vhbt, btcl_u, btcl_v, &
                                        g, us, ms, 1+ievf-ie)
      endif
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        uhbt0(i,j) = uhbt(i,j) - find_uhbt(ubt(i,j), btcl_u(i,j), us)
      enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        vhbt0(i,j) = vhbt(i,j) - find_vhbt(vbt(i,j), btcl_v(i,j), us)
      enddo ; enddo
    else
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        uhbt0(i,j) = uhbt(i,j) - datu(i,j)*ubt(i,j)
      enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        vhbt0(i,j) = vhbt(i,j) - datv(i,j)*vbt(i,j)
      enddo ; enddo
    endif
    if (cs%BT_OBC%apply_u_OBCs) then  ! zero out pressure force across boundary
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
        uhbt0(i,j) = 0.0
      endif ; enddo ; enddo
    endif
    if (cs%BT_OBC%apply_v_OBCs) then  ! zero out PF across boundary
      !$OMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
        vhbt0(i,j) = 0.0
      endif ; enddo ; enddo
    endif
  endif
 
! Calculate the initial barotropic velocities from the layer's velocities.
  !$OMP parallel do default(shared)
  do j=jsvf-1,jevf+1 ; do i=isvf-2,ievf+1
    ubt(i,j) = 0.0 ; uhbt(i,j) = 0.0 ; u_accel_bt(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=jsvf-2,jevf+1 ; do i=isvf-1,ievf+1
    vbt(i,j) = 0.0 ; vhbt(i,j) = 0.0 ; v_accel_bt(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js,je ; do k=1,nz ; do i=is-1,ie
    ubt(i,j) = ubt(i,j) + wt_u(i,j,k) * u_in(i,j,k)
  enddo ; enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do k=1,nz ; do i=is,ie
    vbt(i,j) = vbt(i,j) + wt_v(i,j,k) * v_in(i,j,k)
  enddo ; enddo ;  enddo
  !$OMP parallel do default(shared)
  do j=js,je ; do i=is-1,ie
    if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is,ie
    if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
  enddo ; enddo
 
  if (apply_obcs) then
    ubt_first(:,:) = ubt(:,:) ; vbt_first(:,:) = vbt(:,:)
  endif
 
  if (cs%gradual_BT_ICs) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie
      bt_force_u(i,j) = bt_force_u(i,j) + (ubt(i,j) - cs%ubt_IC(i,j)) * idt
      ubt(i,j) = cs%ubt_IC(i,j)
      if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
    enddo ; enddo
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie
      bt_force_v(i,j) = bt_force_v(i,j) + (vbt(i,j) - cs%vbt_IC(i,j)) * idt
      vbt(i,j) = cs%vbt_IC(i,j)
      if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
    enddo ; enddo
  endif
 
  if ((isq > is-1) .or. (jsq > js-1)) then
    ! Non-symmetric memory is being used, so the edge values need to be
    ! filled in with a halo update of a non-symmetric array.
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
    tmp_u(:,:) = 0.0 ; tmp_v(:,:) = 0.0
    do j=js,je ; do i=isq,ieq ; tmp_u(i,j) = bt_force_u(i,j) ; enddo ; enddo
    do j=jsq,jeq ; do i=is,ie ; tmp_v(i,j) = bt_force_v(i,j) ; enddo ; enddo
    if (nonblock_setup) then
      call start_group_pass(cs%pass_tmp_uv, g%Domain)
    else
      call do_group_pass(cs%pass_tmp_uv, g%Domain)
      do j=jsd,jed ; do i=isdb,iedb ; bt_force_u(i,j) = tmp_u(i,j) ; enddo ; enddo
      do j=jsdb,jedb ; do i=isd,ied ; bt_force_v(i,j) = tmp_v(i,j) ; enddo ; enddo
    endif
    if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  if (nonblock_setup) then
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
    call start_group_pass(cs%pass_gtot, cs%BT_Domain)
    call start_group_pass(cs%pass_ubt_Cor, g%Domain)
    if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  ! Determine the weighted Coriolis parameters for the neighboring velocities.
  !$OMP parallel do default(shared)
  do j=jsvf-1,jevf ; do i=isvf-1,ievf+1
    if (cs%Sadourny) then
      amer(i-1,j) = dcor_u(i-1,j) * q(i-1,j)
      bmer(i,j) = dcor_u(i,j) * q(i,j)
      cmer(i,j+1) = dcor_u(i,j+1) * q(i,j)
      dmer(i-1,j+1) = dcor_u(i-1,j+1) * q(i-1,j)
    else
      amer(i-1,j) = dcor_u(i-1,j) * &
                    ((q(i,j) + q(i-1,j-1)) + q(i-1,j)) / 3.0
      bmer(i,j) = dcor_u(i,j) * &
                  (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0
      cmer(i,j+1) = dcor_u(i,j+1) * &
                    (q(i,j) + (q(i-1,j) + q(i,j+1))) / 3.0
      dmer(i-1,j+1) = dcor_u(i-1,j+1) * &
                      ((q(i,j) + q(i-1,j+1)) + q(i-1,j)) / 3.0
    endif
  enddo ; enddo
 
  !$OMP parallel do default(shared)
  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf
    if (cs%Sadourny) then
      azon(i,j) = dcor_v(i+1,j) * q(i,j)
      bzon(i,j) = dcor_v(i,j) * q(i,j)
      czon(i,j) = dcor_v(i,j-1) * q(i,j-1)
      dzon(i,j) = dcor_v(i+1,j-1) * q(i,j-1)
    else
      azon(i,j) = dcor_v(i+1,j) * &
                  (q(i,j) + (q(i+1,j) + q(i,j-1))) / 3.0
      bzon(i,j) = dcor_v(i,j) * &
                  (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0
      czon(i,j) = dcor_v(i,j-1) * &
                  ((q(i,j) + q(i-1,j-1)) + q(i,j-1)) / 3.0
      dzon(i,j) = dcor_v(i+1,j-1) * &
                  ((q(i,j) + q(i+1,j-1)) + q(i,j-1)) / 3.0
    endif
  enddo ; enddo
 
! Complete the previously initiated message passing.
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
  if (nonblock_setup) then
    if ((isq > is-1) .or. (jsq > js-1)) then
      call complete_group_pass(cs%pass_tmp_uv, g%Domain)
      do j=jsd,jed ; do i=isdb,iedb ; bt_force_u(i,j) = tmp_u(i,j) ; enddo ; enddo
      do j=jsdb,jedb ; do i=isd,ied ; bt_force_v(i,j) = tmp_v(i,j) ; enddo ; enddo
    endif
    call complete_group_pass(cs%pass_gtot, cs%BT_Domain)
    call complete_group_pass(cs%pass_ubt_Cor, g%Domain)
  else
    call do_group_pass(cs%pass_gtot, cs%BT_Domain)
    call do_group_pass(cs%pass_ubt_Cor, g%Domain)
  endif
  ! The various elements of gtot are positive definite but directional, so use
  ! the polarity arrays to sort out when the directions have shifted.
  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
    if (cs%ua_polarity(i,j) < 0.0) call swap(gtot_e(i,j), gtot_w(i,j))
    if (cs%va_polarity(i,j) < 0.0) call swap(gtot_n(i,j), gtot_s(i,j))
  enddo ; enddo
 
  !$OMP parallel do default(shared)
  do j=js,je ; do i=is-1,ie
    cor_ref_u(i,j) =  &
        ((azon(i,j) * vbt_cor(i+1,j) + czon(i,j) * vbt_cor(i  ,j-1)) + &
         (bzon(i,j) * vbt_cor(i  ,j) + dzon(i,j) * vbt_cor(i+1,j-1)))
  enddo ; enddo
  !$OMP parallel do default(shared)
  do j=js-1,je ; do i=is,ie
    cor_ref_v(i,j) = -1.0 * &
        ((amer(i-1,j) * ubt_cor(i-1,j) + cmer(i  ,j+1) * ubt_cor(i  ,j+1)) + &
         (bmer(i  ,j) * ubt_cor(i  ,j) + dmer(i-1,j+1) * ubt_cor(i-1,j+1)))
  enddo ; enddo
 
  ! Now start new halo updates.
  if (nonblock_setup) then
    if (.not.use_bt_cont) &
      call start_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
 
    ! The following halo update is not needed without wide halos.  RWH
    call start_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
  endif
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
!$OMP parallel default(none) shared(is,ie,js,je,nz,av_rem_u,av_rem_v,CS,visc_rem_u, &
!$OMP                               visc_rem_v,bt_rem_u,G,GV,nstep,bt_rem_v,Instep, &
!$OMP                               find_etaav,jsvf,jevf,isvf,ievf,eta_sum,eta_wtd, &
!$OMP                               ubt_sum,uhbt_sum,PFu_bt_sum,Coru_bt_sum,ubt_wtd,&
!$OMP                               ubt_trans,vbt_sum,vhbt_sum,PFv_bt_sum,          &
!$OMP                               Corv_bt_sum,vbt_wtd,vbt_trans,eta_src,dt,dtbt,  &
!$OMP                               Rayleigh_u, Rayleigh_v,                         &
!$OMP                               use_BT_Cont,BTCL_u,uhbt0,BTCL_v,vhbt0,eta,Idt,US)  &
!$OMP                       private(u_max_cor,v_max_cor,eta_cor_max,Htot)
  !$OMP do
  do j=js-1,je+1 ; do i=is-1,ie ; av_rem_u(i,j) = 0.0 ; enddo ; enddo
  !$OMP do
  do j=js-1,je ; do i=is-1,ie+1 ; av_rem_v(i,j) = 0.0 ; enddo ; enddo
  !$OMP do
  do j=js,je ; do k=1,nz ; do i=is-1,ie
    av_rem_u(i,j) = av_rem_u(i,j) + cs%frhatu(i,j,k) * visc_rem_u(i,j,k)
  enddo ; enddo ; enddo
  !$OMP do
  do j=js-1,je ; do k=1,nz ; do i=is,ie
    av_rem_v(i,j) = av_rem_v(i,j) + cs%frhatv(i,j,k) * visc_rem_v(i,j,k)
  enddo ; enddo ; enddo
  if (cs%strong_drag) then
    !$OMP do
    do j=js,je ; do i=is-1,ie
      bt_rem_u(i,j) = g%mask2dCu(i,j) * &
         ((nstep * av_rem_u(i,j)) / (1.0 + (nstep-1)*av_rem_u(i,j)))
    enddo ; enddo
    !$OMP do
    do j=js-1,je ; do i=is,ie
      bt_rem_v(i,j) = g%mask2dCv(i,j) * &
         ((nstep * av_rem_v(i,j)) / (1.0 + (nstep-1)*av_rem_v(i,j)))
    enddo ; enddo
  else
    !$OMP do
    do j=js,je ; do i=is-1,ie
      bt_rem_u(i,j) = 0.0
      if (g%mask2dCu(i,j) * av_rem_u(i,j) > 0.0) &
        bt_rem_u(i,j) = g%mask2dCu(i,j) * (av_rem_u(i,j)**instep)
    enddo ; enddo
    !$OMP do
    do j=js-1,je ; do i=is,ie
      bt_rem_v(i,j) = 0.0
      if (g%mask2dCv(i,j) * av_rem_v(i,j) > 0.0) &
        bt_rem_v(i,j) = g%mask2dCv(i,j) * (av_rem_v(i,j)**instep)
    enddo ; enddo
  endif
  if (cs%linear_wave_drag) then
    !$OMP do
    do j=js,je ; do i=is-1,ie ; if (cs%lin_drag_u(i,j) > 0.0) then
      htot = 0.5 * (eta(i,j) + eta(i+1,j))
      if (gv%Boussinesq) &
        htot = htot + 0.5*gv%Z_to_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j))
      bt_rem_u(i,j) = bt_rem_u(i,j) * (htot / (htot + cs%lin_drag_u(i,j) * dtbt))
 
      rayleigh_u(i,j) = cs%lin_drag_u(i,j) / htot
    endif ; enddo ; enddo
    !$OMP do
    do j=js-1,je ; do i=is,ie ; if (cs%lin_drag_v(i,j) > 0.0) then
      htot = 0.5 * (eta(i,j) + eta(i,j+1))
      if (gv%Boussinesq) &
        htot = htot + 0.5*gv%Z_to_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j+1))
      bt_rem_v(i,j) = bt_rem_v(i,j) * (htot / (htot + cs%lin_drag_v(i,j) * dtbt))
 
      rayleigh_v(i,j) = cs%lin_drag_v(i,j) / htot
    endif ; enddo ; enddo
  endif
 
  ! Zero out the arrays for various time-averaged quantities.
  if (find_etaav) then
    !$OMP do
    do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
      eta_sum(i,j) = 0.0 ; eta_wtd(i,j) = 0.0
    enddo ; enddo
  else
    !$OMP do
    do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
      eta_wtd(i,j) = 0.0
    enddo ; enddo
   endif
  !$OMP do
  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf
    ubt_sum(i,j) = 0.0 ; uhbt_sum(i,j) = 0.0
    pfu_bt_sum(i,j) = 0.0 ; coru_bt_sum(i,j) = 0.0
    ubt_wtd(i,j) = 0.0 ; ubt_trans(i,j) = 0.0
  enddo ; enddo
  !$OMP do
  do j=jsvf-1,jevf ; do i=isvf-1,ievf+1
    vbt_sum(i,j) = 0.0 ; vhbt_sum(i,j) = 0.0
    pfv_bt_sum(i,j) = 0.0 ; corv_bt_sum(i,j) = 0.0
    vbt_wtd(i,j) = 0.0 ; vbt_trans(i,j) = 0.0
  enddo ; enddo
 
  ! Set the mass source, after first initializing the halos to 0.
  !$OMP do
  do j=jsvf-1,jevf+1; do i=isvf-1,ievf+1 ; eta_src(i,j) = 0.0 ; enddo ; enddo
  if (cs%bound_BT_corr) then ; if (use_bt_cont .and. cs%BT_cont_bounds) then
    do j=js,je ; do i=is,ie ; if (g%mask2dT(i,j) > 0.0) then
      if (cs%eta_cor(i,j) > 0.0) then
        !   Limit the source (outward) correction to be a fraction the mass that
        ! can be transported out of the cell by velocities with a CFL number of
        ! CFL_cor.
        u_max_cor = g%dxT(i,j) * (cs%maxCFL_BT_cont*idt)
        v_max_cor = g%dyT(i,j) * (cs%maxCFL_BT_cont*idt)
        eta_cor_max = dt * (cs%IareaT(i,j) * &
                   (((find_uhbt(u_max_cor, btcl_u(i,j), us) + uhbt0(i,j)) - &
                     (find_uhbt(-u_max_cor, btcl_u(i-1,j), us) + uhbt0(i-1,j))) + &
                    ((find_vhbt(v_max_cor, btcl_v(i,j), us) + vhbt0(i,j)) - &
                     (find_vhbt(-v_max_cor, btcl_v(i,j-1), us) + vhbt0(i,j-1))) ))
        cs%eta_cor(i,j) = min(cs%eta_cor(i,j), max(0.0, eta_cor_max))
      else
        ! Limit the sink (inward) correction to the amount of mass that is already
        ! inside the cell.
        htot = eta(i,j)
        if (gv%Boussinesq) htot = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j)
 
        cs%eta_cor(i,j) = max(cs%eta_cor(i,j), -max(0.0,htot))
      endif
    endif ; enddo ; enddo
  else ; do j=js,je ; do i=is,ie
    if (abs(cs%eta_cor(i,j)) > dt*cs%eta_cor_bound(i,j)) &
      cs%eta_cor(i,j) = sign(dt*cs%eta_cor_bound(i,j), cs%eta_cor(i,j))
  enddo ; enddo ; endif ; endif
  !$OMP do
  do j=js,je ; do i=is,ie
    eta_src(i,j) = g%mask2dT(i,j) * (instep * cs%eta_cor(i,j))
  enddo ; enddo
!$OMP end parallel
 
  if (cs%dynamic_psurf) then
    ice_is_rigid = (associated(forces%rigidity_ice_u) .and. &
                    associated(forces%rigidity_ice_v))
    h_min_dyn = gv%Z_to_H * cs%Dmin_dyn_psurf
    if (ice_is_rigid .and. use_bt_cont) &
      call bt_cont_to_face_areas(bt_cont, datu, datv, g, us, ms, 0, .true.)
    if (ice_is_rigid) then
      !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength)
      do j=js,je ; do i=is,ie
      ! First determine the maximum stable value for dyn_coef_eta.
 
      !   This estimate of the maximum stable time step is pretty accurate for
      ! gravity waves, but it is a conservative estimate since it ignores the
      ! stabilizing effect of the bottom drag.
      idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (g%IareaT(i,j) * &
            ((gtot_e(i,j) * (datu(i,j)*g%IdxCu(i,j)) + &
              gtot_w(i,j) * (datu(i-1,j)*g%IdxCu(i-1,j))) + &
             (gtot_n(i,j) * (datv(i,j)*g%IdyCv(i,j)) + &
              gtot_s(i,j) * (datv(i,j-1)*g%IdyCv(i,j-1)))) + &
            ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
             (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)))
      h_eff_dx2 = max(h_min_dyn * ((g%IdxT(i,j))**2 + (g%IdyT(i,j))**2), &
                      g%IareaT(i,j) * &
                        ((datu(i,j)*g%IdxCu(i,j) + datu(i-1,j)*g%IdxCu(i-1,j)) + &
                         (datv(i,j)*g%IdyCv(i,j) + datv(i,j-1)*g%IdyCv(i,j-1)) ) )
      dyn_coef_max = cs%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * idt_max2) / &
                     (dtbt**2 * h_eff_dx2)
 
      ! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [m3 s-1].
      ice_strength = us%m_to_L**4*us%Z_to_m*us%T_to_s* &
                     ((forces%rigidity_ice_u(i,j) + forces%rigidity_ice_u(i-1,j)) + &
                      (forces%rigidity_ice_v(i,j) + forces%rigidity_ice_v(i,j-1))) / &
                      (cs%ice_strength_length**2 * dtbt)
 
      ! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]
      dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * gv%H_to_Z)
    enddo ; enddo ; endif
  endif
 
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
  if (nonblock_setup) then
    call start_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
    ! The following halo update is not needed without wide halos.  RWH
  else
    call do_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
    if (.not.use_bt_cont) &
      call do_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
    call do_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
  endif
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
  ! Complete all of the outstanding halo updates.
  if (nonblock_setup) then
    if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
    if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
 
    if (.not.use_bt_cont) &  !### IS THIS OK HERE?
      call complete_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
    call complete_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
    call complete_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
 
    if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
    if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
  endif
 
  if (cs%debug) then
    call uvchksum("BT [uv]hbt", uhbt, vhbt, cs%debug_BT_HI, haloshift=0, &
                  scale=us%s_to_T*us%L_to_m**2*gv%H_to_m)
    call uvchksum("BT Initial [uv]bt", ubt, vbt, cs%debug_BT_HI, haloshift=0, scale=us%L_T_to_m_s)
    call hchksum(eta, "BT Initial eta", cs%debug_BT_HI, haloshift=0, scale=gv%H_to_m)
    call uvchksum("BT BT_force_[uv]", bt_force_u, bt_force_v, &
                  cs%debug_BT_HI, haloshift=0, scale=us%L_T2_to_m_s2)
    if (interp_eta_pf) then
      call hchksum(eta_pf_1, "BT eta_PF_1",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
      call hchksum(d_eta_pf, "BT d_eta_PF",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
    else
      call hchksum(eta_pf, "BT eta_PF",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
      call hchksum(eta_pf_in, "BT eta_PF_in",g%HI,haloshift=0, scale=gv%H_to_m)
    endif
    call uvchksum("BT Cor_ref_[uv]", cor_ref_u, cor_ref_v, cs%debug_BT_HI, haloshift=0, scale=us%L_T2_to_m_s2)
    call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, cs%debug_BT_HI, haloshift=0, &
                  scale=us%L_to_m**2*us%s_to_T*gv%H_to_m)
    if (.not. use_bt_cont) then
      call uvchksum("BT Dat[uv]", datu, datv, cs%debug_BT_HI, haloshift=1, scale=us%L_to_m*gv%H_to_m)
    endif
    call uvchksum("BT wt_[uv]", wt_u, wt_v, g%HI, 0, .true., .true.)
    call uvchksum("BT frhat[uv]", cs%frhatu, cs%frhatv, g%HI, 0, .true., .true.)
    call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, g%HI, haloshift=0, scale=us%L_T2_to_m_s2)
    call uvchksum("BT IDat[uv]", cs%IDatu, cs%IDatv, g%HI, haloshift=0, scale=us%m_to_Z)
    call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, g%HI, haloshift=1)
  endif
 
  if (query_averaging_enabled(cs%diag)) then
    if (cs%id_eta_st > 0) call post_data(cs%id_eta_st, eta(isd:ied,jsd:jed), cs%diag)
    if (cs%id_ubt_st > 0) call post_data(cs%id_ubt_st, ubt(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vbt_st > 0) call post_data(cs%id_vbt_st, vbt(isd:ied,jsdb:jedb), cs%diag)
  endif
 
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
 
  if (project_velocity) then ; eta_pf_bt => eta ; else ; eta_pf_bt => eta_pred ; endif
 
  if (cs%dt_bt_filter >= 0.0) then
    dt_filt = 0.5 * max(0.0, min(cs%dt_bt_filter, 2.0*dt))
  else
    dt_filt = 0.5 * max(0.0, dt * min(-cs%dt_bt_filter, 2.0))
  endif
  nfilter = ceiling(dt_filt / dtbt)
 
  if (nstep+nfilter==0 ) call mom_error(fatal, &
      "btstep: number of barotropic step (nstep+nfilter) is 0")
 
  ! Set up the normalized weights for the filtered velocity.
  sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
  allocate(wt_vel(nstep+nfilter)) ; allocate(wt_eta(nstep+nfilter))
  allocate(wt_trans(nstep+nfilter+1)) ; allocate(wt_accel(nstep+nfilter+1))
  allocate(wt_accel2(nstep+nfilter+1))
  do n=1,nstep+nfilter
    ! Modify this to use a different filter...
    if ( (n==nstep) .or. (dt_filt - abs(n-nstep)*dtbt >= 0.0)) then
      wt_vel(n) = 1.0  ; wt_eta(n) = 1.0
    elseif (dtbt + dt_filt - abs(n-nstep)*dtbt > 0.0) then
      wt_vel(n) = 1.0 + (dt_filt / dtbt) - abs(n-nstep) ; wt_eta(n) = wt_vel(n)
    else
      wt_vel(n) = 0.0  ; wt_eta(n) = 0.0
    endif
!###    if (n < nstep-nfilter) then ; wt_vel(n) = 0.0 ; else ; wt_vel(n) = 1.0 ; endif
!###    if (n < nstep-nfilter) then ; wt_eta(n) = 0.0 ; else ; wt_eta(n) = 1.0 ; endif
 
    ! The rest should not be changed.
    sum_wt_vel = sum_wt_vel + wt_vel(n) ; sum_wt_eta = sum_wt_eta + wt_eta(n)
  enddo
  wt_trans(nstep+nfilter+1) = 0.0 ; wt_accel(nstep+nfilter+1) = 0.0
  do n=nstep+nfilter,1,-1
    wt_trans(n) = wt_trans(n+1) + wt_eta(n)
    wt_accel(n) = wt_accel(n+1) + wt_vel(n)
    sum_wt_accel = sum_wt_accel + wt_accel(n) ; sum_wt_trans = sum_wt_trans + wt_trans(n)
  enddo
  ! Normalize the weights.
  i_sum_wt_vel = 1.0 / sum_wt_vel ; i_sum_wt_accel = 1.0 / sum_wt_accel
  i_sum_wt_eta = 1.0 / sum_wt_eta ; i_sum_wt_trans = 1.0 / sum_wt_trans
  do n=1,nstep+nfilter
    wt_vel(n) = wt_vel(n) * i_sum_wt_vel
    wt_accel2(n) = wt_accel(n)
    wt_accel(n) = wt_accel(n) * i_sum_wt_accel
    wt_eta(n) = wt_eta(n) * i_sum_wt_eta
!    wt_trans(n) = wt_trans(n) * I_sum_wt_trans
  enddo
 
 
  sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
 
  ! The following loop contains all of the time steps.
  isv=is ; iev=ie ; jsv=js ; jev=je
  do n=1,nstep+nfilter
 
    sum_wt_vel = sum_wt_vel + wt_vel(n)
    sum_wt_eta = sum_wt_eta + wt_eta(n)
    sum_wt_accel = sum_wt_accel + wt_accel2(n)
    sum_wt_trans = sum_wt_trans + wt_trans(n)
 
    if (cs%clip_velocity) then
      do j=jsv,jev ; do i=isv-1,iev
        if ((ubt(i,j) * (dt * g%dy_Cu(i,j))) * g%IareaT(i+1,j) < -cs%CFL_trunc) then
          ! Add some error reporting later.
          ubt(i,j) = (-0.95*cs%CFL_trunc) * (g%areaT(i+1,j) / (dt * g%dy_Cu(i,j)))
        elseif ((ubt(i,j) * (dt * g%dy_Cu(i,j))) * g%IareaT(i,j) > cs%CFL_trunc) then
          ! Add some error reporting later.
          ubt(i,j) = (0.95*cs%CFL_trunc) * (g%areaT(i,j) / (dt * g%dy_Cu(i,j)))
        endif
      enddo ; enddo
      do j=jsv-1,jev ; do i=isv,iev
        if ((vbt(i,j) * (dt * g%dx_Cv(i,j))) * g%IareaT(i,j+1) < -cs%CFL_trunc) then
          ! Add some error reporting later.
          vbt(i,j) = (-0.9*cs%CFL_trunc) * (g%areaT(i,j+1) / (dt * g%dx_Cv(i,j)))
        elseif ((vbt(i,j) * (dt * g%dx_Cv(i,j))) * g%IareaT(i,j) > cs%CFL_trunc) then
          ! Add some error reporting later.
          vbt(i,j) = (0.9*cs%CFL_trunc) * (g%areaT(i,j) / (dt * g%dx_Cv(i,j)))
        endif
      enddo ; enddo
    endif
 
    if ((iev - stencil < ie) .or. (jev - stencil < je)) then
      if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
      call do_group_pass(cs%pass_eta_ubt, cs%BT_Domain, clock=id_clock_pass_step)
      isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf
      if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
    else
      isv = isv+stencil ; iev = iev-stencil
      jsv = jsv+stencil ; jev = jev-stencil
    endif
 
    if ((.not.use_bt_cont) .and. cs%Nonlinear_continuity .and. &
        (cs%Nonlin_cont_update_period > 0)) then
      if ((n>1) .and. (mod(n-1,cs%Nonlin_cont_update_period) == 0)) &
        call find_face_areas(datu, datv, g, gv, us, cs, ms, eta, 1+iev-ie)
    endif
 
    !GOMP parallel default(shared)
    if (cs%dynamic_psurf .or. .not.project_velocity) then
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-2,iev+1
          uhbt(i,j) = find_uhbt(ubt(i,j), btcl_u(i,j), us) + uhbt0(i,j)
        enddo ; enddo
        !GOMP do
        do j=jsv-2,jev+1 ; do i=isv-1,iev+1
          vhbt(i,j) = find_vhbt(vbt(i,j), btcl_v(i,j), us) + vhbt0(i,j)
        enddo ; enddo
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev+1
          eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
                     ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j)))
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev+1
          eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
              (((datu(i-1,j)*ubt(i-1,j) + uhbt0(i-1,j)) - &
                (datu(i,j)*ubt(i,j) + uhbt0(i,j))) + &
               ((datv(i,j-1)*vbt(i,j-1) + vhbt0(i,j-1)) - &
                (datv(i,j)*vbt(i,j) + vhbt0(i,j))))
        enddo ; enddo
      endif
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev+1
          p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j))
        enddo ; enddo
      endif
    endif
 
    ! Recall that just outside the do n loop, there is code like...
    !  eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta
 
    if (find_etaav) then
      !GOMP do
      do j=js,je ; do i=is,ie
        eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_pf_bt(i,j)
      enddo ; enddo
    endif
 
    if (interp_eta_pf) then
      wt_end = n*instep  ! This could be (n-0.5)*Instep.
      !GOMP do
      do j=jsv-1,jev+1 ; do i=isv-1,iev+1
        eta_pf(i,j) = eta_pf_1(i,j) + wt_end*d_eta_pf(i,j)
      enddo ; enddo
    endif
 
    if (apply_obc_flather .or. apply_obc_open) then
      !GOMP do
      do j=jsv,jev ; do i=isv-2,iev+1
        ubt_old(i,j) = ubt(i,j)
      enddo ; enddo
      !GOMP do
      do j=jsv-2,jev+1 ; do i=isv,iev
        vbt_old(i,j) = vbt(i,j)
      enddo ; enddo
    endif
    !GOMP end parallel
 
    if (apply_obcs) then
      if (mod(n+g%first_direction,2)==1) then
        ioff = 1; joff = 0
      else
        ioff = 0; joff = 1
      endif
 
      if (cs%BT_OBC%apply_u_OBCs) then  ! save the old value of ubt and uhbt
        !GOMP parallel do default(shared)
        do j=jsv-joff,jev+joff ; do i=isv-1,iev
          ubt_prev(i,j) = ubt(i,j) ; uhbt_prev(i,j) = uhbt(i,j)
          ubt_sum_prev(i,j) = ubt_sum(i,j) ; uhbt_sum_prev(i,j) = uhbt_sum(i,j) ; ubt_wtd_prev(i,j) = ubt_wtd(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! save the old value of vbt and vhbt
        !GOMP parallel do default(shared)
        do j=jsv-1,jev ; do i=isv-ioff,iev+ioff
          vbt_prev(i,j) = vbt(i,j) ; vhbt_prev(i,j) = vhbt(i,j)
          vbt_sum_prev(i,j) = vbt_sum(i,j) ; vhbt_sum_prev(i,j) = vhbt_sum(i,j) ; vbt_wtd_prev(i,j) = vbt_wtd(i,j)
        enddo ; enddo
      endif
    endif
 
    !GOMP parallel default(shared) private(vel_prev)
    if (mod(n+g%first_direction,2)==1) then
      ! On odd-steps, update v first.
      !GOMP do
      do j=jsv-1,jev ; do i=isv-1,iev+1
        cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + &
               (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
        pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
                     (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
                   dgeo_de * cs%IdyCv(i,j)
      enddo ; enddo
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1
          pfv(i,j) = pfv(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * cs%IdyCv(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! zero out PF across boundary
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
          pfv(i,j) = 0.0
        endif ; enddo ; enddo
      endif
      !GOMP do
      do j=jsv-1,jev ; do i=isv-1,iev+1
        vel_prev = vbt(i,j)
        vbt(i,j) = bt_rem_v(i,j) * (vbt(i,j) + &
                    dtbt * ((bt_force_v(i,j) + cor_v(i,j)) + pfv(i,j)))
        vbt_trans(i,j) = trans_wt1*vbt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * &
              ((cor_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh_v(i,j))
        else
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * (cor_v(i,j) + pfv(i,j))
        endif
      enddo ; enddo
 
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1
          vhbt(i,j) = find_vhbt(vbt_trans(i,j), btcl_v(i,j), us) + vhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1
          vhbt(i,j) = datv(i,j)*vbt_trans(i,j) + vhbt0(i,j)
        enddo ; enddo
      endif
      if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
          vbt(i,j) = vbt_prev(i,j) ; vhbt(i,j) = vhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
      ! Now update the zonal velocity.
      !GOMP do
      do j=jsv,jev ; do i=isv-1,iev
        cor_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + &
                      (bzon(i,j) * vbt(i,j) + dzon(i,j) * vbt(i+1,j-1))) - &
                     cor_ref_u(i,j)
        pfu(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_e(i,j) - &
                     (eta_pf_bt(i+1,j)-eta_pf(i+1,j))*gtot_w(i+1,j)) * &
                    dgeo_de * cs%IdxCu(i,j)
      enddo ; enddo
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev
          pfu(i,j) = pfu(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * cs%IdxCu(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_u_OBCs) then  ! zero out pressure force across boundary
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          pfu(i,j) = 0.0
        endif ; enddo ; enddo
      endif
      !GOMP do
      do j=jsv,jev ; do i=isv-1,iev
        vel_prev = ubt(i,j)
        ubt(i,j) = bt_rem_u(i,j) * (ubt(i,j) + &
             dtbt * ((bt_force_u(i,j) + cor_u(i,j)) + pfu(i,j)))
        if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
        ubt_trans(i,j) = trans_wt1*ubt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * &
              ((cor_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh_u(i,j))
        else
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * (cor_u(i,j) + pfu(i,j))
        endif
      enddo ; enddo
 
      if (use_bt_cont) then
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev
          uhbt(i,j) = find_uhbt(ubt_trans(i,j), btcl_u(i,j), us) + uhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev
          uhbt(i,j) = datu(i,j)*ubt_trans(i,j) + uhbt0(i,j)
        enddo ; enddo
      endif
     if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          ubt(i,j) = ubt_prev(i,j); uhbt(i,j) = uhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
    else
      ! On even steps, update u first.
      !GOMP do
      do j=jsv-1,jev+1 ; do i=isv-1,iev
        cor_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + &
                      (bzon(i,j) * vbt(i,j) +  dzon(i,j) * vbt(i+1,j-1))) - &
                     cor_ref_u(i,j)
        pfu(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_e(i,j) - &
                     (eta_pf_bt(i+1,j)-eta_pf(i+1,j))*gtot_w(i+1,j)) * &
                     dgeo_de * cs%IdxCu(i,j)
      enddo ; enddo
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev
          pfu(i,j) = pfu(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * cs%IdxCu(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_u_OBCs) then  ! zero out pressure force across boundary
        !GOMP do
        do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          pfu(i,j) = 0.0
        endif ; enddo ; enddo
      endif
 
      !GOMP do
      do j=jsv-1,jev+1 ; do i=isv-1,iev
        vel_prev = ubt(i,j)
        ubt(i,j) = bt_rem_u(i,j) * (ubt(i,j) + &
             dtbt * ((bt_force_u(i,j) + cor_u(i,j)) + pfu(i,j)))
        if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
        ubt_trans(i,j) = trans_wt1*ubt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * &
              ((cor_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh_u(i,j))
        else
          u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * (cor_u(i,j) + pfu(i,j))
        endif
      enddo ; enddo
 
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev
          uhbt(i,j) = find_uhbt(ubt_trans(i,j), btcl_u(i,j), us) + uhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev
          uhbt(i,j) = datu(i,j)*ubt_trans(i,j) + uhbt0(i,j)
        enddo ; enddo
      endif
      if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
        !GOMP do
        do j=jsv-1,jev+1 ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
          ubt(i,j) = ubt_prev(i,j); uhbt(i,j) = uhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
 
      ! Now update the meridional velocity.
      if (cs%use_old_coriolis_bracket_bug) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + bmer(i,j) * ubt(i,j)) + &
                  (cmer(i,j+1) * ubt(i,j+1) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
          pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
                       (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
                      dgeo_de * cs%IdyCv(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + &
                  (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
          pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
                       (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
                      dgeo_de * cs%IdyCv(i,j)
        enddo ; enddo
      endif
 
      if (cs%dynamic_psurf) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          pfv(i,j) = pfv(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * cs%IdyCv(i,j)
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! zero out PF across boundary
        !GOMP do
        do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
          pfv(i,j) = 0.0
        endif ; enddo ; enddo
      endif
 
      !GOMP do
      do j=jsv-1,jev ; do i=isv,iev
        vel_prev = vbt(i,j)
        vbt(i,j) = bt_rem_v(i,j) * (vbt(i,j) + &
             dtbt * ((bt_force_v(i,j) + cor_v(i,j)) + pfv(i,j)))
        if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
        vbt_trans(i,j) = trans_wt1*vbt(i,j) + trans_wt2*vel_prev
 
        if (cs%linear_wave_drag) then
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * &
              ((cor_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh_v(i,j))
        else
          v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * (cor_v(i,j) + pfv(i,j))
        endif
      enddo ; enddo
      if (use_bt_cont) then
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          vhbt(i,j) = find_vhbt(vbt_trans(i,j), btcl_v(i,j), us) + vhbt0(i,j)
        enddo ; enddo
      else
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev
          vhbt(i,j) = datv(i,j)*vbt_trans(i,j) + vhbt0(i,j)
        enddo ; enddo
      endif
      if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
        !GOMP do
        do j=jsv-1,jev ; do i=isv,iev ; if (obc%segnum_v(i,j) /= obc_none) then
          vbt(i,j) = vbt_prev(i,j); vhbt(i,j) = vhbt_prev(i,j)
        endif ; enddo ; enddo
      endif
    endif
    !GOMP end parallel
 
    !GOMP parallel default(shared)
    if (find_pf) then
      !GOMP do
      do j=js,je ; do i=is-1,ie
        pfu_bt_sum(i,j)  = pfu_bt_sum(i,j) + wt_accel2(n) * pfu(i,j)
      enddo ; enddo
      !GOMP do
      do j=js-1,je ; do i=is,ie
        pfv_bt_sum(i,j)  = pfv_bt_sum(i,j) + wt_accel2(n) * pfv(i,j)
      enddo ; enddo
    endif
    if (find_cor) then
      !GOMP do
      do j=js,je ; do i=is-1,ie
        coru_bt_sum(i,j) = coru_bt_sum(i,j) + wt_accel2(n) * cor_u(i,j)
      enddo ; enddo
      !GOMP do
      do j=js-1,je ; do i=is,ie
        corv_bt_sum(i,j) = corv_bt_sum(i,j) + wt_accel2(n) * cor_v(i,j)
      enddo ; enddo
    endif
 
    !GOMP do
    do j=js,je ; do i=is-1,ie
      ubt_sum(i,j) = ubt_sum(i,j) + wt_trans(n) * ubt_trans(i,j)
      uhbt_sum(i,j) = uhbt_sum(i,j) + wt_trans(n) * uhbt(i,j)
      ubt_wtd(i,j) = ubt_wtd(i,j) + wt_vel(n) * ubt(i,j)
    enddo ; enddo
    !GOMP do
    do j=js-1,je ; do i=is,ie
      vbt_sum(i,j) = vbt_sum(i,j) + wt_trans(n) * vbt_trans(i,j)
      vhbt_sum(i,j) = vhbt_sum(i,j) + wt_trans(n) * vhbt(i,j)
      vbt_wtd(i,j) = vbt_wtd(i,j) + wt_vel(n) * vbt(i,j)
    enddo ; enddo
    !GOMP end parallel
 
    if (apply_obcs) then
      if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
        !GOMP parallel do default(shared)
        do j=js,je ; do i=is-1,ie
          if (obc%segnum_u(i,j) /= obc_none) then
            ubt_sum(i,j) = ubt_sum_prev(i,j) ; uhbt_sum(i,j) = uhbt_sum_prev(i,j)
            ubt_wtd(i,j) = ubt_wtd_prev(i,j)
          endif
        enddo ; enddo
      endif
 
      if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
        !GOMP parallel do default(shared)
        do j=js-1,je ; do i=is,ie
          if (obc%segnum_v(i,j) /= obc_none) then
            vbt_sum(i,j) = vbt_sum_prev(i,j) ; vhbt_sum(i,j) = vhbt_sum_prev(i,j)
            vbt_wtd(i,j) = vbt_wtd_prev(i,j)
          endif
        enddo ; enddo
      endif
 
      call apply_velocity_obcs(obc, ubt, vbt, uhbt, vhbt, &
           ubt_trans, vbt_trans, eta, ubt_old, vbt_old, cs%BT_OBC, &
           g, ms, us, iev-ie, dtbt, bebt, use_bt_cont, datu, datv, btcl_u, btcl_v, &
           uhbt0, vhbt0)
      if (cs%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do i=is-1,ie
        if (obc%segnum_u(i,j) /= obc_none) then
          ubt_sum(i,j) = ubt_sum(i,j) + wt_trans(n) * ubt_trans(i,j)
          uhbt_sum(i,j) = uhbt_sum(i,j) + wt_trans(n) * uhbt(i,j)
          ubt_wtd(i,j) = ubt_wtd(i,j) + wt_vel(n) * ubt(i,j)
        endif
      enddo ; enddo ; endif
      if (cs%BT_OBC%apply_v_OBCs) then ; do j=js-1,je ; do i=is,ie
        if (obc%segnum_v(i,j) /= obc_none) then
          vbt_sum(i,j) = vbt_sum(i,j) + wt_trans(n) * vbt_trans(i,j)
          vhbt_sum(i,j) = vhbt_sum(i,j) + wt_trans(n) * vhbt(i,j)
          vbt_wtd(i,j) = vbt_wtd(i,j) + wt_vel(n) * vbt(i,j)
        endif
      enddo ; enddo ; endif
    endif
 
    if (cs%debug_bt) then
      call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, cs%debug_BT_HI, haloshift=iev-ie, &
                    scale=us%s_to_T*us%L_to_m**2*gv%H_to_m)
    endif
 
    !$OMP parallel do default(shared)
    do j=jsv,jev ; do i=isv,iev
      eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
                 ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j)))
      eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n)
      ! Should there be a concern if eta drops below 0 or G%bathyT?
    enddo ; enddo
 
    if (do_hifreq_output) then
      time_step_end = time_bt_start + real_to_time(n*us%T_to_s*dtbt)
      call enable_averaging(us%T_to_s*dtbt, time_step_end, cs%diag)
      if (cs%id_ubt_hifreq > 0) call post_data(cs%id_ubt_hifreq, ubt(isdb:iedb,jsd:jed), cs%diag)
      if (cs%id_vbt_hifreq > 0) call post_data(cs%id_vbt_hifreq, vbt(isd:ied,jsdb:jedb), cs%diag)
      if (cs%id_eta_hifreq > 0) call post_data(cs%id_eta_hifreq, eta(isd:ied,jsd:jed), cs%diag)
      if (cs%id_uhbt_hifreq > 0) call post_data(cs%id_uhbt_hifreq, uhbt(isdb:iedb,jsd:jed), cs%diag)
      if (cs%id_vhbt_hifreq > 0) call post_data(cs%id_vhbt_hifreq, vhbt(isd:ied,jsdb:jedb), cs%diag)
      if (cs%id_eta_pred_hifreq > 0) call post_data(cs%id_eta_pred_hifreq, eta_pf_bt(isd:ied,jsd:jed), cs%diag)
    endif
 
    if (cs%debug_bt) then
      write(mesg,'("BT step ",I4)') n
      call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, cs%debug_BT_HI, haloshift=iev-ie, &
                    scale=us%L_T_to_m_s)
      call hchksum(eta, trim(mesg)//" eta", cs%debug_BT_HI, haloshift=iev-ie, scale=gv%H_to_m)
    endif
 
  enddo ! end of do n=1,ntimestep
  if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
 
  ! Reset the time information in the diag type.
  if (do_hifreq_output) call enable_averaging(time_int_in, time_end_in, cs%diag)
 
  i_sum_wt_vel = 1.0 / sum_wt_vel ; i_sum_wt_eta = 1.0 / sum_wt_eta
  i_sum_wt_accel = 1.0 / sum_wt_accel ; i_sum_wt_trans = 1.0 / sum_wt_trans
 
  if (find_etaav) then ; do j=js,je ; do i=is,ie
    etaav(i,j) = eta_sum(i,j) * i_sum_wt_accel
  enddo ; enddo ; endif
  do j=js-1,je+1 ; do i=is-1,ie+1 ; e_anom(i,j) = 0.0 ; enddo ; enddo
  if (interp_eta_pf) then
    do j=js,je ; do i=is,ie
      e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - &
                               (eta_pf_1(i,j) + 0.5*d_eta_pf(i,j)))
    enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - eta_pf(i,j))
    enddo ; enddo
  endif
  if (apply_obcs) then
    !!! Not safe for wide halos...
    if (cs%BT_OBC%apply_u_OBCs) then  ! copy back the value for u-points on the boundary.
      !GOMP parallel do default(shared)
      do j=js,je ; do i=is-1,ie
        if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
          e_anom(i+1,j) = e_anom(i,j)
        elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
          e_anom(i,j) = e_anom(i+1,j)
        endif
      enddo ; enddo
    endif
 
    if (cs%BT_OBC%apply_v_OBCs) then  ! copy back the value for v-points on the boundary.
      !GOMP parallel do default(shared)
      do j=js-1,je ; do i=is,ie
        if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
          e_anom(i,j+1) = e_anom(i,j)
        elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
          e_anom(i,j) = e_anom(i,j+1)
        endif
      enddo ; enddo
    endif
  endif
 
  ! It is possible that eta_out and eta_in are the same.
  do j=js,je ; do i=is,ie
    eta_out(i,j) = eta_wtd(i,j) * i_sum_wt_eta
  enddo ; enddo
 
  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
  if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
  if (g%nonblocking_updates) then
    call start_group_pass(cs%pass_e_anom, g%Domain)
  else
    if (find_etaav) call do_group_pass(cs%pass_etaav, g%Domain)
    call do_group_pass(cs%pass_e_anom, g%Domain)
  endif
  if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
 
  do j=js,je ; do i=is-1,ie
    cs%ubtav(i,j) = ubt_sum(i,j) * i_sum_wt_trans
    uhbtav(i,j) = uhbt_sum(i,j) * i_sum_wt_trans
 ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
 !###   u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel
    ubt_wtd(i,j) = ubt_wtd(i,j) * i_sum_wt_vel
  enddo ; enddo
 
  do j=js-1,je ; do i=is,ie
    cs%vbtav(i,j) = vbt_sum(i,j) * i_sum_wt_trans
    vhbtav(i,j) = vhbt_sum(i,j) * i_sum_wt_trans
 ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
 !###   v_accel_bt(i,J) = v_accel_bt(i,J)  * I_sum_wt_accel
    vbt_wtd(i,j) = vbt_wtd(i,j) * i_sum_wt_vel
  enddo ; enddo
 
  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
  if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
  if (g%nonblocking_updates) then
    call complete_group_pass(cs%pass_e_anom, g%Domain)
    if (find_etaav) call start_group_pass(cs%pass_etaav, g%Domain)
    call start_group_pass(cs%pass_ubta_uhbta, g%DoMain)
  else
    call do_group_pass(cs%pass_ubta_uhbta, g%Domain)
  endif
  if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
 
  ! Now calculate each layer's accelerations.
  !$OMP parallel do default(shared)
  do k=1,nz
    do j=js,je ; do i=is-1,ie
      accel_layer_u(i,j,k) = (u_accel_bt(i,j) - &
           ((pbce(i+1,j,k) - gtot_w(i+1,j)) * e_anom(i+1,j) - &
            (pbce(i,j,k) - gtot_e(i,j)) * e_anom(i,j)) * cs%IdxCu(i,j) )
      if (abs(accel_layer_u(i,j,k)) < accel_underflow) accel_layer_u(i,j,k) = 0.0
    enddo ; enddo
    do j=js-1,je ; do i=is,ie
      accel_layer_v(i,j,k) = (v_accel_bt(i,j) - &
           ((pbce(i,j+1,k) - gtot_s(i,j+1)) * e_anom(i,j+1) - &
            (pbce(i,j,k) - gtot_n(i,j)) * e_anom(i,j)) * cs%IdyCv(i,j) )
      if (abs(accel_layer_v(i,j,k)) < accel_underflow) accel_layer_v(i,j,k) = 0.0
    enddo ; enddo
  enddo
 
  if (apply_obcs) then
    ! Correct the accelerations at OBC velocity points, but only in the
    ! symmetric-memory computational domain, not in the wide halo regions.
    if (cs%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do i=is-1,ie
      if (obc%segnum_u(i,j) /= obc_none) then
        u_accel_bt(i,j) = (ubt_wtd(i,j) - ubt_first(i,j)) / dt
        do k=1,nz ; accel_layer_u(i,j,k) = u_accel_bt(i,j) ; enddo
      endif
    enddo ; enddo ; endif
    if (cs%BT_OBC%apply_v_OBCs) then ; do j=js-1,je ; do i=is,ie
      if (obc%segnum_v(i,j) /= obc_none) then
        v_accel_bt(i,j) = (vbt_wtd(i,j) - vbt_first(i,j)) / dt
        do k=1,nz ; accel_layer_v(i,j,k) = v_accel_bt(i,j) ; enddo
      endif
    enddo ; enddo ; endif
  endif
 
  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
 
  ! Calculate diagnostic quantities.
  if (query_averaging_enabled(cs%diag)) then
 
    do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = ubt_wtd(i,j) ; enddo ; enddo
    do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = vbt_wtd(i,j) ; enddo ; enddo
    if (use_bt_cont) then
      do j=js,je ; do i=is-1,ie
        cs%uhbt_IC(i,j) = find_uhbt(ubt_wtd(i,j), btcl_u(i,j), us) + uhbt0(i,j)
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        cs%vhbt_IC(i,j) = find_vhbt(vbt_wtd(i,j), btcl_v(i,j), us) + vhbt0(i,j)
      enddo ; enddo
    else
      do j=js,je ; do i=is-1,ie
        cs%uhbt_IC(i,j) = ubt_wtd(i,j) * datu(i,j) + uhbt0(i,j)
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        cs%vhbt_IC(i,j) = vbt_wtd(i,j) * datv(i,j) + vhbt0(i,j)
      enddo ; enddo
    endif
 
!  Offer various barotropic terms for averaging.
    if (cs%id_PFu_bt > 0) then
      do j=js,je ; do i=is-1,ie
        pfu_bt_sum(i,j) = pfu_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_PFu_bt, pfu_bt_sum(isdb:iedb,jsd:jed), cs%diag)
    endif
    if (cs%id_PFv_bt > 0) then
      do j=js-1,je ; do i=is,ie
        pfv_bt_sum(i,j) = pfv_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_PFv_bt, pfv_bt_sum(isd:ied,jsdb:jedb), cs%diag)
    endif
    if (cs%id_Coru_bt > 0) then
      do j=js,je ; do i=is-1,ie
        coru_bt_sum(i,j) = coru_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_Coru_bt, coru_bt_sum(isdb:iedb,jsd:jed), cs%diag)
    endif
    if (cs%id_Corv_bt > 0) then
      do j=js-1,je ; do i=is,ie
        corv_bt_sum(i,j) = corv_bt_sum(i,j) * i_sum_wt_accel
      enddo ; enddo
      call post_data(cs%id_Corv_bt, corv_bt_sum(isd:ied,jsdb:jedb), cs%diag)
    endif
    if (cs%id_ubtforce > 0) call post_data(cs%id_ubtforce, bt_force_u(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vbtforce > 0) call post_data(cs%id_vbtforce, bt_force_v(isd:ied,jsdb:jedb), cs%diag)
    if (cs%id_uaccel > 0) call post_data(cs%id_uaccel, u_accel_bt(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vaccel > 0) call post_data(cs%id_vaccel, v_accel_bt(isd:ied,jsdb:jedb), cs%diag)
 
    if (cs%id_eta_cor > 0) call post_data(cs%id_eta_cor, cs%eta_cor, cs%diag)
    if (cs%id_eta_bt > 0) call post_data(cs%id_eta_bt, eta_out, cs%diag)
    if (cs%id_gtotn > 0) call post_data(cs%id_gtotn, gtot_n(isd:ied,jsd:jed), cs%diag)
    if (cs%id_gtots > 0) call post_data(cs%id_gtots, gtot_s(isd:ied,jsd:jed), cs%diag)
    if (cs%id_gtote > 0) call post_data(cs%id_gtote, gtot_e(isd:ied,jsd:jed), cs%diag)
    if (cs%id_gtotw > 0) call post_data(cs%id_gtotw, gtot_w(isd:ied,jsd:jed), cs%diag)
    if (cs%id_ubt > 0) call post_data(cs%id_ubt, ubt_wtd(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vbt > 0) call post_data(cs%id_vbt, vbt_wtd(isd:ied,jsdb:jedb), cs%diag)
    if (cs%id_ubtav > 0) call post_data(cs%id_ubtav, cs%ubtav, cs%diag)
    if (cs%id_vbtav > 0) call post_data(cs%id_vbtav, cs%vbtav, cs%diag)
    if (cs%id_visc_rem_u > 0) call post_data(cs%id_visc_rem_u, visc_rem_u, cs%diag)
    if (cs%id_visc_rem_v > 0) call post_data(cs%id_visc_rem_v, visc_rem_v, cs%diag)
 
    if (cs%id_frhatu > 0) call post_data(cs%id_frhatu, cs%frhatu, cs%diag)
    if (cs%id_uhbt > 0) call post_data(cs%id_uhbt, uhbtav, cs%diag)
    if (cs%id_frhatv > 0) call post_data(cs%id_frhatv, cs%frhatv, cs%diag)
    if (cs%id_vhbt > 0) call post_data(cs%id_vhbt, vhbtav, cs%diag)
    if (cs%id_uhbt0 > 0) call post_data(cs%id_uhbt0, uhbt0(isdb:iedb,jsd:jed), cs%diag)
    if (cs%id_vhbt0 > 0) call post_data(cs%id_vhbt0, vhbt0(isd:ied,jsdb:jedb), cs%diag)
 
    if (cs%id_frhatu1 > 0) call post_data(cs%id_frhatu1, cs%frhatu1, cs%diag)
    if (cs%id_frhatv1 > 0) call post_data(cs%id_frhatv1, cs%frhatv1, cs%diag)
 
    if (use_bt_cont) then
      if (cs%id_BTC_FA_u_EE > 0) call post_data(cs%id_BTC_FA_u_EE, bt_cont%FA_u_EE, cs%diag)
      if (cs%id_BTC_FA_u_E0 > 0) call post_data(cs%id_BTC_FA_u_E0, bt_cont%FA_u_E0, cs%diag)
      if (cs%id_BTC_FA_u_W0 > 0) call post_data(cs%id_BTC_FA_u_W0, bt_cont%FA_u_W0, cs%diag)
      if (cs%id_BTC_FA_u_WW > 0) call post_data(cs%id_BTC_FA_u_WW, bt_cont%FA_u_WW, cs%diag)
      if (cs%id_BTC_uBT_EE > 0) call post_data(cs%id_BTC_uBT_EE, bt_cont%uBT_EE, cs%diag)
      if (cs%id_BTC_uBT_WW > 0) call post_data(cs%id_BTC_uBT_WW, bt_cont%uBT_WW, cs%diag)
      if (cs%id_BTC_FA_v_NN > 0) call post_data(cs%id_BTC_FA_v_NN, bt_cont%FA_v_NN, cs%diag)
      if (cs%id_BTC_FA_v_N0 > 0) call post_data(cs%id_BTC_FA_v_N0, bt_cont%FA_v_N0, cs%diag)
      if (cs%id_BTC_FA_v_S0 > 0) call post_data(cs%id_BTC_FA_v_S0, bt_cont%FA_v_S0, cs%diag)
      if (cs%id_BTC_FA_v_SS > 0) call post_data(cs%id_BTC_FA_v_SS, bt_cont%FA_v_SS, cs%diag)
      if (cs%id_BTC_vBT_NN > 0) call post_data(cs%id_BTC_vBT_NN, bt_cont%vBT_NN, cs%diag)
      if (cs%id_BTC_vBT_SS > 0) call post_data(cs%id_BTC_vBT_SS, bt_cont%vBT_SS, cs%diag)
    endif
  else
    if (cs%id_frhatu1 > 0) cs%frhatu1(:,:,:) = cs%frhatu(:,:,:)
    if (cs%id_frhatv1 > 0) cs%frhatv1(:,:,:) = cs%frhatv(:,:,:)
  endif
 
  if (g%nonblocking_updates) then
    if (find_etaav) call complete_group_pass(cs%pass_etaav, g%Domain)
    call complete_group_pass(cs%pass_ubta_uhbta, g%Domain)
  endif
 

References adjust_local_bt_cont_types(), apply_velocity_obcs(), bt_cont_to_face_areas(), mom_domains::complete_group_pass(), mom_diag_mediator::enable_averaging(), find_face_areas(), find_uhbt(), find_vhbt(), id_clock_calc, id_clock_calc_post, id_clock_calc_pre, id_clock_pass_post, id_clock_pass_pre, id_clock_pass_step, mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), mom_error_handler::mom_mesg(), mom_open_boundary::obc_direction_n, mom_open_boundary::obc_direction_s, mom_time_manager::real_to_time(), set_local_bt_cont_types(), set_up_bt_obc(), mom_domains::start_group_pass(), swap(), and mom_tidal_forcing::tidal_forcing_sensitivity().

Here is the call graph for this function:

destroy_bt_obc()

subroutine mom_barotropic::destroy_bt_obc ( type(bt_obc_type), intent(inout)  BT_OBC )

private

Clean up the BT_OBC memory.

Parameters

[in,out]

bt_obc

A structure with the private barotropic arrays related to the open boundary conditions, set by set_up_BT_OBC.

Definition at line 2736 of file MOM_barotropic.F90.

  type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
                                             !! related to the open boundary conditions,
                                             !! set by set_up_BT_OBC.
 
  if (bt_obc%is_alloced) then
    deallocate(bt_obc%Cg_u)
    deallocate(bt_obc%H_u)
    deallocate(bt_obc%uhbt)
    deallocate(bt_obc%ubt_outer)
    deallocate(bt_obc%eta_outer_u)
 
    deallocate(bt_obc%Cg_v)
    deallocate(bt_obc%H_v)
    deallocate(bt_obc%vhbt)
    deallocate(bt_obc%vbt_outer)
    deallocate(bt_obc%eta_outer_v)
    bt_obc%is_alloced = .false.
  endif

Referenced by barotropic_end().

Here is the caller graph for this function:

find_face_areas()

subroutine mom_barotropic::find_face_areas ( real, dimension(ms%isdw-1:ms%iedw,ms%jsdw:ms%jedw), intent(out)  Datu, real, dimension(ms%isdw:ms%iedw,ms%jsdw-1:ms%jedw), intent(out)  Datv, type(ocean_grid_type), intent(in)  G, type(verticalgrid_type), intent(in)  GV, type(unit_scale_type), intent(in)  US, type(barotropic_cs), pointer  CS, type(memory_size_type), intent(in)  MS, real, dimension(ms%isdw:ms%iedw,ms%jsdw:ms%jedw), intent(in), optional  eta, integer, intent(in), optional  halo, real, intent(in), optional  add_max  )

private

This subroutine determines the open face areas of cells for calculating the barotropic transport.

Parameters

[in]	ms	A type that describes the memory sizes of the argument arrays.
[out]	datu	The open zonal face area [H L ~> m2 or kg m-1].
[out]	datv	The open meridional face area [H L ~> m2 or kg m-1].
[in]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	us	A dimensional unit scaling type
	cs	The control structure returned by a previous call to barotropic_init.
[in]	eta	The barotropic free surface height anomaly
[in]	halo	The halo size to use, default = 1.
[in]	add_max	A value to add to the maximum depth (used to overestimate the external wave speed) [Z ~> m].

Definition at line 3545 of file MOM_barotropic.F90.

  type(memory_size_type),  intent(in) :: MS    !< A type that describes the memory sizes of the argument arrays.
  real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
                           intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1].
  real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
                           intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1].
  type(ocean_grid_type),   intent(in)  :: G    !< The ocean's grid structure.
  type(verticalGrid_type), intent(in)  :: GV   !< The ocean's vertical grid structure.
  type(unit_scale_type),   intent(in)  :: US   !< A dimensional unit scaling type
  type(barotropic_CS),     pointer     :: CS   !< The control structure returned by a previous
                                               !! call to barotropic_init.
  real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), &
                 optional, intent(in)  :: eta  !< The barotropic free surface height anomaly
                                               !! or column mass anomaly [H ~> m or kg m-2].
  integer,       optional, intent(in)  :: halo !< The halo size to use, default = 1.
  real,          optional, intent(in)  :: add_max !< A value to add to the maximum depth (used
                                               !! to overestimate the external wave speed) [Z ~> m].
 
  ! Local variables
  real :: H1, H2      ! Temporary total thicknesses [H ~> m or kg m-2].
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
 
!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,CS,Datu,Datv,add_max) &
!$OMP                       private(H1,H2)
  if (present(eta)) then
    ! The use of harmonic mean thicknesses ensure positive definiteness.
    if (gv%Boussinesq) then
!$OMP do
      do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
        h1 = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j) ; h2 = cs%bathyT(i+1,j)*gv%Z_to_H + eta(i+1,j)
        datu(i,j) = 0.0 ; if ((h1 > 0.0) .and. (h2 > 0.0)) &
        datu(i,j) = cs%dy_Cu(i,j) * (2.0 * h1 * h2) / (h1 + h2)
!       Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
      enddo ; enddo
!$OMP do
      do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
        h1 = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j) ; h2 = cs%bathyT(i,j+1)*gv%Z_to_H + eta(i,j+1)
        datv(i,j) = 0.0 ; if ((h1 > 0.0) .and. (h2 > 0.0)) &
        datv(i,j) = cs%dx_Cv(i,j) * (2.0 * h1 * h2) / (h1 + h2)
!       Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2)
      enddo ; enddo
    else
!$OMP do
      do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
        datu(i,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) &
        datu(i,j) = cs%dy_Cu(i,j) * (2.0 * eta(i,j) * eta(i+1,j)) / &
                                  (eta(i,j) + eta(i+1,j))
        ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))
      enddo ; enddo
!$OMP do
      do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
        datv(i,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) &
        datv(i,j) = cs%dx_Cv(i,j) * (2.0 * eta(i,j) * eta(i,j+1)) / &
                                  (eta(i,j) + eta(i,j+1))
        ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (eta(i,j) + eta(i,j+1))
      enddo ; enddo
    endif
  elseif (present(add_max)) then
!$OMP do
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i,j) = cs%dy_Cu(i,j) * gv%Z_to_H * &
                 (max(cs%bathyT(i+1,j), cs%bathyT(i,j)) + add_max)
    enddo ; enddo
!$OMP do
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i,j) = cs%dx_Cv(i,j) * gv%Z_to_H * &
                 (max(cs%bathyT(i,j+1), cs%bathyT(i,j)) + add_max)
    enddo ; enddo
  else
!$OMP do
    do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
      datu(i, j) = 0.0
      !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain
      if (cs%bathyT(i+1,j)+cs%bathyT(i,j)>0.) &
        datu(i,j) = 2.0*cs%dy_Cu(i,j) * gv%Z_to_H * &
                  (cs%bathyT(i+1,j) * cs%bathyT(i,j)) / &
                  (cs%bathyT(i+1,j) + cs%bathyT(i,j))
    enddo ; enddo
!$OMP do
    do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
      datv(i, j) = 0.0
      !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain
      if (cs%bathyT(i,j+1)+cs%bathyT(i,j)>0.) &
        datv(i,j) = 2.0*cs%dx_Cv(i,j) * gv%Z_to_H * &
                  (cs%bathyT(i,j+1) * cs%bathyT(i,j)) / &
                  (cs%bathyT(i,j+1) + cs%bathyT(i,j))
    enddo ; enddo
  endif
!$OMP end parallel
 

Referenced by barotropic_init(), btstep(), and set_dtbt().

Here is the caller graph for this function:

find_uhbt()

real function mom_barotropic::find_uhbt ( real, intent(in)  u, type(local_bt_cont_u_type), intent(in)  BTC, type(unit_scale_type), intent(in)  US  )

private

The function find_uhbt determines the zonal transport for a given velocity.

Parameters

[in]	u	The local zonal velocity [L T-1 ~> m s-1]
[in]	btc	A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]	us	A dimensional unit scaling type

Returns

The zonal barotropic transport [L2 H T-1 ~> m3 s-1]

Definition at line 3031 of file MOM_barotropic.F90.

  real, intent(in) :: u    !< The local zonal velocity [L T-1 ~> m s-1]
  type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
                           !! allow the barotropic transports to be calculated consistently
                           !! with the layers' continuity equations.
  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
 
  real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1]
 
  if (u == 0.0) then
    uhbt = 0.0
  elseif (u < btc%uBT_EE) then
    uhbt = (u - btc%uBT_EE) * btc%FA_u_EE + btc%uh_EE
  elseif (u < 0.0) then
    uhbt = u * (btc%FA_u_E0 + btc%uh_crvE * u**2)
  elseif (u <= btc%uBT_WW) then
    uhbt = u * (btc%FA_u_W0 + btc%uh_crvW * u**2)
  else ! (u > BTC%uBT_WW)
    uhbt = (u - btc%uBT_WW) * btc%FA_u_WW + btc%uh_WW
  endif
 

Referenced by apply_velocity_obcs(), and btstep().

Here is the caller graph for this function:

find_vhbt()

real function mom_barotropic::find_vhbt ( real, intent(in)  v, type(local_bt_cont_v_type), intent(in)  BTC, type(unit_scale_type), intent(in)  US  )

private

The function find_vhbt determines the meridional transport for a given velocity.

Parameters

[in]	v	The local meridional velocity [L T-1 ~> m s-1]
[in]	btc	A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]	us	A dimensional unit scaling type

Returns

The meridional barotropic transport [L2 H T-1 ~> m3 s-1]

Definition at line 3149 of file MOM_barotropic.F90.

  real, intent(in) :: v    !< The local meridional velocity [L T-1 ~> m s-1]
  type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that
                           !! allow the barotropic transports to be calculated consistently
                           !! with the layers' continuity equations.
  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
  real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1]
 
  if (v == 0.0) then
    vhbt = 0.0
  elseif (v < btc%vBT_NN) then
    vhbt = (v - btc%vBT_NN) * btc%FA_v_NN + btc%vh_NN
  elseif (v < 0.0) then
    vhbt = v * (btc%FA_v_N0 + btc%vh_crvN * v**2)
  elseif (v <= btc%vBT_SS) then
    vhbt = v * (btc%FA_v_S0 + btc%vh_crvS * v**2)
  else ! (v > BTC%vBT_SS)
    vhbt = (v - btc%vBT_SS) * btc%FA_v_SS + btc%vh_SS
  endif
 

Referenced by apply_velocity_obcs(), and btstep().

Here is the caller graph for this function:

register_barotropic_restarts()

subroutine, public mom_barotropic::register_barotropic_restarts	(	type(hor_index_type), intent(in)	HI,
		type(verticalgrid_type), intent(in)	GV,
		type(param_file_type), intent(in)	param_file,
		type(barotropic_cs), pointer	CS,
		type(mom_restart_cs), pointer	restart_CS
	)

This subroutine is used to register any fields from MOM_barotropic.F90 that should be written to or read from the restart file.

Parameters

[in]	hi	A horizontal index type structure.
[in]	param_file	A structure to parse for run-time parameters.
	cs	A pointer that is set to point to the control structure for this module.
[in]	gv	The ocean's vertical grid structure.
	restart_cs	A pointer to the restart control structure.

Definition at line 4430 of file MOM_barotropic.F90.

  type(hor_index_type),    intent(in) :: HI         !< A horizontal index type structure.
  type(param_file_type),   intent(in) :: param_file !< A structure to parse for run-time parameters.
  type(barotropic_CS),     pointer    :: CS         !< A pointer that is set to point to the control
                                                    !! structure for this module.
  type(verticalGrid_type), intent(in) :: GV         !< The ocean's vertical grid structure.
  type(MOM_restart_CS),    pointer    :: restart_CS !< A pointer to the restart control structure.
 
  ! Local variables
  type(vardesc) :: vd(3)
  real :: slow_rate
  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed
  isdb = hi%IsdB ; iedb = hi%IedB ; jsdb = hi%JsdB ; jedb = hi%JedB
 
  if (associated(cs)) then
    call mom_error(warning, "register_barotropic_restarts called with an associated "// &
                            "control structure.")
    return
  endif
  allocate(cs)
 
  alloc_(cs%ubtav(isdb:iedb,jsd:jed))      ; cs%ubtav(:,:) = 0.0
  alloc_(cs%vbtav(isd:ied,jsdb:jedb))      ; cs%vbtav(:,:) = 0.0
  alloc_(cs%ubt_IC(isdb:iedb,jsd:jed))     ; cs%ubt_IC(:,:) = 0.0
  alloc_(cs%vbt_IC(isd:ied,jsdb:jedb))     ; cs%vbt_IC(:,:) = 0.0
  alloc_(cs%uhbt_IC(isdb:iedb,jsd:jed))    ; cs%uhbt_IC(:,:) = 0.0
  alloc_(cs%vhbt_IC(isd:ied,jsdb:jedb))    ; cs%vhbt_IC(:,:) = 0.0
 
  vd(2) = var_desc("ubtav","m s-1","Time mean barotropic zonal velocity", &
                hor_grid='u', z_grid='1')
  vd(3) = var_desc("vbtav","m s-1","Time mean barotropic meridional velocity",&
                hor_grid='v', z_grid='1')
  call register_restart_field(cs%ubtav, vd(2), .false., restart_cs)
  call register_restart_field(cs%vbtav, vd(3), .false., restart_cs)
 
  vd(2) = var_desc("ubt_IC", "m s-1", &
              longname="Next initial condition for the barotropic zonal velocity", &
              hor_grid='u', z_grid='1')
  vd(3) = var_desc("vbt_IC", "m s-1", &
              longname="Next initial condition for the barotropic meridional velocity",&
              hor_grid='v', z_grid='1')
  call register_restart_field(cs%ubt_IC, vd(2), .false., restart_cs)
  call register_restart_field(cs%vbt_IC, vd(3), .false., restart_cs)
 
  if (gv%Boussinesq) then
    vd(2) = var_desc("uhbt_IC", "m3 s-1", &
                longname="Next initial condition for the barotropic zonal transport", &
                hor_grid='u', z_grid='1')
    vd(3) = var_desc("vhbt_IC", "m3 s-1", &
                longname="Next initial condition for the barotropic meridional transport",&
                hor_grid='v', z_grid='1')
  else
    vd(2) = var_desc("uhbt_IC", "kg s-1", &
                longname="Next initial condition for the barotropic zonal transport", &
                hor_grid='u', z_grid='1')
    vd(3) = var_desc("vhbt_IC", "kg s-1", &
                longname="Next initial condition for the barotropic meridional transport",&
                hor_grid='v', z_grid='1')
  endif
  call register_restart_field(cs%uhbt_IC, vd(2), .false., restart_cs)
  call register_restart_field(cs%vhbt_IC, vd(3), .false., restart_cs)
 
  call register_restart_field(cs%dtbt, "DTBT", .false., restart_cs, &
                              longname="Barotropic timestep", units="seconds")
 

References mom_error_handler::mom_error(), and mom_io::var_desc().

Referenced by mom_dynamics_split_rk2::register_restarts_dyn_split_rk2().

Here is the call graph for this function:

Here is the caller graph for this function:

set_dtbt()

subroutine, public mom_barotropic::set_dtbt	(	type(ocean_grid_type), intent(inout)	G,
		type(verticalgrid_type), intent(in)	GV,
		type(unit_scale_type), intent(in)	US,
		type(barotropic_cs), pointer	CS,
		real, dimension( g %isd: g %ied, g %jsd: g %jed), intent(in), optional	eta,
		real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in), optional	pbce,
		type(bt_cont_type), optional, pointer	BT_cont,
		real, intent(in), optional	gtot_est,
		real, intent(in), optional	SSH_add
	)

This subroutine automatically determines an optimal value for dtbt based on some state of the ocean.

Parameters

[in,out]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	us	A dimensional unit scaling type
	cs	Barotropic control structure.
[in]	eta	The barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in]	pbce	The baroclinic pressure anomaly in each layer due to free surface height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
	bt_cont	A structure with elements that describe the effective open face areas as a function of barotropic flow.
[in]	gtot_est	An estimate of the total gravitational acceleration [L2 Z-1 T-2 ~> m s-2].
[in]	ssh_add	An additional contribution to SSH to provide a margin of error when calculating the external wave speed [Z ~> m].

Definition at line 2259 of file MOM_barotropic.F90.

  type(ocean_grid_type),        intent(inout) :: G    !< The ocean's grid structure.
  type(verticalGrid_type),      intent(in)    :: GV   !< The ocean's vertical grid structure.
  type(unit_scale_type),        intent(in)    :: US   !< A dimensional unit scaling type
  type(barotropic_CS),          pointer       :: CS   !< Barotropic control structure.
  real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta  !< The barotropic free surface
                                                      !! height anomaly or column mass anomaly [H ~> m or kg m-2].
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce  !< The baroclinic pressure
                                                      !! anomaly in each layer due to free surface
                                                      !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
  type(BT_cont_type), optional, pointer       :: BT_cont  !< A structure with elements that describe
                                                      !! the effective open face areas as a
                                                      !! function of barotropic flow.
  real,               optional, intent(in)    :: gtot_est !< An estimate of the total gravitational
                                                      !! acceleration [L2 Z-1 T-2 ~> m s-2].
  real,               optional, intent(in)    :: SSH_add  !< An additional contribution to SSH to
                                                      !! provide a margin of error when
                                                      !! calculating the external wave speed [Z ~> m].
 
  ! Local variables
  real, dimension(SZI_(G),SZJ_(G)) :: &
    gtot_E, &     ! gtot_X is the effective total reduced gravity used to relate
    gtot_W, &     ! free surface height deviations to pressure forces (including
    gtot_N, &     ! GFS and baroclinic  contributions) in the barotropic momentum
    gtot_S        ! equations half a grid-point in the X-direction (X is N, S, E, or W)
                  ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
                  ! (See Hallberg, J Comp Phys 1997 for a discussion.)
  real, dimension(SZIBS_(G),SZJ_(G)) :: &
    Datu          ! Basin depth at u-velocity grid points times the y-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real, dimension(SZI_(G),SZJBS_(G)) :: &
    Datv          ! Basin depth at v-velocity grid points times the x-grid
                  ! spacing [H L ~> m2 or kg m-1].
  real :: det_de  ! The partial derivative due to self-attraction and loading
                  ! of the reference geopotential with the sea surface height [nondim].
                  ! This is typically ~0.09 or less.
  real :: dgeo_de ! The constant of proportionality between geopotential and
                  ! sea surface height [nondim].  It is a nondimensional number of
                  ! order 1.  For stability, this may be made larger
                  ! than physical problem would suggest.
  real :: add_SSH ! An additional contribution to SSH to provide a margin of error
                  ! when calculating the external wave speed [Z ~> m].
  real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic
                      ! timesteps [T2 ~> s2]
  real :: dtbt_max    ! The maximum barotropic timestep [T ~> s]
  real :: Idt_max2    ! The squared inverse of the local maximum stable
                      ! barotropic time step [T-2 ~> s-2].
  logical :: use_BT_cont
  type(memory_size_type) :: MS
 
  character(len=200) :: mesg
  integer :: i, j, k, is, ie, js, je, nz
 
  if (.not.associated(cs)) call mom_error(fatal, &
      "set_dtbt: Module MOM_barotropic must be initialized before it is used.")
  if (.not.cs%split) return
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed
 
  if (.not.(present(pbce) .or. present(gtot_est))) call mom_error(fatal, &
      "set_dtbt: Either pbce or gtot_est must be present.")
 
  add_ssh = 0.0 ; if (present(ssh_add)) add_ssh = ssh_add
 
  use_bt_cont = .false.
  if (present(bt_cont)) use_bt_cont = (associated(bt_cont))
 
  if (use_bt_cont) then
    call bt_cont_to_face_areas(bt_cont, datu, datv, g, us, ms, 0, .true.)
  elseif (cs%Nonlinear_continuity .and. present(eta)) then
    call find_face_areas(datu, datv, g, gv, us, cs, ms, eta=eta, halo=0)
  else
    call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=0, add_max=add_ssh)
  endif
 
  det_de = 0.0
  if (cs%tides) call tidal_forcing_sensitivity(g, cs%tides_CSp, det_de)
  dgeo_de = 1.0 + max(0.0, det_de + cs%G_extra)
  if (present(pbce)) then
    do j=js,je ; do i=is,ie
      gtot_e(i,j) = 0.0 ; gtot_w(i,j) = 0.0
      gtot_n(i,j) = 0.0 ; gtot_s(i,j) = 0.0
    enddo ; enddo
    do k=1,nz ; do j=js,je ; do i=is,ie
      gtot_e(i,j) = gtot_e(i,j) + pbce(i,j,k) * cs%frhatu(i,j,k)
      gtot_w(i,j) = gtot_w(i,j) + pbce(i,j,k) * cs%frhatu(i-1,j,k)
      gtot_n(i,j) = gtot_n(i,j) + pbce(i,j,k) * cs%frhatv(i,j,k)
      gtot_s(i,j) = gtot_s(i,j) + pbce(i,j,k) * cs%frhatv(i,j-1,k)
    enddo ; enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      gtot_e(i,j) = gtot_est * gv%H_to_Z ; gtot_w(i,j) = gtot_est * gv%H_to_Z
      gtot_n(i,j) = gtot_est * gv%H_to_Z ; gtot_s(i,j) = gtot_est * gv%H_to_Z
    enddo ; enddo
  endif
 
  min_max_dt2 = 1.0e38*us%s_to_T**2  ! A huge value for the permissible timestep squared.
  do j=js,je ; do i=is,ie
    !   This is pretty accurate for gravity waves, but it is a conservative
    ! estimate since it ignores the stabilizing effect of the bottom drag.
    idt_max2 = 0.5 * (1.0 + 2.0*cs%bebt) * (g%IareaT(i,j) * &
      ((gtot_e(i,j)*datu(i,j)*g%IdxCu(i,j) + gtot_w(i,j)*datu(i-1,j)*g%IdxCu(i-1,j)) + &
       (gtot_n(i,j)*datv(i,j)*g%IdyCv(i,j) + gtot_s(i,j)*datv(i,j-1)*g%IdyCv(i,j-1))) + &
      ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
       (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)))
    if (idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / idt_max2
  enddo ; enddo
  dtbt_max = sqrt(min_max_dt2 / dgeo_de)
  if (id_clock_sync > 0) call cpu_clock_begin(id_clock_sync)
  call min_across_pes(dtbt_max)
  if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync)
 
  cs%dtbt = cs%dtbt_fraction * dtbt_max
  cs%dtbt_max = dtbt_max

References bt_cont_to_face_areas(), find_face_areas(), id_clock_sync, mom_error_handler::mom_error(), and mom_tidal_forcing::tidal_forcing_sensitivity().

Referenced by barotropic_init(), and mom_dynamics_split_rk2::step_mom_dyn_split_rk2().

Here is the call graph for this function:

Here is the caller graph for this function:

set_local_bt_cont_types()

subroutine mom_barotropic::set_local_bt_cont_types ( type(bt_cont_type), intent(inout)  BT_cont, type(local_bt_cont_u_type), dimension( ms %isdw-1: ms %iedw, ms %jsdw: ms %jedw), intent(out)  BTCL_u, type(local_bt_cont_v_type), dimension( ms %isdw: ms %iedw, ms %jsdw-1: ms %jedw), intent(out)  BTCL_v, type(ocean_grid_type), intent(in)  G, type(unit_scale_type), intent(in)  US, type(memory_size_type), intent(in)  MS, type(mom_domain_type), intent(inout)  BT_Domain, integer, intent(in), optional  halo  )

private

This subroutine sets up reordered versions of the BT_cont type in the local_BT_cont types, which have wide halos properly filled in.

Parameters

[in,out]	bt_cont	The BT_cont_type input to the barotropic solver.
[in]	ms	A type that describes the memory sizes of the argument arrays.
[out]	btcl_u	A structure with the u information from BT_cont.
[out]	btcl_v	A structure with the v information from BT_cont.
[in]	g	The ocean's grid structure.
[in]	us	A dimensional unit scaling type
[in,out]	bt_domain	The domain to use for updating the halos of wide arrays.
[in]	halo	The extra halo size to use here.

Definition at line 3267 of file MOM_barotropic.F90.

  type(BT_cont_type),                                    intent(inout) :: BT_cont    !< The BT_cont_type input to the
                                                                                     !! barotropic solver.
  type(memory_size_type),                                intent(in)    :: MS         !< A type that describes the
                                                                                     !! memory sizes of the argument
                                                                                     !! arrays.
  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(out) :: BTCL_u !< A structure with the u
                                                                                     !! information from BT_cont.
  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v
                                                                                     !! information from BT_cont.
  type(ocean_grid_type),                                 intent(in)    :: G          !< The ocean's grid structure.
  type(unit_scale_type),                                 intent(in)    :: US         !< A dimensional unit scaling type
  type(MOM_domain_type),                                 intent(inout) :: BT_Domain  !< The domain to use for updating
                                                                                     !! the halos of wide arrays.
  integer,                                     optional, intent(in)    :: halo       !< The extra halo size to use here.
 
  ! Local variables
  real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
    u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
  real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
    v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
  real, parameter :: C1_3 = 1.0/3.0
  integer :: i, j, is, ie, js, je, hs
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  hs = 1 ; if (present(halo)) hs = max(halo,0)
 
  ! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays.
!$OMP parallel default(none) shared(is,ie,js,je,hs,u_polarity,uBT_EE,uBT_WW,FA_u_EE, &
!$OMP                               FA_u_E0,FA_u_W0,FA_u_WW,v_polarity,vBT_NN,vBT_SS,&
!$OMP                               FA_v_NN,FA_v_N0,FA_v_S0,FA_v_SS,BT_cont )
!$OMP do
  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
    u_polarity(i,j) = 1.0
    ubt_ee(i,j) = 0.0 ; ubt_ww(i,j) = 0.0
    fa_u_ee(i,j) = 0.0 ; fa_u_e0(i,j) = 0.0 ; fa_u_w0(i,j) = 0.0 ; fa_u_ww(i,j) = 0.0
  enddo ; enddo
!$OMP do
  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
    v_polarity(i,j) = 1.0
    vbt_nn(i,j) = 0.0 ; vbt_ss(i,j) = 0.0
    fa_v_nn(i,j) = 0.0 ; fa_v_n0(i,j) = 0.0 ; fa_v_s0(i,j) = 0.0 ; fa_v_ss(i,j) = 0.0
  enddo ; enddo
!$OMP do
  do j=js,je; do i=is-1,ie
    ubt_ee(i,j) = bt_cont%uBT_EE(i,j) ; ubt_ww(i,j) = bt_cont%uBT_WW(i,j)
    fa_u_ee(i,j) = bt_cont%FA_u_EE(i,j) ; fa_u_e0(i,j) = bt_cont%FA_u_E0(i,j)
    fa_u_w0(i,j) = bt_cont%FA_u_W0(i,j) ; fa_u_ww(i,j) = bt_cont%FA_u_WW(i,j)
  enddo ; enddo
!$OMP do
  do j=js-1,je; do i=is,ie
    vbt_nn(i,j) = bt_cont%vBT_NN(i,j) ; vbt_ss(i,j) = bt_cont%vBT_SS(i,j)
    fa_v_nn(i,j) = bt_cont%FA_v_NN(i,j) ; fa_v_n0(i,j) = bt_cont%FA_v_N0(i,j)
    fa_v_s0(i,j) = bt_cont%FA_v_S0(i,j) ; fa_v_ss(i,j) = bt_cont%FA_v_SS(i,j)
  enddo ; enddo
!$OMP end parallel
 
  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
!--- begin setup for group halo update
  call create_group_pass(bt_cont%pass_polarity_BT, u_polarity, v_polarity, bt_domain)
  call create_group_pass(bt_cont%pass_polarity_BT, ubt_ee, vbt_nn, bt_domain)
  call create_group_pass(bt_cont%pass_polarity_BT, ubt_ww, vbt_ss, bt_domain)
 
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_ee, fa_v_nn, bt_domain, to_all+scalar_pair)
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_e0, fa_v_n0, bt_domain, to_all+scalar_pair)
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_w0, fa_v_s0, bt_domain, to_all+scalar_pair)
  call create_group_pass(bt_cont%pass_FA_uv, fa_u_ww, fa_v_ss, bt_domain, to_all+scalar_pair)
!--- end setup for group halo update
  ! Do halo updates on BT_cont.
  call do_group_pass(bt_cont%pass_polarity_BT, bt_domain)
  call do_group_pass(bt_cont%pass_FA_uv, bt_domain)
  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
 
!$OMP parallel default(none) shared(is,ie,js,je,hs,BTCL_u,FA_u_EE,FA_u_E0,FA_u_W0, &
!$OMP                               FA_u_WW,uBT_EE,uBT_WW,u_polarity,BTCL_v,       &
!$OMP                               FA_v_NN,FA_v_N0,FA_v_S0,FA_v_SS,vBT_NN,vBT_SS, &
!$OMP                               v_polarity )
!$OMP do
  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
    btcl_u(i,j)%FA_u_EE = fa_u_ee(i,j) ; btcl_u(i,j)%FA_u_E0 = fa_u_e0(i,j)
    btcl_u(i,j)%FA_u_W0 = fa_u_w0(i,j) ; btcl_u(i,j)%FA_u_WW = fa_u_ww(i,j)
    btcl_u(i,j)%uBT_EE = ubt_ee(i,j)   ; btcl_u(i,j)%uBT_WW = ubt_ww(i,j)
    ! Check for reversed polarity in the tripolar halo regions.
    if (u_polarity(i,j) < 0.0) then
      call swap(btcl_u(i,j)%FA_u_EE, btcl_u(i,j)%FA_u_WW)
      call swap(btcl_u(i,j)%FA_u_E0, btcl_u(i,j)%FA_u_W0)
      call swap(btcl_u(i,j)%uBT_EE,  btcl_u(i,j)%uBT_WW)
    endif
 
    btcl_u(i,j)%uh_EE = btcl_u(i,j)%uBT_EE * &
        (c1_3 * (2.0*btcl_u(i,j)%FA_u_E0 + btcl_u(i,j)%FA_u_EE))
    btcl_u(i,j)%uh_WW = btcl_u(i,j)%uBT_WW * &
        (c1_3 * (2.0*btcl_u(i,j)%FA_u_W0 + btcl_u(i,j)%FA_u_WW))
 
    btcl_u(i,j)%uh_crvE = 0.0 ; btcl_u(i,j)%uh_crvW = 0.0
    if (abs(btcl_u(i,j)%uBT_WW) > 0.0) btcl_u(i,j)%uh_crvW = &
      (c1_3 * (btcl_u(i,j)%FA_u_WW - btcl_u(i,j)%FA_u_W0)) / btcl_u(i,j)%uBT_WW**2
    if (abs(btcl_u(i,j)%uBT_EE) > 0.0) btcl_u(i,j)%uh_crvE = &
      (c1_3 * (btcl_u(i,j)%FA_u_EE - btcl_u(i,j)%FA_u_E0)) / btcl_u(i,j)%uBT_EE**2
  enddo ; enddo
!$OMP do
  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
    btcl_v(i,j)%FA_v_NN = fa_v_nn(i,j) ; btcl_v(i,j)%FA_v_N0 = fa_v_n0(i,j)
    btcl_v(i,j)%FA_v_S0 = fa_v_s0(i,j) ; btcl_v(i,j)%FA_v_SS = fa_v_ss(i,j)
    btcl_v(i,j)%vBT_NN = vbt_nn(i,j)   ; btcl_v(i,j)%vBT_SS = vbt_ss(i,j)
    ! Check for reversed polarity in the tripolar halo regions.
    if (v_polarity(i,j) < 0.0) then
      call swap(btcl_v(i,j)%FA_v_NN, btcl_v(i,j)%FA_v_SS)
      call swap(btcl_v(i,j)%FA_v_N0, btcl_v(i,j)%FA_v_S0)
      call swap(btcl_v(i,j)%vBT_NN,  btcl_v(i,j)%vBT_SS)
    endif
 
    btcl_v(i,j)%vh_NN = btcl_v(i,j)%vBT_NN * &
        (c1_3 * (2.0*btcl_v(i,j)%FA_v_N0 + btcl_v(i,j)%FA_v_NN))
    btcl_v(i,j)%vh_SS = btcl_v(i,j)%vBT_SS * &
        (c1_3 * (2.0*btcl_v(i,j)%FA_v_S0 + btcl_v(i,j)%FA_v_SS))
 
    btcl_v(i,j)%vh_crvN = 0.0 ; btcl_v(i,j)%vh_crvS = 0.0
    if (abs(btcl_v(i,j)%vBT_SS) > 0.0) btcl_v(i,j)%vh_crvS = &
      (c1_3 * (btcl_v(i,j)%FA_v_SS - btcl_v(i,j)%FA_v_S0)) / btcl_v(i,j)%vBT_SS**2
    if (abs(btcl_v(i,j)%vBT_NN) > 0.0) btcl_v(i,j)%vh_crvN = &
      (c1_3 * (btcl_v(i,j)%FA_v_NN - btcl_v(i,j)%FA_v_N0)) / btcl_v(i,j)%vBT_NN**2
  enddo ; enddo
!$OMP end parallel

References id_clock_calc_pre, id_clock_pass_pre, and swap().

Referenced by btstep().

Here is the call graph for this function:

Here is the caller graph for this function:

set_up_bt_obc()

subroutine mom_barotropic::set_up_bt_obc ( type(ocean_obc_type), pointer  OBC, real, dimension(sziw_(ms),szjw_(ms)), intent(in)  eta, type(bt_obc_type), intent(inout)  BT_OBC, type(mom_domain_type), intent(inout)  BT_Domain, type(ocean_grid_type), intent(inout)  G, type(verticalgrid_type), intent(in)  GV, type(unit_scale_type), intent(in)  US, type(memory_size_type), intent(in)  MS, integer, intent(in)  halo, logical, intent(in)  use_BT_cont, real, dimension(szibw_(ms),szjw_(ms)), intent(in)  Datu, real, dimension(sziw_(ms),szjbw_(ms)), intent(in)  Datv, type(local_bt_cont_u_type), dimension(szibw_(ms),szjw_(ms)), intent(in)  BTCL_u, type(local_bt_cont_v_type), dimension(sziw_(ms),szjbw_(ms)), intent(in)  BTCL_v  )

private

This subroutine sets up the private structure used to apply the open boundary conditions, as developed by Mehmet Ilicak.

Parameters

	obc	An associated pointer to an OBC type.
[in]	ms	A type that describes the memory sizes of the argument arrays.
[in]	eta	The barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in,out]	bt_obc	A structure with the private barotropic arrays related to the open boundary conditions, set by set_up_BT_OBC.
[in,out]	bt_domain	MOM_domain_type associated with wide arrays
[in,out]	g	The ocean's grid structure.
[in]	gv	The ocean's vertical grid structure.
[in]	us	A dimensional unit scaling type
[in]	halo	The extra halo size to use here.
[in]	use_bt_cont	If true, use the BT_cont_types to calculate transports.
[in]	datu	A fixed estimate of the face areas at u points [H L ~> m2 or kg m-1].
[in]	datv	A fixed estimate of the face areas at v points [H L ~> m2 or kg m-1].
[in]	btcl_u	Structure of information used for a dynamic estimate of the face areas at u-points.
[in]	btcl_v	Structure of information used for a dynamic estimate of the face areas at v-points.

Definition at line 2557 of file MOM_barotropic.F90.

  type(ocean_OBC_type),                  pointer       :: OBC    !< An associated pointer to an OBC type.
  type(memory_size_type),                intent(in)    :: MS     !< A type that describes the memory sizes of the
                                                                 !! argument arrays.
  real, dimension(SZIW_(MS),SZJW_(MS)),  intent(in)    :: eta    !< The barotropic free surface height anomaly or
                                                                 !! column mass anomaly [H ~> m or kg m-2].
  type(BT_OBC_type),                     intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
                                                                 !! related to the open boundary conditions,
                                                                 !! set by set_up_BT_OBC.
  type(MOM_domain_type),                 intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
  type(ocean_grid_type),                 intent(inout) :: G      !< The ocean's grid structure.
  type(verticalGrid_type),               intent(in)    :: GV     !< The ocean's vertical grid structure.
  type(unit_scale_type),                 intent(in)    :: US     !< A dimensional unit scaling type
  integer,                               intent(in)    :: halo   !< The extra halo size to use here.
  logical,                               intent(in)    :: use_BT_cont !< If true, use the BT_cont_types to calculate
                                                                 !! transports.
  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in)    :: Datu   !< A fixed estimate of the face areas at u points
                                                                 !! [H L ~> m2 or kg m-1].
  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in)    :: Datv   !< A fixed estimate of the face areas at v points
                                                                 !! [H L ~> m2 or kg m-1].
  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
                                                                 !! for a dynamic estimate of the face areas at
                                                                 !! u-points.
  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
                                                                 !! for a dynamic estimate of the face areas at
                                                                 !! v-points.
 
  ! Local variables
  integer :: i, j, k, is, ie, js, je, n, nz, Isq, Ieq, Jsq, Jeq
  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
  integer :: isdw, iedw, jsdw, jedw
  logical :: OBC_used
  type(OBC_segment_type), pointer  :: segment !< Open boundary segment
 
 
  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed ; nz = g%ke
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  isdw = ms%isdw ; iedw = ms%iedw ; jsdw = ms%jsdw ; jedw = ms%jedw
 
 
  if ((isdw < isd) .or. (jsdw < jsd)) then
    call mom_error(fatal, "set_up_BT_OBC: Open boundary conditions are not "//&
                           "yet fully implemented with wide barotropic halos.")
  endif
 
  if (.not. bt_obc%is_alloced) then
    allocate(bt_obc%Cg_u(isdw-1:iedw,jsdw:jedw))        ; bt_obc%Cg_u(:,:) = 0.0
    allocate(bt_obc%H_u(isdw-1:iedw,jsdw:jedw))         ; bt_obc%H_u(:,:) = 0.0
    allocate(bt_obc%uhbt(isdw-1:iedw,jsdw:jedw))        ; bt_obc%uhbt(:,:) = 0.0
    allocate(bt_obc%ubt_outer(isdw-1:iedw,jsdw:jedw))   ; bt_obc%ubt_outer(:,:) = 0.0
    allocate(bt_obc%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; bt_obc%eta_outer_u(:,:) = 0.0
 
    allocate(bt_obc%Cg_v(isdw:iedw,jsdw-1:jedw))        ; bt_obc%Cg_v(:,:) = 0.0
    allocate(bt_obc%H_v(isdw:iedw,jsdw-1:jedw))         ; bt_obc%H_v(:,:) = 0.0
    allocate(bt_obc%vhbt(isdw:iedw,jsdw-1:jedw))        ; bt_obc%vhbt(:,:) = 0.0
    allocate(bt_obc%vbt_outer(isdw:iedw,jsdw-1:jedw))   ; bt_obc%vbt_outer(:,:) = 0.0
    allocate(bt_obc%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; bt_obc%eta_outer_v(:,:)=0.0
    bt_obc%is_alloced = .true.
    call create_group_pass(bt_obc%pass_uv, bt_obc%ubt_outer, bt_obc%vbt_outer, bt_domain)
    call create_group_pass(bt_obc%pass_uhvh, bt_obc%uhbt, bt_obc%vhbt, bt_domain)
    call create_group_pass(bt_obc%pass_eta_outer, bt_obc%eta_outer_u, bt_obc%eta_outer_v, bt_domain,to_all+scalar_pair)
    call create_group_pass(bt_obc%pass_h, bt_obc%H_u, bt_obc%H_v, bt_domain,to_all+scalar_pair)
    call create_group_pass(bt_obc%pass_cg, bt_obc%Cg_u, bt_obc%Cg_v, bt_domain,to_all+scalar_pair)
  endif
 
  if (bt_obc%apply_u_OBCs) then
    if (obc%specified_u_BCs_exist_globally) then
      do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_E_or_W .and. segment%specified) then
          do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
            bt_obc%uhbt(i,j) = 0.
          enddo ; enddo
          do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
            bt_obc%uhbt(i,j) = bt_obc%uhbt(i,j) + segment%normal_trans(i,j,k)
          enddo ; enddo ; enddo
        endif
      enddo
    endif
    do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
      ! Can this go in segment loop above? Is loop above wrong for wide halos??
      if (obc%segment(obc%segnum_u(i,j))%specified) then
        if (use_bt_cont) then
          bt_obc%ubt_outer(i,j) = uhbt_to_ubt(bt_obc%uhbt(i,j), btcl_u(i,j), us)
        else
          if (datu(i,j) > 0.0) bt_obc%ubt_outer(i,j) = bt_obc%uhbt(i,j) / datu(i,j)
        endif
      else  ! This is assuming Flather as only other option
        if (gv%Boussinesq) then
          if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
            bt_obc%H_u(i,j) = g%bathyT(i,j)*gv%Z_to_H + eta(i,j)
          elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
            bt_obc%H_u(i,j) = g%bathyT(i+1,j)*gv%Z_to_H + eta(i+1,j)
          endif
        else
          if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
            bt_obc%H_u(i,j) = eta(i,j)
          elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
            bt_obc%H_u(i,j) = eta(i+1,j)
          endif
        endif
        bt_obc%Cg_u(i,j) = sqrt(gv%g_prime(1) * gv%H_to_Z*bt_obc%H_u(i,j))
      endif
    endif ; enddo ; enddo
    if (obc%Flather_u_BCs_exist_globally) then
     do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_E_or_W .and. segment%Flather) then
          do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
            bt_obc%ubt_outer(i,j) = segment%normal_vel_bt(i,j)
            bt_obc%eta_outer_u(i,j) = segment%eta(i,j)
          enddo ; enddo
        endif
      enddo
    endif
  endif
 
  if (bt_obc%apply_v_OBCs) then
    if (obc%specified_v_BCs_exist_globally) then
      do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_N_or_S .and. segment%specified) then
          do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
            bt_obc%vhbt(i,j) = 0.
          enddo ; enddo
          do k=1,nz ; do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
            bt_obc%vhbt(i,j) = bt_obc%vhbt(i,j) + segment%normal_trans(i,j,k)
          enddo ; enddo ; enddo
        endif
      enddo
    endif
    do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
      ! Can this go in segment loop above? Is loop above wrong for wide halos??
      if (obc%segment(obc%segnum_v(i,j))%specified) then
        if (use_bt_cont) then
          bt_obc%vbt_outer(i,j) = vhbt_to_vbt(bt_obc%vhbt(i,j), btcl_v(i,j), us)
        else
          if (datv(i,j) > 0.0) bt_obc%vbt_outer(i,j) = bt_obc%vhbt(i,j) / datv(i,j)
        endif
      else  ! This is assuming Flather as only other option
        if (gv%Boussinesq) then
          if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
            bt_obc%H_v(i,j) = g%bathyT(i,j)*gv%Z_to_H + eta(i,j)
          elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
            bt_obc%H_v(i,j) = g%bathyT(i,j+1)*gv%Z_to_H + eta(i,j+1)
          endif
        else
          if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
            bt_obc%H_v(i,j) = eta(i,j)
          elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
            bt_obc%H_v(i,j) = eta(i,j+1)
          endif
        endif
        bt_obc%Cg_v(i,j) = sqrt(gv%g_prime(1) * gv%H_to_Z*bt_obc%H_v(i,j))
      endif
    endif ; enddo ; enddo
    if (obc%Flather_v_BCs_exist_globally) then
     do n = 1, obc%number_of_segments
        segment => obc%segment(n)
        if (segment%is_N_or_S .and. segment%Flather) then
          do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
            bt_obc%vbt_outer(i,j) = segment%normal_vel_bt(i,j)
            bt_obc%eta_outer_v(i,j) = segment%eta(i,j)
          enddo ; enddo
        endif
      enddo
    endif
  endif
 
  call do_group_pass(bt_obc%pass_uv, bt_domain)
  call do_group_pass(bt_obc%pass_uhvh, bt_domain)
  call do_group_pass(bt_obc%pass_eta_outer, bt_domain)
  call do_group_pass(bt_obc%pass_h, bt_domain)
  call do_group_pass(bt_obc%pass_cg, bt_domain)
 

References mom_error_handler::mom_error(), mom_open_boundary::obc_direction_n, mom_open_boundary::obc_direction_s, uhbt_to_ubt(), and vhbt_to_vbt().

Referenced by btstep().

Here is the call graph for this function:

Here is the caller graph for this function:

swap()

subroutine mom_barotropic::swap ( real, intent(inout)  a, real, intent(inout)  b  )

private

Swap the values of two real variables.

Parameters

[in,out]	a	The first variable to be swapped.
[in,out]	b	The second variable to be swapped.

Definition at line 3536 of file MOM_barotropic.F90.

  real, intent(inout) :: a !< The first variable to be swapped.
  real, intent(inout) :: b !< The second variable to be swapped.
  real :: tmp
  tmp = a ; a = b ; b = tmp

Referenced by btstep(), and set_local_bt_cont_types().

Here is the caller graph for this function:

uhbt_to_ubt()

real function mom_barotropic::uhbt_to_ubt ( real, intent(in)  uhbt, type(local_bt_cont_u_type), intent(in)  BTC, type(unit_scale_type), intent(in)  US, real, intent(in), optional  guess  )

private

This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport.

Parameters

[in]	uhbt	The barotropic zonal transport that should be inverted for, [H L2 T-1 ~> m3 s-1 or kg s-1].
[in]	btc	A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]	us	A dimensional unit scaling type
[in]	guess	A guess at what ubt will be [L T-1 ~> m s-1]. The result is not allowed to be dramatically larger than guess.

Returns

The result - The velocity that gives uhbt transport [L T-1 ~> m s-1].

Definition at line 3056 of file MOM_barotropic.F90.

  real, intent(in) :: uhbt                      !< The barotropic zonal transport that should be inverted for,
                                                !! [H L2 T-1 ~> m3 s-1 or kg s-1].
  type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the
                                                !! barotropic transports to be calculated consistently with the
                                                !! layers' continuity equations.
  type(unit_scale_type),      intent(in) :: US  !< A dimensional unit scaling type
  real, optional, intent(in) :: guess           !< A guess at what ubt will be [L T-1 ~> m s-1].  The result
                                                !! is not allowed to be dramatically larger than guess.
  real :: ubt                                   !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1].
 
  ! Local variables
  real :: ubt_min, ubt_max, uhbt_err, derr_du
  real :: uherr_min, uherr_max
  real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
  real :: dvel  ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
  real :: vsr   ! Temporary variable used in the limiting the velocity [nondim].
  real, parameter :: vs1 = 1.25  ! Nondimensional parameters used in limiting
  real, parameter :: vs2 = 2.0   ! the velocity, starting at vs1, with the
                                 ! maximum increase of vs2, both nondim.
  integer :: itt, max_itt = 20
 
  ! Find the value of ubt that gives uhbt.
  if (uhbt == 0.0) then
    ubt = 0.0
  elseif (uhbt < btc%uh_EE) then
    ubt = btc%uBT_EE + (uhbt - btc%uh_EE) / btc%FA_u_EE
  elseif (uhbt < 0.0) then
    ! Iterate to convergence with Newton's method (when bounded) and the
    ! false position method otherwise.  ubt will be negative.
    ubt_min = btc%uBT_EE ; uherr_min = btc%uh_EE - uhbt
    ubt_max = 0.0 ; uherr_max = -uhbt
    ! Use a false-position method first guess.
    ubt = btc%uBT_EE * (uhbt / btc%uh_EE)
    do itt = 1, max_itt
      uhbt_err = ubt * (btc%FA_u_E0 + btc%uh_crvE * ubt**2) - uhbt
 
      if (abs(uhbt_err) < tol*abs(uhbt)) exit
      if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
      if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
 
      derr_du = btc%FA_u_E0 + 3.0 * btc%uh_crvE * ubt**2
      if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
          (-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
        ! Use a false-position method guess.
        ubt = ubt_max + (ubt_min-ubt_max) * (uherr_max / (uherr_max-uherr_min))
      else ! Use Newton's method.
        ubt = ubt - uhbt_err / derr_du
        if (abs(uhbt_err) < (0.01*tol)*abs(ubt_min*derr_du)) exit
      endif
    enddo
  elseif (uhbt <= btc%uh_WW) then
    ! Iterate to convergence with Newton's method.  ubt will be positive.
    ubt_min = 0.0 ; uherr_min = -uhbt
    ubt_max = btc%uBT_WW ; uherr_max = btc%uh_WW - uhbt
    ! Use a false-position method first guess.
    ubt = btc%uBT_WW * (uhbt / btc%uh_WW)
    do itt = 1, max_itt
      uhbt_err = ubt * (btc%FA_u_W0 + btc%uh_crvW * ubt**2) - uhbt
 
      if (abs(uhbt_err) < tol*abs(uhbt)) exit
      if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
      if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
 
      derr_du = btc%FA_u_W0 + 3.0 * btc%uh_crvW * ubt**2
      if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
          (-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
        ! Use a false-position method guess.
        ubt = ubt_min + (ubt_max-ubt_min) * (-uherr_min / (uherr_max-uherr_min))
      else ! Use Newton's method.
        ubt = ubt - uhbt_err / derr_du
        if (abs(uhbt_err) < (0.01*tol)*(ubt_max*derr_du)) exit
      endif
    enddo
  else ! (uhbt > BTC%uh_WW)
    ubt = btc%uBT_WW + (uhbt - btc%uh_WW) / btc%FA_u_WW
  endif
 
  if (present(guess)) then
    dvel = abs(ubt) - vs1*abs(guess)
    if (dvel > 0.0) then ! Limit the velocity
      if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then
        vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1)))
      else  ! The exp be less than 4e-18 anyway in this case, so neglect it.
        vsr = vs2
      endif
      ubt = sign(vsr * guess, ubt)
    endif
  endif
 

Referenced by set_up_bt_obc().

Here is the caller graph for this function:

vhbt_to_vbt()

real function mom_barotropic::vhbt_to_vbt ( real, intent(in)  vhbt, type(local_bt_cont_v_type), intent(in)  BTC, type(unit_scale_type), intent(in)  US, real, intent(in), optional  guess  )

private

This function inverts the transport function to determine the barotopic velocity that is consistent with a given transport.

Parameters

[in]	vhbt	The barotropic meridional transport that should be inverted for [H L2 T-1 ~> m3 s-1 or kg s-1].
[in]	btc	A structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]	us	A dimensional unit scaling type
[in]	guess	A guess at what vbt will be. The result is not allowed to be dramatically larger than guess [L T-1 ~> m s-1].

Returns

The result - The velocity that gives vhbt transport [L T-1 ~> m s-1].

Definition at line 3173 of file MOM_barotropic.F90.

  real, intent(in) :: vhbt                      !< The barotropic meridional transport that should be
                                                !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1].
  type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the
                                                !! barotropic transports to be calculated consistently
                                                !! with the layers' continuity equations.
  type(unit_scale_type),      intent(in) :: US  !< A dimensional unit scaling type
  real, optional, intent(in) :: guess           !< A guess at what vbt will be. The result is not allowed
                                                !! to be dramatically larger than guess [L T-1 ~> m s-1].
  real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1].
 
  ! Local variables
  real :: vbt_min, vbt_max, vhbt_err, derr_dv
  real :: vherr_min, vherr_max
  real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
  real :: dvel  ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
  real :: vsr   ! Temporary variable used in the limiting the velocity [nondim].
  real, parameter :: vs1 = 1.25  ! Nondimensional parameters used in limiting
  real, parameter :: vs2 = 2.0   ! the velocity, starting at vs1, with the
                                 ! maximum increase of vs2, both nondim.
  integer :: itt, max_itt = 20
 
  ! Find the value of vbt that gives vhbt.
  if (vhbt == 0.0) then
    vbt = 0.0
  elseif (vhbt < btc%vh_NN) then
    vbt = btc%vBT_NN + (vhbt - btc%vh_NN) / btc%FA_v_NN
  elseif (vhbt < 0.0) then
    ! Iterate to convergence with Newton's method (when bounded) and the
    ! false position method otherwise.  vbt will be negative.
    vbt_min = btc%vBT_NN ; vherr_min = btc%vh_NN - vhbt
    vbt_max = 0.0 ; vherr_max = -vhbt
    ! Use a false-position method first guess.
    vbt = btc%vBT_NN * (vhbt / btc%vh_NN)
    do itt = 1, max_itt
      vhbt_err = vbt * (btc%FA_v_N0 + btc%vh_crvN * vbt**2) - vhbt
 
      if (abs(vhbt_err) < tol*abs(vhbt)) exit
      if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
      if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
 
      derr_dv = btc%FA_v_N0 + 3.0 * btc%vh_crvN * vbt**2
      if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
          (-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
        ! Use a false-position method guess.
        vbt = vbt_max + (vbt_min-vbt_max) * (vherr_max / (vherr_max-vherr_min))
      else ! Use Newton's method.
        vbt = vbt - vhbt_err / derr_dv
        if (abs(vhbt_err) < (0.01*tol)*abs(derr_dv*vbt_min)) exit
      endif
    enddo
  elseif (vhbt <= btc%vh_SS) then
    ! Iterate to convergence with Newton's method.  vbt will be positive.
    vbt_min = 0.0 ; vherr_min = -vhbt
    vbt_max = btc%vBT_SS ; vherr_max = btc%vh_SS - vhbt
    ! Use a false-position method first guess.
    vbt = btc%vBT_SS * (vhbt / btc%vh_SS)
    do itt = 1, max_itt
      vhbt_err = vbt * (btc%FA_v_S0 + btc%vh_crvS * vbt**2) - vhbt
 
      if (abs(vhbt_err) < tol*abs(vhbt)) exit
      if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
      if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
 
      derr_dv = btc%FA_v_S0 + 3.0 * btc%vh_crvS * vbt**2
      if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
          (-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
        ! Use a false-position method guess.
        vbt = vbt_min + (vbt_max-vbt_min) * (-vherr_min / (vherr_max-vherr_min))
      else ! Use Newton's method.
        vbt = vbt - vhbt_err / derr_dv
        if (abs(vhbt_err) < (0.01*tol)*(vbt_max*derr_dv)) exit
      endif
    enddo
  else ! (vhbt > BTC%vh_SS)
    vbt = btc%vBT_SS + (vhbt - btc%vh_SS) / btc%FA_v_SS
  endif
 
  if (present(guess)) then
    dvel = abs(vbt) - vs1*abs(guess)
    if (dvel > 0.0) then ! Limit the velocity
      if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then
        vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1)))
      else  ! The exp be less than 4e-18 anyway in this case, so neglect it.
        vsr = vs2
      endif
      vbt = sign(guess * vsr, vbt)
    endif
  endif
 

Referenced by set_up_bt_obc().

Here is the caller graph for this function:

Variable Documentation

arithmetic

integer, parameter mom_barotropic::arithmetic = 2

private

CPU time clock IDs.

Definition at line 365 of file MOM_barotropic.F90.

integer, parameter :: ARITHMETIC      = 2

Referenced by barotropic_init(), and btcalc().

arithmetic_string

character*(20), parameter mom_barotropic::arithmetic_string = "ARITHMETIC"

private

CPU time clock IDs.

Definition at line 371 of file MOM_barotropic.F90.

character*(20), parameter :: ARITHMETIC_STRING = "ARITHMETIC"

Referenced by barotropic_init().

bt_cont_string

character*(20), parameter mom_barotropic::bt_cont_string = "FROM_BT_CONT"

private

CPU time clock IDs.

Definition at line 372 of file MOM_barotropic.F90.

character*(20), parameter :: BT_CONT_STRING = "FROM_BT_CONT"

Referenced by barotropic_init().

from_bt_cont

integer, parameter mom_barotropic::from_bt_cont = 4

private

CPU time clock IDs.

Definition at line 367 of file MOM_barotropic.F90.

integer, parameter :: FROM_BT_CONT    = 4

Referenced by barotropic_init().

harmonic

integer, parameter mom_barotropic::harmonic = 1

private

Enumeration values for various schemes.

Definition at line 364 of file MOM_barotropic.F90.

integer, parameter :: HARMONIC        = 1

Referenced by barotropic_init(), and btcalc().

harmonic_string

character*(20), parameter mom_barotropic::harmonic_string = "HARMONIC"

private

CPU time clock IDs.

Definition at line 370 of file MOM_barotropic.F90.

character*(20), parameter :: HARMONIC_STRING = "HARMONIC"

Referenced by barotropic_init().

hybrid

integer, parameter mom_barotropic::hybrid = 3

private

CPU time clock IDs.

Definition at line 366 of file MOM_barotropic.F90.

integer, parameter :: HYBRID          = 3

Referenced by barotropic_init(), and btcalc().

hybrid_bt_cont

integer, parameter mom_barotropic::hybrid_bt_cont = 5

private

CPU time clock IDs.

Definition at line 368 of file MOM_barotropic.F90.

integer, parameter :: HYBRID_BT_CONT  = 5

hybrid_string

character*(20), parameter mom_barotropic::hybrid_string = "HYBRID"

private

CPU time clock IDs.

Definition at line 369 of file MOM_barotropic.F90.

character*(20), parameter :: HYBRID_STRING = "HYBRID"

Referenced by barotropic_init().

id_clock_calc

integer mom_barotropic::id_clock_calc =-1

private

CPU time clock IDs.

Definition at line 358 of file MOM_barotropic.F90.

Referenced by barotropic_init(), and btstep().

id_clock_calc_post

integer mom_barotropic::id_clock_calc_post =-1

private

CPU time clock IDs.

Definition at line 359 of file MOM_barotropic.F90.

Referenced by barotropic_init(), and btstep().

id_clock_calc_pre

integer mom_barotropic::id_clock_calc_pre =-1

private

CPU time clock IDs.

Definition at line 359 of file MOM_barotropic.F90.

integer :: id_clock_calc_pre=-1, id_clock_calc_post=-1

Referenced by barotropic_init(), btstep(), and set_local_bt_cont_types().

id_clock_pass_post

integer mom_barotropic::id_clock_pass_post =-1

private

CPU time clock IDs.

Definition at line 360 of file MOM_barotropic.F90.

Referenced by barotropic_init(), and btstep().

id_clock_pass_pre

integer mom_barotropic::id_clock_pass_pre =-1

private

CPU time clock IDs.

Definition at line 360 of file MOM_barotropic.F90.

Referenced by barotropic_init(), btstep(), and set_local_bt_cont_types().

id_clock_pass_step

integer mom_barotropic::id_clock_pass_step =-1

private

CPU time clock IDs.

Definition at line 360 of file MOM_barotropic.F90.

integer :: id_clock_pass_step=-1, id_clock_pass_pre=-1, id_clock_pass_post=-1

Referenced by barotropic_init(), and btstep().

id_clock_sync

integer mom_barotropic::id_clock_sync =-1

private

CPU time clock IDs.

Definition at line 358 of file MOM_barotropic.F90.

integer :: id_clock_sync=-1, id_clock_calc=-1

Referenced by barotropic_init(), and set_dtbt().