MOM6
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]msA type that describes the memory sizes of the argument arrays.
[in]ubtThe linearization zonal barotropic velocity [L T-1 ~> m s-1].
[in]uhbtThe linearization zonal barotropic transport
[in]vbtThe linearization meridional barotropic velocity [L T-1 ~> m s-1].
[in]vhbtThe linearization meridional barotropic transport
[out]btcl_uA structure with the u information from BT_cont.
[out]btcl_vA structure with the v information from BT_cont.
[in]gThe ocean's grid structure.
[in]usA dimensional unit scaling type
[in]haloThe extra halo size to use here.

Definition at line 3398 of file MOM_barotropic.F90.

3398  type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
3399  real, dimension(SZIBW_(MS),SZJW_(MS)), &
3400  intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1].
3401  real, dimension(SZIBW_(MS),SZJW_(MS)), &
3402  intent(in) :: uhbt !< The linearization zonal barotropic transport
3403  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
3404  real, dimension(SZIW_(MS),SZJBW_(MS)), &
3405  intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1].
3406  real, dimension(SZIW_(MS),SZJBW_(MS)), &
3407  intent(in) :: vhbt !< The linearization meridional barotropic transport
3408  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
3409  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), &
3410  intent(out) :: BTCL_u !< A structure with the u information from BT_cont.
3411  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), &
3412  intent(out) :: BTCL_v !< A structure with the v information from BT_cont.
3413  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3414  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3415  integer, optional, intent(in) :: halo !< The extra halo size to use here.
3416 
3417  ! Local variables
3418  real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
3419  u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
3420  real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
3421  v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
3422  real, parameter :: C1_3 = 1.0/3.0
3423  integer :: i, j, is, ie, js, je, hs
3424  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
3425  hs = 1 ; if (present(halo)) hs = max(halo,0)
3426 
3427  !$OMP parallel do default(shared)
3428  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
3429  if ((ubt(i,j) > btcl_u(i,j)%uBT_WW) .and. (uhbt(i,j) > btcl_u(i,j)%uh_WW)) then
3430  ! Expand the cubic fit to use this new point. ubt is negative.
3431  btcl_u(i,j)%ubt_WW = ubt(i,j)
3432  if (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl_u(i,j)%FA_u_W0) then
3433  ! No further bounding is needed.
3434  btcl_u(i,j)%uh_crvW = (uhbt(i,j) - ubt(i,j) * btcl_u(i,j)%FA_u_W0) / ubt(i,j)**3
3435  else ! This should not happen often!
3436  btcl_u(i,j)%FA_u_W0 = 1.5*uhbt(i,j) / ubt(i,j)
3437  btcl_u(i,j)%uh_crvW = -0.5*uhbt(i,j) / ubt(i,j)**3
3438  endif
3439  btcl_u(i,j)%uh_WW = uhbt(i,j)
3440  ! I don't know whether this is helpful.
3441 ! BTCL_u(I,j)%FA_u_WW = min(BTCL_u(I,j)%FA_u_WW, uhbt(I,j) / ubt(I,j))
3442  elseif ((ubt(i,j) < btcl_u(i,j)%uBT_EE) .and. (uhbt(i,j) < btcl_u(i,j)%uh_EE)) then
3443  ! Expand the cubic fit to use this new point. ubt is negative.
3444  btcl_u(i,j)%ubt_EE = ubt(i,j)
3445  if (3.0*uhbt(i,j) < 2.0*ubt(i,j) * btcl_u(i,j)%FA_u_E0) then
3446  ! No further bounding is needed.
3447  btcl_u(i,j)%uh_crvE = (uhbt(i,j) - ubt(i,j) * btcl_u(i,j)%FA_u_E0) / ubt(i,j)**3
3448  else ! This should not happen often!
3449  btcl_u(i,j)%FA_u_E0 = 1.5*uhbt(i,j) / ubt(i,j)
3450  btcl_u(i,j)%uh_crvE = -0.5*uhbt(i,j) / ubt(i,j)**3
3451  endif
3452  btcl_u(i,j)%uh_EE = uhbt(i,j)
3453  ! I don't know whether this is helpful.
3454 ! BTCL_u(I,j)%FA_u_EE = min(BTCL_u(I,j)%FA_u_EE, uhbt(I,j) / ubt(I,j))
3455  endif
3456  enddo ; enddo
3457  !$OMP parallel do default(shared)
3458  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
3459  if ((vbt(i,j) > btcl_v(i,j)%vBT_SS) .and. (vhbt(i,j) > btcl_v(i,j)%vh_SS)) then
3460  ! Expand the cubic fit to use this new point. vbt is negative.
3461  btcl_v(i,j)%vbt_SS = vbt(i,j)
3462  if (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl_v(i,j)%FA_v_S0) then
3463  ! No further bounding is needed.
3464  btcl_v(i,j)%vh_crvS = (vhbt(i,j) - vbt(i,j) * btcl_v(i,j)%FA_v_S0) / vbt(i,j)**3
3465  else ! This should not happen often!
3466  btcl_v(i,j)%FA_v_S0 = 1.5*vhbt(i,j) / (vbt(i,j))
3467  btcl_v(i,j)%vh_crvS = -0.5*vhbt(i,j) / vbt(i,j)**3
3468  endif
3469  btcl_v(i,j)%vh_SS = vhbt(i,j)
3470  ! I don't know whether this is helpful.
3471 ! BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J))
3472  elseif ((vbt(i,j) < btcl_v(i,j)%vBT_NN) .and. (vhbt(i,j) < btcl_v(i,j)%vh_NN)) then
3473  ! Expand the cubic fit to use this new point. vbt is negative.
3474  btcl_v(i,j)%vbt_NN = vbt(i,j)
3475  if (3.0*vhbt(i,j) < 2.0*vbt(i,j) * btcl_v(i,j)%FA_v_N0) then
3476  ! No further bounding is needed.
3477  btcl_v(i,j)%vh_crvN = (vhbt(i,j) - vbt(i,j) * btcl_v(i,j)%FA_v_N0) / vbt(i,j)**3
3478  else ! This should not happen often!
3479  btcl_v(i,j)%FA_v_N0 = 1.5*vhbt(i,j) / (vbt(i,j))
3480  btcl_v(i,j)%vh_crvN = -0.5*vhbt(i,j) / vbt(i,j)**3
3481  endif
3482  btcl_v(i,j)%vh_NN = vhbt(i,j)
3483  ! I don't know whether this is helpful.
3484 ! BTCL_v(i,J)%FA_v_NN = min(BTCL_v(i,J)%FA_v_NN, vhbt(i,J) / vbt(i,J))
3485  endif
3486  enddo ; enddo
3487 

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
obcAn associated pointer to an OBC type.
[in,out]gThe ocean's grid structure.
[in]msA type that describes the memory sizes of the argument arrays.
[in,out]ubtthe zonal barotropic velocity [L T-1 ~> m s-1].
[in,out]uhbtthe zonal barotropic transport [H L2 T-1 ~> m3 s-1 or kg s-1].
[in,out]ubt_transThe zonal barotropic velocity used in transport [L T-1 ~> m s-1].
[in,out]vbtThe meridional barotropic velocity [L T-1 ~> m s-1].
[in,out]vhbtthe meridional barotropic transport [H L2 T-1 ~> m3 s-1 or kg s-1].
[in,out]vbt_transthe meridional BT velocity used in transports [L T-1 ~> m s-1].
[in]etaThe barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in]ubt_oldThe starting value of ubt in a barotropic step [L T-1 ~> m s-1].
[in]vbt_oldThe starting value of vbt in a barotropic step [L T-1 ~> m s-1].
[in]bt_obcA structure with the private barotropic arrays related to the open boundary conditions, set by set_up_BT_OBC.
[in]usA dimensional unit scaling type
[in]haloThe extra halo size to use here.
[in]dtbtThe time step [T ~> s].
[in]bebtThe fractional weighting of the future velocity in determining the transport.
[in]use_bt_contIf true, use the BT_cont_types to calculate transports.
[in]datuA fixed estimate of the face areas at u points [H L ~> m2 or kg m-1].
[in]datvA fixed estimate of the face areas at v points [H L ~> m2 or kg m-1].
[in]btcl_uStructure of information used for a dynamic estimate of the face areas at u-points.
[in]btcl_vStructure of information used for a dynamic estimate of the face areas at v-points.
[in]uhbt0A 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]vhbt0A 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.

2381  type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type.
2382  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
2383  type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of
2384  !! the argument arrays.
2385  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1].
2386  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport
2387  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
2388  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in
2389  !! transport [L T-1 ~> m s-1].
2390  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic velocity
2391  !! [L T-1 ~> m s-1].
2392  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport
2393  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
2394  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in
2395  !! transports [L T-1 ~> m s-1].
2396  real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
2397  !! column mass anomaly [H ~> m or kg m-2].
2398  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic
2399  !! step [L T-1 ~> m s-1].
2400  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic
2401  !! step [L T-1 ~> m s-1].
2402  type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays
2403  !! related to the open boundary conditions,
2404  !! set by set_up_BT_OBC.
2405  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
2406  integer, intent(in) :: halo !< The extra halo size to use here.
2407  real, intent(in) :: dtbt !< The time step [T ~> s].
2408  real, intent(in) :: bebt !< The fractional weighting of the future velocity
2409  !! in determining the transport.
2410  logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
2411  !! transports.
2412  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
2413  !! [H L ~> m2 or kg m-1].
2414  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
2415  !! [H L ~> m2 or kg m-1].
2416  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
2417  !! for a dynamic estimate of the face areas at
2418  !! u-points.
2419  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
2420  !! for a dynamic estimate of the face areas at
2421  !! v-points.
2422  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that
2423  !! the barotropic functions agree with the sum
2424  !! of the layer transports
2425  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
2426  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that
2427  !! the barotropic functions agree with the sum
2428  !! of the layer transports
2429  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
2430 
2431  ! Local variables
2432  real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
2433  real :: vel_trans ! The combination of the previous and current velocity
2434  ! that does the mass transport [L T-1 ~> m s-1].
2435  real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2].
2436  real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2].
2437  real :: cfl ! The CFL number at the point in question [nondim]
2438  real :: u_inlet ! The zonal inflow velocity [L T-1 ~> m s-1]
2439  real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1]
2440  real :: h_in
2441  real :: cff, Cx, Cy, tau
2442  real :: dhdt, dhdx, dhdy
2443  integer :: i, j, is, ie, js, je
2444  real, dimension(SZIB_(G),SZJB_(G)) :: grad
2445  real, parameter :: eps = 1.0e-20
2446  real :: rx_max, ry_max ! coefficients for radiation
2447  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
2448  rx_max = obc%rx_max ; ry_max = obc%rx_max
2449 
2450  if (bt_obc%apply_u_OBCs) then
2451  do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
2452  if (obc%segment(obc%segnum_u(i,j))%specified) then
2453  uhbt(i,j) = bt_obc%uhbt(i,j)
2454  ubt(i,j) = bt_obc%ubt_outer(i,j)
2455  vel_trans = ubt(i,j)
2456  elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
2457  if (obc%segment(obc%segnum_u(i,j))%Flather) then
2458  cfl = dtbt * bt_obc%Cg_u(i,j) * g%IdxCu(i,j) ! CFL
2459  u_inlet = cfl*ubt_old(i-1,j) + (1.0-cfl)*ubt_old(i,j) ! Valid for cfl<1
2460  h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal
2461  h_u = bt_obc%H_u(i,j)
2462  vel_prev = ubt(i,j)
2463  ubt(i,j) = 0.5*((u_inlet + bt_obc%ubt_outer(i,j)) + &
2464  (bt_obc%Cg_u(i,j)/h_u) * (h_in-bt_obc%eta_outer_u(i,j)))
2465  vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(i,j)
2466  elseif (obc%segment(obc%segnum_u(i,j))%gradient) then
2467  ubt(i,j) = ubt(i-1,j)
2468  vel_trans = ubt(i,j)
2469  endif
2470  elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
2471  if (obc%segment(obc%segnum_u(i,j))%Flather) then
2472  cfl = dtbt * bt_obc%Cg_u(i,j) * g%IdxCu(i,j) ! CFL
2473  u_inlet = cfl*ubt_old(i+1,j) + (1.0-cfl)*ubt_old(i,j) ! Valid for cfl<1
2474  h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external
2475 
2476  h_u = bt_obc%H_u(i,j)
2477  vel_prev = ubt(i,j)
2478  ubt(i,j) = 0.5*((u_inlet + bt_obc%ubt_outer(i,j)) + &
2479  (bt_obc%Cg_u(i,j)/h_u) * (bt_obc%eta_outer_u(i,j)-h_in))
2480 
2481  vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(i,j)
2482  elseif (obc%segment(obc%segnum_u(i,j))%gradient) then
2483  ubt(i,j) = ubt(i+1,j)
2484  vel_trans = ubt(i,j)
2485  endif
2486  endif
2487 
2488  if (.not. obc%segment(obc%segnum_u(i,j))%specified) then
2489  if (use_bt_cont) then
2490  uhbt(i,j) = find_uhbt(vel_trans, btcl_u(i,j), us) + uhbt0(i,j)
2491  else
2492  uhbt(i,j) = datu(i,j)*vel_trans + uhbt0(i,j)
2493  endif
2494  endif
2495 
2496  ubt_trans(i,j) = vel_trans
2497  endif ; enddo ; enddo
2498  endif
2499 
2500  if (bt_obc%apply_v_OBCs) then
2501  do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
2502  if (obc%segment(obc%segnum_v(i,j))%specified) then
2503  vhbt(i,j) = bt_obc%vhbt(i,j)
2504  vbt(i,j) = bt_obc%vbt_outer(i,j)
2505  vel_trans = vbt(i,j)
2506  elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
2507  if (obc%segment(obc%segnum_v(i,j))%Flather) then
2508  cfl = dtbt * bt_obc%Cg_v(i,j) * g%IdyCv(i,j) ! CFL
2509  v_inlet = cfl*vbt_old(i,j-1) + (1.0-cfl)*vbt_old(i,j) ! Valid for cfl<1
2510  h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal
2511 
2512  h_v = bt_obc%H_v(i,j)
2513  vel_prev = vbt(i,j)
2514  vbt(i,j) = 0.5*((v_inlet + bt_obc%vbt_outer(i,j)) + &
2515  (bt_obc%Cg_v(i,j)/h_v) * (h_in-bt_obc%eta_outer_v(i,j)))
2516 
2517  vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,j)
2518  elseif (obc%segment(obc%segnum_v(i,j))%gradient) then
2519  vbt(i,j) = vbt(i,j-1)
2520  vel_trans = vbt(i,j)
2521  endif
2522  elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
2523  if (obc%segment(obc%segnum_v(i,j))%Flather) then
2524  cfl = dtbt * bt_obc%Cg_v(i,j) * g%IdyCv(i,j) ! CFL
2525  v_inlet = cfl*vbt_old(i,j+1) + (1.0-cfl)*vbt_old(i,j) ! Valid for cfl <1
2526  h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal
2527 
2528  h_v = bt_obc%H_v(i,j)
2529  vel_prev = vbt(i,j)
2530  vbt(i,j) = 0.5*((v_inlet + bt_obc%vbt_outer(i,j)) + &
2531  (bt_obc%Cg_v(i,j)/h_v) * (bt_obc%eta_outer_v(i,j)-h_in))
2532 
2533  vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,j)
2534  elseif (obc%segment(obc%segnum_v(i,j))%gradient) then
2535  vbt(i,j) = vbt(i,j+1)
2536  vel_trans = vbt(i,j)
2537  endif
2538  endif
2539 
2540  if (.not. obc%segment(obc%segnum_v(i,j))%specified) then
2541  if (use_bt_cont) then
2542  vhbt(i,j) = find_vhbt(vel_trans, btcl_v(i,j), us) + vhbt0(i,j)
2543  else
2544  vhbt(i,j) = vel_trans*datv(i,j) + vhbt0(i,j)
2545  endif
2546  endif
2547 
2548  vbt_trans(i,j) = vel_trans
2549  endif ; enddo ; enddo
2550  endif
2551 

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
csControl structure to clear out.

Definition at line 4412 of file MOM_barotropic.F90.

4412  type(barotropic_CS), pointer :: CS !< Control structure to clear out.
4413  dealloc_(cs%frhatu) ; dealloc_(cs%frhatv)
4414  dealloc_(cs%IDatu) ; dealloc_(cs%IDatv)
4415  dealloc_(cs%ubtav) ; dealloc_(cs%vbtav)
4416  dealloc_(cs%eta_cor)
4417  dealloc_(cs%ua_polarity) ; dealloc_(cs%va_polarity)
4418  if (cs%bound_BT_corr) then
4419  dealloc_(cs%eta_cor_bound)
4420  endif
4421 
4422  call destroy_bt_obc(cs%BT_OBC)
4423 
4424  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
csControl structure for this module
[in]gGrid structure
[in,out]ubtavZonal barotropic velocity averaged over a baroclinic timestep [L T-1 ~> m s-1]
[in,out]vbtavMeridional barotropic velocity averaged over a baroclinic timestep [L T-1 ~> m s-1]
[in]usA dimensional unit scaling type

Definition at line 4389 of file MOM_barotropic.F90.

4389  type(barotropic_CS), pointer :: CS !< Control structure for this module
4390  type(ocean_grid_type), intent(in) :: G !< Grid structure
4391  real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged
4392  !! over a baroclinic timestep [L T-1 ~> m s-1]
4393  real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged
4394  !! over a baroclinic timestep [L T-1 ~> m s-1]
4395  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
4396  ! Local variables
4397  integer :: i,j
4398 
4399  do j=g%jsc,g%jec ; do i=g%isc-1,g%iec
4400  ubtav(i,j) = cs%ubtav(i,j)
4401  enddo ; enddo
4402 
4403  do j=g%jsc-1,g%jec ; do i=g%isc,g%iec
4404  vbtav(i,j) = cs%vbtav(i,j)
4405  enddo ; enddo
4406 

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]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]usA dimensional unit scaling type
[in]uThe zonal velocity [L T-1 ~> m s-1].
[in]vThe meridional velocity [L T-1 ~> m s-1].
[in]hLayer thicknesses [H ~> m or kg m-2].
[in]etaFree surface height or column mass anomaly
[in]timeThe current model time.
[in]param_fileA structure to parse for run-time parameters.
[in,out]diagA structure that is used to regulate diagnostic output.
csA pointer to the control structure for this module that is set in register_barotropic_restarts.
restart_csA pointer to the restart control structure.
[out]calc_dtbtIf true, the barotropic time step must be recalculated before stepping.
bt_contA structure with elements that describe the
tides_cspA pointer to the control structure of the

Definition at line 3704 of file MOM_barotropic.F90.

