MOM6
MOM_dynamics_split_RK2.F90
1 !> Time step the adiabatic dynamic core of MOM using RK2 method.
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
7 use mom_variables, only : bt_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type
10 
11 use mom_checksum_packages, only : mom_thermo_chksum, mom_state_chksum, mom_accel_chksum
12 use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
13 use mom_cpu_clock, only : clock_component, clock_subcomponent
14 use mom_cpu_clock, only : clock_module_driver, clock_module, clock_routine
15 use mom_diag_mediator, only : diag_mediator_init, enable_averaging
16 use mom_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr
17 use mom_diag_mediator, only : register_diag_field, register_static_field
18 use mom_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids
19 use mom_domains, only : mom_domains_init
20 use mom_domains, only : to_south, to_west, to_all, cgrid_ne, scalar_pair
21 use mom_domains, only : to_north, to_east, omit_corners
22 use mom_domains, only : create_group_pass, do_group_pass, group_pass_type
23 use mom_domains, only : start_group_pass, complete_group_pass, pass_var
24 use mom_debugging, only : hchksum, uvchksum
25 use mom_error_handler, only : mom_error, mom_mesg, fatal, warning, is_root_pe
26 use mom_error_handler, only : mom_set_verbosity, calltree_showquery
27 use mom_error_handler, only : calltree_enter, calltree_leave, calltree_waypoint
29 use mom_get_input, only : directories
30 use mom_io, only : mom_io_init, vardesc, var_desc
31 use mom_restart, only : register_restart_field, query_initialized, save_restart
32 use mom_restart, only : restart_init, is_new_run, mom_restart_cs
33 use mom_time_manager, only : time_type, time_type_to_real, operator(+)
34 use mom_time_manager, only : operator(-), operator(>), operator(*), operator(/)
35 
36 use mom_ale, only : ale_cs
37 use mom_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source
38 use mom_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_cs
39 use mom_boundary_update, only : update_obc_data, update_obc_cs
40 use mom_continuity, only : continuity, continuity_init, continuity_cs
41 use mom_continuity, only : continuity_stencil
42 use mom_coriolisadv, only : coradcalc, coriolisadv_init, coriolisadv_cs
44 use mom_grid, only : ocean_grid_type
45 use mom_hor_index, only : hor_index_type
46 use mom_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_cs
49 use mom_meke_types, only : meke_type
50 use mom_open_boundary, only : ocean_obc_type, radiation_open_bdry_conds
51 use mom_open_boundary, only : open_boundary_zero_normal_flow
52 use mom_open_boundary, only : open_boundary_test_extern_h
53 use mom_pressureforce, only : pressureforce, pressureforce_init, pressureforce_cs
54 use mom_set_visc, only : set_viscous_ml, set_visc_cs
56 use mom_tidal_forcing, only : tidal_forcing_init, tidal_forcing_cs
58 use mom_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant
59 use mom_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_cs
60 use mom_vert_friction, only : updatecfltruncationvalue
61 use mom_verticalgrid, only : verticalgrid_type, get_thickness_units
62 use mom_verticalgrid, only : get_flux_units, get_tr_flux_units
64 
65 implicit none ; private
66 
67 #include <MOM_memory.h>
68 
69 !> MOM_dynamics_split_RK2 module control structure
70 type, public :: mom_dyn_split_rk2_cs ; private
71  real allocable_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
72  cau, & !< CAu = f*v - u.grad(u) [m s-2]
73  pfu, & !< PFu = -dM/dx [m s-2]
74  diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]
75 
76  real allocable_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
77  cav, & !< CAv = -f*u - u.grad(v) [m s-2]
78  pfv, & !< PFv = -dM/dy [m s-2]
79  diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]
80 
81  real allocable_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u
82  !< Both the fraction of the zonal momentum originally in a
83  !! layer that remains after a time-step of viscosity, and the
84  !! fraction of a time-step worth of a barotropic acceleration
85  !! that a layer experiences after viscosity is applied.
86  !! Nondimensional between 0 (at the bottom) and 1 (far above).
87  real allocable_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt
88  !< The zonal layer accelerations due to the difference between
89  !! the barotropic accelerations and the baroclinic accelerations
90  !! that were fed into the barotopic calculation [m s-2]
91  real allocable_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v
92  !< Both the fraction of the meridional momentum originally in
93  !! a layer that remains after a time-step of viscosity, and the
94  !! fraction of a time-step worth of a barotropic acceleration
95  !! that a layer experiences after viscosity is applied.
96  !! Nondimensional between 0 (at the bottom) and 1 (far above).
97  real allocable_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt
98  !< The meridional layer accelerations due to the difference between
99  !! the barotropic accelerations and the baroclinic accelerations
100  !! that were fed into the barotopic calculation [m s-2]
101 
102  ! The following variables are only used with the split time stepping scheme.
103  real allocable_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq
104  !! mode) or column mass anomaly (in non-Boussinesq
105  !! mode) [H ~> m or kg m-2]
106  real allocable_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by
107  !! time-mean barotropic velocity over a baroclinic
108  !! timestep [m s-1]
109  real allocable_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by
110  !! time-mean barotropic velocity over a baroclinic
111  !! timestep [m s-1]
112  real allocable_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer
113  !! thicknesses [H ~> m or kg m-2]
114  real allocable_, dimension(NIMEM_,NJMEM_) :: eta_pf !< instantaneous SSH used in calculating PFu and
115  !! PFv [H ~> m or kg m-2]
116  real allocable_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the
117  !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1].
118  !! uhbt is roughly equal to the vertical sum of uh.
119  real allocable_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the
120  !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1].
121  !! vhbt is roughly equal to vertical sum of vh.
122  real allocable_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure
123  !! anomaly in each layer due to free surface height
124  !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2].
125 
126  real, pointer, dimension(:,:) :: taux_bot => null() !< frictional x-bottom stress from the ocean to the seafloor [Pa]
127  real, pointer, dimension(:,:) :: tauy_bot => null() !< frictional y-bottom stress from the ocean to the seafloor [Pa]
128  type(bt_cont_type), pointer :: bt_cont => null() !< A structure with elements that describe the
129  !! effective summed open face areas as a function
130  !! of barotropic flow.
131 
132  ! This is to allow the previous, velocity-based coupling with between the
133  ! baroclinic and barotropic modes.
134  logical :: bt_use_layer_fluxes !< If true, use the summed layered fluxes plus
135  !! an adjustment due to a changed barotropic
136  !! velocity in the barotropic continuity equation.
137  logical :: split_bottom_stress !< If true, provide the bottom stress
138  !! calculated by the vertical viscosity to the
139  !! barotropic solver.
140  logical :: calc_dtbt !< If true, calculate the barotropic time-step
141  !! dynamically.
142 
143  real :: be !< A nondimensional number from 0.5 to 1 that controls
144  !! the backward weighting of the time stepping scheme.
145  real :: begw !< A nondimensional number from 0 to 1 that controls
146  !! the extent to which the treatment of gravity waves
147  !! is forward-backward (0) or simulated backward
148  !! Euler (1). 0 is almost always used.
149  logical :: debug !< If true, write verbose checksums for debugging purposes.
150  logical :: debug_obc !< If true, do debugging calls for open boundary conditions.
151 
152  logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed.
153 
154  !>@{ Diagnostic IDs
155  integer :: id_uh = -1, id_vh = -1
156  integer :: id_umo = -1, id_vmo = -1
157  integer :: id_umo_2d = -1, id_vmo_2d = -1
158  integer :: id_pfu = -1, id_pfv = -1
159  integer :: id_cau = -1, id_cav = -1
160 
161  ! Split scheme only.
162  integer :: id_uav = -1, id_vav = -1
163  integer :: id_u_bt_accel = -1, id_v_bt_accel = -1
164  !!@}
165 
166  type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
167  !! timing of diagnostic output.
168  type(accel_diag_ptrs), pointer :: adp !< A structure pointing to the various
169  !! accelerations in the momentum equations,
170  !! which can later be used to calculate
171  !! derived diagnostics like energy budgets.
172  type(cont_diag_ptrs), pointer :: cdp !< A structure with pointers to various
173  !! terms in the continuity equations,
174  !! which can later be used to calculate
175  !! derived diagnostics like energy budgets.
176 
177  ! The remainder of the structure points to child subroutines' control structures.
178  !> A pointer to the horizontal viscosity control structure
179  type(hor_visc_cs), pointer :: hor_visc_csp => null()
180  !> A pointer to the continuity control structure
181  type(continuity_cs), pointer :: continuity_csp => null()
182  !> A pointer to the CoriolisAdv control structure
183  type(coriolisadv_cs), pointer :: coriolisadv_csp => null()
184  !> A pointer to the PressureForce control structure
185  type(pressureforce_cs), pointer :: pressureforce_csp => null()
186  !> A pointer to the barotropic stepping control structure
187  type(barotropic_cs), pointer :: barotropic_csp => null()
188  !> A pointer to a structure containing interface height diffusivities
189  type(thickness_diffuse_cs), pointer :: thickness_diffuse_csp => null()
190  !> A pointer to the vertical viscosity control structure
191  type(vertvisc_cs), pointer :: vertvisc_csp => null()
192  !> A pointer to the set_visc control structure
193  type(set_visc_cs), pointer :: set_visc_csp => null()
194  !> A pointer to the tidal forcing control structure
195  type(tidal_forcing_cs), pointer :: tides_csp => null()
196  !> A pointer to the ALE control structure.
197  type(ale_cs), pointer :: ale_csp => null()
198 
199  type(ocean_obc_type), pointer :: obc => null() !< A pointer to an open boundary
200  !! condition type that specifies whether, where, and what open boundary
201  !! conditions are used. If no open BCs are used, this pointer stays
202  !! nullified. Flather OBCs use open boundary_CS as well.
203  !> A pointer to the update_OBC control structure
204  type(update_obc_cs), pointer :: update_obc_csp => null()
205 
206  type(group_pass_type) :: pass_eta !< Structure for group halo pass
207  type(group_pass_type) :: pass_visc_rem !< Structure for group halo pass
208  type(group_pass_type) :: pass_uvp !< Structure for group halo pass
209  type(group_pass_type) :: pass_hp_uv !< Structure for group halo pass
210  type(group_pass_type) :: pass_uv !< Structure for group halo pass
211  type(group_pass_type) :: pass_h !< Structure for group halo pass
212  type(group_pass_type) :: pass_av_uvh !< Structure for group halo pass
213 
214 end type mom_dyn_split_rk2_cs
215 
216 
217 public step_mom_dyn_split_rk2
218 public register_restarts_dyn_split_rk2
219 public initialize_dyn_split_rk2
220 public end_dyn_split_rk2
221 
222 !>@{ CPU time clock IDs
223 integer :: id_clock_cor, id_clock_pres, id_clock_vertvisc
224 integer :: id_clock_horvisc, id_clock_mom_update
225 integer :: id_clock_continuity, id_clock_thick_diff
226 integer :: id_clock_btstep, id_clock_btcalc, id_clock_btforce
227 integer :: id_clock_pass, id_clock_pass_init
228 !!@}
229 
230 contains
231 
232 !> RK2 splitting for time stepping MOM adiabatic dynamics
233 subroutine step_mom_dyn_split_rk2(u, v, h, tv, visc, &
234  Time_local, dt, forces, p_surf_begin, p_surf_end, &
235  uh, vh, uhtr, vhtr, eta_av, &
236  G, GV, US, CS, calc_dtbt, VarMix, MEKE, thickness_diffuse_CSp, Waves)
237  type(ocean_grid_type), intent(inout) :: g !< ocean grid structure
238  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
239  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
240  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
241  target, intent(inout) :: u !< zonal velocity [m s-1]
242  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
243  target, intent(inout) :: v !< merid velocity [m s-1]
244  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
245  intent(inout) :: h !< layer thickness [H ~> m or kg m-2]
246  type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type
247  type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related
248  type(time_type), intent(in) :: time_local !< model time at end of time step
249  real, intent(in) :: dt !< time step [s]
250  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
251  real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic
252  !! time step [Pa]
253  real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic
254  !! time step [Pa]
255  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
256  target, intent(inout) :: uh !< zonal volume/mass transport
257  !! [H m2 s-1 ~> m3 s-1 or kg s-1]
258  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
259  target, intent(inout) :: vh !< merid volume/mass transport
260  !! [H m2 s-1 ~> m3 s-1 or kg s-1]
261  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
262  intent(inout) :: uhtr !< accumulatated zonal volume/mass transport
263  !! since last tracer advection [H m2 ~> m3 or kg]
264  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
265  intent(inout) :: vhtr !< accumulatated merid volume/mass transport
266  !! since last tracer advection [H m2 ~> m3 or kg]
267  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time
268  !! averaged over time step [H ~> m or kg m-2]
269  type(mom_dyn_split_rk2_cs), pointer :: cs !< module control structure
270  logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step
271  type(varmix_cs), pointer :: varmix !< specify the spatially varying viscosities
272  type(meke_type), pointer :: meke !< related to mesoscale eddy kinetic energy param
273  type(thickness_diffuse_cs), pointer :: thickness_diffuse_csp!< Pointer to a structure containing
274  !! interface height diffusivities
275  type(wave_parameters_cs), optional, pointer :: waves !< A pointer to a structure containing
276  !! fields related to the surface wave conditions
277 
278  ! local variables
279  real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping.
280 
281  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1].
282  real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1].
283  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2].
284 
285  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel
286  real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel
287  ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each
288  ! layer calculated by the non-barotropic part of the model [m s-2].
289 
290  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in
291  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in
292  ! uh_in and vh_in are the zonal or meridional mass transports that would be
293  ! obtained using the initial velocities [H m2 s-1 ~> m3 s-1 or kg s-1].
294 
295  real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out
296  real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out
297  ! uhbt_out and vhbt_out are the vertically summed transports from the
298  ! barotropic solver based on its final velocities [H m2 s-1 ~> m3 s-1 or kg s-1].
299 
300  real, dimension(SZI_(G),SZJ_(G)) :: eta_pred
301  ! eta_pred is the predictor value of the free surface height or column mass,
302  ! [H ~> m or kg m-2].
303 
304  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj
305  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj
306  ! u_adj and v_adj are the zonal or meridional velocities after u and v
307  ! have been barotropically adjusted so the resulting transports match
308  ! uhbt_out and vhbt_out [m s-1].
309 
310  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_obc
311  real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_obc
312  ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are
313  ! saved for use in the Flather open boundary condition code [m s-1].
314 
315  real :: pa_to_eta ! A factor that converts pressures to the units of eta.
316  real, pointer, dimension(:,:) :: &
317  p_surf => null(), eta_pf_start => null(), &
318  taux_bot => null(), tauy_bot => null(), &
319  eta => null()
320 
321  real, pointer, dimension(:,:,:) :: &
322  uh_ptr => null(), u_ptr => null(), vh_ptr => null(), v_ptr => null(), &
323  u_init => null(), v_init => null(), & ! Pointers to u and v or u_adj and v_adj.
324  u_av, & ! The zonal velocity time-averaged over a time step [m s-1].
325  v_av, & ! The meridional velocity time-averaged over a time step [m s-1].
326  h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2].
327  real :: idt
328  logical :: dyn_p_surf
329  logical :: bt_cont_bt_thick ! If true, use the BT_cont_type to estimate the
330  ! relative weightings of the layers in calculating
331  ! the barotropic accelerations.
332  !---For group halo pass
333  logical :: showcalltree, sym
334 
335  integer :: i, j, k, is, ie, js, je, isq, ieq, jsq, jeq, nz
336  integer :: cont_stencil
337  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
338  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
339  u_av => cs%u_av ; v_av => cs%v_av ; h_av => cs%h_av ; eta => cs%eta
340  idt = 1.0 / dt
341 
342  sym=.false.;if (g%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums
343 
344  showcalltree = calltree_showquery()
345  if (showcalltree) call calltree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90")
346 
347  !$OMP parallel do default(shared)
348  do k = 1, nz
349  do j=g%jsd,g%jed ; do i=g%isdB,g%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo
350  do j=g%jsdB,g%jedB ; do i=g%isd,g%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo
351  do j=g%jsd,g%jed ; do i=g%isd,g%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo
352  enddo
353 
354  ! Update CFL truncation value as function of time
355  call updatecfltruncationvalue(time_local, cs%vertvisc_CSp)
356 
357  if (cs%debug) then
358  call mom_state_chksum("Start predictor ", u, v, h, uh, vh, g, gv, symmetric=sym)
359  call check_redundant("Start predictor u ", u, v, g)
360  call check_redundant("Start predictor uh ", uh, vh, g)
361  endif
362 
363  dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end)
364  if (dyn_p_surf) then
365  p_surf => p_surf_end
366  call safe_alloc_ptr(eta_pf_start,g%isd,g%ied,g%jsd,g%jed)
367  eta_pf_start(:,:) = 0.0
368  else
369  p_surf => forces%p_surf
370  endif
371 
372  if (associated(cs%OBC)) then
373  if (cs%debug_OBC) call open_boundary_test_extern_h(g, cs%OBC, h)
374 
375  do k=1,nz ; do j=g%jsd,g%jed ; do i=g%IsdB,g%IedB
376  u_old_rad_obc(i,j,k) = u_av(i,j,k)
377  enddo ; enddo ; enddo
378  do k=1,nz ; do j=g%JsdB,g%JedB ; do i=g%isd,g%ied
379  v_old_rad_obc(i,j,k) = v_av(i,j,k)
380  enddo ; enddo ; enddo
381  endif
382 
383  bt_cont_bt_thick = .false.
384  if (associated(cs%BT_cont)) bt_cont_bt_thick = &
385  (allocated(cs%BT_cont%h_u) .and. allocated(cs%BT_cont%h_v))
386 
387  if (cs%split_bottom_stress) then
388  taux_bot => cs%taux_bot ; tauy_bot => cs%tauy_bot
389  endif
390 
391  !--- begin set up for group halo pass
392 
393  cont_stencil = continuity_stencil(cs%continuity_CSp)
394  !### Apart from circle_OBCs halo for eta could be 1, but halo>=3 is required
395  !### to match circle_OBCs solutions. Why?
396  call cpu_clock_begin(id_clock_pass)
397  call create_group_pass(cs%pass_eta, eta, g%Domain) !### , halo=1)
398  call create_group_pass(cs%pass_visc_rem, cs%visc_rem_u, cs%visc_rem_v, g%Domain, &
399  to_all+scalar_pair, cgrid_ne, halo=max(1,cont_stencil))
400  call create_group_pass(cs%pass_uvp, up, vp, g%Domain, halo=max(1,cont_stencil))
401  call create_group_pass(cs%pass_hp_uv, hp, g%Domain, halo=2)
402  call create_group_pass(cs%pass_hp_uv, u_av, v_av, g%Domain, halo=2)
403  call create_group_pass(cs%pass_hp_uv, uh(:,:,:), vh(:,:,:), g%Domain, halo=2)
404 
405  call create_group_pass(cs%pass_uv, u, v, g%Domain, halo=max(2,cont_stencil))
406  call create_group_pass(cs%pass_h, h, g%Domain, halo=max(2,cont_stencil))
407  call create_group_pass(cs%pass_av_uvh, u_av, v_av, g%Domain, halo=2)
408  call create_group_pass(cs%pass_av_uvh, uh(:,:,:), vh(:,:,:), g%Domain, halo=2)
409  call cpu_clock_end(id_clock_pass)
410  !--- end set up for group halo pass
411 
412 
413 ! PFu = d/dx M(h,T,S)
414 ! pbce = dM/deta
415  if (cs%begw == 0.0) call enable_averaging(dt, time_local, cs%diag)
416  call cpu_clock_begin(id_clock_pres)
417  call pressureforce(h, tv, cs%PFu, cs%PFv, g, gv, us, cs%PressureForce_CSp, &
418  cs%ALE_CSp, p_surf, cs%pbce, cs%eta_PF)
419  if (dyn_p_surf) then
420  pa_to_eta = 1.0 / gv%H_to_Pa
421  !$OMP parallel do default(shared)
422  do j=jsq,jeq+1 ; do i=isq,ieq+1
423  eta_pf_start(i,j) = cs%eta_PF(i,j) - pa_to_eta * &
424  (p_surf_begin(i,j) - p_surf_end(i,j))
425  enddo ; enddo
426  endif
427  call cpu_clock_end(id_clock_pres)
428  call disable_averaging(cs%diag)
429  if (showcalltree) call calltree_waypoint("done with PressureForce (step_MOM_dyn_split_RK2)")
430 
431  if (associated(cs%OBC)) then; if (cs%OBC%update_OBC) then
432  call update_obc_data(cs%OBC, g, gv, us, tv, h, cs%update_OBC_CSp, time_local)
433  endif; endif
434  if (associated(cs%OBC) .and. cs%debug_OBC) &
435  call open_boundary_zero_normal_flow(cs%OBC, g, cs%PFu, cs%PFv)
436 
437  if (g%nonblocking_updates) &
438  call start_group_pass(cs%pass_eta, g%Domain, clock=id_clock_pass)
439 
440 ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av
441  call cpu_clock_begin(id_clock_cor)
442  call coradcalc(u_av, v_av, h_av, uh, vh, cs%CAu, cs%CAv, cs%OBC, cs%ADp, &
443  g, gv, us, cs%CoriolisAdv_CSp)
444  call cpu_clock_end(id_clock_cor)
445  if (showcalltree) call calltree_waypoint("done with CorAdCalc (step_MOM_dyn_split_RK2)")
446 
447 ! u_bc_accel = CAu + PFu + diffu(u[n-1])
448  call cpu_clock_begin(id_clock_btforce)
449  !$OMP parallel do default(shared)
450  do k=1,nz
451  do j=js,je ; do i=isq,ieq
452  u_bc_accel(i,j,k) = (cs%Cau(i,j,k) + cs%PFu(i,j,k)) + us%s_to_T*cs%diffu(i,j,k)
453  enddo ; enddo
454  do j=jsq,jeq ; do i=is,ie
455  v_bc_accel(i,j,k) = (cs%Cav(i,j,k) + cs%PFv(i,j,k)) + us%s_to_T*cs%diffv(i,j,k)
456  enddo ; enddo
457  enddo
458  if (associated(cs%OBC)) then
459  call open_boundary_zero_normal_flow(cs%OBC, g, u_bc_accel, v_bc_accel)
460  endif
461  call cpu_clock_end(id_clock_btforce)
462 
463  if (cs%debug) then
464  call mom_accel_chksum("pre-btstep accel", cs%CAu, cs%CAv, cs%PFu, cs%PFv, &
465  cs%diffu, cs%diffv, g, gv, us, cs%pbce, u_bc_accel, v_bc_accel, &
466  symmetric=sym)
467  call check_redundant("pre-btstep CS%Ca ", cs%Cau, cs%Cav, g)
468  call check_redundant("pre-btstep CS%PF ", cs%PFu, cs%PFv, g)
469  call check_redundant("pre-btstep CS%diff ", cs%diffu, cs%diffv, g)
470  call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, g)
471  endif
472 
473  call cpu_clock_begin(id_clock_vertvisc)
474  !$OMP parallel do default(shared)
475  do k=1,nz
476  do j=js,je ; do i=isq,ieq
477  up(i,j,k) = g%mask2dCu(i,j) * (u(i,j,k) + dt * u_bc_accel(i,j,k))
478  enddo ; enddo
479  do j=jsq,jeq ; do i=is,ie
480  vp(i,j,k) = g%mask2dCv(i,j) * (v(i,j,k) + dt * v_bc_accel(i,j,k))
481  enddo ; enddo
482  enddo
483 
484  call enable_averaging(dt, time_local, cs%diag)
485  call set_viscous_ml(u, v, h, tv, forces, visc, dt, g, gv, us, &
486  cs%set_visc_CSp)
487  call disable_averaging(cs%diag)
488 
489  if (cs%debug) then
490  call uvchksum("before vertvisc: up", up, vp, g%HI, haloshift=0, symmetric=sym)
491  endif
492  call vertvisc_coef(up, vp, h, forces, visc, dt, g, gv, us, cs%vertvisc_CSp, cs%OBC)
493  call vertvisc_remnant(visc, cs%visc_rem_u, cs%visc_rem_v, dt, g, gv, us, cs%vertvisc_CSp)
494  call cpu_clock_end(id_clock_vertvisc)
495  if (showcalltree) call calltree_waypoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)")
496 
497 
498  call cpu_clock_begin(id_clock_pass)
499  if (g%nonblocking_updates) then
500  call complete_group_pass(cs%pass_eta, g%Domain)
501  call start_group_pass(cs%pass_visc_rem, g%Domain)
502  else
503  call do_group_pass(cs%pass_eta, g%Domain)
504  call do_group_pass(cs%pass_visc_rem, g%Domain)
505  endif
506  call cpu_clock_end(id_clock_pass)
507 
508  call cpu_clock_begin(id_clock_btcalc)
509  ! Calculate the relative layer weights for determining barotropic quantities.
510  if (.not.bt_cont_bt_thick) &
511  call btcalc(h, g, gv, cs%barotropic_CSp, obc=cs%OBC)
512  call bt_mass_source(h, eta, .true., g, gv, cs%barotropic_CSp)
513  call cpu_clock_end(id_clock_btcalc)
514 
515  if (g%nonblocking_updates) &
516  call complete_group_pass(cs%pass_visc_rem, g%Domain, clock=id_clock_pass)
517 
518 ! u_accel_bt = layer accelerations due to barotropic solver
519  if (associated(cs%BT_cont) .or. cs%BT_use_layer_fluxes) then
520  call cpu_clock_begin(id_clock_continuity)
521  call continuity(u, v, h, hp, uh_in, vh_in, dt, g, gv, us, &
522  cs%continuity_CSp, obc=cs%OBC, visc_rem_u=cs%visc_rem_u, &
523  visc_rem_v=cs%visc_rem_v, bt_cont=cs%BT_cont)
524  call cpu_clock_end(id_clock_continuity)
525  if (bt_cont_bt_thick) then
526  call btcalc(h, g, gv, cs%barotropic_CSp, cs%BT_cont%h_u, cs%BT_cont%h_v, &
527  obc=cs%OBC)
528  endif
529  if (showcalltree) call calltree_waypoint("done with continuity[BT_cont] (step_MOM_dyn_split_RK2)")
530  endif
531 
532  if (cs%BT_use_layer_fluxes) then
533  uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v
534  endif
535 
536  u_init => u ; v_init => v
537  call cpu_clock_begin(id_clock_btstep)
538  if (calc_dtbt) call set_dtbt(g, gv, us, cs%barotropic_CSp, eta, cs%pbce)
539  if (showcalltree) call calltree_enter("btstep(), MOM_barotropic.F90")
540  ! This is the predictor step call to btstep.
541  call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, cs%pbce, cs%eta_PF, &
542  u_av, v_av, cs%u_accel_bt, cs%v_accel_bt, eta_pred, cs%uhbt, cs%vhbt, &
543  g, gv, us, cs%barotropic_CSp, cs%visc_rem_u, cs%visc_rem_v, &
544  obc=cs%OBC, bt_cont=cs%BT_cont, eta_pf_start=eta_pf_start, &
545  taux_bot=taux_bot, tauy_bot=tauy_bot, &
546  uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr)
547  if (showcalltree) call calltree_leave("btstep()")
548  call cpu_clock_end(id_clock_btstep)
549 
550 ! up = u + dt_pred*( u_bc_accel + u_accel_bt )
551  dt_pred = dt * cs%be
552  call cpu_clock_begin(id_clock_mom_update)
553 
554  !$OMP parallel do default(shared)
555  do k=1,nz
556  do j=jsq,jeq ; do i=is,ie
557  vp(i,j,k) = g%mask2dCv(i,j) * (v_init(i,j,k) + dt_pred * &
558  (v_bc_accel(i,j,k) + cs%v_accel_bt(i,j,k)))
559  enddo ; enddo
560  do j=js,je ; do i=isq,ieq
561  up(i,j,k) = g%mask2dCu(i,j) * (u_init(i,j,k) + dt_pred * &
562  (u_bc_accel(i,j,k) + cs%u_accel_bt(i,j,k)))
563  enddo ; enddo
564  enddo
565  call cpu_clock_end(id_clock_mom_update)
566 
567  if (cs%debug) then
568  call uvchksum("Predictor 1 [uv]", up, vp, g%HI, haloshift=0, symmetric=sym)
569  call hchksum(h, "Predictor 1 h", g%HI, haloshift=1, scale=gv%H_to_m)
570  call uvchksum("Predictor 1 [uv]h", uh, vh, g%HI,haloshift=2, &
571  symmetric=sym, scale=gv%H_to_m)
572 ! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, haloshift=1)
573  call mom_accel_chksum("Predictor accel", cs%CAu, cs%CAv, cs%PFu, cs%PFv, &
574  cs%diffu, cs%diffv, g, gv, us, cs%pbce, cs%u_accel_bt, cs%v_accel_bt, symmetric=sym)
575  call mom_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, g, gv, haloshift=2, &
576  symmetric=sym)
577  call check_redundant("Predictor 1 up", up, vp, g)
578  call check_redundant("Predictor 1 uh", uh, vh, g)
579  endif
580 
581 ! up <- up + dt_pred d/dz visc d/dz up
582 ! u_av <- u_av + dt_pred d/dz visc d/dz u_av
583  call cpu_clock_begin(id_clock_vertvisc)
584  if (cs%debug) then
585  call uvchksum("0 before vertvisc: [uv]p", up, vp, g%HI,haloshift=0, symmetric=sym)
586  endif
587  call vertvisc_coef(up, vp, h, forces, visc, dt_pred, g, gv, us, cs%vertvisc_CSp, &
588  cs%OBC)
589  call vertvisc(up, vp, h, forces, visc, dt_pred, cs%OBC, cs%ADp, cs%CDp, g, &
590  gv, us, cs%vertvisc_CSp, cs%taux_bot, cs%tauy_bot, waves=waves)
591  if (showcalltree) call calltree_waypoint("done with vertvisc (step_MOM_dyn_split_RK2)")
592  if (g%nonblocking_updates) then
593  call cpu_clock_end(id_clock_vertvisc)
594  call start_group_pass(cs%pass_uvp, g%Domain, clock=id_clock_pass)
595  call cpu_clock_begin(id_clock_vertvisc)
596  endif
597  call vertvisc_remnant(visc, cs%visc_rem_u, cs%visc_rem_v, dt_pred, g, gv, us, cs%vertvisc_CSp)
598  call cpu_clock_end(id_clock_vertvisc)
599 
600  call do_group_pass(cs%pass_visc_rem, g%Domain, clock=id_clock_pass)
601  if (g%nonblocking_updates) then
602  call complete_group_pass(cs%pass_uvp, g%Domain, clock=id_clock_pass)
603  else
604  call do_group_pass(cs%pass_uvp, g%Domain, clock=id_clock_pass)
605  endif
606 
607  ! uh = u_av * h
608  ! hp = h + dt * div . uh
609  call cpu_clock_begin(id_clock_continuity)
610  call continuity(up, vp, h, hp, uh, vh, dt, g, gv, us, cs%continuity_CSp, &
611  cs%uhbt, cs%vhbt, cs%OBC, cs%visc_rem_u, cs%visc_rem_v, &
612  u_av, v_av, bt_cont=cs%BT_cont)
613  call cpu_clock_end(id_clock_continuity)
614  if (showcalltree) call calltree_waypoint("done with continuity (step_MOM_dyn_split_RK2)")
615 
616  call do_group_pass(cs%pass_hp_uv, g%Domain, clock=id_clock_pass)
617 
618  if (associated(cs%OBC)) then
619 
620  if (cs%debug) &
621  call uvchksum("Pre OBC avg [uv]", u_av, v_av, g%HI, haloshift=1, symmetric=sym)
622 
623  call radiation_open_bdry_conds(cs%OBC, u_av, u_old_rad_obc, v_av, v_old_rad_obc, g, dt_pred)
624 
625  if (cs%debug) &
626  call uvchksum("Post OBC avg [uv]", u_av, v_av, g%HI, haloshift=1, symmetric=sym)
627 
628  ! These should be done with a pass that excludes uh & vh.
629 ! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass)
630  endif
631 
632  if (g%nonblocking_updates) then
633  call start_group_pass(cs%pass_av_uvh, g%Domain, clock=id_clock_pass)
634  endif
635 
636  ! h_av = (h + hp)/2
637  !$OMP parallel do default(shared)
638  do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2
639  h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k))
640  enddo ; enddo ; enddo
641 
642  ! The correction phase of the time step starts here.
643  call enable_averaging(dt, time_local, cs%diag)
644 
645  ! Calculate a revised estimate of the free-surface height correction to be
646  ! used in the next call to btstep. This call is at this point so that
647  ! hp can be changed if CS%begw /= 0.
648  ! eta_cor = ... (hidden inside CS%barotropic_CSp)
649  call cpu_clock_begin(id_clock_btcalc)
650  call bt_mass_source(hp, eta_pred, .false., g, gv, cs%barotropic_CSp)
651  call cpu_clock_end(id_clock_btcalc)
652 
653  if (cs%begw /= 0.0) then
654  ! hp <- (1-begw)*h_in + begw*hp
655  ! Back up hp to the value it would have had after a time-step of
656  ! begw*dt. hp is not used again until recalculated by continuity.
657  !$OMP parallel do default(shared)
658  do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
659  hp(i,j,k) = (1.0-cs%begw)*h(i,j,k) + cs%begw*hp(i,j,k)
660  enddo ; enddo ; enddo
661 
662  ! PFu = d/dx M(hp,T,S)
663  ! pbce = dM/deta
664  call cpu_clock_begin(id_clock_pres)
665  call pressureforce(hp, tv, cs%PFu, cs%PFv, g, gv, us, cs%PressureForce_CSp, &
666  cs%ALE_CSp, p_surf, cs%pbce, cs%eta_PF)
667  call cpu_clock_end(id_clock_pres)
668  if (showcalltree) call calltree_waypoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)")
669  endif
670 
671  if (g%nonblocking_updates) &
672  call complete_group_pass(cs%pass_av_uvh, g%Domain, clock=id_clock_pass)
673 
674  if (bt_cont_bt_thick) then
675  call btcalc(h, g, gv, cs%barotropic_CSp, cs%BT_cont%h_u, cs%BT_cont%h_v, &
676  obc=cs%OBC)
677  if (showcalltree) call calltree_waypoint("done with btcalc[BT_cont_BT_thick] (step_MOM_dyn_split_RK2)")
678  endif
679 
680  if (cs%debug) then
681  call mom_state_chksum("Predictor ", up, vp, hp, uh, vh, g, gv, symmetric=sym)
682  call uvchksum("Predictor avg [uv]", u_av, v_av, g%HI, haloshift=1, symmetric=sym)
683  call hchksum(h_av, "Predictor avg h", g%HI, haloshift=0, scale=gv%H_to_m)
684  ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV)
685  call check_redundant("Predictor up ", up, vp, g)
686  call check_redundant("Predictor uh ", uh, vh, g)
687  endif
688 
689 ! diffu = horizontal viscosity terms (u_av)
690  call cpu_clock_begin(id_clock_horvisc)
691  call horizontal_viscosity(u_av, v_av, h_av, cs%diffu, cs%diffv, &
692  meke, varmix, g, gv, us, cs%hor_visc_CSp, &
693  obc=cs%OBC, bt=cs%barotropic_CSp)
694  call cpu_clock_end(id_clock_horvisc)
695  if (showcalltree) call calltree_waypoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)")
696 
697 ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av
698  call cpu_clock_begin(id_clock_cor)
699  call coradcalc(u_av, v_av, h_av, uh, vh, cs%CAu, cs%CAv, cs%OBC, cs%ADp, &
700  g, gv, us, cs%CoriolisAdv_CSp)
701  call cpu_clock_end(id_clock_cor)
702  if (showcalltree) call calltree_waypoint("done with CorAdCalc (step_MOM_dyn_split_RK2)")
703 
704 ! Calculate the momentum forcing terms for the barotropic equations.
705 
706 ! u_bc_accel = CAu + PFu + diffu(u[n-1])
707  call cpu_clock_begin(id_clock_btforce)
708  !$OMP parallel do default(shared)
709  do k=1,nz
710  do j=js,je ; do i=isq,ieq
711  u_bc_accel(i,j,k) = (cs%Cau(i,j,k) + cs%PFu(i,j,k)) + us%s_to_T*cs%diffu(i,j,k)
712  enddo ; enddo
713  do j=jsq,jeq ; do i=is,ie
714  v_bc_accel(i,j,k) = (cs%Cav(i,j,k) + cs%PFv(i,j,k)) + us%s_to_T*cs%diffv(i,j,k)
715  enddo ; enddo
716  enddo
717  if (associated(cs%OBC)) then
718  call open_boundary_zero_normal_flow(cs%OBC, g, u_bc_accel, v_bc_accel)
719  endif
720  call cpu_clock_end(id_clock_btforce)
721 
722  if (cs%debug) then
723  call mom_accel_chksum("corr pre-btstep accel", cs%CAu, cs%CAv, cs%PFu, cs%PFv, &
724  cs%diffu, cs%diffv, g, gv, us, cs%pbce, u_bc_accel, v_bc_accel, &
725  symmetric=sym)
726  call check_redundant("corr pre-btstep CS%Ca ", cs%Cau, cs%Cav, g)
727  call check_redundant("corr pre-btstep CS%PF ", cs%PFu, cs%PFv, g)
728  call check_redundant("corr pre-btstep CS%diff ", cs%diffu, cs%diffv, g)
729  call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, g)
730  endif
731 
732  ! u_accel_bt = layer accelerations due to barotropic solver
733  ! pbce = dM/deta
734  call cpu_clock_begin(id_clock_btstep)
735  if (cs%BT_use_layer_fluxes) then
736  uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av
737  endif
738 
739  if (showcalltree) call calltree_enter("btstep(), MOM_barotropic.F90")
740  ! This is the corrector step call to btstep.
741  call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, cs%pbce, &
742  cs%eta_PF, u_av, v_av, cs%u_accel_bt, cs%v_accel_bt, &
743  eta_pred, cs%uhbt, cs%vhbt, g, gv, us, cs%barotropic_CSp, &
744  cs%visc_rem_u, cs%visc_rem_v, etaav=eta_av, obc=cs%OBC, &
745  bt_cont = cs%BT_cont, eta_pf_start=eta_pf_start, &
746  taux_bot=taux_bot, tauy_bot=tauy_bot, &
747  uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr)
748  do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo
749  call cpu_clock_end(id_clock_btstep)
750  if (showcalltree) call calltree_leave("btstep()")
751 
752  if (cs%debug) then
753  call check_redundant("u_accel_bt ", cs%u_accel_bt, cs%v_accel_bt, g)
754  endif
755 
756  ! u = u + dt*( u_bc_accel + u_accel_bt )
757  call cpu_clock_begin(id_clock_mom_update)
758  !$OMP parallel do default(shared)
759  do k=1,nz
760  do j=js,je ; do i=isq,ieq
761  u(i,j,k) = g%mask2dCu(i,j) * (u_init(i,j,k) + dt * &
762  (u_bc_accel(i,j,k) + cs%u_accel_bt(i,j,k)))
763  enddo ; enddo
764  do j=jsq,jeq ; do i=is,ie
765  v(i,j,k) = g%mask2dCv(i,j) * (v_init(i,j,k) + dt * &
766  (v_bc_accel(i,j,k) + cs%v_accel_bt(i,j,k)))
767  enddo ; enddo
768  enddo
769  call cpu_clock_end(id_clock_mom_update)
770 
771  if (cs%debug) then
772  call uvchksum("Corrector 1 [uv]", u, v, g%HI,haloshift=0, symmetric=sym)
773  call hchksum(h, "Corrector 1 h", g%HI, haloshift=2, scale=gv%H_to_m)
774  call uvchksum("Corrector 1 [uv]h", uh, vh, g%HI, haloshift=2, &
775  symmetric=sym, scale=gv%H_to_m)
776  ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, haloshift=1)
777  call mom_accel_chksum("Corrector accel", cs%CAu, cs%CAv, cs%PFu, cs%PFv, &
778  cs%diffu, cs%diffv, g, gv, us, cs%pbce, cs%u_accel_bt, cs%v_accel_bt, &
779  symmetric=sym)
780  endif
781 
782  ! u <- u + dt d/dz visc d/dz u
783  ! u_av <- u_av + dt d/dz visc d/dz u_av
784  call cpu_clock_begin(id_clock_vertvisc)
785  call vertvisc_coef(u, v, h, forces, visc, dt, g, gv, us, cs%vertvisc_CSp, cs%OBC)
786  call vertvisc(u, v, h, forces, visc, dt, cs%OBC, cs%ADp, cs%CDp, g, gv, us, &
787  cs%vertvisc_CSp, cs%taux_bot, cs%tauy_bot,waves=waves)
788  if (g%nonblocking_updates) then
789  call cpu_clock_end(id_clock_vertvisc)
790  call start_group_pass(cs%pass_uv, g%Domain, clock=id_clock_pass)
791  call cpu_clock_begin(id_clock_vertvisc)
792  endif
793  call vertvisc_remnant(visc, cs%visc_rem_u, cs%visc_rem_v, dt, g, gv, us, cs%vertvisc_CSp)
794  call cpu_clock_end(id_clock_vertvisc)
795  if (showcalltree) call calltree_waypoint("done with vertvisc (step_MOM_dyn_split_RK2)")
796 
797 ! Later, h_av = (h_in + h_out)/2, but for now use h_av to store h_in.
798  !$OMP parallel do default(shared)
799  do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2
800  h_av(i,j,k) = h(i,j,k)
801  enddo ; enddo ; enddo
802 
803  call do_group_pass(cs%pass_visc_rem, g%Domain, clock=id_clock_pass)
804  if (g%nonblocking_updates) then
805  call complete_group_pass(cs%pass_uv, g%Domain, clock=id_clock_pass)
806  else
807  call do_group_pass(cs%pass_uv, g%Domain, clock=id_clock_pass)
808  endif
809 
810  ! uh = u_av * h
811  ! h = h + dt * div . uh
812  ! u_av and v_av adjusted so their mass transports match uhbt and vhbt.
813  call cpu_clock_begin(id_clock_continuity)
814  call continuity(u, v, h, h, uh, vh, dt, g, gv, us, &
815  cs%continuity_CSp, cs%uhbt, cs%vhbt, cs%OBC, &
816  cs%visc_rem_u, cs%visc_rem_v, u_av, v_av)
817  call cpu_clock_end(id_clock_continuity)
818  call do_group_pass(cs%pass_h, g%Domain, clock=id_clock_pass)
819  ! Whenever thickness changes let the diag manager know, target grids
820  ! for vertical remapping may need to be regenerated.
821  call diag_update_remap_grids(cs%diag)
822  if (showcalltree) call calltree_waypoint("done with continuity (step_MOM_dyn_split_RK2)")
823 
824  if (g%nonblocking_updates) then
825  call start_group_pass(cs%pass_av_uvh, g%Domain, clock=id_clock_pass)
826  else
827  call do_group_pass(cs%pass_av_uvh, g%domain, clock=id_clock_pass)
828  endif
829 
830  if (associated(cs%OBC)) then
831  call radiation_open_bdry_conds(cs%OBC, u, u_old_rad_obc, v, v_old_rad_obc, g, dt)
832  endif
833 
834 ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in.
835  !$OMP parallel do default(shared)
836  do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2
837  h_av(i,j,k) = 0.5*(h_av(i,j,k) + h(i,j,k))
838  enddo ; enddo ; enddo
839 
840  if (g%nonblocking_updates) &
841  call complete_group_pass(cs%pass_av_uvh, g%Domain, clock=id_clock_pass)
842 
843  !$OMP parallel do default(shared)
844  do k=1,nz
845  do j=js-2,je+2 ; do i=isq-2,ieq+2
846  uhtr(i,j,k) = uhtr(i,j,k) + uh(i,j,k)*dt
847  enddo ; enddo
848  do j=jsq-2,jeq+2 ; do i=is-2,ie+2
849  vhtr(i,j,k) = vhtr(i,j,k) + vh(i,j,k)*dt
850  enddo ; enddo
851  enddo
852 
853  ! The time-averaged free surface height has already been set by the last
854  ! call to btstep.
855 
856  ! Here various terms used in to update the momentum equations are
857  ! offered for time averaging.
858  if (cs%id_PFu > 0) call post_data(cs%id_PFu, cs%PFu, cs%diag)
859  if (cs%id_PFv > 0) call post_data(cs%id_PFv, cs%PFv, cs%diag)
860  if (cs%id_CAu > 0) call post_data(cs%id_CAu, cs%CAu, cs%diag)
861  if (cs%id_CAv > 0) call post_data(cs%id_CAv, cs%CAv, cs%diag)
862 
863  ! Here the thickness fluxes are offered for time averaging.
864  if (cs%id_uh > 0) call post_data(cs%id_uh , uh, cs%diag)
865  if (cs%id_vh > 0) call post_data(cs%id_vh , vh, cs%diag)
866  if (cs%id_uav > 0) call post_data(cs%id_uav, u_av, cs%diag)
867  if (cs%id_vav > 0) call post_data(cs%id_vav, v_av, cs%diag)
868  if (cs%id_u_BT_accel > 0) call post_data(cs%id_u_BT_accel, cs%u_accel_bt, cs%diag)
869  if (cs%id_v_BT_accel > 0) call post_data(cs%id_v_BT_accel, cs%v_accel_bt, cs%diag)
870 
871  if (cs%debug) then
872  call mom_state_chksum("Corrector ", u, v, h, uh, vh, g, gv, symmetric=sym)
873  call uvchksum("Corrector avg [uv]", u_av, v_av, g%HI,haloshift=1, symmetric=sym)
874  call hchksum(h_av, "Corrector avg h", g%HI, haloshift=1, scale=gv%H_to_m)
875  ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV)
876  endif
877 
878  if (showcalltree) call calltree_leave("step_MOM_dyn_split_RK2()")
879 
880 end subroutine step_mom_dyn_split_rk2
881 
882 !> This subroutine sets up any auxiliary restart variables that are specific
883 !! to the unsplit time stepping scheme. All variables registered here should
884 !! have the ability to be recreated if they are not present in a restart file.
885 subroutine register_restarts_dyn_split_rk2(HI, GV, param_file, CS, restart_CS, uh, vh)
886  type(hor_index_type), intent(in) :: hi !< Horizontal index structure
887  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
888  type(param_file_type), intent(in) :: param_file !< parameter file
889  type(mom_dyn_split_rk2_cs), pointer :: cs !< module control structure
890  type(mom_restart_cs), pointer :: restart_cs !< restart control structure
891  real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), &
892  target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1]
893  real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), &
894  target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1]
895 
896  type(vardesc) :: vd
897  character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name.
898  character(len=48) :: thickness_units, flux_units
899 
900  integer :: isd, ied, jsd, jed, nz, isdb, iedb, jsdb, jedb
901  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
902  isdb = hi%IsdB ; iedb = hi%IedB ; jsdb = hi%JsdB ; jedb = hi%JedB
903 
904  ! This is where a control structure specific to this module would be allocated.
905  if (associated(cs)) then
906  call mom_error(warning, "register_restarts_dyn_split_RK2 called with an associated "// &
907  "control structure.")
908  return
909  endif
910  allocate(cs)
911 
912  alloc_(cs%diffu(isdb:iedb,jsd:jed,nz)) ; cs%diffu(:,:,:) = 0.0
913  alloc_(cs%diffv(isd:ied,jsdb:jedb,nz)) ; cs%diffv(:,:,:) = 0.0
914  alloc_(cs%CAu(isdb:iedb,jsd:jed,nz)) ; cs%CAu(:,:,:) = 0.0
915  alloc_(cs%CAv(isd:ied,jsdb:jedb,nz)) ; cs%CAv(:,:,:) = 0.0
916  alloc_(cs%PFu(isdb:iedb,jsd:jed,nz)) ; cs%PFu(:,:,:) = 0.0
917  alloc_(cs%PFv(isd:ied,jsdb:jedb,nz)) ; cs%PFv(:,:,:) = 0.0
918 
919  alloc_(cs%eta(isd:ied,jsd:jed)) ; cs%eta(:,:) = 0.0
920  alloc_(cs%u_av(isdb:iedb,jsd:jed,nz)) ; cs%u_av(:,:,:) = 0.0
921  alloc_(cs%v_av(isd:ied,jsdb:jedb,nz)) ; cs%v_av(:,:,:) = 0.0
922  alloc_(cs%h_av(isd:ied,jsd:jed,nz)) ; cs%h_av(:,:,:) = gv%Angstrom_H
923 
924  thickness_units = get_thickness_units(gv)
925  flux_units = get_flux_units(gv)
926 
927  if (gv%Boussinesq) then
928  vd = var_desc("sfc",thickness_units,"Free surface Height",'h','1')
929  else
930  vd = var_desc("p_bot",thickness_units,"Bottom Pressure",'h','1')
931  endif
932  call register_restart_field(cs%eta, vd, .false., restart_cs)
933 
934  vd = var_desc("u2","m s-1","Auxiliary Zonal velocity",'u','L')
935  call register_restart_field(cs%u_av, vd, .false., restart_cs)
936 
937  vd = var_desc("v2","m s-1","Auxiliary Meridional velocity",'v','L')
938  call register_restart_field(cs%v_av, vd, .false., restart_cs)
939 
940  vd = var_desc("h2",thickness_units,"Auxiliary Layer Thickness",'h','L')
941  call register_restart_field(cs%h_av, vd, .false., restart_cs)
942 
943  vd = var_desc("uh",flux_units,"Zonal thickness flux",'u','L')
944  call register_restart_field(uh, vd, .false., restart_cs)
945 
946  vd = var_desc("vh",flux_units,"Meridional thickness flux",'v','L')
947  call register_restart_field(vh, vd, .false., restart_cs)
948 
949  vd = var_desc("diffu","m s-2","Zonal horizontal viscous acceleration",'u','L')
950  call register_restart_field(cs%diffu, vd, .false., restart_cs)
951 
952  vd = var_desc("diffv","m s-2","Meridional horizontal viscous acceleration",'v','L')
953  call register_restart_field(cs%diffv, vd, .false., restart_cs)
954 
955  call register_barotropic_restarts(hi, gv, param_file, cs%barotropic_CSp, &
956  restart_cs)
957 
958 end subroutine register_restarts_dyn_split_rk2
959 
960 !> This subroutine initializes all of the variables that are used by this
961 !! dynamic core, including diagnostics and the cpu clocks.
962 subroutine initialize_dyn_split_rk2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, &
963  diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, &
964  VarMix, MEKE, thickness_diffuse_CSp, &
965  OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, &
966  visc, dirs, ntrunc, calc_dtbt)
967  type(ocean_grid_type), intent(inout) :: g !< ocean grid structure
968  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
969  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
970  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
971  intent(inout) :: u !< zonal velocity [m s-1]
972  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
973  intent(inout) :: v !< merid velocity [m s-1]
974  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2]
975  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
976  target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1]
977  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
978  target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1]
979  real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2]
980  type(time_type), target, intent(in) :: time !< current model time
981  type(param_file_type), intent(in) :: param_file !< parameter file for parsing
982  type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics
983  type(mom_dyn_split_rk2_cs), pointer :: cs !< module control structure
984  type(mom_restart_cs), pointer :: restart_cs !< restart control structure
985  real, intent(in) :: dt !< time step [s]
986  type(accel_diag_ptrs), target, intent(inout) :: accel_diag !< points to momentum equation terms for
987  !! budget analysis
988  type(cont_diag_ptrs), target, intent(inout) :: cont_diag !< points to terms in continuity equation
989  type(ocean_internal_state), intent(inout) :: mis !< "MOM6 internal state" used to pass
990  !! diagnostic pointers
991  type(varmix_cs), pointer :: varmix !< points to spatially variable viscosities
992  type(meke_type), pointer :: meke !< points to mesoscale eddy kinetic energy fields
993 ! type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for
994 ! !! the barotropic module
995  type(thickness_diffuse_cs), pointer :: thickness_diffuse_csp !< Pointer to the control structure
996  !! used for the isopycnal height diffusive transport.
997  type(ocean_obc_type), pointer :: obc !< points to OBC related fields
998  type(update_obc_cs), pointer :: update_obc_csp !< points to OBC update related fields
999  type(ale_cs), pointer :: ale_csp !< points to ALE control structure
1000  type(set_visc_cs), pointer :: setvisc_csp !< points to the set_visc control structure.
1001  type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related
1002  type(directories), intent(in) :: dirs !< contains directory paths
1003  integer, target, intent(inout) :: ntrunc !< A target for the variable that records
1004  !! the number of times the velocity is
1005  !! truncated (this should be 0).
1006  logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step
1007 
1008  ! local variables
1009  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp
1010  character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name.
1011  character(len=48) :: thickness_units, flux_units, eta_rest_name
1012  real :: h_rescale ! A rescaling factor for thicknesses from the representation in
1013  ! a restart file to the internal representation in this run.
1014  real :: uh_rescale ! A rescaling factor for thickness transports from the representation in
1015  ! a restart file to the internal representation in this run.
1016  real :: h_convert
1017  type(group_pass_type) :: pass_av_h_uvh
1018  logical :: use_tides, debug_truncations
1019 
1020  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
1021  integer :: isdb, iedb, jsdb, jedb
1022  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
1023  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1024  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
1025 
1026  if (.not.associated(cs)) call mom_error(fatal, &
1027  "initialize_dyn_split_RK2 called with an unassociated control structure.")
1028  if (cs%module_is_initialized) then
1029  call mom_error(warning, "initialize_dyn_split_RK2 called with a control "// &
1030  "structure that has already been initialized.")
1031  return
1032  endif
1033  cs%module_is_initialized = .true.
1034 
1035  cs%diag => diag
1036 
1037  call get_param(param_file, mdl, "TIDES", use_tides, &
1038  "If true, apply tidal momentum forcing.", default=.false.)
1039  call get_param(param_file, mdl, "BE", cs%be, &
1040  "If SPLIT is true, BE determines the relative weighting "//&
1041  "of a 2nd-order Runga-Kutta baroclinic time stepping "//&
1042  "scheme (0.5) and a backward Euler scheme (1) that is "//&
1043  "used for the Coriolis and inertial terms. BE may be "//&
1044  "from 0.5 to 1, but instability may occur near 0.5. "//&
1045  "BE is also applicable if SPLIT is false and USE_RK2 "//&
1046  "is true.", units="nondim", default=0.6)
1047  call get_param(param_file, mdl, "BEGW", cs%begw, &
1048  "If SPLIT is true, BEGW is a number from 0 to 1 that "//&
1049  "controls the extent to which the treatment of gravity "//&
1050  "waves is forward-backward (0) or simulated backward "//&
1051  "Euler (1). 0 is almost always used. "//&
1052  "If SPLIT is false and USE_RK2 is true, BEGW can be "//&
1053  "between 0 and 0.5 to damp gravity waves.", &
1054  units="nondim", default=0.0)
1055 
1056  call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", cs%split_bottom_stress, &
1057  "If true, provide the bottom stress calculated by the "//&
1058  "vertical viscosity to the barotropic solver.", default=.false.)
1059  call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", cs%BT_use_layer_fluxes, &
1060  "If true, use the summed layered fluxes plus an "//&
1061  "adjustment due to the change in the barotropic velocity "//&
1062  "in the barotropic continuity equation.", default=.true.)
1063  call get_param(param_file, mdl, "DEBUG", cs%debug, &
1064  "If true, write out verbose debugging data.", &
1065  default=.false., debuggingparam=.true.)
1066  call get_param(param_file, mdl, "DEBUG_OBC", cs%debug_OBC, default=.false.)
1067  call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, &
1068  default=.false.)
1069 
1070  allocate(cs%taux_bot(isdb:iedb,jsd:jed)) ; cs%taux_bot(:,:) = 0.0
1071  allocate(cs%tauy_bot(isd:ied,jsdb:jedb)) ; cs%tauy_bot(:,:) = 0.0
1072 
1073  alloc_(cs%uhbt(isdb:iedb,jsd:jed)) ; cs%uhbt(:,:) = 0.0
1074  alloc_(cs%vhbt(isd:ied,jsdb:jedb)) ; cs%vhbt(:,:) = 0.0
1075  alloc_(cs%visc_rem_u(isdb:iedb,jsd:jed,nz)) ; cs%visc_rem_u(:,:,:) = 0.0
1076  alloc_(cs%visc_rem_v(isd:ied,jsdb:jedb,nz)) ; cs%visc_rem_v(:,:,:) = 0.0
1077  alloc_(cs%eta_PF(isd:ied,jsd:jed)) ; cs%eta_PF(:,:) = 0.0
1078  alloc_(cs%pbce(isd:ied,jsd:jed,nz)) ; cs%pbce(:,:,:) = 0.0
1079 
1080  alloc_(cs%u_accel_bt(isdb:iedb,jsd:jed,nz)) ; cs%u_accel_bt(:,:,:) = 0.0
1081  alloc_(cs%v_accel_bt(isd:ied,jsdb:jedb,nz)) ; cs%v_accel_bt(:,:,:) = 0.0
1082 
1083  mis%diffu => cs%diffu
1084  mis%diffv => cs%diffv
1085  mis%PFu => cs%PFu
1086  mis%PFv => cs%PFv
1087  mis%CAu => cs%CAu
1088  mis%CAv => cs%CAv
1089  mis%pbce => cs%pbce
1090  mis%u_accel_bt => cs%u_accel_bt
1091  mis%v_accel_bt => cs%v_accel_bt
1092  mis%u_av => cs%u_av
1093  mis%v_av => cs%v_av
1094 
1095  cs%ADp => accel_diag
1096  cs%CDp => cont_diag
1097  accel_diag%diffu => cs%diffu
1098  accel_diag%diffv => cs%diffv
1099  accel_diag%PFu => cs%PFu
1100  accel_diag%PFv => cs%PFv
1101  accel_diag%CAu => cs%CAu
1102  accel_diag%CAv => cs%CAv
1103 
1104 ! Accel_diag%pbce => CS%pbce
1105 ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt
1106 ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av
1107 
1108  call continuity_init(time, g, gv, param_file, diag, cs%continuity_CSp)
1109  call coriolisadv_init(time, g, param_file, diag, cs%ADp, cs%CoriolisAdv_CSp)
1110  if (use_tides) call tidal_forcing_init(time, g, param_file, cs%tides_CSp)
1111  call pressureforce_init(time, g, gv, us, param_file, diag, cs%PressureForce_CSp, &
1112  cs%tides_CSp)
1113  call hor_visc_init(time, g, us, param_file, diag, cs%hor_visc_CSp, meke)
1114  call vertvisc_init(mis, time, g, gv, us, param_file, diag, cs%ADp, dirs, &
1115  ntrunc, cs%vertvisc_CSp)
1116  if (.not.associated(setvisc_csp)) call mom_error(fatal, &
1117  "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.")
1118  cs%set_visc_CSp => setvisc_csp
1119  call updatecfltruncationvalue(time, cs%vertvisc_CSp, &
1120  activate=is_new_run(restart_cs) )
1121 
1122  if (associated(ale_csp)) cs%ALE_CSp => ale_csp
1123  if (associated(obc)) cs%OBC => obc
1124  if (associated(update_obc_csp)) cs%update_OBC_CSp => update_obc_csp
1125 
1126  eta_rest_name = "sfc" ; if (.not.gv%Boussinesq) eta_rest_name = "p_bot"
1127  if (.not. query_initialized(cs%eta, trim(eta_rest_name), restart_cs)) then
1128  ! Estimate eta based on the layer thicknesses - h. With the Boussinesq
1129  ! approximation, eta is the free surface height anomaly, while without it
1130  ! eta is the mass of ocean per unit area. eta always has the same
1131  ! dimensions as h, either m or kg m-3.
1132  ! CS%eta(:,:) = 0.0 already from initialization.
1133  if (gv%Boussinesq) then
1134  do j=js,je ; do i=is,ie ; cs%eta(i,j) = -gv%Z_to_H * g%bathyT(i,j) ; enddo ; enddo
1135  endif
1136  do k=1,nz ; do j=js,je ; do i=is,ie
1137  cs%eta(i,j) = cs%eta(i,j) + h(i,j,k)
1138  enddo ; enddo ; enddo
1139  elseif ((gv%m_to_H_restart /= 0.0) .and. (gv%m_to_H_restart /= gv%m_to_H)) then
1140  h_rescale = gv%m_to_H / gv%m_to_H_restart
1141  do j=js,je ; do i=is,ie ; cs%eta(i,j) = h_rescale * cs%eta(i,j) ; enddo ; enddo
1142  endif
1143  ! Copy eta into an output array.
1144  do j=js,je ; do i=is,ie ; eta(i,j) = cs%eta(i,j) ; enddo ; enddo
1145 
1146  call barotropic_init(u, v, h, cs%eta, time, g, gv, us, param_file, diag, &
1147  cs%barotropic_CSp, restart_cs, calc_dtbt, cs%BT_cont, &
1148  cs%tides_CSp)
1149 
1150  if (.not. query_initialized(cs%diffu,"diffu",restart_cs) .or. &
1151  .not. query_initialized(cs%diffv,"diffv",restart_cs)) &
1152  call horizontal_viscosity(u, v, h, cs%diffu, cs%diffv, meke, varmix, &
1153  g, gv, us, cs%hor_visc_CSp, &
1154  obc=cs%OBC, bt=cs%barotropic_CSp)
1155  if (.not. query_initialized(cs%u_av,"u2", restart_cs) .or. &
1156  .not. query_initialized(cs%u_av,"v2", restart_cs)) then
1157  cs%u_av(:,:,:) = u(:,:,:)
1158  cs%v_av(:,:,:) = v(:,:,:)
1159  endif
1160 
1161  ! This call is just here to initialize uh and vh.
1162  if (.not. query_initialized(uh,"uh",restart_cs) .or. &
1163  .not. query_initialized(vh,"vh",restart_cs)) then
1164  h_tmp(:,:,:) = h(:,:,:)
1165  call continuity(u, v, h, h_tmp, uh, vh, dt, g, gv, us, cs%continuity_CSp, obc=cs%OBC)
1166  call pass_var(h_tmp, g%Domain, clock=id_clock_pass_init)
1167  cs%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:))
1168  else
1169  if (.not. query_initialized(cs%h_av,"h2",restart_cs)) then
1170  cs%h_av(:,:,:) = h(:,:,:)
1171  elseif ((gv%m_to_H_restart /= 0.0) .and. (gv%m_to_H_restart /= gv%m_to_H)) then
1172  h_rescale = gv%m_to_H / gv%m_to_H_restart
1173  do k=1,nz ; do j=js,je ; do i=is,ie ; cs%h_av(i,j,k) = h_rescale * cs%h_av(i,j,k) ; enddo ; enddo ; enddo
1174  endif
1175  if ((gv%m_to_H_restart /= 0.0) .and. (gv%m_to_H_restart /= gv%m_to_H)) then
1176  uh_rescale = gv%m_to_H / gv%m_to_H_restart
1177  do k=1,nz ; do j=js,je ; do i=g%IscB,g%IecB ; uh(i,j,k) = uh_rescale * uh(i,j,k) ; enddo ; enddo ; enddo
1178  do k=1,nz ; do j=g%JscB,g%JecB ; do i=is,ie ; vh(i,j,k) = uh_rescale * vh(i,j,k) ; enddo ; enddo ; enddo
1179  endif
1180  endif
1181 
1182  call cpu_clock_begin(id_clock_pass_init)
1183  call create_group_pass(pass_av_h_uvh, cs%u_av, cs%v_av, g%Domain, halo=2)
1184  call create_group_pass(pass_av_h_uvh, cs%h_av, g%Domain, halo=2)
1185  call create_group_pass(pass_av_h_uvh, uh, vh, g%Domain, halo=2)
1186  call do_group_pass(pass_av_h_uvh, g%Domain)
1187  call cpu_clock_end(id_clock_pass_init)
1188 
1189  flux_units = get_flux_units(gv)
1190  h_convert = gv%H_to_m ; if (.not.gv%Boussinesq) h_convert = gv%H_to_kg_m2
1191  cs%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, time, &
1192  'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., &
1193  conversion=h_convert)
1194  cs%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, time, &
1195  'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., &
1196  conversion=h_convert)
1197 
1198  cs%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, time, &
1199  'Zonal Coriolis and Advective Acceleration', 'm s-2')
1200  cs%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, time, &
1201  'Meridional Coriolis and Advective Acceleration', 'm s-2')
1202  cs%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, time, &
1203  'Zonal Pressure Force Acceleration', 'm s-2')
1204  cs%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, time, &
1205  'Meridional Pressure Force Acceleration', 'm s-2')
1206 
1207  cs%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, time, &
1208  'Barotropic-step Averaged Zonal Velocity', 'm s-1')
1209  cs%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, time, &
1210  'Barotropic-step Averaged Meridional Velocity', 'm s-1')
1211 
1212  cs%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, time, &
1213  'Barotropic Anomaly Zonal Acceleration', 'm s-1')
1214  cs%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, time, &
1215  'Barotropic Anomaly Meridional Acceleration', 'm s-1')
1216 
1217  id_clock_cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=clock_module)
1218  id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=clock_module)
1219  id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=clock_module)
1220  id_clock_vertvisc = cpu_clock_id('(Ocean vertical viscosity)', grain=clock_module)
1221  id_clock_horvisc = cpu_clock_id('(Ocean horizontal viscosity)', grain=clock_module)
1222  id_clock_mom_update = cpu_clock_id('(Ocean momentum increments)', grain=clock_module)
1223  id_clock_pass = cpu_clock_id('(Ocean message passing)', grain=clock_module)
1224  id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', grain=clock_routine)
1225  id_clock_btcalc = cpu_clock_id('(Ocean barotropic mode calc)', grain=clock_module)
1226  id_clock_btstep = cpu_clock_id('(Ocean barotropic mode stepping)', grain=clock_module)
1227  id_clock_btforce = cpu_clock_id('(Ocean barotropic forcing calc)', grain=clock_module)
1228 
1229 end subroutine initialize_dyn_split_rk2
1230 
1231 
1232 !> Close the dyn_split_RK2 module
1233 subroutine end_dyn_split_rk2(CS)
1234  type(mom_dyn_split_rk2_cs), pointer :: cs !< module control structure
1235 
1236  dealloc_(cs%diffu) ; dealloc_(cs%diffv)
1237  dealloc_(cs%CAu) ; dealloc_(cs%CAv)
1238  dealloc_(cs%PFu) ; dealloc_(cs%PFv)
1239 
1240  if (associated(cs%taux_bot)) deallocate(cs%taux_bot)
1241  if (associated(cs%tauy_bot)) deallocate(cs%tauy_bot)
1242  dealloc_(cs%uhbt) ; dealloc_(cs%vhbt)
1243  dealloc_(cs%u_accel_bt) ; dealloc_(cs%v_accel_bt)
1244  dealloc_(cs%visc_rem_u) ; dealloc_(cs%visc_rem_v)
1245 
1246  dealloc_(cs%eta) ; dealloc_(cs%eta_PF) ; dealloc_(cs%pbce)
1247  dealloc_(cs%h_av) ; dealloc_(cs%u_av) ; dealloc_(cs%v_av)
1248 
1249  call dealloc_bt_cont_type(cs%BT_cont)
1250 
1251  deallocate(cs)
1252 end subroutine end_dyn_split_rk2
1253 
1254 
1255 !> \namespace mom_dynamics_split_rk2
1256 !!
1257 !! This file time steps the adiabatic dynamic core by splitting
1258 !! between baroclinic and barotropic modes. It uses a pseudo-second order
1259 !! Runge-Kutta time stepping scheme for the baroclinic momentum
1260 !! equation and a forward-backward coupling between the baroclinic
1261 !! momentum and continuity equations. This split time-stepping
1262 !! scheme is described in detail in Hallberg (JCP, 1997). Additional
1263 !! issues related to exact tracer conservation and how to
1264 !! ensure consistency between the barotropic and layered estimates
1265 !! of the free surface height are described in Hallberg and
1266 !! Adcroft (Ocean Modelling, 2009). This was the time stepping code
1267 !! that is used for most GOLD applications, including GFDL's ESM2G
1268 !! Earth system model, and all of the examples provided with the
1269 !! MOM code (although several of these solutions are routinely
1270 !! verified by comparison with the slower unsplit schemes).
1271 !!
1272 !! The subroutine step_MOM_dyn_split_RK2 actually does the time
1273 !! stepping, while register_restarts_dyn_split_RK2 sets the fields
1274 !! that are found in a full restart file with this scheme, and
1275 !! initialize_dyn_split_RK2 initializes the cpu clocks that are
1276 !! used in this module. For largely historical reasons, this module
1277 !! does not have its own control structure, but shares the same
1278 !! control structure with MOM.F90 and the other MOM_dynamics_...
1279 !! modules.
1280 
1281 end module mom_dynamics_split_rk2
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_forcing_type::mech_forcing
Structure that contains pointers to the mechanical forcing at the surface used to drive the liquid oc...
Definition: MOM_forcing_type.F90:185
mom_checksum_packages::mom_state_chksum
Write out checksums of the MOM6 state variables.
Definition: MOM_checksum_packages.F90:23
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_continuity::continuity_cs
Control structure for mom_continuity.
Definition: MOM_continuity.F90:26
mom_hor_visc::hor_visc_cs
Control structure for horizontal viscosity.
Definition: MOM_hor_visc.F90:29
mom_coriolisadv::coriolisadv_cs
Control structure for mom_coriolisadv.
Definition: MOM_CoriolisAdv.F90:27
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_boundary_update
Controls where open boundary conditions are applied.
Definition: MOM_boundary_update.F90:3
mom_dynamics_split_rk2
Time step the adiabatic dynamic core of MOM using RK2 method.
Definition: MOM_dynamics_split_RK2.F90:2
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:82
mom_get_input::directories
Container for paths and parameter file names.
Definition: MOM_get_input.F90:20
mom_barotropic
Baropotric solver.
Definition: MOM_barotropic.F90:2
mom_domains::pass_var
Do a halo update on an array.
Definition: MOM_domains.F90:49
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_boundary_update::update_obc_cs
The control structure for the MOM_boundary_update module.
Definition: MOM_boundary_update.F90:37
mom_variables::bt_cont_type
Container for information about the summed layer transports and how they will vary as the barotropic ...
Definition: MOM_variables.F90:266
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_checksum_packages
Provides routines that do checksums of groups of MOM variables.
Definition: MOM_checksum_packages.F90:2
mom_hor_index
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Definition: MOM_hor_index.F90:2
mom_io
This module contains I/O framework code.
Definition: MOM_io.F90:2
mom_vert_friction::vertvisc_cs
The control structure with parameters and memory for the MOM_vert_friction module.
Definition: MOM_vert_friction.F90:39
mom_restart::mom_restart_cs
A restart registry and the control structure for restarts.
Definition: MOM_restart.F90:72
mom_get_input
Reads the only Fortran name list needed to boot-strap the model.
Definition: MOM_get_input.F90:6
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
mom_tidal_forcing
Tidal contributions to geopotential.
Definition: MOM_tidal_forcing.F90:2
mom_thickness_diffuse::thickness_diffuse_cs
Control structure for thickness diffusion.
Definition: MOM_thickness_diffuse.F90:37
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_hor_visc
Calculates horizontal viscosity and viscous stresses.
Definition: MOM_hor_visc.F90:2
mom_wave_interface
Interface for surface waves.
Definition: MOM_wave_interface.F90:2
mom_wave_interface::wave_parameters_cs
Container for all surface wave related parameters.
Definition: MOM_wave_interface.F90:47
mom_tidal_forcing::tidal_forcing_cs
The control structure for the MOM_tidal_forcing module.
Definition: MOM_tidal_forcing.F90:26
mom_variables::vertvisc_type
Vertical viscosities, drag coefficients, and related fields.
Definition: MOM_variables.F90:200
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_restart
The MOM6 facility for reading and writing restart files, and querying what has been read.
Definition: MOM_restart.F90:2
mom_meke_types::meke_type
This type is used to exchange information related to the MEKE calculations.
Definition: MOM_MEKE_types.F90:8
mom_domains
Describes the decomposed MOM domain and has routines for communications across PEs.
Definition: MOM_domains.F90:2
mom_ale
This module contains the main regridding routines.
Definition: MOM_ALE.F90:9
mom_lateral_mixing_coeffs::varmix_cs
Variable mixing coefficients.
Definition: MOM_lateral_mixing_coeffs.F90:26
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
mom_dynamics_split_rk2::mom_dyn_split_rk2_cs
MOM_dynamics_split_RK2 module control structure.
Definition: MOM_dynamics_split_RK2.F90:70
mom_open_boundary
Controls where open boundary conditions are applied.
Definition: MOM_open_boundary.F90:2
mom_cpu_clock
Wraps the MPP cpu clock functions.
Definition: MOM_cpu_clock.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_ale::ale_cs
ALE control structure.
Definition: MOM_ALE.F90:63
mom_variables::cont_diag_ptrs
Pointers to arrays with transports, which can later be used for derived diagnostics,...
Definition: MOM_variables.F90:185
mom_variables::accel_diag_ptrs
Pointers to arrays with accelerations, which can later be used for derived diagnostics,...
Definition: MOM_variables.F90:155
mom_hor_index::hor_index_type
Container for horizontal index ranges for data, computational and global domains.
Definition: MOM_hor_index.F90:15
mom_interface_heights::find_eta
Calculates the heights of sruface or all interfaces from layer thicknesses.
Definition: MOM_interface_heights.F90:21
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_open_boundary::ocean_obc_type
Open-boundary data.
Definition: MOM_open_boundary.F90:186
mom_debugging::check_redundant
Check for consistency between the duplicated points of a C-grid vector.
Definition: MOM_debugging.F90:33
mom_restart::register_restart_field
Register fields for restarts.
Definition: MOM_restart.F90:107
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_set_visc
Calculates various values related to the bottom boundary layer, such as the viscosity and thickness o...
Definition: MOM_set_viscosity.F90:3
mom_debugging
Provides checksumming functions for debugging.
Definition: MOM_debugging.F90:7
mom_io::vardesc
Type for describing a variable, typically a tracer.
Definition: MOM_io.F90:53
mom_continuity
Solve the layer continuity equation.
Definition: MOM_continuity.F90:2
mom_vert_friction
Implements vertical viscosity (vertvisc)
Definition: MOM_vert_friction.F90:2
mom_pressureforce::pressureforce_cs
Pressure force control structure.
Definition: MOM_PressureForce.F90:31
mom_coriolisadv
Accelerations due to the Coriolis force and momentum advection.
Definition: MOM_CoriolisAdv.F90:2
mom_thickness_diffuse
Thickness diffusion (or Gent McWilliams)
Definition: MOM_thickness_diffuse.F90:2
mom_lateral_mixing_coeffs
Variable mixing coefficients.
Definition: MOM_lateral_mixing_coeffs.F90:2
mom_restart::query_initialized
Indicate whether a field has been read from a restart file.
Definition: MOM_restart.F90:116
mom_variables::ocean_internal_state
Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM....
Definition: MOM_variables.F90:126
mom_pressureforce
A thin wrapper for Boussinesq/non-Boussinesq forms of the pressure force calculation.
Definition: MOM_PressureForce.F90:2
mom_domains::create_group_pass
Set up a group of halo updates.
Definition: MOM_domains.F90:79
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_interface_heights
Functions for calculating interface heights, including free surface height.
Definition: MOM_interface_heights.F90:2
mom_barotropic::barotropic_cs
The barotropic stepping control stucture.
Definition: MOM_barotropic.F90:100
mom_set_visc::set_visc_cs
Control structure for MOM_set_visc.
Definition: MOM_set_viscosity.F90:44
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:25
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239