3704  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
3705  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3706  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3707  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
3708  intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
3709  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
3710  intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
3711  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
3712  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
3713  real, dimension(SZI_(G),SZJ_(G)), &
3714  intent(in) :: eta !< Free surface height or column mass anomaly
3715  !! [Z ~> m] or [H ~> kg m-2].
3716  type(time_type), target, intent(in) :: Time !< The current model time.
3717  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
3718  type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
3719  !! output.
3720  type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module
3721  !! that is set in register_barotropic_restarts.
3722  type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
3723  logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must
3724  !! be recalculated before stepping.
3725  type(BT_cont_type), optional, &
3726  pointer :: BT_cont !< A structure with elements that describe the
3727  !! effective open face areas as a function of
3728  !! barotropic flow.
3729  type(tidal_forcing_CS), optional, &
3730  pointer :: tides_CSp !< A pointer to the control structure of the
3731  !! tide module.
3732 
3733 ! This include declares and sets the variable "version".
3734 #include "version_variable.h"
3735  ! Local variables
3736  character(len=40) :: mdl = "MOM_barotropic" ! This module's name.
3737  real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1].
3738  real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1].
3739  real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce.
3740  real :: SSH_extra ! An estimate of how much higher SSH might get, for use
3741  ! in calculating the safe external wave speed [Z ~> m].
3742  real :: dtbt_input ! The input value of DTBT, [nondim] if negative or [s] if positive.
3743  real :: dtbt_tmp ! A temporary copy of CS%dtbt read from a restart file [T ~> s]
3744  real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag
3745  ! piston velocities.
3746  character(len=200) :: inputdir ! The directory in which to find input files.
3747  character(len=200) :: wave_drag_file ! The file from which to read the wave
3748  ! drag piston velocity.
3749  character(len=80) :: wave_drag_var ! The wave drag piston velocity variable
3750  ! name in wave_drag_file.
3751  real :: vel_rescale ! A rescaling factor for horizontal velocity from the representation in
3752  ! a restart file to the internal representation in this run.
3753  real :: uH_rescale ! A rescaling factor for thickness transports from the representation in
3754  ! a restart file to the internal representation in this run.
3755  real, allocatable, dimension(:,:) :: lin_drag_h
3756  type(memory_size_type) :: MS
3757  type(group_pass_type) :: pass_static_data, pass_q_D_Cor
3758  type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity
3759  logical :: apply_bt_drag, use_BT_cont_type
3760  character(len=48) :: thickness_units, flux_units
3761  character*(40) :: hvel_str
3762  integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
3763  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
3764  integer :: isdw, iedw, jsdw, jedw
3765  integer :: i, j, k
3766  integer :: wd_halos(2), bt_halo_sz
3767  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
3768  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
3769  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
3770  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
3771  ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed
3772 
3773  if (cs%module_is_initialized) then
3774  call mom_error(warning, "barotropic_init called with a control structure "// &
3775  "that has already been initialized.")
3776  return
3777  endif
3778  cs%module_is_initialized = .true.
3779 
3780  cs%diag => diag ; cs%Time => time
3781  if (present(tides_csp)) then
3782  if (associated(tides_csp)) cs%tides_CSp => tides_csp
3783  endif
3784 
3785  ! Read all relevant parameters and write them to the model log.
3786  call log_version(param_file, mdl, version, "")
3787  call get_param(param_file, mdl, "SPLIT", cs%split, &
3788  "Use the split time stepping if true.", default=.true.)
3789  if (.not.cs%split) return
3790 
3791  call get_param(param_file, mdl, "BOUND_BT_CORRECTION", cs%bound_BT_corr, &
3792  "If true, the corrective pseudo mass-fluxes into the "//&
3793  "barotropic solver are limited to values that require "//&
3794  "less than maxCFL_BT_cont to be accommodated.",default=.false.)
3795  call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", cs%BT_cont_bounds, &
3796  "If true, and BOUND_BT_CORRECTION is true, use the "//&
3797  "BT_cont_type variables to set limits determined by "//&
3798  "MAXCFL_BT_CONT on the CFL number of the velocities "//&
3799  "that are likely to be driven by the corrective mass fluxes.", &
3800  default=.true.) !, do_not_log=.not.CS%bound_BT_corr)
3801  call get_param(param_file, mdl, "ADJUST_BT_CONT", cs%adjust_BT_cont, &
3802  "If true, adjust the curve fit to the BT_cont type "//&
3803  "that is used by the barotropic solver to match the "//&
3804  "transport about which the flow is being linearized.", default=.false.)
3805  call get_param(param_file, mdl, "GRADUAL_BT_ICS", cs%gradual_BT_ICs, &
3806  "If true, adjust the initial conditions for the "//&
3807  "barotropic solver to the values from the layered "//&
3808  "solution over a whole timestep instead of instantly. "//&
3809  "This is a decent approximation to the inclusion of "//&
3810  "sum(u dh_dt) while also correcting for truncation errors.", &
3811  default=.false.)
3812  call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", cs%visc_rem_u_uh0, &
3813  "If true, use the viscous remnants when estimating the "//&
3814  "barotropic velocities that were used to calculate uh0 "//&
3815  "and vh0. False is probably the better choice.", default=.false.)
3816  call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", cs%use_wide_halos, &
3817  "If true, use wide halos and march in during the "//&
3818  "barotropic time stepping for efficiency.", default=.true., &
3819  layoutparam=.true.)
3820  call get_param(param_file, mdl, "BTHALO", bt_halo_sz, &
3821  "The minimum halo size for the barotropic solver.", default=0, &
3822  layoutparam=.true.)
3823 #ifdef STATIC_MEMORY_
3824  if ((bt_halo_sz > 0) .and. (bt_halo_sz /= bthalo_)) call mom_error(fatal, &
3825  "barotropic_init: Run-time values of BTHALO must agree with the "//&
3826  "macro BTHALO_ with STATIC_MEMORY_.")
3827  wd_halos(1) = whaloi_+nihalo_ ; wd_halos(2) = whaloj_+njhalo_
3828 #else
3829  wd_halos(1) = bt_halo_sz; wd_halos(2) = bt_halo_sz
3830 #endif
3831  call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), &
3832  "The barotropic x-halo size that is actually used.", &
3833  layoutparam=.true.)
3834  call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), &
3835  "The barotropic y-halo size that is actually used.", &
3836  layoutparam=.true.)
3837 
3838  call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_bt_cont_type, &
3839  "If true, use a structure with elements that describe "//&
3840  "effective face areas from the summed continuity solver "//&
3841  "as a function the barotropic flow in coupling between "//&
3842  "the barotropic and baroclinic flow. This is only used "//&
3843  "if SPLIT is true. \n", default=.true.)
3844  call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", &
3845  cs%Nonlinear_continuity, &
3846  "If true, use nonlinear transports in the barotropic "//&
3847  "continuity equation. This does not apply if "//&
3848  "USE_BT_CONT_TYPE is true.", default=.false.)
3849  cs%Nonlin_cont_update_period = 1
3850  if (cs%Nonlinear_continuity) &
3851  call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", &
3852  cs%Nonlin_cont_update_period, &
3853  "If NONLINEAR_BT_CONTINUITY is true, this is the number "//&
3854  "of barotropic time steps between updates to the face "//&
3855  "areas, or 0 to update only before the barotropic stepping.",&
3856  units="nondim", default=1)
3857  call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", cs%BT_project_velocity,&
3858  "If true, step the barotropic velocity first and project "//&
3859  "out the velocity tendency by 1+BEBT when calculating the "//&
3860  "transport. The default (false) is to use a predictor "//&
3861  "continuity step to find the pressure field, and then "//&
3862  "to do a corrector continuity step using a weighted "//&
3863  "average of the old and new velocities, with weights "//&
3864  "of (1-BEBT) and BEBT.", default=.false.)
3865 
3866  call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", cs%dynamic_psurf, &
3867  "If true, add a dynamic pressure due to a viscous ice "//&
3868  "shelf, for instance.", default=.false.)
3869  if (cs%dynamic_psurf) then
3870  call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", cs%ice_strength_length, &
3871  "The length scale at which the Rayleigh damping rate due "//&
3872  "to the ice strength should be the same as if a Laplacian "//&
3873  "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", &
3874  units="m", default=1.0e4, scale=us%m_to_L)
3875  call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", cs%Dmin_dyn_psurf, &
3876  "The minimum depth to use in limiting the size of the "//&
3877  "dynamic surface pressure for stability, if "//&
3878  "DYNAMIC_SURFACE_PRESSURE is true..", &
3879  units="m", default=1.0e-6, scale=us%m_to_Z)
3880  call get_param(param_file, mdl, "CONST_DYN_PSURF", cs%const_dyn_psurf, &
3881  "The constant that scales the dynamic surface pressure, "//&
3882  "if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//&
3883  "are < ~1.0.", units="nondim", default=0.9)
3884  endif
3885 
3886  call get_param(param_file, mdl, "TIDES", cs%tides, &
3887  "If true, apply tidal momentum forcing.", default=.false.)
3888  call get_param(param_file, mdl, "SADOURNY", cs%Sadourny, &
3889  "If true, the Coriolis terms are discretized with the "//&
3890  "Sadourny (1975) energy conserving scheme, otherwise "//&
3891  "the Arakawa & Hsu scheme is used. If the internal "//&
3892  "deformation radius is not resolved, the Sadourny scheme "//&
3893  "should probably be used.", default=.true.)
3894 
3895  call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, &
3896  "A string describing the scheme that is used to set the "//&
3897  "open face areas used for barotropic transport and the "//&
3898  "relative weights of the accelerations. Valid values are:\n"//&
3899  "\t ARITHMETIC - arithmetic mean layer thicknesses \n"//&
3900  "\t HARMONIC - harmonic mean layer thicknesses \n"//&
3901  "\t HYBRID (the default) - use arithmetic means for \n"//&
3902  "\t layers above the shallowest bottom, the harmonic \n"//&
3903  "\t mean for layers below, and a weighted average for \n"//&
3904  "\t layers that straddle that depth \n"//&
3905  "\t FROM_BT_CONT - use the average thicknesses kept \n"//&
3906  "\t in the h_u and h_v fields of the BT_cont_type", &
3907  default=bt_cont_string)
3908  select case (hvel_str)
3909  case (hybrid_string) ; cs%hvel_scheme = hybrid
3910  case (harmonic_string) ; cs%hvel_scheme = harmonic
3911  case (arithmetic_string) ; cs%hvel_scheme = arithmetic
3912  case (bt_cont_string) ; cs%hvel_scheme = from_bt_cont
3913  case default
3914  call mom_mesg('barotropic_init: BT_THICK_SCHEME ="'//trim(hvel_str)//'"', 0)
3915  call mom_error(fatal, "barotropic_init: Unrecognized setting "// &
3916  "#define BT_THICK_SCHEME "//trim(hvel_str)//" found in input file.")
3917  end select
3918  if ((cs%hvel_scheme == from_bt_cont) .and. .not.use_bt_cont_type) &
3919  call mom_error(fatal, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//&
3920  "can only be used if USE_BT_CONT_TYPE is defined.")
3921 
3922  call get_param(param_file, mdl, "BT_STRONG_DRAG", cs%strong_drag, &
3923  "If true, use a stronger estimate of the retarding "//&
3924  "effects of strong bottom drag, by making it implicit "//&
3925  "with the barotropic time-step instead of implicit with "//&
3926  "the baroclinic time-step and dividing by the number of "//&
3927  "barotropic steps.", default=.false.)
3928  call get_param(param_file, mdl, "BT_LINEAR_WAVE_DRAG", cs%linear_wave_drag, &
3929  "If true, apply a linear drag to the barotropic velocities, "//&
3930  "using rates set by lin_drag_u & _v divided by the depth of "//&
3931  "the ocean. This was introduced to facilitate tide modeling.", &
3932  default=.false.)
3933  call get_param(param_file, mdl, "BT_WAVE_DRAG_FILE", wave_drag_file, &
3934  "The name of the file with the barotropic linear wave drag "//&
3935  "piston velocities.", default="", do_not_log=.not.cs%linear_wave_drag)
3936  call get_param(param_file, mdl, "BT_WAVE_DRAG_VAR", wave_drag_var, &
3937  "The name of the variable in BT_WAVE_DRAG_FILE with the "//&
3938  "barotropic linear wave drag piston velocities at h points.", &
3939  default="rH", do_not_log=.not.cs%linear_wave_drag)
3940  call get_param(param_file, mdl, "BT_WAVE_DRAG_SCALE", wave_drag_scale, &
3941  "A scaling factor for the barotropic linear wave drag "//&
3942  "piston velocities.", default=1.0, units="nondim", &
3943  do_not_log=.not.cs%linear_wave_drag)
3944 
3945  call get_param(param_file, mdl, "CLIP_BT_VELOCITY", cs%clip_velocity, &
3946  "If true, limit any velocity components that exceed "//&
3947  "CFL_TRUNCATE. This should only be used as a desperate "//&
3948  "debugging measure.", default=.false.)
3949  call get_param(param_file, mdl, "CFL_TRUNCATE", cs%CFL_trunc, &
3950  "The value of the CFL number that will cause velocity "//&
3951  "components to be truncated; instability can occur past 0.5.", &
3952  units="nondim", default=0.5, do_not_log=.not.cs%clip_velocity)
3953  call get_param(param_file, mdl, "MAXVEL", cs%maxvel, &
3954  "The maximum velocity allowed before the velocity "//&
3955  "components are truncated.", units="m s-1", default=3.0e8, scale=us%m_s_to_L_T, &
3956  do_not_log=.not.cs%clip_velocity)
3957  call get_param(param_file, mdl, "MAXCFL_BT_CONT", cs%maxCFL_BT_cont, &
3958  "The maximum permitted CFL number associated with the "//&
3959  "barotropic accelerations from the summed velocities "//&
3960  "times the time-derivatives of thicknesses.", units="nondim", &
3961  default=0.25)
3962  call get_param(param_file, mdl, "VEL_UNDERFLOW", cs%vel_underflow, &
3963  "A negligibly small velocity magnitude below which velocity "//&
3964  "components are set to 0. A reasonable value might be "//&
3965  "1e-30 m/s, which is less than an Angstrom divided by "//&
3966  "the age of the universe.", units="m s-1", default=0.0, scale=us%m_s_to_L_T)
3967 
3968  call get_param(param_file, mdl, "DT_BT_FILTER", cs%dt_bt_filter, &
3969  "A time-scale over which the barotropic mode solutions "//&
3970  "are filtered, in seconds if positive, or as a fraction "//&
3971  "of DT if negative. When used this can never be taken to "//&
3972  "be longer than 2*dt. Set this to 0 to apply no filtering.", &
3973  units="sec or nondim", default=-0.25)
3974  if (cs%dt_bt_filter > 0.0) cs%dt_bt_filter = us%s_to_T*cs%dt_bt_filter
3975  call get_param(param_file, mdl, "G_BT_EXTRA", cs%G_extra, &
3976  "A nondimensional factor by which gtot is enhanced.", &
3977  units="nondim", default=0.0)
3978  call get_param(param_file, mdl, "SSH_EXTRA", ssh_extra, &
3979  "An estimate of how much higher SSH might get, for use "//&
3980  "in calculating the safe external wave speed. The "//&
3981  "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", &
3982  units="m", default=min(10.0,0.05*g%max_depth*us%Z_to_m), scale=us%m_to_Z)
3983 
3984  call get_param(param_file, mdl, "DEBUG", cs%debug, &
3985  "If true, write out verbose debugging data.", &
3986  default=.false., debuggingparam=.true.)
3987  call get_param(param_file, mdl, "DEBUG_BT", cs%debug_bt, &
3988  "If true, write out verbose debugging data within the "//&
3989  "barotropic time-stepping loop. The data volume can be "//&
3990  "quite large if this is true.", default=cs%debug, &
3991  debuggingparam=.true.)
3992 
3993  cs%linearized_BT_PV = .true.
3994  call get_param(param_file, mdl, "BEBT", cs%bebt, &
3995  "BEBT determines whether the barotropic time stepping "//&
3996  "uses the forward-backward time-stepping scheme or a "//&
3997  "backward Euler scheme. BEBT is valid in the range from "//&
3998  "0 (for a forward-backward treatment of nonrotating "//&
3999  "gravity waves) to 1 (for a backward Euler treatment). "//&
4000  "In practice, BEBT must be greater than about 0.05.", &
4001  units="nondim", default=0.1)
4002  call get_param(param_file, mdl, "DTBT", dtbt_input, &
4003  "The barotropic time step, in s. DTBT is only used with "//&
4004  "the split explicit time stepping. To set the time step "//&
4005  "automatically based the maximum stable value use 0, or "//&
4006  "a negative value gives the fraction of the stable value. "//&
4007  "Setting DTBT to 0 is the same as setting it to -0.98. "//&
4008  "The value of DTBT that will actually be used is an "//&
4009  "integer fraction of DT, rounding down.", units="s or nondim",&
4010  default = -0.98)
4011  call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", &
4012  cs%use_old_coriolis_bracket_bug , &
4013  "If True, use an order of operations that is not bitwise "//&
4014  "rotationally symmetric in the meridional Coriolis term of "//&
4015  "the barotropic solver.", default=.false.)
4016 
4017  ! Initialize a version of the MOM domain that is specific to the barotropic solver.
4018  call clone_mom_domain(g%Domain, cs%BT_Domain, min_halo=wd_halos, symmetric=.true.)
4019 #ifdef STATIC_MEMORY_
4020  if (wd_halos(1) /= whaloi_+nihalo_) call mom_error(fatal, "barotropic_init: "//&
4021  "Barotropic x-halo sizes are incorrectly resized with STATIC_MEMORY_.")
4022  if (wd_halos(2) /= whaloj_+njhalo_) call mom_error(fatal, "barotropic_init: "//&
4023  "Barotropic y-halo sizes are incorrectly resized with STATIC_MEMORY_.")
4024 #else
4025  if (bt_halo_sz > 0) then
4026  if (wd_halos(1) > bt_halo_sz) &
4027  call mom_mesg("barotropic_init: barotropic x-halo size increased.", 3)
4028  if (wd_halos(2) > bt_halo_sz) &
4029  call mom_mesg("barotropic_init: barotropic y-halo size increased.", 3)
4030  endif
4031 #endif
4032 
4033  cs%isdw = g%isc-wd_halos(1) ; cs%iedw = g%iec+wd_halos(1)
4034  cs%jsdw = g%jsc-wd_halos(2) ; cs%jedw = g%jec+wd_halos(2)
4035  isdw = cs%isdw ; iedw = cs%iedw ; jsdw = cs%jsdw ; jedw = cs%jedw
4036 
4037  alloc_(cs%frhatu(isdb:iedb,jsd:jed,nz)) ; alloc_(cs%frhatv(isd:ied,jsdb:jedb,nz))
4038  alloc_(cs%eta_cor(isd:ied,jsd:jed))
4039  if (cs%bound_BT_corr) then
4040  alloc_(cs%eta_cor_bound(isd:ied,jsd:jed)) ; cs%eta_cor_bound(:,:) = 0.0
4041  endif
4042  alloc_(cs%IDatu(isdb:iedb,jsd:jed)) ; alloc_(cs%IDatv(isd:ied,jsdb:jedb))
4043 
4044  alloc_(cs%ua_polarity(isdw:iedw,jsdw:jedw))
4045  alloc_(cs%va_polarity(isdw:iedw,jsdw:jedw))
4046 
4047  cs%frhatu(:,:,:) = 0.0 ; cs%frhatv(:,:,:) = 0.0
4048  cs%eta_cor(:,:) = 0.0
4049  cs%IDatu(:,:) = 0.0 ; cs%IDatv(:,:) = 0.0
4050 
4051  cs%ua_polarity(:,:) = 1.0 ; cs%va_polarity(:,:) = 1.0
4052  call create_group_pass(pass_a_polarity, cs%ua_polarity, cs%va_polarity, cs%BT_domain, to_all, agrid)
4053  call do_group_pass(pass_a_polarity, cs%BT_domain)
4054 
4055  if (use_bt_cont_type) &
4056  call alloc_bt_cont_type(bt_cont, g, (cs%hvel_scheme == from_bt_cont))
4057 
4058  if (cs%debug) then ! Make a local copy of loop ranges for chksum calls
4059  allocate(cs%debug_BT_HI)
4060  cs%debug_BT_HI%isc=g%isc
4061  cs%debug_BT_HI%iec=g%iec
4062  cs%debug_BT_HI%jsc=g%jsc
4063  cs%debug_BT_HI%jec=g%jec
4064  cs%debug_BT_HI%IscB=g%isc-1
4065  cs%debug_BT_HI%IecB=g%iec
4066  cs%debug_BT_HI%JscB=g%jsc-1
4067  cs%debug_BT_HI%JecB=g%jec
4068  cs%debug_BT_HI%isd=cs%isdw
4069  cs%debug_BT_HI%ied=cs%iedw
4070  cs%debug_BT_HI%jsd=cs%jsdw
4071  cs%debug_BT_HI%jed=cs%jedw
4072  cs%debug_BT_HI%IsdB=cs%isdw-1
4073  cs%debug_BT_HI%IedB=cs%iedw
4074  cs%debug_BT_HI%JsdB=cs%jsdw-1
4075  cs%debug_BT_HI%JedB=cs%jedw
4076  endif
4077 
4078  ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos.
4079  alloc_(cs%IareaT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IareaT(:,:) = 0.0
4080  alloc_(cs%bathyT(cs%isdw:cs%iedw,cs%jsdw:cs%jedw)) ; cs%bathyT(:,:) = gv%Angstrom_m !### Change to 0.0?
4081  alloc_(cs%IdxCu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%IdxCu(:,:) = 0.0
4082  alloc_(cs%IdyCv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%IdyCv(:,:) = 0.0
4083  alloc_(cs%dy_Cu(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw)) ; cs%dy_Cu(:,:) = 0.0
4084  alloc_(cs%dx_Cv(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw)) ; cs%dx_Cv(:,:) = 0.0
4085  do j=g%jsd,g%jed ; do i=g%isd,g%ied
4086  cs%IareaT(i,j) = g%IareaT(i,j)
4087  cs%bathyT(i,j) = g%bathyT(i,j)
4088  enddo ; enddo
4089 
4090  ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without
4091  ! wide halos.
4092  do j=g%jsd,g%jed ; do i=g%IsdB,g%IedB
4093  cs%IdxCu(i,j) = g%IdxCu(i,j) ; cs%dy_Cu(i,j) = g%dy_Cu(i,j)
4094  enddo ; enddo
4095  do j=g%JsdB,g%JedB ; do i=g%isd,g%ied
4096  cs%IdyCv(i,j) = g%IdyCv(i,j) ; cs%dx_Cv(i,j) = g%dx_Cv(i,j)
4097  enddo ; enddo
4098  call create_group_pass(pass_static_data, cs%IareaT, cs%BT_domain, to_all)
4099  call create_group_pass(pass_static_data, cs%bathyT, cs%BT_domain, to_all)
4100  call create_group_pass(pass_static_data, cs%IdxCu, cs%IdyCv, cs%BT_domain, to_all+scalar_pair)
4101  call create_group_pass(pass_static_data, cs%dy_Cu, cs%dx_Cv, cs%BT_domain, to_all+scalar_pair)
4102  call do_group_pass(pass_static_data, cs%BT_domain)
4103 
4104  if (cs%linearized_BT_PV) then
4105  alloc_(cs%q_D(cs%isdw-1:cs%iedw,cs%jsdw-1:cs%jedw))
4106  alloc_(cs%D_u_Cor(cs%isdw-1:cs%iedw,cs%jsdw:cs%jedw))
4107  alloc_(cs%D_v_Cor(cs%isdw:cs%iedw,cs%jsdw-1:cs%jedw))
4108  cs%q_D(:,:) = 0.0 ; cs%D_u_Cor(:,:) = 0.0 ; cs%D_v_Cor(:,:) = 0.0
4109  do j=js,je ; do i=is-1,ie
4110  cs%D_u_Cor(i,j) = 0.5 * (g%bathyT(i+1,j) + g%bathyT(i,j))
4111  enddo ; enddo
4112  do j=js-1,je ; do i=is,ie
4113  cs%D_v_Cor(i,j) = 0.5 * (g%bathyT(i,j+1) + g%bathyT(i,j))
4114  enddo ; enddo
4115  do j=js-1,je ; do i=is-1,ie
4116  if (g%mask2dT(i,j)+g%mask2dT(i,j+1)+g%mask2dT(i+1,j)+g%mask2dT(i+1,j+1)>0.) then
4117  cs%q_D(i,j) = 0.25 * g%CoriolisBu(i,j) * &
4118  ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / &
4119  ((g%areaT(i,j) * g%bathyT(i,j) + g%areaT(i+1,j+1) * g%bathyT(i+1,j+1)) + &
4120  (g%areaT(i+1,j) * g%bathyT(i+1,j) + g%areaT(i,j+1) * g%bathyT(i,j+1)) )
4121  else ! All four h points are masked out so q_D(I,J) will is meaningless
4122  cs%q_D(i,j) = 0.
4123  endif
4124  enddo ; enddo
4125  ! With very wide halos, q and D need to be calculated on the available data
4126  ! domain and then updated onto the full computational domain.
4127  call create_group_pass(pass_q_d_cor, cs%q_D, cs%BT_Domain, to_all, position=corner)
4128  call create_group_pass(pass_q_d_cor, cs%D_u_Cor, cs%D_v_Cor, cs%BT_Domain, &
4129  to_all+scalar_pair)
4130  call do_group_pass(pass_q_d_cor, cs%BT_Domain)
4131  endif
4132 
4133  if (cs%linear_wave_drag) then
4134  alloc_(cs%lin_drag_u(isdb:iedb,jsd:jed)) ; cs%lin_drag_u(:,:) = 0.0
4135  alloc_(cs%lin_drag_v(isd:ied,jsdb:jedb)) ; cs%lin_drag_v(:,:) = 0.0
4136 
4137  if (len_trim(wave_drag_file) > 0) then
4138  inputdir = "." ; call get_param(param_file, mdl, "INPUTDIR", inputdir)
4139  wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file)
4140  call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file)
4141 
4142  allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0
4143 
4144  call mom_read_data(wave_drag_file, wave_drag_var, lin_drag_h, g%Domain, scale=us%m_to_Z*us%T_to_s)
4145  call pass_var(lin_drag_h, g%Domain)
4146  do j=js,je ; do i=is-1,ie
4147  cs%lin_drag_u(i,j) = (gv%Z_to_H * wave_drag_scale) * &
4148  0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j))
4149  enddo ; enddo
4150  do j=js-1,je ; do i=is,ie
4151  cs%lin_drag_v(i,j) = (gv%Z_to_H * wave_drag_scale) * &
4152  0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1))
4153  enddo ; enddo
4154  deallocate(lin_drag_h)
4155  endif
4156  endif
4157 
4158  cs%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) cs%dtbt_fraction = -dtbt_input
4159 
4160  dtbt_tmp = -1.0
4161  if (query_initialized(cs%dtbt, "DTBT", restart_cs)) then
4162  dtbt_tmp = cs%dtbt
4163  if ((us%s_to_T_restart /= 0.0) .and. (us%s_to_T_restart /= us%s_to_T)) &
4164  dtbt_tmp = (us%s_to_T / us%s_to_T_restart) * cs%dtbt
4165  endif
4166 
4167  ! Estimate the maximum stable barotropic time step.
4168  gtot_estimate = 0.0
4169  do k=1,g%ke ; gtot_estimate = gtot_estimate + gv%g_prime(k) ; enddo
4170  call set_dtbt(g, gv, us, cs, gtot_est=gtot_estimate, ssh_add=ssh_extra)
4171 
4172  if (dtbt_input > 0.0) then
4173  cs%dtbt = us%s_to_T * dtbt_input
4174  elseif (dtbt_tmp > 0.0) then
4175  cs%dtbt = dtbt_tmp
4176  endif
4177  if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false.
4178 
4179  call log_param(param_file, mdl, "DTBT as used", cs%dtbt*us%T_to_s)
4180  call log_param(param_file, mdl, "estimated maximum DTBT", cs%dtbt_max*us%T_to_s)
4181 
4182  ! ubtav, vbtav, ubt_IC, vbt_IC, uhbt_IC, and vhbt_IC are allocated and
4183  ! initialized in register_barotropic_restarts.
4184 
4185  if (gv%Boussinesq) then
4186  thickness_units = "m" ; flux_units = "m3 s-1"
4187  else
4188  thickness_units = "kg m-2" ; flux_units = "kg s-1"
4189  endif
4190 
4191  cs%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, time, &
4192  'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
4193  cs%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, time, &
4194  'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
4195  cs%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, time, &
4196  'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
4197  cs%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, time, &
4198  'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
4199  cs%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, time, &
4200  'Barotropic zonal acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
4201  cs%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, time, &
4202  'Barotropic meridional acceleration', 'm s-2', conversion=us%L_T2_to_m_s2)
4203  cs%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, time, &
4204  'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=us%L_T2_to_m_s2)
4205  cs%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, time, &
4206  'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=us%L_T2_to_m_s2)
4207 
4208  cs%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, time, &
4209  'Barotropic end SSH', thickness_units, conversion=gv%H_to_m)
4210  cs%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, time, &
4211  'Barotropic end zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
4212  cs%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, time, &
4213  'Barotropic end meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
4214  cs%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, time, &
4215  'Barotropic start SSH', thickness_units, conversion=gv%H_to_m)
4216  cs%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, time, &
4217  'Barotropic start zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
4218  cs%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, time, &
4219  'Barotropic start meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
4220  cs%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, time, &
4221  'Barotropic time-average zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
4222  cs%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, time, &
4223  'Barotropic time-average meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
4224  cs%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, time, &
4225  'Corrective mass flux', 'm s-1', conversion=gv%H_to_m)
4226  cs%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, time, &
4227  'Viscous remnant at u', 'nondim')
4228  cs%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, time, &
4229  'Viscous remnant at v', 'nondim')
4230  cs%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, time, &
4231  'gtot to North', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
4232  cs%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, time, &
4233  'gtot to South', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
4234  cs%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, time, &
4235  'gtot to East', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
4236  cs%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, time, &
4237  'gtot to West', 'm s-2', conversion=gv%m_to_H*(us%L_T_to_m_s**2))
4238  cs%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, time, &
4239  'High Frequency Barotropic SSH', thickness_units, conversion=gv%H_to_m)
4240  cs%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, time, &
4241  'High Frequency Barotropic zonal velocity', 'm s-1', conversion=us%L_T_to_m_s)
4242  cs%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, time, &
4243  'High Frequency Barotropic meridional velocity', 'm s-1', conversion=us%L_T_to_m_s)
4244  cs%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, time, &
4245  'High Frequency Predictor Barotropic SSH', thickness_units, &
4246  conversion=gv%H_to_m)
4247  cs%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, time, &
4248  'High Frequency Barotropic zonal transport', 'm3 s-1', &
4249  conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
4250  cs%id_vhbt_hifreq = register_diag_field('ocean_model', 'vhbt_hifreq', diag%axesCv1, time, &
4251  'High Frequency Barotropic meridional transport', 'm3 s-1', &
4252  conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
4253  cs%id_frhatu = register_diag_field('ocean_model', 'frhatu', diag%axesCuL, time, &
4254  'Fractional thickness of layers in u-columns', 'nondim')
4255  cs%id_frhatv = register_diag_field('ocean_model', 'frhatv', diag%axesCvL, time, &
4256  'Fractional thickness of layers in v-columns', 'nondim')
4257  cs%id_frhatu1 = register_diag_field('ocean_model', 'frhatu1', diag%axesCuL, time, &
4258  'Predictor Fractional thickness of layers in u-columns', 'nondim')
4259  cs%id_frhatv1 = register_diag_field('ocean_model', 'frhatv1', diag%axesCvL, time, &
4260  'Predictor Fractional thickness of layers in v-columns', 'nondim')
4261  cs%id_uhbt = register_diag_field('ocean_model', 'uhbt', diag%axesCu1, time, &
4262  'Barotropic zonal transport averaged over a baroclinic step', 'm3 s-1', &
4263  conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
4264  cs%id_vhbt = register_diag_field('ocean_model', 'vhbt', diag%axesCv1, time, &
4265  'Barotropic meridional transport averaged over a baroclinic step', 'm3 s-1', &
4266  conversion=gv%H_to_m*us%L_to_m*us%L_T_to_m_s)
4267 
4268  if (use_bt_cont_type) then
4269  cs%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, time, &
4270  'BTCont type far east face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4271  cs%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, time, &
4272  'BTCont type near east face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4273  cs%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, time, &
4274  'BTCont type far west face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4275  cs%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, time, &
4276  'BTCont type near west face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4277  cs%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, time, &
4278  'BTCont type far east velocity', 'm s-1', conversion=us%L_T_to_m_s)
4279  cs%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, time, &
4280  'BTCont type far west velocity', 'm s-1', conversion=us%L_T_to_m_s)
4281  cs%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, time, &
4282  'BTCont type far north face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4283  cs%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, time, &
4284  'BTCont type near north face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4285  cs%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, time, &
4286  'BTCont type far south face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4287  cs%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, time, &
4288  'BTCont type near south face area', 'm2', conversion=us%L_to_m*gv%H_to_m)
4289  cs%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, time, &
4290  'BTCont type far north velocity', 'm s-1', conversion=us%L_T_to_m_s)
4291  cs%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, time, &
4292  'BTCont type far south velocity', 'm s-1', conversion=us%L_T_to_m_s)
4293  endif
4294  cs%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, time, &
4295  'Barotropic zonal transport difference', 'm3 s-1', conversion=gv%H_to_m*us%L_to_m**2*us%s_to_T)
4296  cs%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, time, &
4297  'Barotropic meridional transport difference', 'm3 s-1', conversion=gv%H_to_m*us%L_to_m**2*us%s_to_T)
4298 
4299  if (cs%id_frhatu1 > 0) call safe_alloc_ptr(cs%frhatu1, isdb,iedb,jsd,jed,nz)
4300  if (cs%id_frhatv1 > 0) call safe_alloc_ptr(cs%frhatv1, isd,ied,jsdb,jedb,nz)
4301 
4302  if (.NOT.query_initialized(cs%ubtav,"ubtav",restart_cs) .or. &
4303  .NOT.query_initialized(cs%vbtav,"vbtav",restart_cs)) then
4304  call btcalc(h, g, gv, cs, may_use_default=.true.)
4305  cs%ubtav(:,:) = 0.0 ; cs%vbtav(:,:) = 0.0
4306  do k=1,nz ; do j=js,je ; do i=is-1,ie
4307  cs%ubtav(i,j) = cs%ubtav(i,j) + cs%frhatu(i,j,k) * u(i,j,k)
4308  enddo ; enddo ; enddo
4309  do k=1,nz ; do j=js-1,je ; do i=is,ie
4310  cs%vbtav(i,j) = cs%vbtav(i,j) + cs%frhatv(i,j,k) * v(i,j,k)
4311  enddo ; enddo ; enddo
4312  elseif ((us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
4313  (us%m_to_L*us%s_to_T_restart) /= (us%m_to_L_restart*us%s_to_T)) then
4314  vel_rescale = (us%m_to_L*us%s_to_T_restart) / (us%m_to_L_restart*us%s_to_T)
4315  do j=js,je ; do i=is-1,ie ; cs%ubtav(i,j) = vel_rescale * cs%ubtav(i,j) ; enddo ; enddo
4316  do j=js-1,je ; do i=is,ie ; cs%vbtav(i,j) = vel_rescale * cs%vbtav(i,j) ; enddo ; enddo
4317  endif
4318 
4319  if (.NOT.query_initialized(cs%ubt_IC,"ubt_IC",restart_cs) .or. &
4320  .NOT.query_initialized(cs%vbt_IC,"vbt_IC",restart_cs)) then
4321  do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = cs%ubtav(i,j) ; enddo ; enddo
4322  do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = cs%vbtav(i,j) ; enddo ; enddo
4323  elseif ((us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
4324  (us%m_to_L*us%s_to_T_restart) /= (us%m_to_L_restart*us%s_to_T)) then
4325  vel_rescale = (us%m_to_L*us%s_to_T_restart) / (us%m_to_L_restart*us%s_to_T)
4326  do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = vel_rescale * cs%ubt_IC(i,j) ; enddo ; enddo
4327  do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = vel_rescale * cs%vbt_IC(i,j) ; enddo ; enddo
4328  endif
4329 
4330 ! Calculate other constants which are used for btstep.
4331 
4332  do j=js,je ; do i=is-1,ie
4333  if (g%mask2dCu(i,j)>0.) then
4334  cs%IDatu(i,j) = g%mask2dCu(i,j) * 2.0 / (g%bathyT(i+1,j) + g%bathyT(i,j))
4335  else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless
4336  cs%IDatu(i,j) = 0.
4337  endif
4338  enddo ; enddo
4339  do j=js-1,je ; do i=is,ie
4340  if (g%mask2dCv(i,j)>0.) then
4341  cs%IDatv(i,j) = g%mask2dCv(i,j) * 2.0 / (g%bathyT(i,j+1) + g%bathyT(i,j))
4342  else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless
4343  cs%IDatv(i,j) = 0.
4344  endif
4345  enddo ; enddo
4346 
4347  call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=1)
4348  if (cs%bound_BT_corr) then
4349  ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt)
4350  ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt)
4351  do j=js,je ; do i=is,ie
4352  cs%eta_cor_bound(i,j) = gv%m_to_H * g%IareaT(i,j) * 0.1 * cs%maxvel * &
4353  ((datu(i-1,j) + datu(i,j)) + (datv(i,j) + datv(i,j-1)))
4354  enddo ; enddo
4355  endif
4356 
4357  if (.NOT.query_initialized(cs%uhbt_IC,"uhbt_IC",restart_cs) .or. &
4358  .NOT.query_initialized(cs%vhbt_IC,"vhbt_IC",restart_cs)) then
4359  do j=js,je ; do i=is-1,ie ; cs%uhbt_IC(i,j) = cs%ubtav(i,j) * datu(i,j) ; enddo ; enddo
4360  do j=js-1,je ; do i=is,ie ; cs%vhbt_IC(i,j) = cs%vbtav(i,j) * datv(i,j) ; enddo ; enddo
4361  elseif ((us%s_to_T_restart * us%m_to_L_restart * gv%m_to_H_restart /= 0.0) .and. &
4362  ((us%s_to_T_restart * us%m_to_L**2 * gv%m_to_H) /= &
4363  (us%s_to_T * us%m_to_L_restart**2 * gv%m_to_H_restart))) then
4364  uh_rescale = (us%s_to_T_restart * us%m_to_L**2 * gv%m_to_H) / &
4365  (us%s_to_T * us%m_to_L_restart**2 * gv%m_to_H_restart)
4366  do j=js,je ; do i=is-1,ie ; cs%uhbt_IC(i,j) = uh_rescale * cs%uhbt_IC(i,j) ; enddo ; enddo
4367  do j=js-1,je ; do i=is,ie ; cs%vhbt_IC(i,j) = uh_rescale * cs%vhbt_IC(i,j) ; enddo ; enddo
4368  endif
4369 
4370  call create_group_pass(pass_bt_hbt_btav, cs%ubt_IC, cs%vbt_IC, g%Domain)
4371  call create_group_pass(pass_bt_hbt_btav, cs%uhbt_IC, cs%vhbt_IC, g%Domain)
4372  call create_group_pass(pass_bt_hbt_btav, cs%ubtav, cs%vbtav, g%Domain)
4373  call do_group_pass(pass_bt_hbt_btav, g%Domain)
4374 
4375 ! id_clock_pass = cpu_clock_id('(Ocean BT halo updates)', grain=CLOCK_ROUTINE)
4376  id_clock_calc_pre = cpu_clock_id('(Ocean BT pre-calcs only)', grain=clock_routine)
4377  id_clock_pass_pre = cpu_clock_id('(Ocean BT pre-step halo updates)', grain=clock_routine)
4378  id_clock_calc = cpu_clock_id('(Ocean BT stepping calcs only)', grain=clock_routine)
4379  id_clock_pass_step = cpu_clock_id('(Ocean BT stepping halo updates)', grain=clock_routine)
4380  id_clock_calc_post = cpu_clock_id('(Ocean BT post-calcs only)', grain=clock_routine)
4381  id_clock_pass_post = cpu_clock_id('(Ocean BT post-step halo updates)', grain=clock_routine)
4382  if (dtbt_input <= 0.0) &
4383  id_clock_sync = cpu_clock_id('(Ocean BT global synch)', grain=clock_routine)
4384 

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_contThe BT_cont_type input to the barotropic solver.
[in]msA type that describes the memory sizes of the argument arrays.
[out]datuThe effective zonal face area [H L ~> m2 or kg m-1].
[out]datvThe effective meridional face area [H L ~> m2 or kg m-1].
[in]gThe ocean's grid structure.
[in]usA dimensional unit scaling type
[in]haloThe extra halo size to use here.
[in]maximizeIf present and true, find the maximum face area for any velocity.

Definition at line 3493 of file MOM_barotropic.F90.

3493  type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the
3494  !! barotropic solver.
3495  type(memory_size_type), intent(in) :: MS !< A type that describes the memory
3496  !! sizes of the argument arrays.
3497  real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
3498  intent(out) :: Datu !< The effective zonal face area [H L ~> m2 or kg m-1].
3499  real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
3500  intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1].
3501  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3502  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3503  integer, optional, intent(in) :: halo !< The extra halo size to use here.
3504  logical, optional, intent(in) :: maximize !< If present and true, find the
3505  !! maximum face area for any velocity.
3506 
3507  ! Local variables
3508  logical :: find_max
3509  integer :: i, j, is, ie, js, je, hs
3510  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
3511  hs = 1 ; if (present(halo)) hs = max(halo,0)
3512  find_max = .false. ; if (present(maximize)) find_max = maximize
3513 
3514  if (find_max) then
3515  do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
3516  datu(i,j) = max(bt_cont%FA_u_EE(i,j), bt_cont%FA_u_E0(i,j), &
3517  bt_cont%FA_u_W0(i,j), bt_cont%FA_u_WW(i,j))
3518  enddo ; enddo
3519  do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
3520  datv(i,j) = max(bt_cont%FA_v_NN(i,j), bt_cont%FA_v_N0(i,j), &
3521  bt_cont%FA_v_S0(i,j), bt_cont%FA_v_SS(i,j))
3522  enddo ; enddo
3523  else
3524  do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
3525  datu(i,j) = 0.5 * (bt_cont%FA_u_E0(i,j) + bt_cont%FA_u_W0(i,j))
3526  enddo ; enddo
3527  do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
3528  datv(i,j) = 0.5 * (bt_cont%FA_v_N0(i,j) + bt_cont%FA_v_S0(i,j))
3529  enddo ; enddo
3530  endif
3531 

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]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]hLayer thicknesses [H ~> m or kg m-2].
[in]etaThe free surface height that is to be corrected [H ~> m or kg m-2].
[in]set_corA 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.
csThe control structure returned by a previous call to barotropic_init.

Definition at line 3643 of file MOM_barotropic.F90.

3643  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3644  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3645  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
3646  real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be
3647  !! corrected [H ~> m or kg m-2].
3648  logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective
3649  !! fluxes (and update the slowly varying part of eta_cor)
3650  !! (.true.) or whether to incrementally update the
3651  !! corrective fluxes.
3652  type(barotropic_CS), pointer :: CS !< The control structure returned by a previous call
3653  !! to barotropic_init.
3654 
3655  ! Local variables
3656  real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses [H ~> m or kg m-2].
3657  real :: eta_h(SZI_(G)) ! The free surface height determined from
3658  ! the sum of the layer thicknesses [H ~> m or kg m-2].
3659  real :: d_eta ! The difference between estimates of the total
3660  ! thicknesses [H ~> m or kg m-2].
3661  integer :: is, ie, js, je, nz, i, j, k
3662  real, parameter :: frac_cor = 0.25
3663  real, parameter :: slow_rate = 0.125
3664 
3665  if (.not.associated(cs)) call mom_error(fatal, "bt_mass_source: "// &
3666  "Module MOM_barotropic must be initialized before it is used.")
3667  if (.not.cs%split) return
3668 
3669  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
3670 
3671  !$OMP parallel do default(shared) private(eta_h,h_tot,d_eta)
3672  do j=js,je
3673  do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo
3674  if (gv%Boussinesq) then
3675  do i=is,ie ; eta_h(i) = h(i,j,1) - g%bathyT(i,j)*gv%Z_to_H ; enddo
3676  else
3677  do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo
3678  endif
3679  do k=2,nz ; do i=is,ie
3680  eta_h(i) = eta_h(i) + h(i,j,k)
3681  h_tot(i) = h_tot(i) + h(i,j,k)
3682  enddo ; enddo
3683 
3684  if (set_cor) then
3685  do i=is,ie
3686  d_eta = eta_h(i) - eta(i,j)
3687  cs%eta_cor(i,j) = d_eta
3688  enddo
3689  else
3690  do i=is,ie
3691  d_eta = eta_h(i) - eta(i,j)
3692  cs%eta_cor(i,j) = cs%eta_cor(i,j) + d_eta
3693  enddo
3694  endif
3695  enddo
3696 

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]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]hLayer thicknesses [H ~> m or kg m-2].
csThe control structure returned by a previous call to barotropic_init.
[in]h_uThe specified thicknesses at u-points [H ~> m or kg m-2].
[in]h_vThe specified thicknesses at v-points [H ~> m or kg m-2].
[in]may_use_defaultAn 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.
obcOpen boundary control structure.

Definition at line 2762 of file MOM_barotropic.F90.

2762  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
2763  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
2764  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
2765  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
2766  type(barotropic_CS), pointer :: CS !< The control structure returned by a previous
2767  !! call to barotropic_init.
2768  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
2769  optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2].
2770  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
2771  optional, intent(in) :: h_v !< The specified thicknesses at v-points [H ~> m or kg m-2].
2772  logical, optional, intent(in) :: may_use_default !< An optional logical argument
2773  !! to indicate that the default velocity point
2774  !! thicknesses may be used for this particular
2775  !! calculation, even though the setting of
2776  !! CS%hvel_scheme would usually require that h_u
2777  !! and h_v be passed in.
2778  type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure.
2779 
2780  ! Local variables
2781  real :: hatutot(SZIB_(G)) ! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2].
2782  real :: hatvtot(SZI_(G)) ! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2].
2783  real :: Ihatutot(SZIB_(G)) ! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1].
2784  real :: Ihatvtot(SZI_(G)) ! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1].
2785  real :: h_arith ! The arithmetic mean thickness [H ~> m or kg m-2].
2786  real :: h_harm ! The harmonic mean thicknesses [H ~> m or kg m-2].
2787  real :: h_neglect ! A thickness that is so small it is usually lost
2788  ! in roundoff and can be neglected [H ~> m or kg m-2].
2789  real :: wt_arith ! The nondimensional weight for the arithmetic mean thickness.
2790  ! The harmonic mean uses a weight of (1 - wt_arith).
2791  real :: Rh ! A ratio of summed thicknesses, nondim.
2792  real :: e_u(SZIB_(G),SZK_(G)+1) ! The interface heights at u-velocity and
2793  real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points [H ~> m or kg m-2].
2794  real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths [H ~> m or kg m-2].
2795  real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths [H ~> m or kg m-2].
2796  real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2].
2797  real :: Ihtot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1].
2798 
2799  logical :: use_default, test_dflt, apply_OBCs
2800  integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k
2801  integer :: iss, ies, n
2802 
2803 ! This section interpolates thicknesses onto u & v grid points with the
2804 ! second order accurate estimate h = 2*(h+ * h-)/(h+ + h-).
2805  if (.not.associated(cs)) call mom_error(fatal, &
2806  "btcalc: Module MOM_barotropic must be initialized before it is used.")
2807  if (.not.cs%split) return
2808 
2809  use_default = .false.
2810  test_dflt = .false. ; if (present(may_use_default)) test_dflt = may_use_default
2811 
2812  if (test_dflt) then
2813  if (.not.((present(h_u) .and. present(h_v)) .or. &
2814  (cs%hvel_scheme == harmonic) .or. (cs%hvel_scheme == hybrid) .or.&
2815  (cs%hvel_scheme == arithmetic))) use_default = .true.
2816  else
2817  if (.not.((present(h_u) .and. present(h_v)) .or. &
2818  (cs%hvel_scheme == harmonic) .or. (cs%hvel_scheme == hybrid) .or.&
2819  (cs%hvel_scheme == arithmetic))) call mom_error(fatal, &
2820  "btcalc: Inconsistent settings of optional arguments and hvel_scheme.")
2821  endif
2822 
2823  apply_obcs = .false.
2824  if (present(obc)) then ; if (associated(obc)) then ; if (obc%OBC_pe) then
2825  ! Some open boundary condition points might be in this processor's symmetric
2826  ! computational domain.
2827  apply_obcs = (obc%number_of_segments > 0)
2828  endif ; endif ; endif
2829 
2830  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
2831  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
2832  h_neglect = gv%H_subroundoff
2833 
2834  ! This estimates the fractional thickness of each layer at the velocity
2835  ! points, using a harmonic mean estimate.
2836 !$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) &
2837 !$OMP private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith)
2838 
2839  do j=js,je
2840  if (present(h_u)) then
2841  do i=is-1,ie ; hatutot(i) = h_u(i,j,1) ; enddo
2842  do k=2,nz ; do i=is-1,ie
2843  hatutot(i) = hatutot(i) + h_u(i,j,k)
2844  enddo ; enddo
2845  do i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h_neglect) ; enddo
2846  do k=1,nz ; do i=is-1,ie
2847  cs%frhatu(i,j,k) = h_u(i,j,k) * ihatutot(i)
2848  enddo ; enddo
2849  else
2850  if (cs%hvel_scheme == arithmetic) then
2851  do i=is-1,ie
2852  cs%frhatu(i,j,1) = 0.5 * (h(i+1,j,1) + h(i,j,1))
2853  hatutot(i) = cs%frhatu(i,j,1)
2854  enddo
2855  do k=2,nz ; do i=is-1,ie
2856  cs%frhatu(i,j,k) = 0.5 * (h(i+1,j,k) + h(i,j,k))
2857  hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
2858  enddo ; enddo
2859  elseif (cs%hvel_scheme == hybrid .or. use_default) then
2860  do i=is-1,ie
2861  e_u(i,nz+1) = -0.5 * gv%Z_to_H * (g%bathyT(i+1,j) + g%bathyT(i,j))
2862  d_shallow_u(i) = -gv%Z_to_H * min(g%bathyT(i+1,j), g%bathyT(i,j))
2863  hatutot(i) = 0.0
2864  enddo
2865  do k=nz,1,-1 ; do i=is-1,ie
2866  e_u(i,k) = e_u(i,k+1) + 0.5 * (h(i+1,j,k) + h(i,j,k))
2867  h_arith = 0.5 * (h(i+1,j,k) + h(i,j,k))
2868  if (e_u(i,k+1) >= d_shallow_u(i)) then
2869  cs%frhatu(i,j,k) = h_arith
2870  else
2871  h_harm = (h(i+1,j,k) * h(i,j,k)) / (h_arith + h_neglect)
2872  if (e_u(i,k) <= d_shallow_u(i)) then
2873  cs%frhatu(i,j,k) = h_harm
2874  else
2875  wt_arith = (e_u(i,k) - d_shallow_u(i)) / (h_arith + h_neglect)
2876  cs%frhatu(i,j,k) = wt_arith*h_arith + (1.0-wt_arith)*h_harm
2877  endif
2878  endif
2879  hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
2880  enddo ; enddo
2881  elseif (cs%hvel_scheme == harmonic) then
2882  do i=is-1,ie
2883  cs%frhatu(i,j,1) = 2.0*(h(i+1,j,1) * h(i,j,1)) / &
2884  ((h(i+1,j,1) + h(i,j,1)) + h_neglect)
2885  hatutot(i) = cs%frhatu(i,j,1)
2886  enddo
2887  do k=2,nz ; do i=is-1,ie
2888  cs%frhatu(i,j,k) = 2.0*(h(i+1,j,k) * h(i,j,k)) / &
2889  ((h(i+1,j,k) + h(i,j,k)) + h_neglect)
2890  hatutot(i) = hatutot(i) + cs%frhatu(i,j,k)
2891  enddo ; enddo
2892  endif
2893  do i=is-1,ie ; ihatutot(i) = g%mask2dCu(i,j) / (hatutot(i) + h_neglect) ; enddo
2894  do k=1,nz ; do i=is-1,ie
2895  cs%frhatu(i,j,k) = cs%frhatu(i,j,k) * ihatutot(i)
2896  enddo ; enddo
2897  endif
2898  enddo
2899 
2900 !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) &
2901 !$OMP private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith)
2902  do j=js-1,je
2903  if (present(h_v)) then
2904  do i=is,ie ; hatvtot(i) = h_v(i,j,1) ; enddo
2905  do k=2,nz ; do i=is,ie
2906  hatvtot(i) = hatvtot(i) + h_v(i,j,k)
2907  enddo ; enddo
2908  do i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect) ; enddo
2909  do k=1,nz ; do i=is,ie
2910  cs%frhatv(i,j,k) = h_v(i,j,k) * ihatvtot(i)
2911  enddo ; enddo
2912  else
2913  if (cs%hvel_scheme == arithmetic) then
2914  do i=is,ie
2915  cs%frhatv(i,j,1) = 0.5 * (h(i,j+1,1) + h(i,j,1))
2916  hatvtot(i) = cs%frhatv(i,j,1)
2917  enddo
2918  do k=2,nz ; do i=is,ie
2919  cs%frhatv(i,j,k) = 0.5 * (h(i,j+1,k) + h(i,j,k))
2920  hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
2921  enddo ; enddo
2922  elseif (cs%hvel_scheme == hybrid .or. use_default) then
2923  do i=is,ie
2924  e_v(i,nz+1) = -0.5 * gv%Z_to_H * (g%bathyT(i,j+1) + g%bathyT(i,j))
2925  d_shallow_v(i) = -gv%Z_to_H * min(g%bathyT(i,j+1), g%bathyT(i,j))
2926  hatvtot(i) = 0.0
2927  enddo
2928  do k=nz,1,-1 ; do i=is,ie
2929  e_v(i,k) = e_v(i,k+1) + 0.5 * (h(i,j+1,k) + h(i,j,k))
2930  h_arith = 0.5 * (h(i,j+1,k) + h(i,j,k))
2931  if (e_v(i,k+1) >= d_shallow_v(i)) then
2932  cs%frhatv(i,j,k) = h_arith
2933  else
2934  h_harm = (h(i,j+1,k) * h(i,j,k)) / (h_arith + h_neglect)
2935  if (e_v(i,k) <= d_shallow_v(i)) then
2936  cs%frhatv(i,j,k) = h_harm
2937  else
2938  wt_arith = (e_v(i,k) - d_shallow_v(i)) / (h_arith + h_neglect)
2939  cs%frhatv(i,j,k) = wt_arith*h_arith + (1.0-wt_arith)*h_harm
2940  endif
2941  endif
2942  hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
2943  enddo ; enddo
2944  elseif (cs%hvel_scheme == harmonic) then
2945  do i=is,ie
2946  cs%frhatv(i,j,1) = 2.0*(h(i,j+1,1) * h(i,j,1)) / &
2947  ((h(i,j+1,1) + h(i,j,1)) + h_neglect)
2948  hatvtot(i) = cs%frhatv(i,j,1)
2949  enddo
2950  do k=2,nz ; do i=is,ie
2951  cs%frhatv(i,j,k) = 2.0*(h(i,j+1,k) * h(i,j,k)) / &
2952  ((h(i,j+1,k) + h(i,j,k)) + h_neglect)
2953  hatvtot(i) = hatvtot(i) + cs%frhatv(i,j,k)
2954  enddo ; enddo
2955  endif
2956  do i=is,ie ; ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect) ; enddo
2957  do k=1,nz ; do i=is,ie
2958  cs%frhatv(i,j,k) = cs%frhatv(i,j,k) * ihatvtot(i)
2959  enddo ; enddo
2960  endif
2961  enddo
2962 
2963  if (apply_obcs) then ; do n=1,obc%number_of_segments ! Test for segment type?
2964  if (.not. obc%segment(n)%on_pe) cycle
2965  if (obc%segment(n)%direction == obc_direction_n) then
2966  j = obc%segment(n)%HI%JsdB
2967  if ((j >= js-1) .and. (j <= je)) then
2968  iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied)
2969  do i=iss,ies ; hatvtot(i) = h(i,j,1) ; enddo
2970  do k=2,nz ; do i=iss,ies
2971  hatvtot(i) = hatvtot(i) + h(i,j,k)
2972  enddo ; enddo
2973  do i=iss,ies
2974  ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect)
2975  enddo
2976  do k=1,nz ; do i=iss,ies
2977  cs%frhatv(i,j,k) = h(i,j,k) * ihatvtot(i)
2978  enddo ; enddo
2979  endif
2980  elseif (obc%segment(n)%direction == obc_direction_s) then
2981  j = obc%segment(n)%HI%JsdB
2982  if ((j >= js-1) .and. (j <= je)) then
2983  iss = max(is,obc%segment(n)%HI%isd) ; ies = min(ie,obc%segment(n)%HI%ied)
2984  do i=iss,ies ; hatvtot(i) = h(i,j+1,1) ; enddo
2985  do k=2,nz ; do i=iss,ies
2986  hatvtot(i) = hatvtot(i) + h(i,j+1,k)
2987  enddo ; enddo
2988  do i=iss,ies
2989  ihatvtot(i) = g%mask2dCv(i,j) / (hatvtot(i) + h_neglect)
2990  enddo
2991  do k=1,nz ; do i=iss,ies
2992  cs%frhatv(i,j,k) = h(i,j+1,k) * ihatvtot(i)
2993  enddo ; enddo
2994  endif
2995  elseif (obc%segment(n)%direction == obc_direction_e) then
2996  i = obc%segment(n)%HI%IsdB
2997  if ((i >= is-1) .and. (i <= ie)) then
2998  do j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed)
2999  htot = h(i,j,1)
3000  do k=2,nz ; htot = htot + h(i,j,k) ; enddo
3001  ihtot = g%mask2dCu(i,j) / (htot + h_neglect)
3002  do k=1,nz ; cs%frhatu(i,j,k) = h(i,j,k) * ihtot ; enddo
3003  enddo
3004  endif
3005  elseif (obc%segment(n)%direction == obc_direction_w) then
3006  i = obc%segment(n)%HI%IsdB
3007  if ((i >= is-1) .and. (i <= ie)) then
3008  do j = max(js,obc%segment(n)%HI%jsd), min(je,obc%segment(n)%HI%jed)
3009  htot = h(i+1,j,1)
3010  do k=2,nz ; htot = htot + h(i+1,j,k) ; enddo
3011  ihtot = g%mask2dCu(i,j) / (htot + h_neglect)
3012  do k=1,nz ; cs%frhatu(i,j,k) = h(i+1,j,k) * ihtot ; enddo
3013  enddo
3014  endif
3015  else
3016  call mom_error(fatal, "btcalc encountered and OBC segment of indeterminate direction.")
3017  endif
3018  enddo ; endif
3019 
3020  if (cs%debug) then
3021  call uvchksum("btcalc frhat[uv]", cs%frhatu, cs%frhatv, g%HI, 0, .true., .true.)
3022  if (present(h_u) .and. present(h_v)) &
3023  call uvchksum("btcalc h_[uv]", h_u, h_v, g%HI, 0, .true., .true., scale=gv%H_to_m)
3024  call hchksum(h, "btcalc h",g%HI, haloshift=1, scale=gv%H_to_m)
3025  endif
3026 

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]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]usA dimensional unit scaling type
[in]u_inThe initial (3-D) zonal velocity [L T-1 ~> m s-1].
[in]v_inThe initial (3-D) meridional velocity [L T-1 ~> m s-1].
[in]eta_inThe initial barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in]dtThe time increment to integrate over [T ~> s].
[in]bc_accel_uThe zonal baroclinic accelerations, [L T-2 ~> m s-2].
[in]bc_accel_vThe meridional baroclinic accelerations, [L T-2 ~> m s-2].
[in]forcesA structure with the driving mechanical forces
[in]pbceThe 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_inThe 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_corThe (3-D) zonal velocities used to calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
[in]v_corThe (3-D) meridional velocities used to calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
[out]accel_layer_uThe zonal acceleration of each layer due to the barotropic calculation [L T-2 ~> m s-2].
[out]accel_layer_vThe meridional acceleration of each layer due to the barotropic calculation [L T-2 ~> m s-2].
[out]eta_outThe final barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[out]uhbtavthe barotropic zonal volume or mass fluxes averaged through the barotropic steps [H L2 T-1 ~> m3 or kg s-1].
[out]vhbtavthe barotropic meridional volume or mass fluxes averaged through the barotropic steps [H L2 T-1 ~> m3 or kg s-1].
csThe control structure returned by a previous call to barotropic_init.
[in]visc_rem_uBoth 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_vDitto for meridional direction [nondim].
[out]etaavThe free surface height or column mass averaged over the barotropic integration [H ~> m or kg m-2].
obcThe open boundary condition structure.
bt_contA structure with elements that describe the effective open face areas as a function of barotropic flow.
eta_pf_startThe eta field consistent with the pressure gradient at the start of the barotropic stepping [H ~> m or kg m-2].
taux_botThe zonal bottom frictional stress from ocean to the seafloor [R L Z T-2 ~> Pa].
tauy_botThe meridional bottom frictional stress from ocean to the seafloor [R L Z T-2 ~> Pa].
uh0The zonal layer transports at reference velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
u_uh0The velocities used to calculate uh0 [L T-1 ~> m s-1]
vh0The zonal layer transports at reference velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
v_vh0The velocities used to calculate vh0 [L T-1 ~> m s-1]

Definition at line 388 of file MOM_barotropic.F90.

388  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
389  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
390  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
391  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal
392  !! velocity [L T-1 ~> m s-1].
393  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional
394  !! velocity [L T-1 ~> m s-1].
395  real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height
396  !! anomaly or column mass anomaly [H ~> m or kg m-2].
397  real, intent(in) :: dt !< The time increment to integrate over [T ~> s].
398  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations,
399  !! [L T-2 ~> m s-2].
400  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations,
401  !! [L T-2 ~> m s-2].
402  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
403  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer
404  !! due to free surface height anomalies
405  !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
406  real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or
407  !! column mass anomaly) that was used to calculate the input
408  !! pressure gradient accelerations (or its final value if
409  !! eta_PF_start is provided [H ~> m or kg m-2].
410  !! Note: eta_in, pbce, and eta_PF_in must have up-to-date
411  !! values in the first point of their halos.
412  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to
413  !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
414  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to
415  !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1].
416  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due
417  !! to the barotropic calculation [L T-2 ~> m s-2].
418  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer
419  !! due to the barotropic calculation [L T-2 ~> m s-2].
420  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface
421  !! height anomaly or column mass anomaly [H ~> m or kg m-2].
422  real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass
423  !! fluxes averaged through the barotropic steps
424  !! [H L2 T-1 ~> m3 or kg s-1].
425  real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass
426  !! fluxes averaged through the barotropic steps
427  !! [H L2 T-1 ~> m3 or kg s-1].
428  type(barotropic_CS), pointer :: CS !< The control structure returned by a
429  !! previous call to barotropic_init.
430  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum
431  !! originally in a layer that remains after a time-step of
432  !! viscosity, and the fraction of a time-step's worth of a
433  !! barotropic acceleration that a layer experiences after
434  !! viscosity is applied, in the zonal direction. Nondimensional
435  !! between 0 (at the bottom) and 1 (far above the bottom).
436  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim].
437  real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass
438  !! averaged over the barotropic integration [H ~> m or kg m-2].
439  type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure.
440  type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe
441  !! the effective open face areas as a function of barotropic
442  !! flow.
443  real, dimension(:,:), optional, pointer :: eta_PF_start !< The eta field consistent with the pressure
444  !! gradient at the start of the barotropic stepping
445  !! [H ~> m or kg m-2].
446  real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from
447  !! ocean to the seafloor [R L Z T-2 ~> Pa].
448  real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress
449  !! from ocean to the seafloor [R L Z T-2 ~> Pa].
450  real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference
451  !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
452  real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate
453  !! uh0 [L T-1 ~> m s-1]
454  real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference
455  !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
456  real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate
457  !! vh0 [L T-1 ~> m s-1]
458 
459  ! Local variables
460  real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been
461  real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis
462  ! terms [L T-1 ~> m s-1].
463  real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the
464  real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to
465  ! be used in calculating barotropic velocities, possibly with
466  ! sums less than one due to viscous losses. Nondimensional.
467  real, dimension(SZIB_(G),SZJ_(G)) :: &
468  av_rem_u, & ! The weighted average of visc_rem_u, nondimensional.
469  tmp_u ! A temporary array at u points.
470  real, dimension(SZI_(G),SZJB_(G)) :: &
471  av_rem_v, & ! The weighted average of visc_rem_v, nondimensional.
472  tmp_v ! A temporary array at v points.
473  real, dimension(SZI_(G),SZJ_(G)) :: &
474  e_anom ! The anomaly in the sea surface height or column mass
475  ! averaged between the beginning and end of the time step,
476  ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2].
477 
478  ! These are always allocated with symmetric memory and wide halos.
479  real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1].
480  real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
481  ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1].
482  bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains
483  ! after a time step, the remainder being lost to bottom drag.
484  ! bt_rem_u is a nondimensional number between 0 and 1.
485  bt_force_u, & ! The vertical average of all of the u-accelerations that are
486  ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
487  u_accel_bt, & ! The difference between the zonal acceleration from the
488  ! barotropic calculation and BT_force_u [L T-2 ~> m s-2].
489  uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
490  uhbt0, & ! The difference between the sum of the layer zonal thickness
491  ! fluxes and the barotropic thickness flux using the same
492  ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1].
493  ubt_old, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1].
494  ubt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
495  ubt_sum, & ! The sum of ubt over the time steps [L T-1 ~> m s-1].
496  uhbt_sum, & ! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
497  ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1].
498  ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1].
499  azon, bzon, & ! _zon & _mer are the values of the Coriolis force which
500  czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav,
501  amer, bmer, & ! respectively to get the barotropic inertial rotation
502  cmer, dmer, & ! [T-1 ~> s-1].
503  cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2].
504  cor_ref_u, & ! The zonal barotropic Coriolis acceleration due
505  ! to the reference velocities [L T-2 ~> m s-2].
506  pfu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2].
507  rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1].
508  pfu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2].
509  coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2].
510  dcor_u, & ! A simply averaged depth at u points [Z ~> m].
511  datu ! Basin depth at u-velocity grid points times the y-grid
512  ! spacing [H L ~> m2 or kg m-1].
513  real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
514  vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1].
515  bt_rem_v, & ! The fraction of the barotropic meridional velocity that
516  ! remains after a time step, the rest being lost to bottom
517  ! drag. bt_rem_v is a nondimensional number between 0 and 1.
518  bt_force_v, & ! The vertical average of all of the v-accelerations that are
519  ! not explicitly included in the barotropic equation [L T-2 ~> m s-2].
520  v_accel_bt, & ! The difference between the meridional acceleration from the
521  ! barotropic calculation and BT_force_v [L T-2 ~> m s-2].
522  vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1].
523  vhbt0, & ! The difference between the sum of the layer meridional
524  ! thickness fluxes and the barotropic thickness flux using
525  ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1].
526  vbt_old, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1].
527  vbt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1].
528  vbt_sum, & ! The sum of vbt over the time steps [L T-1 ~> m s-1].
529  vhbt_sum, & ! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1].
530  vbt_wtd, & ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1].
531  vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1].
532  cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2].
533  cor_ref_v, & ! The meridional barotropic Coriolis acceleration due
534  ! to the reference velocities [L T-2 ~> m s-2].
535  pfv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2].
536  rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1].
537  pfv_bt_sum, & ! The summed meridional barotropic pressure gradient force,
538  ! [L T-2 ~> m s-2].
539  corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration,
540  ! [L T-2 ~> m s-2].
541  dcor_v, & ! A simply averaged depth at v points [Z ~> m].
542  datv ! Basin depth at v-velocity grid points times the x-grid
543  ! spacing [H L ~> m2 or kg m-1].
544  real, target, dimension(SZIW_(CS),SZJW_(CS)) :: &
545  eta, & ! The barotropic free surface height anomaly or column mass
546  ! anomaly [H ~> m or kg m-2]
547  eta_pred ! A predictor value of eta [H ~> m or kg m-2] like eta.
548  real, dimension(:,:), pointer :: &
549  eta_PF_BT ! A pointer to the eta array (either eta or eta_pred) that
550  ! determines the barotropic pressure force [H ~> m or kg m-2]
551  real, dimension(SZIW_(CS),SZJW_(CS)) :: &
552  eta_sum, & ! eta summed across the timesteps [H ~> m or kg m-2].
553  eta_wtd, & ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2].
554  eta_PF, & ! A local copy of the 2-D eta field (either SSH anomaly or
555  ! column mass anomaly) that was used to calculate the input
556  ! pressure gradient accelerations [H ~> m or kg m-2].
557  eta_pf_1, & ! The initial value of eta_PF, when interp_eta_PF is
558  ! true [H ~> m or kg m-2].
559  d_eta_pf, & ! The change in eta_PF over the barotropic time stepping when
560  ! interp_eta_PF is true [H ~> m or kg m-2].
561  gtot_e, & ! gtot_X is the effective total reduced gravity used to relate
562  gtot_w, & ! free surface height deviations to pressure forces (including
563  gtot_n, & ! GFS and baroclinic contributions) in the barotropic momentum
564  gtot_s, & ! equations half a grid-point in the X-direction (X is N, S, E, or W)
565  ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
566  ! (See Hallberg, J Comp Phys 1997 for a discussion.)
567  eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2].
568  dyn_coef_eta, & ! The coefficient relating the changes in eta to the
569  ! dynamic surface pressure under rigid ice
570  ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
571  p_surf_dyn ! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2].
572  type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: &
573  BTCL_u ! A repackaged version of the u-point information in BT_cont.
574  type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: &
575  BTCL_v ! A repackaged version of the v-point information in BT_cont.
576  ! End of wide-sized variables.
577 
578  real, dimension(SZIBW_(CS),SZJW_(CS)) :: &
579  ubt_prev, uhbt_prev, ubt_sum_prev, uhbt_sum_prev, ubt_wtd_prev ! for OBC
580  real, dimension(SZIW_(CS),SZJBW_(CS)) :: &
581  vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC
582 
583  real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m-1 R-1 ~> m3 kg-1].
584  real :: mass_accel_to_Z ! The inverse of the mean density (Rho0) [R-1 ~> m3 kg-1].
585  real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim.
586  real :: vel_prev ! The previous velocity [L T-1 ~> m s-1].
587  real :: dtbt ! The barotropic time step [T ~> s].
588  real :: bebt ! A copy of CS%bebt [nondim].
589  real :: be_proj ! The fractional amount by which velocities are projected
590  ! when project_velocity is true. For now be_proj is set
591  ! to equal bebt, as they have similar roles and meanings.
592  real :: Idt ! The inverse of dt [T-1 ~> s-1].
593  real :: det_de ! The partial derivative due to self-attraction and loading
594  ! of the reference geopotential with the sea surface height.
595  ! This is typically ~0.09 or less.
596  real :: dgeo_de ! The constant of proportionality between geopotential and
597  ! sea surface height. It is a nondimensional number of
598  ! order 1. For stability, this may be made larger
599  ! than physical problem would suggest.
600  real :: Instep ! The inverse of the number of barotropic time steps
601  ! to take.
602  real :: wt_end ! The weighting of the final value of eta_PF [nondim]
603  integer :: nstep ! The number of barotropic time steps to take.
604  type(time_type) :: &
605  time_bt_start, & ! The starting time of the barotropic steps.
606  time_step_end, & ! The end time of a barotropic step.
607  time_end_in ! The end time for diagnostics when this routine started.
608  real :: time_int_in ! The diagnostics' time interval when this routine started.
609  logical :: do_hifreq_output ! If true, output occurs every barotropic step.
610  logical :: use_BT_cont, do_ave, find_etaav, find_PF, find_Cor
611  logical :: ice_is_rigid, nonblock_setup, interp_eta_PF
612  logical :: project_velocity, add_uh0
613 
614  real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta
615  ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1].
616  real :: ice_strength = 0.0 ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2].
617  real :: Idt_max2 ! The squared inverse of the local maximum stable
618  ! barotropic time step [T-2 ~> s-2].
619  real :: H_min_dyn ! The minimum depth to use in limiting the size of the
620  ! dynamic surface pressure for stability [H ~> m or kg m-2].
621  real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing
622  ! squared [H L-2 ~> m-1 or kg m-4].
623  real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1].
624  real :: Htot ! The total thickness [H ~> m or kg m-2].
625  real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2].
626  real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2].
627 
628  real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2
629  real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans
630  real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans
631  real :: dt_filt ! The half-width of the barotropic filter [T ~> s].
632  real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans
633  integer :: nfilter
634 
635  logical :: apply_OBCs, apply_OBC_flather, apply_OBC_open
636  type(memory_size_type) :: MS
637  character(len=200) :: mesg
638  integer :: isv, iev, jsv, jev ! The valid array size at the end of a step.
639  integer :: stencil ! The stencil size of the algorithm, often 1 or 2.
640  integer :: isvf, ievf, jsvf, jevf, num_cycles
641  integer :: i, j, k, n
642  integer :: is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq
643  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
644  integer :: ioff, joff
645 
646  if (.not.associated(cs)) call mom_error(fatal, &
647  "btstep: Module MOM_barotropic must be initialized before it is used.")
648  if (.not.cs%split) return
649  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
650  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
651  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
652  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
653  ms%isdw = cs%isdw ; ms%iedw = cs%iedw ; ms%jsdw = cs%jsdw ; ms%jedw = cs%jedw
654 
655  idt = 1.0 / dt
656  accel_underflow = cs%vel_underflow * idt
657 
658  use_bt_cont = .false.
659  if (present(bt_cont)) use_bt_cont = (associated(bt_cont))
660 
661  interp_eta_pf = .false.
662  if (present(eta_pf_start)) interp_eta_pf = (associated(eta_pf_start))
663 
664  project_velocity = cs%BT_project_velocity
665 
666  ! Figure out the fullest arrays that could be updated.
667  stencil = 1
668  if ((.not.use_bt_cont) .and. cs%Nonlinear_continuity .and. &
669  (cs%Nonlin_cont_update_period > 0)) stencil = 2
670 
671  do_ave = query_averaging_enabled(cs%diag)
672  find_etaav = present(etaav)
673  find_pf = (do_ave .and. ((cs%id_PFu_bt > 0) .or. (cs%id_PFv_bt > 0)))
674  find_cor = (do_ave .and. ((cs%id_Coru_bt > 0) .or. (cs%id_Corv_bt > 0)))
675 
676  add_uh0 = .false.
677  if (present(uh0)) add_uh0 = associated(uh0)
678  if (add_uh0 .and. .not.(present(vh0) .and. present(u_uh0) .and. &
679  present(v_vh0))) call mom_error(fatal, &
680  "btstep: vh0, u_uh0, and v_vh0 must be present if uh0 is used.")
681  if (add_uh0 .and. .not.(associated(vh0) .and. associated(u_uh0) .and. &
682  associated(v_vh0))) call mom_error(fatal, &
683  "btstep: vh0, u_uh0, and v_vh0 must be associated if uh0 is used.")
684 
685  ! This can be changed to try to optimize the performance.
686  nonblock_setup = g%nonblocking_updates
687 
688  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
689 
690  apply_obcs = .false. ; cs%BT_OBC%apply_u_OBCs = .false. ; cs%BT_OBC%apply_v_OBCs = .false.
691  apply_obc_open = .false.
692  apply_obc_flather = .false.
693  if (present(obc)) then ; if (associated(obc)) then
694  cs%BT_OBC%apply_u_OBCs = obc%open_u_BCs_exist_globally .or. obc%specified_u_BCs_exist_globally
695  cs%BT_OBC%apply_v_OBCs = obc%open_v_BCs_exist_globally .or. obc%specified_v_BCs_exist_globally
696  apply_obc_flather = open_boundary_query(obc, apply_flather_obc=.true.)
697  apply_obc_open = open_boundary_query(obc, apply_open_obc=.true.)
698  apply_obcs = open_boundary_query(obc, apply_specified_obc=.true.) .or. &
699  apply_obc_flather .or. apply_obc_open
700 
701  if (apply_obc_flather .and. .not.gv%Boussinesq) call mom_error(fatal, &
702  "btstep: Flather open boundary conditions have not yet been "// &
703  "implemented for a non-Boussinesq model.")
704  endif ; endif
705 
706  num_cycles = 1
707  if (cs%use_wide_halos) &
708  num_cycles = min((is-cs%isdw) / stencil, (js-cs%jsdw) / stencil)
709  isvf = is - (num_cycles-1)*stencil ; ievf = ie + (num_cycles-1)*stencil
710  jsvf = js - (num_cycles-1)*stencil ; jevf = je + (num_cycles-1)*stencil
711 
712  nstep = ceiling(dt/cs%dtbt - 0.0001)
713  if (is_root_pe() .and. (nstep /= cs%nstep_last)) then
714  write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, &
715  & " seconds, max ", ES12.6, ".")') (us%T_to_s*dt/nstep), us%T_to_s*cs%dtbt_max
716  call mom_mesg(mesg, 3)
717  endif
718  cs%nstep_last = nstep
719 
720  ! Set the actual barotropic time step.
721  instep = 1.0 / real(nstep)
722  dtbt = dt * instep
723  bebt = cs%bebt
724  be_proj = cs%bebt
725  mass_accel_to_z = 1.0 / gv%Rho0
726  mass_to_z = us%m_to_Z / gv%Rho0
727 
728  !--- setup the weight when computing vbt_trans and ubt_trans
729  if (project_velocity) then
730  trans_wt1 = (1.0 + be_proj); trans_wt2 = -be_proj
731  else
732  trans_wt1 = bebt ; trans_wt2 = (1.0-bebt)
733  endif
734 
735  do_hifreq_output = .false.
736  if ((cs%id_ubt_hifreq > 0) .or. (cs%id_vbt_hifreq > 0) .or. &
737  (cs%id_eta_hifreq > 0) .or. (cs%id_eta_pred_hifreq > 0) .or. &
738  (cs%id_uhbt_hifreq > 0) .or. (cs%id_vhbt_hifreq > 0)) then
739  do_hifreq_output = query_averaging_enabled(cs%diag, time_int_in, time_end_in)
740  if (do_hifreq_output) &
741  time_bt_start = time_end_in - real_to_time(us%T_to_s*dt)
742  endif
743 
744 !--- begin setup for group halo update
745  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
746  if (.not. cs%linearized_BT_PV) then
747  call create_group_pass(cs%pass_q_DCor, q, cs%BT_Domain, to_all, position=corner)
748  call create_group_pass(cs%pass_q_DCor, dcor_u, dcor_v, cs%BT_Domain, &
749  to_all+scalar_pair)
750  endif
751  if ((isq > is-1) .or. (jsq > js-1)) &
752  call create_group_pass(cs%pass_tmp_uv, tmp_u, tmp_v, g%Domain)
753  call create_group_pass(cs%pass_gtot, gtot_e, gtot_n, cs%BT_Domain, &
754  to_all+scalar_pair, agrid)
755  call create_group_pass(cs%pass_gtot, gtot_w, gtot_s, cs%BT_Domain, &
756  to_all+scalar_pair, agrid)
757 
758  if (cs%dynamic_psurf) &
759  call create_group_pass(cs%pass_eta_bt_rem, dyn_coef_eta, cs%BT_Domain)
760  if (interp_eta_pf) then
761  call create_group_pass(cs%pass_eta_bt_rem, eta_pf_1, cs%BT_Domain)
762  call create_group_pass(cs%pass_eta_bt_rem, d_eta_pf, cs%BT_Domain)
763  else
764  call create_group_pass(cs%pass_eta_bt_rem, eta_pf, cs%BT_Domain)
765  endif
766  call create_group_pass(cs%pass_eta_bt_rem, eta_src, cs%BT_Domain)
767  ! The following halo updates are not needed without wide halos. RWH
768  ! We do need them after all.
769 ! if (ievf > ie) then
770  call create_group_pass(cs%pass_eta_bt_rem, bt_rem_u, bt_rem_v, &
771  cs%BT_Domain, to_all+scalar_pair)
772  if (cs%linear_wave_drag) &
773  call create_group_pass(cs%pass_eta_bt_rem, rayleigh_u, rayleigh_v, &
774  cs%BT_Domain, to_all+scalar_pair)
775 ! endif
776  ! The following halo update is not needed without wide halos. RWH
777  if (((g%isd > cs%isdw) .or. (g%jsd > cs%jsdw)) .or. (isq <= is-1) .or. (jsq <= js-1)) &
778  call create_group_pass(cs%pass_force_hbt0_Cor_ref, bt_force_u, bt_force_v, cs%BT_Domain)
779  if (add_uh0) call create_group_pass(cs%pass_force_hbt0_Cor_ref, uhbt0, vhbt0, cs%BT_Domain)
780  call create_group_pass(cs%pass_force_hbt0_Cor_ref, cor_ref_u, cor_ref_v, cs%BT_Domain)
781  if (.not. use_bt_cont) then
782  call create_group_pass(cs%pass_Dat_uv, datu, datv, cs%BT_Domain, to_all+scalar_pair)
783  endif
784  call create_group_pass(cs%pass_eta_ubt, eta, cs%BT_Domain)
785  call create_group_pass(cs%pass_eta_ubt, ubt, vbt, cs%BT_Domain)
786 
787  call create_group_pass(cs%pass_ubt_Cor, ubt_cor, vbt_cor, g%Domain)
788  ! These passes occur at the end of the routine, as data is being readied to
789  ! share with the main part of the MOM6 code.
790  if (find_etaav) then
791  call create_group_pass(cs%pass_etaav, etaav, g%Domain)
792  endif
793  call create_group_pass(cs%pass_e_anom, e_anom, g%Domain)
794  call create_group_pass(cs%pass_ubta_uhbta, cs%ubtav, cs%vbtav, g%Domain)
795  call create_group_pass(cs%pass_ubta_uhbta, uhbtav, vhbtav, g%Domain)
796 
797  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
798 !--- end setup for group halo update
799 
800 ! Calculate the constant coefficients for the Coriolis force terms in the
801 ! barotropic momentum equations. This has to be done quite early to start
802 ! the halo update that needs to be completed before the next calculations.
803  if (cs%linearized_BT_PV) then
804  !$OMP parallel do default(shared)
805  do j=jsvf-2,jevf+1 ; do i=isvf-2,ievf+1
806  q(i,j) = cs%q_D(i,j)
807  enddo ; enddo
808  !$OMP parallel do default(shared)
809  do j=jsvf-1,jevf+1 ; do i=isvf-2,ievf+1
810  dcor_u(i,j) = cs%D_u_Cor(i,j)
811  enddo ; enddo
812  !$OMP parallel do default(shared)
813  do j=jsvf-2,jevf+1 ; do i=isvf-1,ievf+1
814  dcor_v(i,j) = cs%D_v_Cor(i,j)
815  enddo ; enddo
816  else
817  q(:,:) = 0.0 ; dcor_u(:,:) = 0.0 ; dcor_v(:,:) = 0.0
818  ! This option has not yet been written properly.
819  ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous).
820  !$OMP parallel do default(shared)
821  do j=js,je ; do i=is-1,ie
822  dcor_u(i,j) = 0.5 * (g%bathyT(i+1,j) + g%bathyT(i,j))
823  enddo ; enddo
824  !$OMP parallel do default(shared)
825  do j=js-1,je ; do i=is,ie
826  dcor_v(i,j) = 0.5 * (g%bathyT(i,j+1) + g%bathyT(i,j))
827  enddo ; enddo
828  !$OMP parallel do default(shared)
829  do j=js-1,je ; do i=is-1,ie
830  q(i,j) = 0.25 * g%CoriolisBu(i,j) * &
831  ((g%areaT(i,j) + g%areaT(i+1,j+1)) + (g%areaT(i+1,j) + g%areaT(i,j+1))) / &
832  ((g%areaT(i,j) * g%bathyT(i,j) + g%areaT(i+1,j+1) * g%bathyT(i+1,j+1)) + &
833  (g%areaT(i+1,j) * g%bathyT(i+1,j) + g%areaT(i,j+1) * g%bathyT(i,j+1)) )
834  enddo ; enddo
835 
836  ! With very wide halos, q and D need to be calculated on the available data
837  ! domain and then updated onto the full computational domain.
838  ! These calculations can be done almost immediately, but the halo updates
839  ! must be done before the [abcd]mer and [abcd]zon are calculated.
840  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
841  if (nonblock_setup) then
842  call start_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
843  else
844  call do_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
845  endif
846  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
847  endif
848 
849  ! Zero out various wide-halo arrays.
850  !$OMP parallel do default(shared)
851  do j=cs%jsdw,cs%jedw ; do i=cs%isdw,cs%iedw
852  gtot_e(i,j) = 0.0 ; gtot_w(i,j) = 0.0
853  gtot_n(i,j) = 0.0 ; gtot_s(i,j) = 0.0
854  eta(i,j) = 0.0
855  eta_pf(i,j) = 0.0
856  if (interp_eta_pf) then
857  eta_pf_1(i,j) = 0.0 ; d_eta_pf(i,j) = 0.0
858  endif
859  p_surf_dyn(i,j) = 0.0
860  if (cs%dynamic_psurf) dyn_coef_eta(i,j) = 0.0
861  enddo ; enddo
862  ! The halo regions of various arrays need to be initialized to
863  ! non-NaNs in case the neighboring domains are not part of the ocean.
864  ! Otherwise a halo update later on fills in the correct values.
865  !$OMP parallel do default(shared)
866  do j=cs%jsdw,cs%jedw ; do i=cs%isdw-1,cs%iedw
867  cor_ref_u(i,j) = 0.0 ; bt_force_u(i,j) = 0.0 ; ubt(i,j) = 0.0
868  datu(i,j) = 0.0 ; bt_rem_u(i,j) = 0.0 ; uhbt0(i,j) = 0.0
869  enddo ; enddo
870  !$OMP parallel do default(shared)
871  do j=cs%jsdw-1,cs%jedw ; do i=cs%isdw,cs%iedw
872  cor_ref_v(i,j) = 0.0 ; bt_force_v(i,j) = 0.0 ; vbt(i,j) = 0.0
873  datv(i,j) = 0.0 ; bt_rem_v(i,j) = 0.0 ; vhbt0(i,j) = 0.0
874  enddo ; enddo
875 
876  ! Copy input arrays into their wide-halo counterparts.
877  if (interp_eta_pf) then
878  !$OMP parallel do default(shared)
879  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?
880  eta(i,j) = eta_in(i,j)
881  eta_pf_1(i,j) = eta_pf_start(i,j)
882  d_eta_pf(i,j) = eta_pf_in(i,j) - eta_pf_start(i,j)
883  enddo ; enddo
884  else
885  !$OMP parallel do default(shared)
886  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?
887  eta(i,j) = eta_in(i,j)
888  eta_pf(i,j) = eta_pf_in(i,j)
889  enddo ; enddo
890  endif
891 
892  !$OMP parallel do default(shared) private(visc_rem)
893  do k=1,nz ; do j=js,je ; do i=is-1,ie
894  ! rem needs greater than visc_rem_u and 1-Instep/visc_rem_u.
895  ! The 0.5 below is just for safety.
896  if (visc_rem_u(i,j,k) <= 0.0) then ; visc_rem = 0.0
897  elseif (visc_rem_u(i,j,k) >= 1.0) then ; visc_rem = 1.0
898  elseif (visc_rem_u(i,j,k)**2 > visc_rem_u(i,j,k) - 0.5*instep) then
899  visc_rem = visc_rem_u(i,j,k)
900  else ; visc_rem = 1.0 - 0.5*instep/visc_rem_u(i,j,k) ; endif
901  wt_u(i,j,k) = cs%frhatu(i,j,k) * visc_rem
902  enddo ; enddo ; enddo
903  !$OMP parallel do default(shared) private(visc_rem)
904  do k=1,nz ; do j=js-1,je ; do i=is,ie
905  ! rem needs greater than visc_rem_v and 1-Instep/visc_rem_v.
906  if (visc_rem_v(i,j,k) <= 0.0) then ; visc_rem = 0.0
907  elseif (visc_rem_v(i,j,k) >= 1.0) then ; visc_rem = 1.0
908  elseif (visc_rem_v(i,j,k)**2 > visc_rem_v(i,j,k) - 0.5*instep) then
909  visc_rem = visc_rem_v(i,j,k)
910  else ; visc_rem = 1.0 - 0.5*instep/visc_rem_v(i,j,k) ; endif
911  wt_v(i,j,k) = cs%frhatv(i,j,k) * visc_rem
912  enddo ; enddo ; enddo
913 
914  ! Use u_Cor and v_Cor as the reference values for the Coriolis terms,
915  ! including the viscous remnant.
916  !$OMP parallel do default(shared)
917  do j=js-1,je+1 ; do i=is-1,ie ; ubt_cor(i,j) = 0.0 ; enddo ; enddo
918  !$OMP parallel do default(shared)
919  do j=js-1,je ; do i=is-1,ie+1 ; vbt_cor(i,j) = 0.0 ; enddo ; enddo
920  !$OMP parallel do default(shared)
921  do j=js,je ; do k=1,nz ; do i=is-1,ie
922  ubt_cor(i,j) = ubt_cor(i,j) + wt_u(i,j,k) * u_cor(i,j,k)
923  enddo ; enddo ; enddo
924  !$OMP parallel do default(shared)
925  do j=js-1,je ; do k=1,nz ; do i=is,ie
926  vbt_cor(i,j) = vbt_cor(i,j) + wt_v(i,j,k) * v_cor(i,j,k)
927  enddo ; enddo ; enddo
928 
929  ! The gtot arrays are the effective layer-weighted reduced gravities for
930  ! accelerations across the various faces, with names for the relative
931  ! locations of the faces to the pressure point. They will have their halos
932  ! updated later on.
933  !$OMP parallel do default(shared)
934  do j=js,je
935  do k=1,nz ; do i=is-1,ie
936  gtot_e(i,j) = gtot_e(i,j) + pbce(i,j,k) * wt_u(i,j,k)
937  gtot_w(i+1,j) = gtot_w(i+1,j) + pbce(i+1,j,k) * wt_u(i,j,k)
938  enddo ; enddo
939  enddo
940  !$OMP parallel do default(shared)
941  do j=js-1,je
942  do k=1,nz ; do i=is,ie
943  gtot_n(i,j) = gtot_n(i,j) + pbce(i,j,k) * wt_v(i,j,k)
944  gtot_s(i,j+1) = gtot_s(i,j+1) + pbce(i,j+1,k) * wt_v(i,j,k)
945  enddo ; enddo
946  enddo
947 
948  if (cs%tides) then
949  call tidal_forcing_sensitivity(g, cs%tides_CSp, det_de)
950  dgeo_de = 1.0 + det_de + cs%G_extra
951  else
952  dgeo_de = 1.0 + cs%G_extra
953  endif
954 
955  if (nonblock_setup .and. .not.cs%linearized_BT_PV) then
956  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
957  call complete_group_pass(cs%pass_q_DCor, cs%BT_Domain, clock=id_clock_pass_pre)
958  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
959  endif
960 
961  ! Calculate the open areas at the velocity points.
962  ! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor.
963  if (use_bt_cont) then
964  call set_local_bt_cont_types(bt_cont, btcl_u, btcl_v, g, us, ms, cs%BT_Domain, 1+ievf-ie)
965  else
966  if (cs%Nonlinear_continuity) then
967  call find_face_areas(datu, datv, g, gv, us, cs, ms, eta, 1)
968  else
969  call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=1)
970  endif
971  endif
972 
973  ! Set up fields related to the open boundary conditions.
974  if (apply_obcs) then
975  call set_up_bt_obc(obc, eta, cs%BT_OBC, cs%BT_Domain, g, gv, us, ms, ievf-ie, use_bt_cont, &
976  datu, datv, btcl_u, btcl_v)
977  endif
978 
979 ! Here the vertical average accelerations due to the Coriolis, advective,
980 ! pressure gradient and horizontal viscous terms in the layer momentum
981 ! equations are calculated. These will be used to determine the difference
982 ! between the accelerations due to the average of the layer equations and the
983 ! barotropic calculation.
984 
985  !$OMP parallel do default(shared)
986  do j=js,je ; do i=is-1,ie
987  ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
988  ! ### although with BT_cont_types IDatu should be replaced by
989  ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds).
990  bt_force_u(i,j) = forces%taux(i,j) * mass_accel_to_z * cs%IDatu(i,j)*visc_rem_u(i,j,1)
991  enddo ; enddo
992  !$OMP parallel do default(shared)
993  do j=js-1,je ; do i=is,ie
994  ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous).
995  ! ### although with BT_cont_types IDatv should be replaced by
996  ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds).
997  bt_force_v(i,j) = forces%tauy(i,j) * mass_accel_to_z * cs%IDatv(i,j)*visc_rem_v(i,j,1)
998  enddo ; enddo
999  if (present(taux_bot) .and. present(tauy_bot)) then
1000  if (associated(taux_bot) .and. associated(tauy_bot)) then
1001  !$OMP parallel do default(shared)
1002  do j=js,je ; do i=is-1,ie
1003  bt_force_u(i,j) = bt_force_u(i,j) - taux_bot(i,j) * mass_to_z * cs%IDatu(i,j)
1004  enddo ; enddo
1005  !$OMP parallel do default(shared)
1006  do j=js-1,je ; do i=is,ie
1007  bt_force_v(i,j) = bt_force_v(i,j) - tauy_bot(i,j) * mass_to_z * cs%IDatv(i,j)
1008  enddo ; enddo
1009  endif
1010  endif
1011 
1012  ! bc_accel_u & bc_accel_v are only available on the potentially
1013  ! non-symmetric computational domain.
1014  !$OMP parallel do default(shared)
1015  do j=js,je ; do k=1,nz ; do i=isq,ieq
1016  bt_force_u(i,j) = bt_force_u(i,j) + wt_u(i,j,k) * bc_accel_u(i,j,k)
1017  enddo ; enddo ; enddo
1018  !$OMP parallel do default(shared)
1019  do j=jsq,jeq ; do k=1,nz ; do i=is,ie
1020  bt_force_v(i,j) = bt_force_v(i,j) + wt_v(i,j,k) * bc_accel_v(i,j,k)
1021  enddo ; enddo ; enddo
1022 
1023  ! Determine the difference between the sum of the layer fluxes and the
1024  ! barotropic fluxes found from the same input velocities.
1025  if (add_uh0) then
1026  !$OMP parallel do default(shared)
1027  do j=js,je ; do i=is-1,ie ; uhbt(i,j) = 0.0 ; ubt(i,j) = 0.0 ; enddo ; enddo
1028  !$OMP parallel do default(shared)
1029  do j=js-1,je ; do i=is,ie ; vhbt(i,j) = 0.0 ; vbt(i,j) = 0.0 ; enddo ; enddo
1030  if (cs%visc_rem_u_uh0) then
1031  !$OMP parallel do default(shared)
1032  do j=js,je ; do k=1,nz ; do i=is-1,ie
1033  uhbt(i,j) = uhbt(i,j) + uh0(i,j,k)
1034  ubt(i,j) = ubt(i,j) + wt_u(i,j,k) * u_uh0(i,j,k)
1035  enddo ; enddo ; enddo
1036  !$OMP parallel do default(shared)
1037  do j=js-1,je ; do k=1,nz ; do i=is,ie
1038  vhbt(i,j) = vhbt(i,j) + vh0(i,j,k)
1039  vbt(i,j) = vbt(i,j) + wt_v(i,j,k) * v_vh0(i,j,k)
1040  enddo ; enddo ; enddo
1041  else
1042  !$OMP parallel do default(shared)
1043  do j=js,je ; do k=1,nz ; do i=is-1,ie
1044  uhbt(i,j) = uhbt(i,j) + uh0(i,j,k)
1045  ubt(i,j) = ubt(i,j) + cs%frhatu(i,j,k) * u_uh0(i,j,k)
1046  enddo ; enddo ; enddo
1047  !$OMP parallel do default(shared)
1048  do j=js-1,je ; do k=1,nz ; do i=is,ie
1049  vhbt(i,j) = vhbt(i,j) + vh0(i,j,k)
1050  vbt(i,j) = vbt(i,j) + cs%frhatv(i,j,k) * v_vh0(i,j,k)
1051  enddo ; enddo ; enddo
1052  endif
1053  if (use_bt_cont) then
1054  if (cs%adjust_BT_cont) then
1055  ! Use the additional input transports to broaden the fits
1056  ! over which the bt_cont_type applies.
1057 
1058  ! Fill in the halo data for ubt, vbt, uhbt, and vhbt.
1059  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1060  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1061  call pass_vector(ubt, vbt, cs%BT_Domain, complete=.false., halo=1+ievf-ie)
1062  call pass_vector(uhbt, vhbt, cs%BT_Domain, complete=.true., halo=1+ievf-ie)
1063  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1064  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1065 
1066  call adjust_local_bt_cont_types(ubt, uhbt, vbt, vhbt, btcl_u, btcl_v, &
1067  g, us, ms, 1+ievf-ie)
1068  endif
1069  !$OMP parallel do default(shared)
1070  do j=js,je ; do i=is-1,ie
1071  uhbt0(i,j) = uhbt(i,j) - find_uhbt(ubt(i,j), btcl_u(i,j), us)
1072  enddo ; enddo
1073  !$OMP parallel do default(shared)
1074  do j=js-1,je ; do i=is,ie
1075  vhbt0(i,j) = vhbt(i,j) - find_vhbt(vbt(i,j), btcl_v(i,j), us)
1076  enddo ; enddo
1077  else
1078  !$OMP parallel do default(shared)
1079  do j=js,je ; do i=is-1,ie
1080  uhbt0(i,j) = uhbt(i,j) - datu(i,j)*ubt(i,j)
1081  enddo ; enddo
1082  !$OMP parallel do default(shared)
1083  do j=js-1,je ; do i=is,ie
1084  vhbt0(i,j) = vhbt(i,j) - datv(i,j)*vbt(i,j)
1085  enddo ; enddo
1086  endif
1087  if (cs%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary
1088  !$OMP parallel do default(shared)
1089  do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
1090  uhbt0(i,j) = 0.0
1091  endif ; enddo ; enddo
1092  endif
1093  if (cs%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary
1094  !$OMP parallel do default(shared)
1095  do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
1096  vhbt0(i,j) = 0.0
1097  endif ; enddo ; enddo
1098  endif
1099  endif
1100 
1101 ! Calculate the initial barotropic velocities from the layer's velocities.
1102  !$OMP parallel do default(shared)
1103  do j=jsvf-1,jevf+1 ; do i=isvf-2,ievf+1
1104  ubt(i,j) = 0.0 ; uhbt(i,j) = 0.0 ; u_accel_bt(i,j) = 0.0
1105  enddo ; enddo
1106  !$OMP parallel do default(shared)
1107  do j=jsvf-2,jevf+1 ; do i=isvf-1,ievf+1
1108  vbt(i,j) = 0.0 ; vhbt(i,j) = 0.0 ; v_accel_bt(i,j) = 0.0
1109  enddo ; enddo
1110  !$OMP parallel do default(shared)
1111  do j=js,je ; do k=1,nz ; do i=is-1,ie
1112  ubt(i,j) = ubt(i,j) + wt_u(i,j,k) * u_in(i,j,k)
1113  enddo ; enddo ; enddo
1114  !$OMP parallel do default(shared)
1115  do j=js-1,je ; do k=1,nz ; do i=is,ie
1116  vbt(i,j) = vbt(i,j) + wt_v(i,j,k) * v_in(i,j,k)
1117  enddo ; enddo ; enddo
1118  !$OMP parallel do default(shared)
1119  do j=js,je ; do i=is-1,ie
1120  if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
1121  enddo ; enddo
1122  !$OMP parallel do default(shared)
1123  do j=js-1,je ; do i=is,ie
1124  if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
1125  enddo ; enddo
1126 
1127  if (apply_obcs) then
1128  ubt_first(:,:) = ubt(:,:) ; vbt_first(:,:) = vbt(:,:)
1129  endif
1130 
1131  if (cs%gradual_BT_ICs) then
1132  !$OMP parallel do default(shared)
1133  do j=js,je ; do i=is-1,ie
1134  bt_force_u(i,j) = bt_force_u(i,j) + (ubt(i,j) - cs%ubt_IC(i,j)) * idt
1135  ubt(i,j) = cs%ubt_IC(i,j)
1136  if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
1137  enddo ; enddo
1138  !$OMP parallel do default(shared)
1139  do j=js-1,je ; do i=is,ie
1140  bt_force_v(i,j) = bt_force_v(i,j) + (vbt(i,j) - cs%vbt_IC(i,j)) * idt
1141  vbt(i,j) = cs%vbt_IC(i,j)
1142  if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
1143  enddo ; enddo
1144  endif
1145 
1146  if ((isq > is-1) .or. (jsq > js-1)) then
1147  ! Non-symmetric memory is being used, so the edge values need to be
1148  ! filled in with a halo update of a non-symmetric array.
1149  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1150  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1151  tmp_u(:,:) = 0.0 ; tmp_v(:,:) = 0.0
1152  do j=js,je ; do i=isq,ieq ; tmp_u(i,j) = bt_force_u(i,j) ; enddo ; enddo
1153  do j=jsq,jeq ; do i=is,ie ; tmp_v(i,j) = bt_force_v(i,j) ; enddo ; enddo
1154  if (nonblock_setup) then
1155  call start_group_pass(cs%pass_tmp_uv, g%Domain)
1156  else
1157  call do_group_pass(cs%pass_tmp_uv, g%Domain)
1158  do j=jsd,jed ; do i=isdb,iedb ; bt_force_u(i,j) = tmp_u(i,j) ; enddo ; enddo
1159  do j=jsdb,jedb ; do i=isd,ied ; bt_force_v(i,j) = tmp_v(i,j) ; enddo ; enddo
1160  endif
1161  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1162  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1163  endif
1164 
1165  if (nonblock_setup) then
1166  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1167  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1168  call start_group_pass(cs%pass_gtot, cs%BT_Domain)
1169  call start_group_pass(cs%pass_ubt_Cor, g%Domain)
1170  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1171  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1172  endif
1173 
1174  ! Determine the weighted Coriolis parameters for the neighboring velocities.
1175  !$OMP parallel do default(shared)
1176  do j=jsvf-1,jevf ; do i=isvf-1,ievf+1
1177  if (cs%Sadourny) then
1178  amer(i-1,j) = dcor_u(i-1,j) * q(i-1,j)
1179  bmer(i,j) = dcor_u(i,j) * q(i,j)
1180  cmer(i,j+1) = dcor_u(i,j+1) * q(i,j)
1181  dmer(i-1,j+1) = dcor_u(i-1,j+1) * q(i-1,j)
1182  else
1183  amer(i-1,j) = dcor_u(i-1,j) * &
1184  ((q(i,j) + q(i-1,j-1)) + q(i-1,j)) / 3.0
1185  bmer(i,j) = dcor_u(i,j) * &
1186  (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0
1187  cmer(i,j+1) = dcor_u(i,j+1) * &
1188  (q(i,j) + (q(i-1,j) + q(i,j+1))) / 3.0
1189  dmer(i-1,j+1) = dcor_u(i-1,j+1) * &
1190  ((q(i,j) + q(i-1,j+1)) + q(i-1,j)) / 3.0
1191  endif
1192  enddo ; enddo
1193 
1194  !$OMP parallel do default(shared)
1195  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf
1196  if (cs%Sadourny) then
1197  azon(i,j) = dcor_v(i+1,j) * q(i,j)
1198  bzon(i,j) = dcor_v(i,j) * q(i,j)
1199  czon(i,j) = dcor_v(i,j-1) * q(i,j-1)
1200  dzon(i,j) = dcor_v(i+1,j-1) * q(i,j-1)
1201  else
1202  azon(i,j) = dcor_v(i+1,j) * &
1203  (q(i,j) + (q(i+1,j) + q(i,j-1))) / 3.0
1204  bzon(i,j) = dcor_v(i,j) * &
1205  (q(i,j) + (q(i-1,j) + q(i,j-1))) / 3.0
1206  czon(i,j) = dcor_v(i,j-1) * &
1207  ((q(i,j) + q(i-1,j-1)) + q(i,j-1)) / 3.0
1208  dzon(i,j) = dcor_v(i+1,j-1) * &
1209  ((q(i,j) + q(i+1,j-1)) + q(i,j-1)) / 3.0
1210  endif
1211  enddo ; enddo
1212 
1213 ! Complete the previously initiated message passing.
1214  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1215  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1216  if (nonblock_setup) then
1217  if ((isq > is-1) .or. (jsq > js-1)) then
1218  call complete_group_pass(cs%pass_tmp_uv, g%Domain)
1219  do j=jsd,jed ; do i=isdb,iedb ; bt_force_u(i,j) = tmp_u(i,j) ; enddo ; enddo
1220  do j=jsdb,jedb ; do i=isd,ied ; bt_force_v(i,j) = tmp_v(i,j) ; enddo ; enddo
1221  endif
1222  call complete_group_pass(cs%pass_gtot, cs%BT_Domain)
1223  call complete_group_pass(cs%pass_ubt_Cor, g%Domain)
1224  else
1225  call do_group_pass(cs%pass_gtot, cs%BT_Domain)
1226  call do_group_pass(cs%pass_ubt_Cor, g%Domain)
1227  endif
1228  ! The various elements of gtot are positive definite but directional, so use
1229  ! the polarity arrays to sort out when the directions have shifted.
1230  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
1231  if (cs%ua_polarity(i,j) < 0.0) call swap(gtot_e(i,j), gtot_w(i,j))
1232  if (cs%va_polarity(i,j) < 0.0) call swap(gtot_n(i,j), gtot_s(i,j))
1233  enddo ; enddo
1234 
1235  !$OMP parallel do default(shared)
1236  do j=js,je ; do i=is-1,ie
1237  cor_ref_u(i,j) = &
1238  ((azon(i,j) * vbt_cor(i+1,j) + czon(i,j) * vbt_cor(i ,j-1)) + &
1239  (bzon(i,j) * vbt_cor(i ,j) + dzon(i,j) * vbt_cor(i+1,j-1)))
1240  enddo ; enddo
1241  !$OMP parallel do default(shared)
1242  do j=js-1,je ; do i=is,ie
1243  cor_ref_v(i,j) = -1.0 * &
1244  ((amer(i-1,j) * ubt_cor(i-1,j) + cmer(i ,j+1) * ubt_cor(i ,j+1)) + &
1245  (bmer(i ,j) * ubt_cor(i ,j) + dmer(i-1,j+1) * ubt_cor(i-1,j+1)))
1246  enddo ; enddo
1247 
1248  ! Now start new halo updates.
1249  if (nonblock_setup) then
1250  if (.not.use_bt_cont) &
1251  call start_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
1252 
1253  ! The following halo update is not needed without wide halos. RWH
1254  call start_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
1255  endif
1256  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1257  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1258 !$OMP parallel default(none) shared(is,ie,js,je,nz,av_rem_u,av_rem_v,CS,visc_rem_u, &
1259 !$OMP visc_rem_v,bt_rem_u,G,GV,nstep,bt_rem_v,Instep, &
1260 !$OMP find_etaav,jsvf,jevf,isvf,ievf,eta_sum,eta_wtd, &
1261 !$OMP ubt_sum,uhbt_sum,PFu_bt_sum,Coru_bt_sum,ubt_wtd,&
1262 !$OMP ubt_trans,vbt_sum,vhbt_sum,PFv_bt_sum, &
1263 !$OMP Corv_bt_sum,vbt_wtd,vbt_trans,eta_src,dt,dtbt, &
1264 !$OMP Rayleigh_u, Rayleigh_v, &
1265 !$OMP use_BT_Cont,BTCL_u,uhbt0,BTCL_v,vhbt0,eta,Idt,US) &
1266 !$OMP private(u_max_cor,v_max_cor,eta_cor_max,Htot)
1267  !$OMP do
1268  do j=js-1,je+1 ; do i=is-1,ie ; av_rem_u(i,j) = 0.0 ; enddo ; enddo
1269  !$OMP do
1270  do j=js-1,je ; do i=is-1,ie+1 ; av_rem_v(i,j) = 0.0 ; enddo ; enddo
1271  !$OMP do
1272  do j=js,je ; do k=1,nz ; do i=is-1,ie
1273  av_rem_u(i,j) = av_rem_u(i,j) + cs%frhatu(i,j,k) * visc_rem_u(i,j,k)
1274  enddo ; enddo ; enddo
1275  !$OMP do
1276  do j=js-1,je ; do k=1,nz ; do i=is,ie
1277  av_rem_v(i,j) = av_rem_v(i,j) + cs%frhatv(i,j,k) * visc_rem_v(i,j,k)
1278  enddo ; enddo ; enddo
1279  if (cs%strong_drag) then
1280  !$OMP do
1281  do j=js,je ; do i=is-1,ie
1282  bt_rem_u(i,j) = g%mask2dCu(i,j) * &
1283  ((nstep * av_rem_u(i,j)) / (1.0 + (nstep-1)*av_rem_u(i,j)))
1284  enddo ; enddo
1285  !$OMP do
1286  do j=js-1,je ; do i=is,ie
1287  bt_rem_v(i,j) = g%mask2dCv(i,j) * &
1288  ((nstep * av_rem_v(i,j)) / (1.0 + (nstep-1)*av_rem_v(i,j)))
1289  enddo ; enddo
1290  else
1291  !$OMP do
1292  do j=js,je ; do i=is-1,ie
1293  bt_rem_u(i,j) = 0.0
1294  if (g%mask2dCu(i,j) * av_rem_u(i,j) > 0.0) &
1295  bt_rem_u(i,j) = g%mask2dCu(i,j) * (av_rem_u(i,j)**instep)
1296  enddo ; enddo
1297  !$OMP do
1298  do j=js-1,je ; do i=is,ie
1299  bt_rem_v(i,j) = 0.0
1300  if (g%mask2dCv(i,j) * av_rem_v(i,j) > 0.0) &
1301  bt_rem_v(i,j) = g%mask2dCv(i,j) * (av_rem_v(i,j)**instep)
1302  enddo ; enddo
1303  endif
1304  if (cs%linear_wave_drag) then
1305  !$OMP do
1306  do j=js,je ; do i=is-1,ie ; if (cs%lin_drag_u(i,j) > 0.0) then
1307  htot = 0.5 * (eta(i,j) + eta(i+1,j))
1308  if (gv%Boussinesq) &
1309  htot = htot + 0.5*gv%Z_to_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j))
1310  bt_rem_u(i,j) = bt_rem_u(i,j) * (htot / (htot + cs%lin_drag_u(i,j) * dtbt))
1311 
1312  rayleigh_u(i,j) = cs%lin_drag_u(i,j) / htot
1313  endif ; enddo ; enddo
1314  !$OMP do
1315  do j=js-1,je ; do i=is,ie ; if (cs%lin_drag_v(i,j) > 0.0) then
1316  htot = 0.5 * (eta(i,j) + eta(i,j+1))
1317  if (gv%Boussinesq) &
1318  htot = htot + 0.5*gv%Z_to_H * (cs%bathyT(i,j) + cs%bathyT(i+1,j+1))
1319  bt_rem_v(i,j) = bt_rem_v(i,j) * (htot / (htot + cs%lin_drag_v(i,j) * dtbt))
1320 
1321  rayleigh_v(i,j) = cs%lin_drag_v(i,j) / htot
1322  endif ; enddo ; enddo
1323  endif
1324 
1325  ! Zero out the arrays for various time-averaged quantities.
1326  if (find_etaav) then
1327  !$OMP do
1328  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
1329  eta_sum(i,j) = 0.0 ; eta_wtd(i,j) = 0.0
1330  enddo ; enddo
1331  else
1332  !$OMP do
1333  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1
1334  eta_wtd(i,j) = 0.0
1335  enddo ; enddo
1336  endif
1337  !$OMP do
1338  do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf
1339  ubt_sum(i,j) = 0.0 ; uhbt_sum(i,j) = 0.0
1340  pfu_bt_sum(i,j) = 0.0 ; coru_bt_sum(i,j) = 0.0
1341  ubt_wtd(i,j) = 0.0 ; ubt_trans(i,j) = 0.0
1342  enddo ; enddo
1343  !$OMP do
1344  do j=jsvf-1,jevf ; do i=isvf-1,ievf+1
1345  vbt_sum(i,j) = 0.0 ; vhbt_sum(i,j) = 0.0
1346  pfv_bt_sum(i,j) = 0.0 ; corv_bt_sum(i,j) = 0.0
1347  vbt_wtd(i,j) = 0.0 ; vbt_trans(i,j) = 0.0
1348  enddo ; enddo
1349 
1350  ! Set the mass source, after first initializing the halos to 0.
1351  !$OMP do
1352  do j=jsvf-1,jevf+1; do i=isvf-1,ievf+1 ; eta_src(i,j) = 0.0 ; enddo ; enddo
1353  if (cs%bound_BT_corr) then ; if (use_bt_cont .and. cs%BT_cont_bounds) then
1354  do j=js,je ; do i=is,ie ; if (g%mask2dT(i,j) > 0.0) then
1355  if (cs%eta_cor(i,j) > 0.0) then
1356  ! Limit the source (outward) correction to be a fraction the mass that
1357  ! can be transported out of the cell by velocities with a CFL number of
1358  ! CFL_cor.
1359  u_max_cor = g%dxT(i,j) * (cs%maxCFL_BT_cont*idt)
1360  v_max_cor = g%dyT(i,j) * (cs%maxCFL_BT_cont*idt)
1361  eta_cor_max = dt * (cs%IareaT(i,j) * &
1362  (((find_uhbt(u_max_cor, btcl_u(i,j), us) + uhbt0(i,j)) - &
1363  (find_uhbt(-u_max_cor, btcl_u(i-1,j), us) + uhbt0(i-1,j))) + &
1364  ((find_vhbt(v_max_cor, btcl_v(i,j), us) + vhbt0(i,j)) - &
1365  (find_vhbt(-v_max_cor, btcl_v(i,j-1), us) + vhbt0(i,j-1))) ))
1366  cs%eta_cor(i,j) = min(cs%eta_cor(i,j), max(0.0, eta_cor_max))
1367  else
1368  ! Limit the sink (inward) correction to the amount of mass that is already
1369  ! inside the cell.
1370  htot = eta(i,j)
1371  if (gv%Boussinesq) htot = cs%bathyT(i,j)*gv%Z_to_H + eta(i,j)
1372 
1373  cs%eta_cor(i,j) = max(cs%eta_cor(i,j), -max(0.0,htot))
1374  endif
1375  endif ; enddo ; enddo
1376  else ; do j=js,je ; do i=is,ie
1377  if (abs(cs%eta_cor(i,j)) > dt*cs%eta_cor_bound(i,j)) &
1378  cs%eta_cor(i,j) = sign(dt*cs%eta_cor_bound(i,j), cs%eta_cor(i,j))
1379  enddo ; enddo ; endif ; endif
1380  !$OMP do
1381  do j=js,je ; do i=is,ie
1382  eta_src(i,j) = g%mask2dT(i,j) * (instep * cs%eta_cor(i,j))
1383  enddo ; enddo
1384 !$OMP end parallel
1385 
1386  if (cs%dynamic_psurf) then
1387  ice_is_rigid = (associated(forces%rigidity_ice_u) .and. &
1388  associated(forces%rigidity_ice_v))
1389  h_min_dyn = gv%Z_to_H * cs%Dmin_dyn_psurf
1390  if (ice_is_rigid .and. use_bt_cont) &
1391  call bt_cont_to_face_areas(bt_cont, datu, datv, g, us, ms, 0, .true.)
1392  if (ice_is_rigid) then
1393  !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength)
1394  do j=js,je ; do i=is,ie
1395  ! First determine the maximum stable value for dyn_coef_eta.
1396 
1397  ! This estimate of the maximum stable time step is pretty accurate for
1398  ! gravity waves, but it is a conservative estimate since it ignores the
1399  ! stabilizing effect of the bottom drag.
1400  idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (g%IareaT(i,j) * &
1401  ((gtot_e(i,j) * (datu(i,j)*g%IdxCu(i,j)) + &
1402  gtot_w(i,j) * (datu(i-1,j)*g%IdxCu(i-1,j))) + &
1403  (gtot_n(i,j) * (datv(i,j)*g%IdyCv(i,j)) + &
1404  gtot_s(i,j) * (datv(i,j-1)*g%IdyCv(i,j-1)))) + &
1405  ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
1406  (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)))
1407  h_eff_dx2 = max(h_min_dyn * ((g%IdxT(i,j))**2 + (g%IdyT(i,j))**2), &
1408  g%IareaT(i,j) * &
1409  ((datu(i,j)*g%IdxCu(i,j) + datu(i-1,j)*g%IdxCu(i-1,j)) + &
1410  (datv(i,j)*g%IdyCv(i,j) + datv(i,j-1)*g%IdyCv(i,j-1)) ) )
1411  dyn_coef_max = cs%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * idt_max2) / &
1412  (dtbt**2 * h_eff_dx2)
1413 
1414  ! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [m3 s-1].
1415  ice_strength = us%m_to_L**4*us%Z_to_m*us%T_to_s* &
1416  ((forces%rigidity_ice_u(i,j) + forces%rigidity_ice_u(i-1,j)) + &
1417  (forces%rigidity_ice_v(i,j) + forces%rigidity_ice_v(i,j-1))) / &
1418  (cs%ice_strength_length**2 * dtbt)
1419 
1420  ! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]
1421  dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * gv%H_to_Z)
1422  enddo ; enddo ; endif
1423  endif
1424 
1425  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1426  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1427  if (nonblock_setup) then
1428  call start_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
1429  ! The following halo update is not needed without wide halos. RWH
1430  else
1431  call do_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
1432  if (.not.use_bt_cont) &
1433  call do_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
1434  call do_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
1435  endif
1436  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1437  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1438 
1439  ! Complete all of the outstanding halo updates.
1440  if (nonblock_setup) then
1441  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1442  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
1443 
1444  if (.not.use_bt_cont) & !### IS THIS OK HERE?
1445  call complete_group_pass(cs%pass_Dat_uv, cs%BT_Domain)
1446  call complete_group_pass(cs%pass_force_hbt0_Cor_ref, cs%BT_Domain)
1447  call complete_group_pass(cs%pass_eta_bt_rem, cs%BT_Domain)
1448 
1449  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
1450  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
1451  endif
1452 
1453  if (cs%debug) then
1454  call uvchksum("BT [uv]hbt", uhbt, vhbt, cs%debug_BT_HI, haloshift=0, &
1455  scale=us%s_to_T*us%L_to_m**2*gv%H_to_m)
1456  call uvchksum("BT Initial [uv]bt", ubt, vbt, cs%debug_BT_HI, haloshift=0, scale=us%L_T_to_m_s)
1457  call hchksum(eta, "BT Initial eta", cs%debug_BT_HI, haloshift=0, scale=gv%H_to_m)
1458  call uvchksum("BT BT_force_[uv]", bt_force_u, bt_force_v, &
1459  cs%debug_BT_HI, haloshift=0, scale=us%L_T2_to_m_s2)
1460  if (interp_eta_pf) then
1461  call hchksum(eta_pf_1, "BT eta_PF_1",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
1462  call hchksum(d_eta_pf, "BT d_eta_PF",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
1463  else
1464  call hchksum(eta_pf, "BT eta_PF",cs%debug_BT_HI,haloshift=0, scale=gv%H_to_m)
1465  call hchksum(eta_pf_in, "BT eta_PF_in",g%HI,haloshift=0, scale=gv%H_to_m)
1466  endif
1467  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)
1468  call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, cs%debug_BT_HI, haloshift=0, &
1469  scale=us%L_to_m**2*us%s_to_T*gv%H_to_m)
1470  if (.not. use_bt_cont) then
1471  call uvchksum("BT Dat[uv]", datu, datv, cs%debug_BT_HI, haloshift=1, scale=us%L_to_m*gv%H_to_m)
1472  endif
1473  call uvchksum("BT wt_[uv]", wt_u, wt_v, g%HI, 0, .true., .true.)
1474  call uvchksum("BT frhat[uv]", cs%frhatu, cs%frhatv, g%HI, 0, .true., .true.)
1475  call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, g%HI, haloshift=0, scale=us%L_T2_to_m_s2)
1476  call uvchksum("BT IDat[uv]", cs%IDatu, cs%IDatv, g%HI, haloshift=0, scale=us%m_to_Z)
1477  call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, g%HI, haloshift=1)
1478  endif
1479 
1480  if (query_averaging_enabled(cs%diag)) then
1481  if (cs%id_eta_st > 0) call post_data(cs%id_eta_st, eta(isd:ied,jsd:jed), cs%diag)
1482  if (cs%id_ubt_st > 0) call post_data(cs%id_ubt_st, ubt(isdb:iedb,jsd:jed), cs%diag)
1483  if (cs%id_vbt_st > 0) call post_data(cs%id_vbt_st, vbt(isd:ied,jsdb:jedb), cs%diag)
1484  endif
1485 
1486  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
1487  if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
1488 
1489  if (project_velocity) then ; eta_pf_bt => eta ; else ; eta_pf_bt => eta_pred ; endif
1490 
1491  if (cs%dt_bt_filter >= 0.0) then
1492  dt_filt = 0.5 * max(0.0, min(cs%dt_bt_filter, 2.0*dt))
1493  else
1494  dt_filt = 0.5 * max(0.0, dt * min(-cs%dt_bt_filter, 2.0))
1495  endif
1496  nfilter = ceiling(dt_filt / dtbt)
1497 
1498  if (nstep+nfilter==0 ) call mom_error(fatal, &
1499  "btstep: number of barotropic step (nstep+nfilter) is 0")
1500 
1501  ! Set up the normalized weights for the filtered velocity.
1502  sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
1503  allocate(wt_vel(nstep+nfilter)) ; allocate(wt_eta(nstep+nfilter))
1504  allocate(wt_trans(nstep+nfilter+1)) ; allocate(wt_accel(nstep+nfilter+1))
1505  allocate(wt_accel2(nstep+nfilter+1))
1506  do n=1,nstep+nfilter
1507  ! Modify this to use a different filter...
1508  if ( (n==nstep) .or. (dt_filt - abs(n-nstep)*dtbt >= 0.0)) then
1509  wt_vel(n) = 1.0 ; wt_eta(n) = 1.0
1510  elseif (dtbt + dt_filt - abs(n-nstep)*dtbt > 0.0) then
1511  wt_vel(n) = 1.0 + (dt_filt / dtbt) - abs(n-nstep) ; wt_eta(n) = wt_vel(n)
1512  else
1513  wt_vel(n) = 0.0 ; wt_eta(n) = 0.0
1514  endif
1515 !### if (n < nstep-nfilter) then ; wt_vel(n) = 0.0 ; else ; wt_vel(n) = 1.0 ; endif
1516 !### if (n < nstep-nfilter) then ; wt_eta(n) = 0.0 ; else ; wt_eta(n) = 1.0 ; endif
1517 
1518  ! The rest should not be changed.
1519  sum_wt_vel = sum_wt_vel + wt_vel(n) ; sum_wt_eta = sum_wt_eta + wt_eta(n)
1520  enddo
1521  wt_trans(nstep+nfilter+1) = 0.0 ; wt_accel(nstep+nfilter+1) = 0.0
1522  do n=nstep+nfilter,1,-1
1523  wt_trans(n) = wt_trans(n+1) + wt_eta(n)
1524  wt_accel(n) = wt_accel(n+1) + wt_vel(n)
1525  sum_wt_accel = sum_wt_accel + wt_accel(n) ; sum_wt_trans = sum_wt_trans + wt_trans(n)
1526  enddo
1527  ! Normalize the weights.
1528  i_sum_wt_vel = 1.0 / sum_wt_vel ; i_sum_wt_accel = 1.0 / sum_wt_accel
1529  i_sum_wt_eta = 1.0 / sum_wt_eta ; i_sum_wt_trans = 1.0 / sum_wt_trans
1530  do n=1,nstep+nfilter
1531  wt_vel(n) = wt_vel(n) * i_sum_wt_vel
1532  wt_accel2(n) = wt_accel(n)
1533  wt_accel(n) = wt_accel(n) * i_sum_wt_accel
1534  wt_eta(n) = wt_eta(n) * i_sum_wt_eta
1535 ! wt_trans(n) = wt_trans(n) * I_sum_wt_trans
1536  enddo
1537 
1538 
1539  sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0
1540 
1541  ! The following loop contains all of the time steps.
1542  isv=is ; iev=ie ; jsv=js ; jev=je
1543  do n=1,nstep+nfilter
1544 
1545  sum_wt_vel = sum_wt_vel + wt_vel(n)
1546  sum_wt_eta = sum_wt_eta + wt_eta(n)
1547  sum_wt_accel = sum_wt_accel + wt_accel2(n)
1548  sum_wt_trans = sum_wt_trans + wt_trans(n)
1549 
1550  if (cs%clip_velocity) then
1551  do j=jsv,jev ; do i=isv-1,iev
1552  if ((ubt(i,j) * (dt * g%dy_Cu(i,j))) * g%IareaT(i+1,j) < -cs%CFL_trunc) then
1553  ! Add some error reporting later.
1554  ubt(i,j) = (-0.95*cs%CFL_trunc) * (g%areaT(i+1,j) / (dt * g%dy_Cu(i,j)))
1555  elseif ((ubt(i,j) * (dt * g%dy_Cu(i,j))) * g%IareaT(i,j) > cs%CFL_trunc) then
1556  ! Add some error reporting later.
1557  ubt(i,j) = (0.95*cs%CFL_trunc) * (g%areaT(i,j) / (dt * g%dy_Cu(i,j)))
1558  endif
1559  enddo ; enddo
1560  do j=jsv-1,jev ; do i=isv,iev
1561  if ((vbt(i,j) * (dt * g%dx_Cv(i,j))) * g%IareaT(i,j+1) < -cs%CFL_trunc) then
1562  ! Add some error reporting later.
1563  vbt(i,j) = (-0.9*cs%CFL_trunc) * (g%areaT(i,j+1) / (dt * g%dx_Cv(i,j)))
1564  elseif ((vbt(i,j) * (dt * g%dx_Cv(i,j))) * g%IareaT(i,j) > cs%CFL_trunc) then
1565  ! Add some error reporting later.
1566  vbt(i,j) = (0.9*cs%CFL_trunc) * (g%areaT(i,j) / (dt * g%dx_Cv(i,j)))
1567  endif
1568  enddo ; enddo
1569  endif
1570 
1571  if ((iev - stencil < ie) .or. (jev - stencil < je)) then
1572  if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
1573  call do_group_pass(cs%pass_eta_ubt, cs%BT_Domain, clock=id_clock_pass_step)
1574  isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf
1575  if (id_clock_calc > 0) call cpu_clock_begin(id_clock_calc)
1576  else
1577  isv = isv+stencil ; iev = iev-stencil
1578  jsv = jsv+stencil ; jev = jev-stencil
1579  endif
1580 
1581  if ((.not.use_bt_cont) .and. cs%Nonlinear_continuity .and. &
1582  (cs%Nonlin_cont_update_period > 0)) then
1583  if ((n>1) .and. (mod(n-1,cs%Nonlin_cont_update_period) == 0)) &
1584  call find_face_areas(datu, datv, g, gv, us, cs, ms, eta, 1+iev-ie)
1585  endif
1586 
1587  !GOMP parallel default(shared)
1588  if (cs%dynamic_psurf .or. .not.project_velocity) then
1589  if (use_bt_cont) then
1590  !GOMP do
1591  do j=jsv-1,jev+1 ; do i=isv-2,iev+1
1592  uhbt(i,j) = find_uhbt(ubt(i,j), btcl_u(i,j), us) + uhbt0(i,j)
1593  enddo ; enddo
1594  !GOMP do
1595  do j=jsv-2,jev+1 ; do i=isv-1,iev+1
1596  vhbt(i,j) = find_vhbt(vbt(i,j), btcl_v(i,j), us) + vhbt0(i,j)
1597  enddo ; enddo
1598  !GOMP do
1599  do j=jsv-1,jev+1 ; do i=isv-1,iev+1
1600  eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
1601  ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j)))
1602  enddo ; enddo
1603  else
1604  !GOMP do
1605  do j=jsv-1,jev+1 ; do i=isv-1,iev+1
1606  eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
1607  (((datu(i-1,j)*ubt(i-1,j) + uhbt0(i-1,j)) - &
1608  (datu(i,j)*ubt(i,j) + uhbt0(i,j))) + &
1609  ((datv(i,j-1)*vbt(i,j-1) + vhbt0(i,j-1)) - &
1610  (datv(i,j)*vbt(i,j) + vhbt0(i,j))))
1611  enddo ; enddo
1612  endif
1613 
1614  if (cs%dynamic_psurf) then
1615  !GOMP do
1616  do j=jsv-1,jev+1 ; do i=isv-1,iev+1
1617  p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j))
1618  enddo ; enddo
1619  endif
1620  endif
1621 
1622  ! Recall that just outside the do n loop, there is code like...
1623  ! eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta
1624 
1625  if (find_etaav) then
1626  !GOMP do
1627  do j=js,je ; do i=is,ie
1628  eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_pf_bt(i,j)
1629  enddo ; enddo
1630  endif
1631 
1632  if (interp_eta_pf) then
1633  wt_end = n*instep ! This could be (n-0.5)*Instep.
1634  !GOMP do
1635  do j=jsv-1,jev+1 ; do i=isv-1,iev+1
1636  eta_pf(i,j) = eta_pf_1(i,j) + wt_end*d_eta_pf(i,j)
1637  enddo ; enddo
1638  endif
1639 
1640  if (apply_obc_flather .or. apply_obc_open) then
1641  !GOMP do
1642  do j=jsv,jev ; do i=isv-2,iev+1
1643  ubt_old(i,j) = ubt(i,j)
1644  enddo ; enddo
1645  !GOMP do
1646  do j=jsv-2,jev+1 ; do i=isv,iev
1647  vbt_old(i,j) = vbt(i,j)
1648  enddo ; enddo
1649  endif
1650  !GOMP end parallel
1651 
1652  if (apply_obcs) then
1653  if (mod(n+g%first_direction,2)==1) then
1654  ioff = 1; joff = 0
1655  else
1656  ioff = 0; joff = 1
1657  endif
1658 
1659  if (cs%BT_OBC%apply_u_OBCs) then ! save the old value of ubt and uhbt
1660  !GOMP parallel do default(shared)
1661  do j=jsv-joff,jev+joff ; do i=isv-1,iev
1662  ubt_prev(i,j) = ubt(i,j) ; uhbt_prev(i,j) = uhbt(i,j)
1663  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)
1664  enddo ; enddo
1665  endif
1666 
1667  if (cs%BT_OBC%apply_v_OBCs) then ! save the old value of vbt and vhbt
1668  !GOMP parallel do default(shared)
1669  do j=jsv-1,jev ; do i=isv-ioff,iev+ioff
1670  vbt_prev(i,j) = vbt(i,j) ; vhbt_prev(i,j) = vhbt(i,j)
1671  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)
1672  enddo ; enddo
1673  endif
1674  endif
1675 
1676  !GOMP parallel default(shared) private(vel_prev)
1677  if (mod(n+g%first_direction,2)==1) then
1678  ! On odd-steps, update v first.
1679  !GOMP do
1680  do j=jsv-1,jev ; do i=isv-1,iev+1
1681  cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + &
1682  (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
1683  pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
1684  (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
1685  dgeo_de * cs%IdyCv(i,j)
1686  enddo ; enddo
1687  if (cs%dynamic_psurf) then
1688  !GOMP do
1689  do j=jsv-1,jev ; do i=isv-1,iev+1
1690  pfv(i,j) = pfv(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * cs%IdyCv(i,j)
1691  enddo ; enddo
1692  endif
1693 
1694  if (cs%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary
1695  !GOMP do
1696  do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
1697  pfv(i,j) = 0.0
1698  endif ; enddo ; enddo
1699  endif
1700  !GOMP do
1701  do j=jsv-1,jev ; do i=isv-1,iev+1
1702  vel_prev = vbt(i,j)
1703  vbt(i,j) = bt_rem_v(i,j) * (vbt(i,j) + &
1704  dtbt * ((bt_force_v(i,j) + cor_v(i,j)) + pfv(i,j)))
1705  vbt_trans(i,j) = trans_wt1*vbt(i,j) + trans_wt2*vel_prev
1706 
1707  if (cs%linear_wave_drag) then
1708  v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * &
1709  ((cor_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh_v(i,j))
1710  else
1711  v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * (cor_v(i,j) + pfv(i,j))
1712  endif
1713  enddo ; enddo
1714 
1715  if (use_bt_cont) then
1716  !GOMP do
1717  do j=jsv-1,jev ; do i=isv-1,iev+1
1718  vhbt(i,j) = find_vhbt(vbt_trans(i,j), btcl_v(i,j), us) + vhbt0(i,j)
1719  enddo ; enddo
1720  else
1721  !GOMP do
1722  do j=jsv-1,jev ; do i=isv-1,iev+1
1723  vhbt(i,j) = datv(i,j)*vbt_trans(i,j) + vhbt0(i,j)
1724  enddo ; enddo
1725  endif
1726  if (cs%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
1727  !GOMP do
1728  do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
1729  vbt(i,j) = vbt_prev(i,j) ; vhbt(i,j) = vhbt_prev(i,j)
1730  endif ; enddo ; enddo
1731  endif
1732  ! Now update the zonal velocity.
1733  !GOMP do
1734  do j=jsv,jev ; do i=isv-1,iev
1735  cor_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + &
1736  (bzon(i,j) * vbt(i,j) + dzon(i,j) * vbt(i+1,j-1))) - &
1737  cor_ref_u(i,j)
1738  pfu(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_e(i,j) - &
1739  (eta_pf_bt(i+1,j)-eta_pf(i+1,j))*gtot_w(i+1,j)) * &
1740  dgeo_de * cs%IdxCu(i,j)
1741  enddo ; enddo
1742 
1743  if (cs%dynamic_psurf) then
1744  !GOMP do
1745  do j=jsv,jev ; do i=isv-1,iev
1746  pfu(i,j) = pfu(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * cs%IdxCu(i,j)
1747  enddo ; enddo
1748  endif
1749 
1750  if (cs%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary
1751  !GOMP do
1752  do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
1753  pfu(i,j) = 0.0
1754  endif ; enddo ; enddo
1755  endif
1756  !GOMP do
1757  do j=jsv,jev ; do i=isv-1,iev
1758  vel_prev = ubt(i,j)
1759  ubt(i,j) = bt_rem_u(i,j) * (ubt(i,j) + &
1760  dtbt * ((bt_force_u(i,j) + cor_u(i,j)) + pfu(i,j)))
1761  if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
1762  ubt_trans(i,j) = trans_wt1*ubt(i,j) + trans_wt2*vel_prev
1763 
1764  if (cs%linear_wave_drag) then
1765  u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * &
1766  ((cor_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh_u(i,j))
1767  else
1768  u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * (cor_u(i,j) + pfu(i,j))
1769  endif
1770  enddo ; enddo
1771 
1772  if (use_bt_cont) then
1773  !GOMP do
1774  do j=jsv,jev ; do i=isv-1,iev
1775  uhbt(i,j) = find_uhbt(ubt_trans(i,j), btcl_u(i,j), us) + uhbt0(i,j)
1776  enddo ; enddo
1777  else
1778  !GOMP do
1779  do j=jsv,jev ; do i=isv-1,iev
1780  uhbt(i,j) = datu(i,j)*ubt_trans(i,j) + uhbt0(i,j)
1781  enddo ; enddo
1782  endif
1783  if (cs%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
1784  !GOMP do
1785  do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
1786  ubt(i,j) = ubt_prev(i,j); uhbt(i,j) = uhbt_prev(i,j)
1787  endif ; enddo ; enddo
1788  endif
1789  else
1790  ! On even steps, update u first.
1791  !GOMP do
1792  do j=jsv-1,jev+1 ; do i=isv-1,iev
1793  cor_u(i,j) = ((azon(i,j) * vbt(i+1,j) + czon(i,j) * vbt(i,j-1)) + &
1794  (bzon(i,j) * vbt(i,j) + dzon(i,j) * vbt(i+1,j-1))) - &
1795  cor_ref_u(i,j)
1796  pfu(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_e(i,j) - &
1797  (eta_pf_bt(i+1,j)-eta_pf(i+1,j))*gtot_w(i+1,j)) * &
1798  dgeo_de * cs%IdxCu(i,j)
1799  enddo ; enddo
1800 
1801  if (cs%dynamic_psurf) then
1802  !GOMP do
1803  do j=jsv-1,jev+1 ; do i=isv-1,iev
1804  pfu(i,j) = pfu(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * cs%IdxCu(i,j)
1805  enddo ; enddo
1806  endif
1807 
1808  if (cs%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary
1809  !GOMP do
1810  do j=jsv,jev ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
1811  pfu(i,j) = 0.0
1812  endif ; enddo ; enddo
1813  endif
1814 
1815  !GOMP do
1816  do j=jsv-1,jev+1 ; do i=isv-1,iev
1817  vel_prev = ubt(i,j)
1818  ubt(i,j) = bt_rem_u(i,j) * (ubt(i,j) + &
1819  dtbt * ((bt_force_u(i,j) + cor_u(i,j)) + pfu(i,j)))
1820  if (abs(ubt(i,j)) < cs%vel_underflow) ubt(i,j) = 0.0
1821  ubt_trans(i,j) = trans_wt1*ubt(i,j) + trans_wt2*vel_prev
1822 
1823  if (cs%linear_wave_drag) then
1824  u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * &
1825  ((cor_u(i,j) + pfu(i,j)) - ubt(i,j)*rayleigh_u(i,j))
1826  else
1827  u_accel_bt(i,j) = u_accel_bt(i,j) + wt_accel(n) * (cor_u(i,j) + pfu(i,j))
1828  endif
1829  enddo ; enddo
1830 
1831  if (use_bt_cont) then
1832  !GOMP do
1833  do j=jsv-1,jev+1 ; do i=isv-1,iev
1834  uhbt(i,j) = find_uhbt(ubt_trans(i,j), btcl_u(i,j), us) + uhbt0(i,j)
1835  enddo ; enddo
1836  else
1837  !GOMP do
1838  do j=jsv-1,jev+1 ; do i=isv-1,iev
1839  uhbt(i,j) = datu(i,j)*ubt_trans(i,j) + uhbt0(i,j)
1840  enddo ; enddo
1841  endif
1842  if (cs%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
1843  !GOMP do
1844  do j=jsv-1,jev+1 ; do i=isv-1,iev ; if (obc%segnum_u(i,j) /= obc_none) then
1845  ubt(i,j) = ubt_prev(i,j); uhbt(i,j) = uhbt_prev(i,j)
1846  endif ; enddo ; enddo
1847  endif
1848 
1849  ! Now update the meridional velocity.
1850  if (cs%use_old_coriolis_bracket_bug) then
1851  !GOMP do
1852  do j=jsv-1,jev ; do i=isv,iev
1853  cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + bmer(i,j) * ubt(i,j)) + &
1854  (cmer(i,j+1) * ubt(i,j+1) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
1855  pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
1856  (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
1857  dgeo_de * cs%IdyCv(i,j)
1858  enddo ; enddo
1859  else
1860  !GOMP do
1861  do j=jsv-1,jev ; do i=isv,iev
1862  cor_v(i,j) = -1.0*((amer(i-1,j) * ubt(i-1,j) + cmer(i,j+1) * ubt(i,j+1)) + &
1863  (bmer(i,j) * ubt(i,j) + dmer(i-1,j+1) * ubt(i-1,j+1))) - cor_ref_v(i,j)
1864  pfv(i,j) = ((eta_pf_bt(i,j)-eta_pf(i,j))*gtot_n(i,j) - &
1865  (eta_pf_bt(i,j+1)-eta_pf(i,j+1))*gtot_s(i,j+1)) * &
1866  dgeo_de * cs%IdyCv(i,j)
1867  enddo ; enddo
1868  endif
1869 
1870  if (cs%dynamic_psurf) then
1871  !GOMP do
1872  do j=jsv-1,jev ; do i=isv,iev
1873  pfv(i,j) = pfv(i,j) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * cs%IdyCv(i,j)
1874  enddo ; enddo
1875  endif
1876 
1877  if (cs%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary
1878  !GOMP do
1879  do j=jsv-1,jev ; do i=isv-1,iev+1 ; if (obc%segnum_v(i,j) /= obc_none) then
1880  pfv(i,j) = 0.0
1881  endif ; enddo ; enddo
1882  endif
1883 
1884  !GOMP do
1885  do j=jsv-1,jev ; do i=isv,iev
1886  vel_prev = vbt(i,j)
1887  vbt(i,j) = bt_rem_v(i,j) * (vbt(i,j) + &
1888  dtbt * ((bt_force_v(i,j) + cor_v(i,j)) + pfv(i,j)))
1889  if (abs(vbt(i,j)) < cs%vel_underflow) vbt(i,j) = 0.0
1890  vbt_trans(i,j) = trans_wt1*vbt(i,j) + trans_wt2*vel_prev
1891 
1892  if (cs%linear_wave_drag) then
1893  v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * &
1894  ((cor_v(i,j) + pfv(i,j)) - vbt(i,j)*rayleigh_v(i,j))
1895  else
1896  v_accel_bt(i,j) = v_accel_bt(i,j) + wt_accel(n) * (cor_v(i,j) + pfv(i,j))
1897  endif
1898  enddo ; enddo
1899  if (use_bt_cont) then
1900  !GOMP do
1901  do j=jsv-1,jev ; do i=isv,iev
1902  vhbt(i,j) = find_vhbt(vbt_trans(i,j), btcl_v(i,j), us) + vhbt0(i,j)
1903  enddo ; enddo
1904  else
1905  !GOMP do
1906  do j=jsv-1,jev ; do i=isv,iev
1907  vhbt(i,j) = datv(i,j)*vbt_trans(i,j) + vhbt0(i,j)
1908  enddo ; enddo
1909  endif
1910  if (cs%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
1911  !GOMP do
1912  do j=jsv-1,jev ; do i=isv,iev ; if (obc%segnum_v(i,j) /= obc_none) then
1913  vbt(i,j) = vbt_prev(i,j); vhbt(i,j) = vhbt_prev(i,j)
1914  endif ; enddo ; enddo
1915  endif
1916  endif
1917  !GOMP end parallel
1918 
1919  !GOMP parallel default(shared)
1920  if (find_pf) then
1921  !GOMP do
1922  do j=js,je ; do i=is-1,ie
1923  pfu_bt_sum(i,j) = pfu_bt_sum(i,j) + wt_accel2(n) * pfu(i,j)
1924  enddo ; enddo
1925  !GOMP do
1926  do j=js-1,je ; do i=is,ie
1927  pfv_bt_sum(i,j) = pfv_bt_sum(i,j) + wt_accel2(n) * pfv(i,j)
1928  enddo ; enddo
1929  endif
1930  if (find_cor) then
1931  !GOMP do
1932  do j=js,je ; do i=is-1,ie
1933  coru_bt_sum(i,j) = coru_bt_sum(i,j) + wt_accel2(n) * cor_u(i,j)
1934  enddo ; enddo
1935  !GOMP do
1936  do j=js-1,je ; do i=is,ie
1937  corv_bt_sum(i,j) = corv_bt_sum(i,j) + wt_accel2(n) * cor_v(i,j)
1938  enddo ; enddo
1939  endif
1940 
1941  !GOMP do
1942  do j=js,je ; do i=is-1,ie
1943  ubt_sum(i,j) = ubt_sum(i,j) + wt_trans(n) * ubt_trans(i,j)
1944  uhbt_sum(i,j) = uhbt_sum(i,j) + wt_trans(n) * uhbt(i,j)
1945  ubt_wtd(i,j) = ubt_wtd(i,j) + wt_vel(n) * ubt(i,j)
1946  enddo ; enddo
1947  !GOMP do
1948  do j=js-1,je ; do i=is,ie
1949  vbt_sum(i,j) = vbt_sum(i,j) + wt_trans(n) * vbt_trans(i,j)
1950  vhbt_sum(i,j) = vhbt_sum(i,j) + wt_trans(n) * vhbt(i,j)
1951  vbt_wtd(i,j) = vbt_wtd(i,j) + wt_vel(n) * vbt(i,j)
1952  enddo ; enddo
1953  !GOMP end parallel
1954 
1955  if (apply_obcs) then
1956  if (cs%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
1957  !GOMP parallel do default(shared)
1958  do j=js,je ; do i=is-1,ie
1959  if (obc%segnum_u(i,j) /= obc_none) then
1960  ubt_sum(i,j) = ubt_sum_prev(i,j) ; uhbt_sum(i,j) = uhbt_sum_prev(i,j)
1961  ubt_wtd(i,j) = ubt_wtd_prev(i,j)
1962  endif
1963  enddo ; enddo
1964  endif
1965 
1966  if (cs%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
1967  !GOMP parallel do default(shared)
1968  do j=js-1,je ; do i=is,ie
1969  if (obc%segnum_v(i,j) /= obc_none) then
1970  vbt_sum(i,j) = vbt_sum_prev(i,j) ; vhbt_sum(i,j) = vhbt_sum_prev(i,j)
1971  vbt_wtd(i,j) = vbt_wtd_prev(i,j)
1972  endif
1973  enddo ; enddo
1974  endif
1975 
1976  call apply_velocity_obcs(obc, ubt, vbt, uhbt, vhbt, &
1977  ubt_trans, vbt_trans, eta, ubt_old, vbt_old, cs%BT_OBC, &
1978  g, ms, us, iev-ie, dtbt, bebt, use_bt_cont, datu, datv, btcl_u, btcl_v, &
1979  uhbt0, vhbt0)
1980  if (cs%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do i=is-1,ie
1981  if (obc%segnum_u(i,j) /= obc_none) then
1982  ubt_sum(i,j) = ubt_sum(i,j) + wt_trans(n) * ubt_trans(i,j)
1983  uhbt_sum(i,j) = uhbt_sum(i,j) + wt_trans(n) * uhbt(i,j)
1984  ubt_wtd(i,j) = ubt_wtd(i,j) + wt_vel(n) * ubt(i,j)
1985  endif
1986  enddo ; enddo ; endif
1987  if (cs%BT_OBC%apply_v_OBCs) then ; do j=js-1,je ; do i=is,ie
1988  if (obc%segnum_v(i,j) /= obc_none) then
1989  vbt_sum(i,j) = vbt_sum(i,j) + wt_trans(n) * vbt_trans(i,j)
1990  vhbt_sum(i,j) = vhbt_sum(i,j) + wt_trans(n) * vhbt(i,j)
1991  vbt_wtd(i,j) = vbt_wtd(i,j) + wt_vel(n) * vbt(i,j)
1992  endif
1993  enddo ; enddo ; endif
1994  endif
1995 
1996  if (cs%debug_bt) then
1997  call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, cs%debug_BT_HI, haloshift=iev-ie, &
1998  scale=us%s_to_T*us%L_to_m**2*gv%H_to_m)
1999  endif
2000 
2001  !$OMP parallel do default(shared)
2002  do j=jsv,jev ; do i=isv,iev
2003  eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * cs%IareaT(i,j)) * &
2004  ((uhbt(i-1,j) - uhbt(i,j)) + (vhbt(i,j-1) - vhbt(i,j)))
2005  eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n)
2006  ! Should there be a concern if eta drops below 0 or G%bathyT?
2007  enddo ; enddo
2008 
2009  if (do_hifreq_output) then
2010  time_step_end = time_bt_start + real_to_time(n*us%T_to_s*dtbt)
2011  call enable_averaging(us%T_to_s*dtbt, time_step_end, cs%diag)
2012  if (cs%id_ubt_hifreq > 0) call post_data(cs%id_ubt_hifreq, ubt(isdb:iedb,jsd:jed), cs%diag)
2013  if (cs%id_vbt_hifreq > 0) call post_data(cs%id_vbt_hifreq, vbt(isd:ied,jsdb:jedb), cs%diag)
2014  if (cs%id_eta_hifreq > 0) call post_data(cs%id_eta_hifreq, eta(isd:ied,jsd:jed), cs%diag)
2015  if (cs%id_uhbt_hifreq > 0) call post_data(cs%id_uhbt_hifreq, uhbt(isdb:iedb,jsd:jed), cs%diag)
2016  if (cs%id_vhbt_hifreq > 0) call post_data(cs%id_vhbt_hifreq, vhbt(isd:ied,jsdb:jedb), cs%diag)
2017  if (cs%id_eta_pred_hifreq > 0) call post_data(cs%id_eta_pred_hifreq, eta_pf_bt(isd:ied,jsd:jed), cs%diag)
2018  endif
2019 
2020  if (cs%debug_bt) then
2021  write(mesg,'("BT step ",I4)') n
2022  call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, cs%debug_BT_HI, haloshift=iev-ie, &
2023  scale=us%L_T_to_m_s)
2024  call hchksum(eta, trim(mesg)//" eta", cs%debug_BT_HI, haloshift=iev-ie, scale=gv%H_to_m)
2025  endif
2026 
2027  enddo ! end of do n=1,ntimestep
2028  if (id_clock_calc > 0) call cpu_clock_end(id_clock_calc)
2029  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
2030 
2031  ! Reset the time information in the diag type.
2032  if (do_hifreq_output) call enable_averaging(time_int_in, time_end_in, cs%diag)
2033 
2034  i_sum_wt_vel = 1.0 / sum_wt_vel ; i_sum_wt_eta = 1.0 / sum_wt_eta
2035  i_sum_wt_accel = 1.0 / sum_wt_accel ; i_sum_wt_trans = 1.0 / sum_wt_trans
2036 
2037  if (find_etaav) then ; do j=js,je ; do i=is,ie
2038  etaav(i,j) = eta_sum(i,j) * i_sum_wt_accel
2039  enddo ; enddo ; endif
2040  do j=js-1,je+1 ; do i=is-1,ie+1 ; e_anom(i,j) = 0.0 ; enddo ; enddo
2041  if (interp_eta_pf) then
2042  do j=js,je ; do i=is,ie
2043  e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - &
2044  (eta_pf_1(i,j) + 0.5*d_eta_pf(i,j)))
2045  enddo ; enddo
2046  else
2047  do j=js,je ; do i=is,ie
2048  e_anom(i,j) = dgeo_de * (0.5 * (eta(i,j) + eta_in(i,j)) - eta_pf(i,j))
2049  enddo ; enddo
2050  endif
2051  if (apply_obcs) then
2052  !!! Not safe for wide halos...
2053  if (cs%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary.
2054  !GOMP parallel do default(shared)
2055  do j=js,je ; do i=is-1,ie
2056  if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
2057  e_anom(i+1,j) = e_anom(i,j)
2058  elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
2059  e_anom(i,j) = e_anom(i+1,j)
2060  endif
2061  enddo ; enddo
2062  endif
2063 
2064  if (cs%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary.
2065  !GOMP parallel do default(shared)
2066  do j=js-1,je ; do i=is,ie
2067  if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
2068  e_anom(i,j+1) = e_anom(i,j)
2069  elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
2070  e_anom(i,j) = e_anom(i,j+1)
2071  endif
2072  enddo ; enddo
2073  endif
2074  endif
2075 
2076  ! It is possible that eta_out and eta_in are the same.
2077  do j=js,je ; do i=is,ie
2078  eta_out(i,j) = eta_wtd(i,j) * i_sum_wt_eta
2079  enddo ; enddo
2080 
2081  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2082  if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
2083  if (g%nonblocking_updates) then
2084  call start_group_pass(cs%pass_e_anom, g%Domain)
2085  else
2086  if (find_etaav) call do_group_pass(cs%pass_etaav, g%Domain)
2087  call do_group_pass(cs%pass_e_anom, g%Domain)
2088  endif
2089  if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
2090  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
2091 
2092  do j=js,je ; do i=is-1,ie
2093  cs%ubtav(i,j) = ubt_sum(i,j) * i_sum_wt_trans
2094  uhbtav(i,j) = uhbt_sum(i,j) * i_sum_wt_trans
2095  ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
2096  !### u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel
2097  ubt_wtd(i,j) = ubt_wtd(i,j) * i_sum_wt_vel
2098  enddo ; enddo
2099 
2100  do j=js-1,je ; do i=is,ie
2101  cs%vbtav(i,j) = vbt_sum(i,j) * i_sum_wt_trans
2102  vhbtav(i,j) = vhbt_sum(i,j) * i_sum_wt_trans
2103  ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1.
2104  !### v_accel_bt(i,J) = v_accel_bt(i,J) * I_sum_wt_accel
2105  vbt_wtd(i,j) = vbt_wtd(i,j) * i_sum_wt_vel
2106  enddo ; enddo
2107 
2108  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2109  if (id_clock_pass_post > 0) call cpu_clock_begin(id_clock_pass_post)
2110  if (g%nonblocking_updates) then
2111  call complete_group_pass(cs%pass_e_anom, g%Domain)
2112  if (find_etaav) call start_group_pass(cs%pass_etaav, g%Domain)
2113  call start_group_pass(cs%pass_ubta_uhbta, g%DoMain)
2114  else
2115  call do_group_pass(cs%pass_ubta_uhbta, g%Domain)
2116  endif
2117  if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post)
2118  if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post)
2119 
2120  ! Now calculate each layer's accelerations.
2121  !$OMP parallel do default(shared)
2122  do k=1,nz
2123  do j=js,je ; do i=is-1,ie
2124  accel_layer_u(i,j,k) = (u_accel_bt(i,j) - &
2125  ((pbce(i+1,j,k) - gtot_w(i+1,j)) * e_anom(i+1,j) - &
2126  (pbce(i,j,k) - gtot_e(i,j)) * e_anom(i,j)) * cs%IdxCu(i,j) )
2127  if (abs(accel_layer_u(i,j,k)) < accel_underflow) accel_layer_u(i,j,k) = 0.0
2128  enddo ; enddo
2129  do j=js-1,je ; do i=is,ie
2130  accel_layer_v(i,j,k) = (v_accel_bt(i,j) - &
2131  ((pbce(i,j+1,k) - gtot_s(i,j+1)) * e_anom(i,j+1) - &
2132  (pbce(i,j,k) - gtot_n(i,j)) * e_anom(i,j)) * cs%IdyCv(i,j) )
2133  if (abs(accel_layer_v(i,j,k)) < accel_underflow) accel_layer_v(i,j,k) = 0.0
2134  enddo ; enddo
2135  enddo
2136 
2137  if (apply_obcs) then
2138  ! Correct the accelerations at OBC velocity points, but only in the
2139  ! symmetric-memory computational domain, not in the wide halo regions.
2140  if (cs%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do i=is-1,ie
2141  if (obc%segnum_u(i,j) /= obc_none) then
2142  u_accel_bt(i,j) = (ubt_wtd(i,j) - ubt_first(i,j)) / dt
2143  do k=1,nz ; accel_layer_u(i,j,k) = u_accel_bt(i,j) ; enddo
2144  endif
2145  enddo ; enddo ; endif
2146  if (cs%BT_OBC%apply_v_OBCs) then ; do j=js-1,je ; do i=is,ie
2147  if (obc%segnum_v(i,j) /= obc_none) then
2148  v_accel_bt(i,j) = (vbt_wtd(i,j) - vbt_first(i,j)) / dt
2149  do k=1,nz ; accel_layer_v(i,j,k) = v_accel_bt(i,j) ; enddo
2150  endif
2151  enddo ; enddo ; endif
2152  endif
2153 
2154  if (id_clock_calc_post > 0) call cpu_clock_end(id_clock_calc_post)
2155 
2156  ! Calculate diagnostic quantities.
2157  if (query_averaging_enabled(cs%diag)) then
2158 
2159  do j=js,je ; do i=is-1,ie ; cs%ubt_IC(i,j) = ubt_wtd(i,j) ; enddo ; enddo
2160  do j=js-1,je ; do i=is,ie ; cs%vbt_IC(i,j) = vbt_wtd(i,j) ; enddo ; enddo
2161  if (use_bt_cont) then
2162  do j=js,je ; do i=is-1,ie
2163  cs%uhbt_IC(i,j) = find_uhbt(ubt_wtd(i,j), btcl_u(i,j), us) + uhbt0(i,j)
2164  enddo ; enddo
2165  do j=js-1,je ; do i=is,ie
2166  cs%vhbt_IC(i,j) = find_vhbt(vbt_wtd(i,j), btcl_v(i,j), us) + vhbt0(i,j)
2167  enddo ; enddo
2168  else
2169  do j=js,je ; do i=is-1,ie
2170  cs%uhbt_IC(i,j) = ubt_wtd(i,j) * datu(i,j) + uhbt0(i,j)
2171  enddo ; enddo
2172  do j=js-1,je ; do i=is,ie
2173  cs%vhbt_IC(i,j) = vbt_wtd(i,j) * datv(i,j) + vhbt0(i,j)
2174  enddo ; enddo
2175  endif
2176 
2177 ! Offer various barotropic terms for averaging.
2178  if (cs%id_PFu_bt > 0) then
2179  do j=js,je ; do i=is-1,ie
2180  pfu_bt_sum(i,j) = pfu_bt_sum(i,j) * i_sum_wt_accel
2181  enddo ; enddo
2182  call post_data(cs%id_PFu_bt, pfu_bt_sum(isdb:iedb,jsd:jed), cs%diag)
2183  endif
2184  if (cs%id_PFv_bt > 0) then
2185  do j=js-1,je ; do i=is,ie
2186  pfv_bt_sum(i,j) = pfv_bt_sum(i,j) * i_sum_wt_accel
2187  enddo ; enddo
2188  call post_data(cs%id_PFv_bt, pfv_bt_sum(isd:ied,jsdb:jedb), cs%diag)
2189  endif
2190  if (cs%id_Coru_bt > 0) then
2191  do j=js,je ; do i=is-1,ie
2192  coru_bt_sum(i,j) = coru_bt_sum(i,j) * i_sum_wt_accel
2193  enddo ; enddo
2194  call post_data(cs%id_Coru_bt, coru_bt_sum(isdb:iedb,jsd:jed), cs%diag)
2195  endif
2196  if (cs%id_Corv_bt > 0) then
2197  do j=js-1,je ; do i=is,ie
2198  corv_bt_sum(i,j) = corv_bt_sum(i,j) * i_sum_wt_accel
2199  enddo ; enddo
2200  call post_data(cs%id_Corv_bt, corv_bt_sum(isd:ied,jsdb:jedb), cs%diag)
2201  endif
2202  if (cs%id_ubtforce > 0) call post_data(cs%id_ubtforce, bt_force_u(isdb:iedb,jsd:jed), cs%diag)
2203  if (cs%id_vbtforce > 0) call post_data(cs%id_vbtforce, bt_force_v(isd:ied,jsdb:jedb), cs%diag)
2204  if (cs%id_uaccel > 0) call post_data(cs%id_uaccel, u_accel_bt(isdb:iedb,jsd:jed), cs%diag)
2205  if (cs%id_vaccel > 0) call post_data(cs%id_vaccel, v_accel_bt(isd:ied,jsdb:jedb), cs%diag)
2206 
2207  if (cs%id_eta_cor > 0) call post_data(cs%id_eta_cor, cs%eta_cor, cs%diag)
2208  if (cs%id_eta_bt > 0) call post_data(cs%id_eta_bt, eta_out, cs%diag)
2209  if (cs%id_gtotn > 0) call post_data(cs%id_gtotn, gtot_n(isd:ied,jsd:jed), cs%diag)
2210  if (cs%id_gtots > 0) call post_data(cs%id_gtots, gtot_s(isd:ied,jsd:jed), cs%diag)
2211  if (cs%id_gtote > 0) call post_data(cs%id_gtote, gtot_e(isd:ied,jsd:jed), cs%diag)
2212  if (cs%id_gtotw > 0) call post_data(cs%id_gtotw, gtot_w(isd:ied,jsd:jed), cs%diag)
2213  if (cs%id_ubt > 0) call post_data(cs%id_ubt, ubt_wtd(isdb:iedb,jsd:jed), cs%diag)
2214  if (cs%id_vbt > 0) call post_data(cs%id_vbt, vbt_wtd(isd:ied,jsdb:jedb), cs%diag)
2215  if (cs%id_ubtav > 0) call post_data(cs%id_ubtav, cs%ubtav, cs%diag)
2216  if (cs%id_vbtav > 0) call post_data(cs%id_vbtav, cs%vbtav, cs%diag)
2217  if (cs%id_visc_rem_u > 0) call post_data(cs%id_visc_rem_u, visc_rem_u, cs%diag)
2218  if (cs%id_visc_rem_v > 0) call post_data(cs%id_visc_rem_v, visc_rem_v, cs%diag)
2219 
2220  if (cs%id_frhatu > 0) call post_data(cs%id_frhatu, cs%frhatu, cs%diag)
2221  if (cs%id_uhbt > 0) call post_data(cs%id_uhbt, uhbtav, cs%diag)
2222  if (cs%id_frhatv > 0) call post_data(cs%id_frhatv, cs%frhatv, cs%diag)
2223  if (cs%id_vhbt > 0) call post_data(cs%id_vhbt, vhbtav, cs%diag)
2224  if (cs%id_uhbt0 > 0) call post_data(cs%id_uhbt0, uhbt0(isdb:iedb,jsd:jed), cs%diag)
2225  if (cs%id_vhbt0 > 0) call post_data(cs%id_vhbt0, vhbt0(isd:ied,jsdb:jedb), cs%diag)
2226 
2227  if (cs%id_frhatu1 > 0) call post_data(cs%id_frhatu1, cs%frhatu1, cs%diag)
2228  if (cs%id_frhatv1 > 0) call post_data(cs%id_frhatv1, cs%frhatv1, cs%diag)
2229 
2230  if (use_bt_cont) then
2231  if (cs%id_BTC_FA_u_EE > 0) call post_data(cs%id_BTC_FA_u_EE, bt_cont%FA_u_EE, cs%diag)
2232  if (cs%id_BTC_FA_u_E0 > 0) call post_data(cs%id_BTC_FA_u_E0, bt_cont%FA_u_E0, cs%diag)
2233  if (cs%id_BTC_FA_u_W0 > 0) call post_data(cs%id_BTC_FA_u_W0, bt_cont%FA_u_W0, cs%diag)
2234  if (cs%id_BTC_FA_u_WW > 0) call post_data(cs%id_BTC_FA_u_WW, bt_cont%FA_u_WW, cs%diag)
2235  if (cs%id_BTC_uBT_EE > 0) call post_data(cs%id_BTC_uBT_EE, bt_cont%uBT_EE, cs%diag)
2236  if (cs%id_BTC_uBT_WW > 0) call post_data(cs%id_BTC_uBT_WW, bt_cont%uBT_WW, cs%diag)
2237  if (cs%id_BTC_FA_v_NN > 0) call post_data(cs%id_BTC_FA_v_NN, bt_cont%FA_v_NN, cs%diag)
2238  if (cs%id_BTC_FA_v_N0 > 0) call post_data(cs%id_BTC_FA_v_N0, bt_cont%FA_v_N0, cs%diag)
2239  if (cs%id_BTC_FA_v_S0 > 0) call post_data(cs%id_BTC_FA_v_S0, bt_cont%FA_v_S0, cs%diag)
2240  if (cs%id_BTC_FA_v_SS > 0) call post_data(cs%id_BTC_FA_v_SS, bt_cont%FA_v_SS, cs%diag)
2241  if (cs%id_BTC_vBT_NN > 0) call post_data(cs%id_BTC_vBT_NN, bt_cont%vBT_NN, cs%diag)
2242  if (cs%id_BTC_vBT_SS > 0) call post_data(cs%id_BTC_vBT_SS, bt_cont%vBT_SS, cs%diag)
2243  endif
2244  else
2245  if (cs%id_frhatu1 > 0) cs%frhatu1(:,:,:) = cs%frhatu(:,:,:)
2246  if (cs%id_frhatv1 > 0) cs%frhatv1(:,:,:) = cs%frhatv(:,:,:)
2247  endif
2248 
2249  if (g%nonblocking_updates) then
2250  if (find_etaav) call complete_group_pass(cs%pass_etaav, g%Domain)
2251  call complete_group_pass(cs%pass_ubta_uhbta, g%Domain)
2252  endif
2253 

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_obcA 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.

2736  type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
2737  !! related to the open boundary conditions,
2738  !! set by set_up_BT_OBC.
2739 
2740  if (bt_obc%is_alloced) then
2741  deallocate(bt_obc%Cg_u)
2742  deallocate(bt_obc%H_u)
2743  deallocate(bt_obc%uhbt)
2744  deallocate(bt_obc%ubt_outer)
2745  deallocate(bt_obc%eta_outer_u)
2746 
2747  deallocate(bt_obc%Cg_v)
2748  deallocate(bt_obc%H_v)
2749  deallocate(bt_obc%vhbt)
2750  deallocate(bt_obc%vbt_outer)
2751  deallocate(bt_obc%eta_outer_v)
2752  bt_obc%is_alloced = .false.
2753  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]msA type that describes the memory sizes of the argument arrays.
[out]datuThe open zonal face area [H L ~> m2 or kg m-1].
[out]datvThe open meridional face area [H L ~> m2 or kg m-1].
[in]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]usA dimensional unit scaling type
csThe control structure returned by a previous call to barotropic_init.
[in]etaThe barotropic free surface height anomaly
[in]haloThe halo size to use, default = 1.
[in]add_maxA 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.

3545  type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays.
3546  real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), &
3547  intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1].
3548  real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), &
3549  intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1].
3550  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3551  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
3552  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3553  type(barotropic_CS), pointer :: CS !< The control structure returned by a previous
3554  !! call to barotropic_init.
3555  real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), &
3556  optional, intent(in) :: eta !< The barotropic free surface height anomaly
3557  !! or column mass anomaly [H ~> m or kg m-2].
3558  integer, optional, intent(in) :: halo !< The halo size to use, default = 1.
3559  real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used
3560  !! to overestimate the external wave speed) [Z ~> m].
3561 
3562  ! Local variables
3563  real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2].
3564  integer :: i, j, is, ie, js, je, hs
3565  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
3566  hs = 1 ; if (present(halo)) hs = max(halo,0)
3567 
3568 !$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,CS,Datu,Datv,add_max) &
3569 !$OMP private(H1,H2)
3570  if (present(eta)) then
3571  ! The use of harmonic mean thicknesses ensure positive definiteness.
3572  if (gv%Boussinesq) then
3573 !$OMP do
3574  do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
3575  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)
3576  datu(i,j) = 0.0 ; if ((h1 > 0.0) .and. (h2 > 0.0)) &
3577  datu(i,j) = cs%dy_Cu(i,j) * (2.0 * h1 * h2) / (h1 + h2)
3578 ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2)
3579  enddo ; enddo
3580 !$OMP do
3581  do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
3582  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)
3583  datv(i,j) = 0.0 ; if ((h1 > 0.0) .and. (h2 > 0.0)) &
3584  datv(i,j) = cs%dx_Cv(i,j) * (2.0 * h1 * h2) / (h1 + h2)
3585 ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2)
3586  enddo ; enddo
3587  else
3588 !$OMP do
3589  do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
3590  datu(i,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) &
3591  datu(i,j) = cs%dy_Cu(i,j) * (2.0 * eta(i,j) * eta(i+1,j)) / &
3592  (eta(i,j) + eta(i+1,j))
3593  ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j))
3594  enddo ; enddo
3595 !$OMP do
3596  do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
3597  datv(i,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) &
3598  datv(i,j) = cs%dx_Cv(i,j) * (2.0 * eta(i,j) * eta(i,j+1)) / &
3599  (eta(i,j) + eta(i,j+1))
3600  ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (eta(i,j) + eta(i,j+1))
3601  enddo ; enddo
3602  endif
3603  elseif (present(add_max)) then
3604 !$OMP do
3605  do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
3606  datu(i,j) = cs%dy_Cu(i,j) * gv%Z_to_H * &
3607  (max(cs%bathyT(i+1,j), cs%bathyT(i,j)) + add_max)
3608  enddo ; enddo
3609 !$OMP do
3610  do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
3611  datv(i,j) = cs%dx_Cv(i,j) * gv%Z_to_H * &
3612  (max(cs%bathyT(i,j+1), cs%bathyT(i,j)) + add_max)
3613  enddo ; enddo
3614  else
3615 !$OMP do
3616  do j=js-hs,je+hs ; do i=is-1-hs,ie+hs
3617  datu(i, j) = 0.0
3618  !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain
3619  if (cs%bathyT(i+1,j)+cs%bathyT(i,j)>0.) &
3620  datu(i,j) = 2.0*cs%dy_Cu(i,j) * gv%Z_to_H * &
3621  (cs%bathyT(i+1,j) * cs%bathyT(i,j)) / &
3622  (cs%bathyT(i+1,j) + cs%bathyT(i,j))
3623  enddo ; enddo
3624 !$OMP do
3625  do j=js-1-hs,je+hs ; do i=is-hs,ie+hs
3626  datv(i, j) = 0.0
3627  !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain
3628  if (cs%bathyT(i,j+1)+cs%bathyT(i,j)>0.) &
3629  datv(i,j) = 2.0*cs%dx_Cv(i,j) * gv%Z_to_H * &
3630  (cs%bathyT(i,j+1) * cs%bathyT(i,j)) / &
3631  (cs%bathyT(i,j+1) + cs%bathyT(i,j))
3632  enddo ; enddo
3633  endif
3634 !$OMP end parallel
3635 

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]uThe local zonal velocity [L T-1 ~> m s-1]
[in]btcA structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]usA 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.

3031  real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1]
3032  type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that
3033  !! allow the barotropic transports to be calculated consistently
3034  !! with the layers' continuity equations.
3035  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3036 
3037  real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1]
3038 
3039  if (u == 0.0) then
3040  uhbt = 0.0
3041  elseif (u < btc%uBT_EE) then
3042  uhbt = (u - btc%uBT_EE) * btc%FA_u_EE + btc%uh_EE
3043  elseif (u < 0.0) then
3044  uhbt = u * (btc%FA_u_E0 + btc%uh_crvE * u**2)
3045  elseif (u <= btc%uBT_WW) then
3046  uhbt = u * (btc%FA_u_W0 + btc%uh_crvW * u**2)
3047  else ! (u > BTC%uBT_WW)
3048  uhbt = (u - btc%uBT_WW) * btc%FA_u_WW + btc%uh_WW
3049  endif
3050 

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]vThe local meridional velocity [L T-1 ~> m s-1]
[in]btcA structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]usA 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.

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

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]hiA horizontal index type structure.
[in]param_fileA structure to parse for run-time parameters.
csA pointer that is set to point to the control structure for this module.
[in]gvThe ocean's vertical grid structure.
restart_csA pointer to the restart control structure.

Definition at line 4430 of file MOM_barotropic.F90.

4430  type(hor_index_type), intent(in) :: HI !< A horizontal index type structure.
4431  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
4432  type(barotropic_CS), pointer :: CS !< A pointer that is set to point to the control
4433  !! structure for this module.
4434  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
4435  type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
4436 
4437  ! Local variables
4438  type(vardesc) :: vd(3)
4439  real :: slow_rate
4440  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
4441  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed
4442  isdb = hi%IsdB ; iedb = hi%IedB ; jsdb = hi%JsdB ; jedb = hi%JedB
4443 
4444  if (associated(cs)) then
4445  call mom_error(warning, "register_barotropic_restarts called with an associated "// &
4446  "control structure.")
4447  return
4448  endif
4449  allocate(cs)
4450 
4451  alloc_(cs%ubtav(isdb:iedb,jsd:jed)) ; cs%ubtav(:,:) = 0.0
4452  alloc_(cs%vbtav(isd:ied,jsdb:jedb)) ; cs%vbtav(:,:) = 0.0
4453  alloc_(cs%ubt_IC(isdb:iedb,jsd:jed)) ; cs%ubt_IC(:,:) = 0.0
4454  alloc_(cs%vbt_IC(isd:ied,jsdb:jedb)) ; cs%vbt_IC(:,:) = 0.0
4455  alloc_(cs%uhbt_IC(isdb:iedb,jsd:jed)) ; cs%uhbt_IC(:,:) = 0.0
4456  alloc_(cs%vhbt_IC(isd:ied,jsdb:jedb)) ; cs%vhbt_IC(:,:) = 0.0
4457 
4458  vd(2) = var_desc("ubtav","m s-1","Time mean barotropic zonal velocity", &
4459  hor_grid='u', z_grid='1')
4460  vd(3) = var_desc("vbtav","m s-1","Time mean barotropic meridional velocity",&
4461  hor_grid='v', z_grid='1')
4462  call register_restart_field(cs%ubtav, vd(2), .false., restart_cs)
4463  call register_restart_field(cs%vbtav, vd(3), .false., restart_cs)
4464 
4465  vd(2) = var_desc("ubt_IC", "m s-1", &
4466  longname="Next initial condition for the barotropic zonal velocity", &
4467  hor_grid='u', z_grid='1')
4468  vd(3) = var_desc("vbt_IC", "m s-1", &
4469  longname="Next initial condition for the barotropic meridional velocity",&
4470  hor_grid='v', z_grid='1')
4471  call register_restart_field(cs%ubt_IC, vd(2), .false., restart_cs)
4472  call register_restart_field(cs%vbt_IC, vd(3), .false., restart_cs)
4473 
4474  if (gv%Boussinesq) then
4475  vd(2) = var_desc("uhbt_IC", "m3 s-1", &
4476  longname="Next initial condition for the barotropic zonal transport", &
4477  hor_grid='u', z_grid='1')
4478  vd(3) = var_desc("vhbt_IC", "m3 s-1", &
4479  longname="Next initial condition for the barotropic meridional transport",&
4480  hor_grid='v', z_grid='1')
4481  else
4482  vd(2) = var_desc("uhbt_IC", "kg s-1", &
4483  longname="Next initial condition for the barotropic zonal transport", &
4484  hor_grid='u', z_grid='1')
4485  vd(3) = var_desc("vhbt_IC", "kg s-1", &
4486  longname="Next initial condition for the barotropic meridional transport",&
4487  hor_grid='v', z_grid='1')
4488  endif
4489  call register_restart_field(cs%uhbt_IC, vd(2), .false., restart_cs)
4490  call register_restart_field(cs%vhbt_IC, vd(3), .false., restart_cs)
4491 
4492  call register_restart_field(cs%dtbt, "DTBT", .false., restart_cs, &
4493  longname="Barotropic timestep", units="seconds")
4494 

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]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]usA dimensional unit scaling type
csBarotropic control structure.
[in]etaThe barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in]pbceThe 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_contA structure with elements that describe the effective open face areas as a function of barotropic flow.
[in]gtot_estAn estimate of the total gravitational acceleration [L2 Z-1 T-2 ~> m s-2].
[in]ssh_addAn 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.

2259  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
2260  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
2261  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
2262  type(barotropic_CS), pointer :: CS !< Barotropic control structure.
2263  real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface
2264  !! height anomaly or column mass anomaly [H ~> m or kg m-2].
2265  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure
2266  !! anomaly in each layer due to free surface
2267  !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
2268  type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe
2269  !! the effective open face areas as a
2270  !! function of barotropic flow.
2271  real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational
2272  !! acceleration [L2 Z-1 T-2 ~> m s-2].
2273  real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to
2274  !! provide a margin of error when
2275  !! calculating the external wave speed [Z ~> m].
2276 
2277  ! Local variables
2278  real, dimension(SZI_(G),SZJ_(G)) :: &
2279  gtot_E, & ! gtot_X is the effective total reduced gravity used to relate
2280  gtot_W, & ! free surface height deviations to pressure forces (including
2281  gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum
2282  gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W)
2283  ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
2284  ! (See Hallberg, J Comp Phys 1997 for a discussion.)
2285  real, dimension(SZIBS_(G),SZJ_(G)) :: &
2286  Datu ! Basin depth at u-velocity grid points times the y-grid
2287  ! spacing [H L ~> m2 or kg m-1].
2288  real, dimension(SZI_(G),SZJBS_(G)) :: &
2289  Datv ! Basin depth at v-velocity grid points times the x-grid
2290  ! spacing [H L ~> m2 or kg m-1].
2291  real :: det_de ! The partial derivative due to self-attraction and loading
2292  ! of the reference geopotential with the sea surface height [nondim].
2293  ! This is typically ~0.09 or less.
2294  real :: dgeo_de ! The constant of proportionality between geopotential and
2295  ! sea surface height [nondim]. It is a nondimensional number of
2296  ! order 1. For stability, this may be made larger
2297  ! than physical problem would suggest.
2298  real :: add_SSH ! An additional contribution to SSH to provide a margin of error
2299  ! when calculating the external wave speed [Z ~> m].
2300  real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic
2301  ! timesteps [T2 ~> s2]
2302  real :: dtbt_max ! The maximum barotropic timestep [T ~> s]
2303  real :: Idt_max2 ! The squared inverse of the local maximum stable
2304  ! barotropic time step [T-2 ~> s-2].
2305  logical :: use_BT_cont
2306  type(memory_size_type) :: MS
2307 
2308  character(len=200) :: mesg
2309  integer :: i, j, k, is, ie, js, je, nz
2310 
2311  if (.not.associated(cs)) call mom_error(fatal, &
2312  "set_dtbt: Module MOM_barotropic must be initialized before it is used.")
2313  if (.not.cs%split) return
2314  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
2315  ms%isdw = g%isd ; ms%iedw = g%ied ; ms%jsdw = g%jsd ; ms%jedw = g%jed
2316 
2317  if (.not.(present(pbce) .or. present(gtot_est))) call mom_error(fatal, &
2318  "set_dtbt: Either pbce or gtot_est must be present.")
2319 
2320  add_ssh = 0.0 ; if (present(ssh_add)) add_ssh = ssh_add
2321 
2322  use_bt_cont = .false.
2323  if (present(bt_cont)) use_bt_cont = (associated(bt_cont))
2324 
2325  if (use_bt_cont) then
2326  call bt_cont_to_face_areas(bt_cont, datu, datv, g, us, ms, 0, .true.)
2327  elseif (cs%Nonlinear_continuity .and. present(eta)) then
2328  call find_face_areas(datu, datv, g, gv, us, cs, ms, eta=eta, halo=0)
2329  else
2330  call find_face_areas(datu, datv, g, gv, us, cs, ms, halo=0, add_max=add_ssh)
2331  endif
2332 
2333  det_de = 0.0
2334  if (cs%tides) call tidal_forcing_sensitivity(g, cs%tides_CSp, det_de)
2335  dgeo_de = 1.0 + max(0.0, det_de + cs%G_extra)
2336  if (present(pbce)) then
2337  do j=js,je ; do i=is,ie
2338  gtot_e(i,j) = 0.0 ; gtot_w(i,j) = 0.0
2339  gtot_n(i,j) = 0.0 ; gtot_s(i,j) = 0.0
2340  enddo ; enddo
2341  do k=1,nz ; do j=js,je ; do i=is,ie
2342  gtot_e(i,j) = gtot_e(i,j) + pbce(i,j,k) * cs%frhatu(i,j,k)
2343  gtot_w(i,j) = gtot_w(i,j) + pbce(i,j,k) * cs%frhatu(i-1,j,k)
2344  gtot_n(i,j) = gtot_n(i,j) + pbce(i,j,k) * cs%frhatv(i,j,k)
2345  gtot_s(i,j) = gtot_s(i,j) + pbce(i,j,k) * cs%frhatv(i,j-1,k)
2346  enddo ; enddo ; enddo
2347  else
2348  do j=js,je ; do i=is,ie
2349  gtot_e(i,j) = gtot_est * gv%H_to_Z ; gtot_w(i,j) = gtot_est * gv%H_to_Z
2350  gtot_n(i,j) = gtot_est * gv%H_to_Z ; gtot_s(i,j) = gtot_est * gv%H_to_Z
2351  enddo ; enddo
2352  endif
2353 
2354  min_max_dt2 = 1.0e38*us%s_to_T**2 ! A huge value for the permissible timestep squared.
2355  do j=js,je ; do i=is,ie
2356  ! This is pretty accurate for gravity waves, but it is a conservative
2357  ! estimate since it ignores the stabilizing effect of the bottom drag.
2358  idt_max2 = 0.5 * (1.0 + 2.0*cs%bebt) * (g%IareaT(i,j) * &
2359  ((gtot_e(i,j)*datu(i,j)*g%IdxCu(i,j) + gtot_w(i,j)*datu(i-1,j)*g%IdxCu(i-1,j)) + &
2360  (gtot_n(i,j)*datv(i,j)*g%IdyCv(i,j) + gtot_s(i,j)*datv(i,j-1)*g%IdyCv(i,j-1))) + &
2361  ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
2362  (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2)))
2363  if (idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / idt_max2
2364  enddo ; enddo
2365  dtbt_max = sqrt(min_max_dt2 / dgeo_de)
2366  if (id_clock_sync > 0) call cpu_clock_begin(id_clock_sync)
2367  call min_across_pes(dtbt_max)
2368  if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync)
2369 
2370  cs%dtbt = cs%dtbt_fraction * dtbt_max
2371  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_contThe BT_cont_type input to the barotropic solver.
[in]msA type that describes the memory sizes of the argument arrays.
[out]btcl_uA structure with the u information from BT_cont.
[out]btcl_vA structure with the v information from BT_cont.
[in]gThe ocean's grid structure.
[in]usA dimensional unit scaling type
[in,out]bt_domainThe domain to use for updating the halos of wide arrays.
[in]haloThe extra halo size to use here.

Definition at line 3267 of file MOM_barotropic.F90.

3267  type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the
3268  !! barotropic solver.
3269  type(memory_size_type), intent(in) :: MS !< A type that describes the
3270  !! memory sizes of the argument
3271  !! arrays.
3272  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(out) :: BTCL_u !< A structure with the u
3273  !! information from BT_cont.
3274  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v
3275  !! information from BT_cont.
3276  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
3277  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3278  type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating
3279  !! the halos of wide arrays.
3280  integer, optional, intent(in) :: halo !< The extra halo size to use here.
3281 
3282  ! Local variables
3283  real, dimension(SZIBW_(MS),SZJW_(MS)) :: &
3284  u_polarity, uBT_EE, uBT_WW, FA_u_EE, FA_u_E0, FA_u_W0, FA_u_WW
3285  real, dimension(SZIW_(MS),SZJBW_(MS)) :: &
3286  v_polarity, vBT_NN, vBT_SS, FA_v_NN, FA_v_N0, FA_v_S0, FA_v_SS
3287  real, parameter :: C1_3 = 1.0/3.0
3288  integer :: i, j, is, ie, js, je, hs
3289  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
3290  hs = 1 ; if (present(halo)) hs = max(halo,0)
3291 
3292  ! Copy the BT_cont arrays into symmetric, potentially wide haloed arrays.
3293 !$OMP parallel default(none) shared(is,ie,js,je,hs,u_polarity,uBT_EE,uBT_WW,FA_u_EE, &
3294 !$OMP FA_u_E0,FA_u_W0,FA_u_WW,v_polarity,vBT_NN,vBT_SS,&
3295 !$OMP FA_v_NN,FA_v_N0,FA_v_S0,FA_v_SS,BT_cont )
3296 !$OMP do
3297  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
3298  u_polarity(i,j) = 1.0
3299  ubt_ee(i,j) = 0.0 ; ubt_ww(i,j) = 0.0
3300  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
3301  enddo ; enddo
3302 !$OMP do
3303  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
3304  v_polarity(i,j) = 1.0
3305  vbt_nn(i,j) = 0.0 ; vbt_ss(i,j) = 0.0
3306  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
3307  enddo ; enddo
3308 !$OMP do
3309  do j=js,je; do i=is-1,ie
3310  ubt_ee(i,j) = bt_cont%uBT_EE(i,j) ; ubt_ww(i,j) = bt_cont%uBT_WW(i,j)
3311  fa_u_ee(i,j) = bt_cont%FA_u_EE(i,j) ; fa_u_e0(i,j) = bt_cont%FA_u_E0(i,j)
3312  fa_u_w0(i,j) = bt_cont%FA_u_W0(i,j) ; fa_u_ww(i,j) = bt_cont%FA_u_WW(i,j)
3313  enddo ; enddo
3314 !$OMP do
3315  do j=js-1,je; do i=is,ie
3316  vbt_nn(i,j) = bt_cont%vBT_NN(i,j) ; vbt_ss(i,j) = bt_cont%vBT_SS(i,j)
3317  fa_v_nn(i,j) = bt_cont%FA_v_NN(i,j) ; fa_v_n0(i,j) = bt_cont%FA_v_N0(i,j)
3318  fa_v_s0(i,j) = bt_cont%FA_v_S0(i,j) ; fa_v_ss(i,j) = bt_cont%FA_v_SS(i,j)
3319  enddo ; enddo
3320 !$OMP end parallel
3321 
3322  if (id_clock_calc_pre > 0) call cpu_clock_end(id_clock_calc_pre)
3323  if (id_clock_pass_pre > 0) call cpu_clock_begin(id_clock_pass_pre)
3324 !--- begin setup for group halo update
3325  call create_group_pass(bt_cont%pass_polarity_BT, u_polarity, v_polarity, bt_domain)
3326  call create_group_pass(bt_cont%pass_polarity_BT, ubt_ee, vbt_nn, bt_domain)
3327  call create_group_pass(bt_cont%pass_polarity_BT, ubt_ww, vbt_ss, bt_domain)
3328 
3329  call create_group_pass(bt_cont%pass_FA_uv, fa_u_ee, fa_v_nn, bt_domain, to_all+scalar_pair)
3330  call create_group_pass(bt_cont%pass_FA_uv, fa_u_e0, fa_v_n0, bt_domain, to_all+scalar_pair)
3331  call create_group_pass(bt_cont%pass_FA_uv, fa_u_w0, fa_v_s0, bt_domain, to_all+scalar_pair)
3332  call create_group_pass(bt_cont%pass_FA_uv, fa_u_ww, fa_v_ss, bt_domain, to_all+scalar_pair)
3333 !--- end setup for group halo update
3334  ! Do halo updates on BT_cont.
3335  call do_group_pass(bt_cont%pass_polarity_BT, bt_domain)
3336  call do_group_pass(bt_cont%pass_FA_uv, bt_domain)
3337  if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
3338  if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
3339 
3340 !$OMP parallel default(none) shared(is,ie,js,je,hs,BTCL_u,FA_u_EE,FA_u_E0,FA_u_W0, &
3341 !$OMP FA_u_WW,uBT_EE,uBT_WW,u_polarity,BTCL_v, &
3342 !$OMP FA_v_NN,FA_v_N0,FA_v_S0,FA_v_SS,vBT_NN,vBT_SS, &
3343 !$OMP v_polarity )
3344 !$OMP do
3345  do j=js-hs,je+hs ; do i=is-hs-1,ie+hs
3346  btcl_u(i,j)%FA_u_EE = fa_u_ee(i,j) ; btcl_u(i,j)%FA_u_E0 = fa_u_e0(i,j)
3347  btcl_u(i,j)%FA_u_W0 = fa_u_w0(i,j) ; btcl_u(i,j)%FA_u_WW = fa_u_ww(i,j)
3348  btcl_u(i,j)%uBT_EE = ubt_ee(i,j) ; btcl_u(i,j)%uBT_WW = ubt_ww(i,j)
3349  ! Check for reversed polarity in the tripolar halo regions.
3350  if (u_polarity(i,j) < 0.0) then
3351  call swap(btcl_u(i,j)%FA_u_EE, btcl_u(i,j)%FA_u_WW)
3352  call swap(btcl_u(i,j)%FA_u_E0, btcl_u(i,j)%FA_u_W0)
3353  call swap(btcl_u(i,j)%uBT_EE, btcl_u(i,j)%uBT_WW)
3354  endif
3355 
3356  btcl_u(i,j)%uh_EE = btcl_u(i,j)%uBT_EE * &
3357  (c1_3 * (2.0*btcl_u(i,j)%FA_u_E0 + btcl_u(i,j)%FA_u_EE))
3358  btcl_u(i,j)%uh_WW = btcl_u(i,j)%uBT_WW * &
3359  (c1_3 * (2.0*btcl_u(i,j)%FA_u_W0 + btcl_u(i,j)%FA_u_WW))
3360 
3361  btcl_u(i,j)%uh_crvE = 0.0 ; btcl_u(i,j)%uh_crvW = 0.0
3362  if (abs(btcl_u(i,j)%uBT_WW) > 0.0) btcl_u(i,j)%uh_crvW = &
3363  (c1_3 * (btcl_u(i,j)%FA_u_WW - btcl_u(i,j)%FA_u_W0)) / btcl_u(i,j)%uBT_WW**2
3364  if (abs(btcl_u(i,j)%uBT_EE) > 0.0) btcl_u(i,j)%uh_crvE = &
3365  (c1_3 * (btcl_u(i,j)%FA_u_EE - btcl_u(i,j)%FA_u_E0)) / btcl_u(i,j)%uBT_EE**2
3366  enddo ; enddo
3367 !$OMP do
3368  do j=js-hs-1,je+hs ; do i=is-hs,ie+hs
3369  btcl_v(i,j)%FA_v_NN = fa_v_nn(i,j) ; btcl_v(i,j)%FA_v_N0 = fa_v_n0(i,j)
3370  btcl_v(i,j)%FA_v_S0 = fa_v_s0(i,j) ; btcl_v(i,j)%FA_v_SS = fa_v_ss(i,j)
3371  btcl_v(i,j)%vBT_NN = vbt_nn(i,j) ; btcl_v(i,j)%vBT_SS = vbt_ss(i,j)
3372  ! Check for reversed polarity in the tripolar halo regions.
3373  if (v_polarity(i,j) < 0.0) then
3374  call swap(btcl_v(i,j)%FA_v_NN, btcl_v(i,j)%FA_v_SS)
3375  call swap(btcl_v(i,j)%FA_v_N0, btcl_v(i,j)%FA_v_S0)
3376  call swap(btcl_v(i,j)%vBT_NN, btcl_v(i,j)%vBT_SS)
3377  endif
3378 
3379  btcl_v(i,j)%vh_NN = btcl_v(i,j)%vBT_NN * &
3380  (c1_3 * (2.0*btcl_v(i,j)%FA_v_N0 + btcl_v(i,j)%FA_v_NN))
3381  btcl_v(i,j)%vh_SS = btcl_v(i,j)%vBT_SS * &
3382  (c1_3 * (2.0*btcl_v(i,j)%FA_v_S0 + btcl_v(i,j)%FA_v_SS))
3383 
3384  btcl_v(i,j)%vh_crvN = 0.0 ; btcl_v(i,j)%vh_crvS = 0.0
3385  if (abs(btcl_v(i,j)%vBT_SS) > 0.0) btcl_v(i,j)%vh_crvS = &
3386  (c1_3 * (btcl_v(i,j)%FA_v_SS - btcl_v(i,j)%FA_v_S0)) / btcl_v(i,j)%vBT_SS**2
3387  if (abs(btcl_v(i,j)%vBT_NN) > 0.0) btcl_v(i,j)%vh_crvN = &
3388  (c1_3 * (btcl_v(i,j)%FA_v_NN - btcl_v(i,j)%FA_v_N0)) / btcl_v(i,j)%vBT_NN**2
3389  enddo ; enddo
3390 !$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
obcAn associated pointer to an OBC type.
[in]msA type that describes the memory sizes of the argument arrays.
[in]etaThe barotropic free surface height anomaly or column mass anomaly [H ~> m or kg m-2].
[in,out]bt_obcA structure with the private barotropic arrays related to the open boundary conditions, set by set_up_BT_OBC.
[in,out]bt_domainMOM_domain_type associated with wide arrays
[in,out]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]usA dimensional unit scaling type
[in]haloThe extra halo size to use here.
[in]use_bt_contIf true, use the BT_cont_types to calculate transports.
[in]datuA fixed estimate of the face areas at u points [H L ~> m2 or kg m-1].
[in]datvA fixed estimate of the face areas at v points [H L ~> m2 or kg m-1].
[in]btcl_uStructure of information used for a dynamic estimate of the face areas at u-points.
[in]btcl_vStructure of information used for a dynamic estimate of the face areas at v-points.

Definition at line 2557 of file MOM_barotropic.F90.

2557  type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type.
2558  type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the
2559  !! argument arrays.
2560  real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or
2561  !! column mass anomaly [H ~> m or kg m-2].
2562  type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays
2563  !! related to the open boundary conditions,
2564  !! set by set_up_BT_OBC.
2565  type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays
2566  type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
2567  type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
2568  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
2569  integer, intent(in) :: halo !< The extra halo size to use here.
2570  logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate
2571  !! transports.
2572  real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points
2573  !! [H L ~> m2 or kg m-1].
2574  real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points
2575  !! [H L ~> m2 or kg m-1].
2576  type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used
2577  !! for a dynamic estimate of the face areas at
2578  !! u-points.
2579  type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used
2580  !! for a dynamic estimate of the face areas at
2581  !! v-points.
2582 
2583  ! Local variables
2584  integer :: i, j, k, is, ie, js, je, n, nz, Isq, Ieq, Jsq, Jeq
2585  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
2586  integer :: isdw, iedw, jsdw, jedw
2587  logical :: OBC_used
2588  type(OBC_segment_type), pointer :: segment !< Open boundary segment
2589 
2590 
2591  is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
2592  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed ; nz = g%ke
2593  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
2594  isdw = ms%isdw ; iedw = ms%iedw ; jsdw = ms%jsdw ; jedw = ms%jedw
2595 
2596 
2597  if ((isdw < isd) .or. (jsdw < jsd)) then
2598  call mom_error(fatal, "set_up_BT_OBC: Open boundary conditions are not "//&
2599  "yet fully implemented with wide barotropic halos.")
2600  endif
2601 
2602  if (.not. bt_obc%is_alloced) then
2603  allocate(bt_obc%Cg_u(isdw-1:iedw,jsdw:jedw)) ; bt_obc%Cg_u(:,:) = 0.0
2604  allocate(bt_obc%H_u(isdw-1:iedw,jsdw:jedw)) ; bt_obc%H_u(:,:) = 0.0
2605  allocate(bt_obc%uhbt(isdw-1:iedw,jsdw:jedw)) ; bt_obc%uhbt(:,:) = 0.0
2606  allocate(bt_obc%ubt_outer(isdw-1:iedw,jsdw:jedw)) ; bt_obc%ubt_outer(:,:) = 0.0
2607  allocate(bt_obc%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; bt_obc%eta_outer_u(:,:) = 0.0
2608 
2609  allocate(bt_obc%Cg_v(isdw:iedw,jsdw-1:jedw)) ; bt_obc%Cg_v(:,:) = 0.0
2610  allocate(bt_obc%H_v(isdw:iedw,jsdw-1:jedw)) ; bt_obc%H_v(:,:) = 0.0
2611  allocate(bt_obc%vhbt(isdw:iedw,jsdw-1:jedw)) ; bt_obc%vhbt(:,:) = 0.0
2612  allocate(bt_obc%vbt_outer(isdw:iedw,jsdw-1:jedw)) ; bt_obc%vbt_outer(:,:) = 0.0
2613  allocate(bt_obc%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; bt_obc%eta_outer_v(:,:)=0.0
2614  bt_obc%is_alloced = .true.
2615  call create_group_pass(bt_obc%pass_uv, bt_obc%ubt_outer, bt_obc%vbt_outer, bt_domain)
2616  call create_group_pass(bt_obc%pass_uhvh, bt_obc%uhbt, bt_obc%vhbt, bt_domain)
2617  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)
2618  call create_group_pass(bt_obc%pass_h, bt_obc%H_u, bt_obc%H_v, bt_domain,to_all+scalar_pair)
2619  call create_group_pass(bt_obc%pass_cg, bt_obc%Cg_u, bt_obc%Cg_v, bt_domain,to_all+scalar_pair)
2620  endif
2621 
2622  if (bt_obc%apply_u_OBCs) then
2623  if (obc%specified_u_BCs_exist_globally) then
2624  do n = 1, obc%number_of_segments
2625  segment => obc%segment(n)
2626  if (segment%is_E_or_W .and. segment%specified) then
2627  do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
2628  bt_obc%uhbt(i,j) = 0.
2629  enddo ; enddo
2630  do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
2631  bt_obc%uhbt(i,j) = bt_obc%uhbt(i,j) + segment%normal_trans(i,j,k)
2632  enddo ; enddo ; enddo
2633  endif
2634  enddo
2635  endif
2636  do j=js,je ; do i=is-1,ie ; if (obc%segnum_u(i,j) /= obc_none) then
2637  ! Can this go in segment loop above? Is loop above wrong for wide halos??
2638  if (obc%segment(obc%segnum_u(i,j))%specified) then
2639  if (use_bt_cont) then
2640  bt_obc%ubt_outer(i,j) = uhbt_to_ubt(bt_obc%uhbt(i,j), btcl_u(i,j), us)
2641  else
2642  if (datu(i,j) > 0.0) bt_obc%ubt_outer(i,j) = bt_obc%uhbt(i,j) / datu(i,j)
2643  endif
2644  else ! This is assuming Flather as only other option
2645  if (gv%Boussinesq) then
2646  if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
2647  bt_obc%H_u(i,j) = g%bathyT(i,j)*gv%Z_to_H + eta(i,j)
2648  elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
2649  bt_obc%H_u(i,j) = g%bathyT(i+1,j)*gv%Z_to_H + eta(i+1,j)
2650  endif
2651  else
2652  if (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_e) then
2653  bt_obc%H_u(i,j) = eta(i,j)
2654  elseif (obc%segment(obc%segnum_u(i,j))%direction == obc_direction_w) then
2655  bt_obc%H_u(i,j) = eta(i+1,j)
2656  endif
2657  endif
2658  bt_obc%Cg_u(i,j) = sqrt(gv%g_prime(1) * gv%H_to_Z*bt_obc%H_u(i,j))
2659  endif
2660  endif ; enddo ; enddo
2661  if (obc%Flather_u_BCs_exist_globally) then
2662  do n = 1, obc%number_of_segments
2663  segment => obc%segment(n)
2664  if (segment%is_E_or_W .and. segment%Flather) then
2665  do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%IsdB,segment%HI%IedB
2666  bt_obc%ubt_outer(i,j) = segment%normal_vel_bt(i,j)
2667  bt_obc%eta_outer_u(i,j) = segment%eta(i,j)
2668  enddo ; enddo
2669  endif
2670  enddo
2671  endif
2672  endif
2673 
2674  if (bt_obc%apply_v_OBCs) then
2675  if (obc%specified_v_BCs_exist_globally) then
2676  do n = 1, obc%number_of_segments
2677  segment => obc%segment(n)
2678  if (segment%is_N_or_S .and. segment%specified) then
2679  do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
2680  bt_obc%vhbt(i,j) = 0.
2681  enddo ; enddo
2682  do k=1,nz ; do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
2683  bt_obc%vhbt(i,j) = bt_obc%vhbt(i,j) + segment%normal_trans(i,j,k)
2684  enddo ; enddo ; enddo
2685  endif
2686  enddo
2687  endif
2688  do j=js-1,je ; do i=is,ie ; if (obc%segnum_v(i,j) /= obc_none) then
2689  ! Can this go in segment loop above? Is loop above wrong for wide halos??
2690  if (obc%segment(obc%segnum_v(i,j))%specified) then
2691  if (use_bt_cont) then
2692  bt_obc%vbt_outer(i,j) = vhbt_to_vbt(bt_obc%vhbt(i,j), btcl_v(i,j), us)
2693  else
2694  if (datv(i,j) > 0.0) bt_obc%vbt_outer(i,j) = bt_obc%vhbt(i,j) / datv(i,j)
2695  endif
2696  else ! This is assuming Flather as only other option
2697  if (gv%Boussinesq) then
2698  if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
2699  bt_obc%H_v(i,j) = g%bathyT(i,j)*gv%Z_to_H + eta(i,j)
2700  elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
2701  bt_obc%H_v(i,j) = g%bathyT(i,j+1)*gv%Z_to_H + eta(i,j+1)
2702  endif
2703  else
2704  if (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_n) then
2705  bt_obc%H_v(i,j) = eta(i,j)
2706  elseif (obc%segment(obc%segnum_v(i,j))%direction == obc_direction_s) then
2707  bt_obc%H_v(i,j) = eta(i,j+1)
2708  endif
2709  endif
2710  bt_obc%Cg_v(i,j) = sqrt(gv%g_prime(1) * gv%H_to_Z*bt_obc%H_v(i,j))
2711  endif
2712  endif ; enddo ; enddo
2713  if (obc%Flather_v_BCs_exist_globally) then
2714  do n = 1, obc%number_of_segments
2715  segment => obc%segment(n)
2716  if (segment%is_N_or_S .and. segment%Flather) then
2717  do j=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
2718  bt_obc%vbt_outer(i,j) = segment%normal_vel_bt(i,j)
2719  bt_obc%eta_outer_v(i,j) = segment%eta(i,j)
2720  enddo ; enddo
2721  endif
2722  enddo
2723  endif
2724  endif
2725 
2726  call do_group_pass(bt_obc%pass_uv, bt_domain)
2727  call do_group_pass(bt_obc%pass_uhvh, bt_domain)
2728  call do_group_pass(bt_obc%pass_eta_outer, bt_domain)
2729  call do_group_pass(bt_obc%pass_h, bt_domain)
2730  call do_group_pass(bt_obc%pass_cg, bt_domain)
2731 

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]aThe first variable to be swapped.
[in,out]bThe second variable to be swapped.

Definition at line 3536 of file MOM_barotropic.F90.

3536  real, intent(inout) :: a !< The first variable to be swapped.
3537  real, intent(inout) :: b !< The second variable to be swapped.
3538  real :: tmp
3539  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]uhbtThe barotropic zonal transport that should be inverted for, [H L2 T-1 ~> m3 s-1 or kg s-1].
[in]btcA structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]usA dimensional unit scaling type
[in]guessA 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.

3056  real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for,
3057  !! [H L2 T-1 ~> m3 s-1 or kg s-1].
3058  type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the
3059  !! barotropic transports to be calculated consistently with the
3060  !! layers' continuity equations.
3061  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3062  real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1]. The result
3063  !! is not allowed to be dramatically larger than guess.
3064  real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1].
3065 
3066  ! Local variables
3067  real :: ubt_min, ubt_max, uhbt_err, derr_du
3068  real :: uherr_min, uherr_max
3069  real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
3070  real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
3071  real :: vsr ! Temporary variable used in the limiting the velocity [nondim].
3072  real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
3073  real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
3074  ! maximum increase of vs2, both nondim.
3075  integer :: itt, max_itt = 20
3076 
3077  ! Find the value of ubt that gives uhbt.
3078  if (uhbt == 0.0) then
3079  ubt = 0.0
3080  elseif (uhbt < btc%uh_EE) then
3081  ubt = btc%uBT_EE + (uhbt - btc%uh_EE) / btc%FA_u_EE
3082  elseif (uhbt < 0.0) then
3083  ! Iterate to convergence with Newton's method (when bounded) and the
3084  ! false position method otherwise. ubt will be negative.
3085  ubt_min = btc%uBT_EE ; uherr_min = btc%uh_EE - uhbt
3086  ubt_max = 0.0 ; uherr_max = -uhbt
3087  ! Use a false-position method first guess.
3088  ubt = btc%uBT_EE * (uhbt / btc%uh_EE)
3089  do itt = 1, max_itt
3090  uhbt_err = ubt * (btc%FA_u_E0 + btc%uh_crvE * ubt**2) - uhbt
3091 
3092  if (abs(uhbt_err) < tol*abs(uhbt)) exit
3093  if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
3094  if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
3095 
3096  derr_du = btc%FA_u_E0 + 3.0 * btc%uh_crvE * ubt**2
3097  if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
3098  (-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
3099  ! Use a false-position method guess.
3100  ubt = ubt_max + (ubt_min-ubt_max) * (uherr_max / (uherr_max-uherr_min))
3101  else ! Use Newton's method.
3102  ubt = ubt - uhbt_err / derr_du
3103  if (abs(uhbt_err) < (0.01*tol)*abs(ubt_min*derr_du)) exit
3104  endif
3105  enddo
3106  elseif (uhbt <= btc%uh_WW) then
3107  ! Iterate to convergence with Newton's method. ubt will be positive.
3108  ubt_min = 0.0 ; uherr_min = -uhbt
3109  ubt_max = btc%uBT_WW ; uherr_max = btc%uh_WW - uhbt
3110  ! Use a false-position method first guess.
3111  ubt = btc%uBT_WW * (uhbt / btc%uh_WW)
3112  do itt = 1, max_itt
3113  uhbt_err = ubt * (btc%FA_u_W0 + btc%uh_crvW * ubt**2) - uhbt
3114 
3115  if (abs(uhbt_err) < tol*abs(uhbt)) exit
3116  if (uhbt_err > 0.0) then ; ubt_max = ubt ; uherr_max = uhbt_err ; endif
3117  if (uhbt_err < 0.0) then ; ubt_min = ubt ; uherr_min = uhbt_err ; endif
3118 
3119  derr_du = btc%FA_u_W0 + 3.0 * btc%uh_crvW * ubt**2
3120  if ((uhbt_err >= derr_du*(ubt - ubt_min)) .or. &
3121  (-uhbt_err >= derr_du*(ubt_max - ubt)) .or. (derr_du <= 0.0)) then
3122  ! Use a false-position method guess.
3123  ubt = ubt_min + (ubt_max-ubt_min) * (-uherr_min / (uherr_max-uherr_min))
3124  else ! Use Newton's method.
3125  ubt = ubt - uhbt_err / derr_du
3126  if (abs(uhbt_err) < (0.01*tol)*(ubt_max*derr_du)) exit
3127  endif
3128  enddo
3129  else ! (uhbt > BTC%uh_WW)
3130  ubt = btc%uBT_WW + (uhbt - btc%uh_WW) / btc%FA_u_WW
3131  endif
3132 
3133  if (present(guess)) then
3134  dvel = abs(ubt) - vs1*abs(guess)
3135  if (dvel > 0.0) then ! Limit the velocity
3136  if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then
3137  vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1)))
3138  else ! The exp be less than 4e-18 anyway in this case, so neglect it.
3139  vsr = vs2
3140  endif
3141  ubt = sign(vsr * guess, ubt)
3142  endif
3143  endif
3144 

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]vhbtThe barotropic meridional transport that should be inverted for [H L2 T-1 ~> m3 s-1 or kg s-1].
[in]btcA structure containing various fields that allow the barotropic transports to be calculated consistently with the layers' continuity equations.
[in]usA dimensional unit scaling type
[in]guessA 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.

3173  real, intent(in) :: vhbt !< The barotropic meridional transport that should be
3174  !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1].
3175  type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the
3176  !! barotropic transports to be calculated consistently
3177  !! with the layers' continuity equations.
3178  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3179  real, optional, intent(in) :: guess !< A guess at what vbt will be. The result is not allowed
3180  !! to be dramatically larger than guess [L T-1 ~> m s-1].
3181  real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1].
3182 
3183  ! Local variables
3184  real :: vbt_min, vbt_max, vhbt_err, derr_dv
3185  real :: vherr_min, vherr_max
3186  real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim]
3187  real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1].
3188  real :: vsr ! Temporary variable used in the limiting the velocity [nondim].
3189  real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting
3190  real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the
3191  ! maximum increase of vs2, both nondim.
3192  integer :: itt, max_itt = 20
3193 
3194  ! Find the value of vbt that gives vhbt.
3195  if (vhbt == 0.0) then
3196  vbt = 0.0
3197  elseif (vhbt < btc%vh_NN) then
3198  vbt = btc%vBT_NN + (vhbt - btc%vh_NN) / btc%FA_v_NN
3199  elseif (vhbt < 0.0) then
3200  ! Iterate to convergence with Newton's method (when bounded) and the
3201  ! false position method otherwise. vbt will be negative.
3202  vbt_min = btc%vBT_NN ; vherr_min = btc%vh_NN - vhbt
3203  vbt_max = 0.0 ; vherr_max = -vhbt
3204  ! Use a false-position method first guess.
3205  vbt = btc%vBT_NN * (vhbt / btc%vh_NN)
3206  do itt = 1, max_itt
3207  vhbt_err = vbt * (btc%FA_v_N0 + btc%vh_crvN * vbt**2) - vhbt
3208 
3209  if (abs(vhbt_err) < tol*abs(vhbt)) exit
3210  if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
3211  if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
3212 
3213  derr_dv = btc%FA_v_N0 + 3.0 * btc%vh_crvN * vbt**2
3214  if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
3215  (-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
3216  ! Use a false-position method guess.
3217  vbt = vbt_max + (vbt_min-vbt_max) * (vherr_max / (vherr_max-vherr_min))
3218  else ! Use Newton's method.
3219  vbt = vbt - vhbt_err / derr_dv
3220  if (abs(vhbt_err) < (0.01*tol)*abs(derr_dv*vbt_min)) exit
3221  endif
3222  enddo
3223  elseif (vhbt <= btc%vh_SS) then
3224  ! Iterate to convergence with Newton's method. vbt will be positive.
3225  vbt_min = 0.0 ; vherr_min = -vhbt
3226  vbt_max = btc%vBT_SS ; vherr_max = btc%vh_SS - vhbt
3227  ! Use a false-position method first guess.
3228  vbt = btc%vBT_SS * (vhbt / btc%vh_SS)
3229  do itt = 1, max_itt
3230  vhbt_err = vbt * (btc%FA_v_S0 + btc%vh_crvS * vbt**2) - vhbt
3231 
3232  if (abs(vhbt_err) < tol*abs(vhbt)) exit
3233  if (vhbt_err > 0.0) then ; vbt_max = vbt ; vherr_max = vhbt_err ; endif
3234  if (vhbt_err < 0.0) then ; vbt_min = vbt ; vherr_min = vhbt_err ; endif
3235 
3236  derr_dv = btc%FA_v_S0 + 3.0 * btc%vh_crvS * vbt**2
3237  if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
3238  (-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0)) then
3239  ! Use a false-position method guess.
3240  vbt = vbt_min + (vbt_max-vbt_min) * (-vherr_min / (vherr_max-vherr_min))
3241  else ! Use Newton's method.
3242  vbt = vbt - vhbt_err / derr_dv
3243  if (abs(vhbt_err) < (0.01*tol)*(vbt_max*derr_dv)) exit
3244  endif
3245  enddo
3246  else ! (vhbt > BTC%vh_SS)
3247  vbt = btc%vBT_SS + (vhbt - btc%vh_SS) / btc%FA_v_SS
3248  endif
3249 
3250  if (present(guess)) then
3251  dvel = abs(vbt) - vs1*abs(guess)
3252  if (dvel > 0.0) then ! Limit the velocity
3253  if (dvel < 40.0 * (abs(guess)*(vs2-vs1)) ) then
3254  vsr = vs2 - (vs2-vs1) * exp(-dvel / (abs(guess)*(vs2-vs1)))
3255  else ! The exp be less than 4e-18 anyway in this case, so neglect it.
3256  vsr = vs2
3257  endif
3258  vbt = sign(guess * vsr, vbt)
3259  endif
3260  endif
3261 

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.

365 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.

371 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.

372 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.

367 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.

364 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.

370 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.

366 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.

368 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.

369 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.

359 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.

360 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.

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

Referenced by barotropic_init(), and set_dtbt().