src/core/MOM.F90

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

1		! This file is part of MOM6, the Modular Ocean Model version 6.
2		! See the LICENSE file for licensing information.
3		! SPDX-License-Identifier: Apache-2.0
4
5		!> The central module of the MOM6 ocean model
6		module MOM
7
8		! Infrastructure modules
9		use MOM_array_transform, only : rotate_array, rotate_vector
10		use MOM_debugging, only : MOM_debugging_init, hchksum, uvchksum, totalTandS
11		use MOM_debugging, only : check_redundant, query_debugging_checks
12		use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum
13		use MOM_checksum_packages, only : MOM_accel_chksum, MOM_surface_chksum
14		use MOM_coms, only : num_PEs
15		use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
16		use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT
17		use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE
18		use MOM_diag_mediator, only : diag_mediator_init, enable_averaging, enable_averages
19		use MOM_diag_mediator, only : diag_mediator_infrastructure_init
20		use MOM_diag_mediator, only : diag_set_state_ptrs, diag_update_remap_grids
21		use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr
22		use MOM_diag_mediator, only : register_diag_field, register_cell_measure
23		use MOM_diag_mediator, only : set_axes_info, diag_ctrl, diag_masks_set
24		use MOM_diag_mediator, only : set_masks_for_axes
25		use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init
26		use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids
27		use MOM_diag_mediator, only : diag_copy_storage_to_diag, diag_copy_diag_to_storage
28		use MOM_domains, only : MOM_domains_init, MOM_domain_type
29		use MOM_domains, only : sum_across_PEs, pass_var, pass_vector
30		use MOM_domains, only : clone_MOM_domain, deallocate_MOM_domain
31		use MOM_domains, only : To_North, To_East, To_South, To_West
32		use MOM_domains, only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR
33		use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
34		use MOM_domains, only : start_group_pass, complete_group_pass, Omit_Corners
35		use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
36		use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery
37		use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint
38		use MOM_file_parser, only : read_param, get_param, log_version, param_file_type
39		use MOM_forcing_type, only : forcing, mech_forcing, find_ustar
40		use MOM_forcing_type, only : MOM_forcing_chksum, MOM_mech_forcing_chksum
41		use MOM_get_input, only : Get_MOM_Input, directories
42		use MOM_io, only : MOM_io_init, vardesc, var_desc
43		use MOM_io, only : slasher, file_exists, MOM_read_data
44		use MOM_obsolete_params, only : find_obsolete_params
45		use MOM_restart, only : register_restart_field, register_restart_pair, save_restart
46		use MOM_restart, only : query_initialized, set_initialized, restart_registry_lock
47		use MOM_restart, only : restart_init, is_new_run, determine_is_new_run, MOM_restart_CS
48		use MOM_spatial_means, only : global_mass_integral
49		use MOM_time_manager, only : time_type, real_to_time, operator(+)
50		use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/)
51		use MOM_time_manager, only : operator(>=), operator(==), increment_date
52		use MOM_unit_tests, only : unit_tests
53
54		! MOM core modules
55		use MOM_ALE, only : ALE_init, ALE_end, ALE_regrid, ALE_CS, adjustGridForIntegrity
56		use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile
57		use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, pre_ALE_adjustments
58		use MOM_ALE, only : ALE_remap_tracers, ALE_remap_velocities
59		use MOM_ALE, only : ALE_remap_set_h_vel, ALE_remap_set_h_vel_via_dz
60		use MOM_ALE, only : ALE_update_regrid_weights, pre_ALE_diagnostics, ALE_register_diags
61		use MOM_ALE, only : ALE_set_extrap_boundaries
62		use MOM_ALE_sponge, only : rotate_ALE_sponge, update_ALE_sponge_field
63		use MOM_barotropic, only : Barotropic_CS
64		use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS
65		use MOM_check_scaling, only : check_MOM6_scaling_factors
66		use MOM_coord_initialization, only : MOM_initialize_coord, write_vertgrid_file
67		use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS, extract_diabatic_member
68		use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end
69		use MOM_diabatic_driver, only : register_diabatic_restarts
70		use MOM_stochastics, only : stochastics_init, update_stochastics, stochastic_CS, apply_skeb
71		use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init
72		use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics
73		use MOM_diagnostics, only : register_surface_diags, write_static_fields
74		use MOM_diagnostics, only : post_surface_dyn_diags, post_surface_thermo_diags
75		use MOM_diagnostics, only : diagnostics_CS, surface_diag_IDs, transport_diag_IDs
76		use MOM_diagnostics, only : MOM_diagnostics_end
77		use MOM_dynamics_unsplit, only : step_MOM_dyn_unsplit, register_restarts_dyn_unsplit
78		use MOM_dynamics_unsplit, only : initialize_dyn_unsplit, end_dyn_unsplit
79		use MOM_dynamics_unsplit, only : MOM_dyn_unsplit_CS
80		use MOM_dynamics_split_RK2, only : step_MOM_dyn_split_RK2, register_restarts_dyn_split_RK2
81		use MOM_dynamics_split_RK2, only : initialize_dyn_split_RK2, end_dyn_split_RK2
82		use MOM_dynamics_split_RK2, only : MOM_dyn_split_RK2_CS, remap_dyn_split_rk2_aux_vars
83		use MOM_dynamics_split_RK2, only : init_dyn_split_RK2_diabatic
84		use MOM_dynamics_split_RK2b, only : step_MOM_dyn_split_RK2b, register_restarts_dyn_split_RK2b
85		use MOM_dynamics_split_RK2b, only : initialize_dyn_split_RK2b, end_dyn_split_RK2b
86		use MOM_dynamics_split_RK2b, only : MOM_dyn_split_RK2b_CS, remap_dyn_split_RK2b_aux_vars
87		use MOM_dynamics_unsplit_RK2, only : step_MOM_dyn_unsplit_RK2, register_restarts_dyn_unsplit_RK2
88		use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2
89		use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS
90		use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid
91		use MOM_dyn_horgrid, only : rotate_dyn_horgrid
92		use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze, EOS_domain
93		use MOM_fixed_initialization, only : MOM_initialize_fixed
94		use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
95		use MOM_forcing_type, only : deallocate_mech_forcing, deallocate_forcing_type
96		use MOM_forcing_type, only : rotate_forcing, rotate_mech_forcing
97		use MOM_forcing_type, only : copy_common_forcing_fields, set_derived_forcing_fields
98		use MOM_forcing_type, only : homogenize_forcing, homogenize_mech_forcing
99		use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end
100		use MOM_grid, only : set_first_direction
101		use MOM_harmonic_analysis, only : HA_accum, harmonic_analysis_CS
102		use MOM_hor_index, only : hor_index_type, hor_index_init
103		use MOM_hor_index, only : rotate_hor_index
104		use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz
105		use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end
106		use MOM_interface_filter, only : interface_filter_CS
107		use MOM_internal_tides, only : int_tide_CS
108		use MOM_kappa_shear, only : kappa_shear_at_vertex
109		use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init, VarMix_end
110		use MOM_lateral_mixing_coeffs, only : calc_resoln_function, calc_depth_function, VarMix_CS
111		use MOM_MEKE, only : MEKE_alloc_register_restart, step_forward_MEKE
112		use MOM_MEKE, only : MEKE_CS, MEKE_init, MEKE_end
113		use MOM_MEKE_types, only : MEKE_type
114		use MOM_mixed_layer_restrat, only : mixedlayer_restrat, mixedlayer_restrat_init, mixedlayer_restrat_CS
115		use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts
116		use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics
117		use MOM_open_boundary, only : ocean_OBC_type, open_boundary_end
118		use MOM_open_boundary, only : register_temp_salt_segments, update_segment_tracer_reservoirs
119		use MOM_open_boundary, only : read_OBC_segment_data, initialize_OBC_segment_reservoirs
120		use MOM_open_boundary, only : setup_OBC_tracer_reservoirs
121		use MOM_open_boundary, only : setup_OBC_thickness_reservoirs
122		use MOM_open_boundary, only : open_boundary_register_restarts, remap_OBC_fields
123		use MOM_open_boundary, only : open_boundary_setup_vert, initialize_segment_data
124		use MOM_open_boundary, only : update_OBC_segment_data, rotate_OBC_config
125		use MOM_open_boundary, only : open_boundary_halo_update, write_OBC_info, chksum_OBC_segments
126		use MOM_open_boundary, only : segment_thickness_reservoir_init
127		use MOM_porous_barriers, only : porous_widths_layer, porous_widths_interface, porous_barriers_init
128		use MOM_porous_barriers, only : porous_barrier_CS
129		use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS
130		use MOM_set_visc, only : set_visc_register_restarts, remap_vertvisc_aux_vars
131		use MOM_set_visc, only : set_visc_init, set_visc_end
132		use MOM_shared_initialization, only : write_ocean_geometry_file
133		use MOM_sponge, only : init_sponge_diags, sponge_CS
134		use MOM_state_initialization, only : MOM_initialize_state, MOM_initialize_OBCs
135		use MOM_stoch_eos, only : MOM_stoch_eos_init, MOM_stoch_eos_run, MOM_stoch_eos_CS
136		use MOM_stoch_eos, only : stoch_EOS_register_restarts, post_stoch_EOS_diags, mom_calc_varT
137		use MOM_sum_output, only : write_energy, accumulate_net_input
138		use MOM_sum_output, only : MOM_sum_output_init, MOM_sum_output_end
139		use MOM_sum_output, only : sum_output_CS
140		use MOM_ALE_sponge, only : init_ALE_sponge_diags, ALE_sponge_CS
141		use MOM_thickness_diffuse, only : thickness_diffuse, thickness_diffuse_init
142		use MOM_thickness_diffuse, only : thickness_diffuse_end, thickness_diffuse_CS
143		use MOM_tracer_advect, only : advect_tracer, tracer_advect_init
144		use MOM_tracer_advect, only : tracer_advect_end, tracer_advect_CS
145		use MOM_tracer_hor_diff, only : tracer_hordiff, tracer_hor_diff_init
146		use MOM_tracer_hor_diff, only : tracer_hor_diff_end, tracer_hor_diff_CS
147		use MOM_tracer_registry, only : tracer_registry_type, register_tracer, tracer_registry_init
148		use MOM_tracer_registry, only : register_tracer_diagnostics, post_tracer_diagnostics_at_sync
149		use MOM_tracer_registry, only : post_tracer_transport_diagnostics, MOM_tracer_chksum
150		use MOM_tracer_registry, only : preALE_tracer_diagnostics, postALE_tracer_diagnostics
151		use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end
152		use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS
153		use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state
154		use MOM_tracer_flow_control, only : tracer_flow_control_end, call_tracer_register_obc_segments
155		use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid
156		use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init, unit_scaling_end
157		use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state
158		use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type
159		use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state
160		use MOM_variables, only : rotate_surface_state
161		use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd
162		use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units
163		use MOM_wave_interface, only : wave_parameters_CS, waves_end, waves_register_restarts
164		use MOM_wave_interface, only : Update_Stokes_Drift
165
166		! Database client used for machine-learning interface
167		use MOM_database_comms, only : dbcomms_CS_type, database_comms_init, dbclient_type
168
169		! ODA modules
170		use MOM_oda_driver_mod, only : ODA_CS, oda, init_oda, oda_end
171		use MOM_oda_driver_mod, only : set_prior_tracer, set_analysis_time, apply_oda_tracer_increments
172		use MOM_oda_incupd, only : oda_incupd_CS, init_oda_incupd_diags
173
174		! Offline modules
175		use MOM_offline_main, only : offline_transport_CS, offline_transport_init, update_offline_fields
176		use MOM_offline_main, only : insert_offline_main, extract_offline_main, post_offline_convergence_diags
177		use MOM_offline_main, only : register_diags_offline_transport, offline_advection_ale
178		use MOM_offline_main, only : offline_redistribute_residual, offline_diabatic_ale
179		use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean
180		use MOM_offline_main, only : offline_advection_layer, offline_transport_end
181		use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf
182		use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end
183		use MOM_particles_mod, only : particles_to_k_space, particles_to_z_space
184		implicit none ; private
185
186		#include <MOM_memory.h>
187
188		! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
189		! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
190		! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
191		! vary with the Boussinesq approximation, the Boussinesq variant is given first.
192
193		!> A structure with diagnostic IDs of the state variables
194		type MOM_diag_IDs
195		!>@{ 3-d state field diagnostic IDs
196		integer :: id_u = -1, id_v = -1, id_h = -1
197		!>@}
198		!> 2-d state field diagnostic ID
199		integer :: id_ssh_inst = -1
200		end type MOM_diag_IDs
201
202		!> Control structure for the MOM module, including the variables that describe
203		!! the state of the ocean.
204		type, public :: MOM_control_struct ; private
205		real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: &
206		h, & !< layer thickness [H ~> m or kg m-2]
207		T, & !< potential temperature [C ~> degC]
208		S !< salinity [S ~> ppt]
209		real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
210		u, & !< zonal velocity component [L T-1 ~> m s-1]
211		uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1]
212		uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg]
213		real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
214		v, & !< meridional velocity [L T-1 ~> m s-1]
215		vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1]
216		vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg]
217		real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint
218		!< A running time integral of the sea surface height [T Z ~> s m].
219		real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc
220		!< time-averaged (over a forcing time step) sea surface height
221		!! with a correction for the inverse barometer [Z ~> m]
222		real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc
223		!< free surface height or column mass time averaged over the last
224		!! baroclinic dynamics time step [H ~> m or kg m-2]
225		real, dimension(:,:), pointer :: Hml => NULL()
226		!< active mixed layer depth, or 0 if there is no boundary layer scheme [Z ~> m]
227		real :: time_in_cycle !< The running time of the current time-stepping cycle
228		!! in calls that step the dynamics, and also the length of
229		!! the time integral of ssh_rint [T ~> s].
230		real :: time_in_thermo_cycle !< The running time of the current time-stepping
231		!! cycle in calls that step the thermodynamics [T ~> s].
232
233		type(ocean_grid_type), allocatable :: G_in !< Input grid metric
234		type(ocean_grid_type), pointer :: G => NULL() !< Model grid metric
235		logical :: rotate_index = .false. !< True if index map is rotated
236		logical :: homogenize_forcings = .false. !< True if all inputs are homogenized
237		logical :: update_ustar = .false. !< True to update ustar from homogenized tau
238		logical :: vertex_shear = .false. !< True if vertex shear is on
239
240		type(verticalGrid_type), pointer :: &
241		GV => NULL() !< structure containing vertical grid info
242		type(unit_scale_type), pointer :: &
243		US => NULL() !< structure containing various unit conversion factors
244		type(thermo_var_ptrs), allocatable :: tv
245		!< structure containing pointers to available thermodynamic fields
246		real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer advection and lateral mixing
247		!! [T ~> s], or equivalently the elapsed time since advectively updating the
248		!! tracers. t_dyn_rel_adv is invariably positive and may span multiple coupling timesteps.
249		integer :: n_dyn_steps_in_adv !< The number of dynamics time steps that contributed to uhtr
250		!! and vhtr since the last time tracer advection occured.
251		real :: t_dyn_rel_thermo !< The time of the dynamics relative to diabatic processes and remapping
252		!! [T ~> s]. t_dyn_rel_thermo can be negative or positive depending on whether
253		!! the diabatic processes are applied before or after the dynamics and may span
254		!! multiple coupling timesteps.
255		real :: t_dyn_rel_diag !< The time of the diagnostics relative to diabatic processes and remapping
256		!! [T ~> s]. t_dyn_rel_diag is always positive, since the diagnostics must lag.
257		logical :: preadv_h_stored = .false. !< If true, the thicknesses from before the advective cycle
258		!! have been stored for use in diagnostics.
259
260		type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing
261		type(vertvisc_type), allocatable :: visc
262		!< structure containing vertical viscosities, bottom drag viscosities, and related fields
263		type(MEKE_type) :: MEKE !< Fields related to the Mesoscale Eddy Kinetic Energy
264		logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls
265		!! to routines to calculate or apply diapycnal fluxes.
266		logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time
267		!! stepping the dynamics.
268		logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered
269		!! isopycnal/stacked shallow water mode. This logical is set by calling the
270		!! function useRegridding() from the MOM_regridding module.
271		logical :: remap_aux_vars !< If true, apply ALE remapping to all of the auxiliary 3-D
272		!! variables that are needed to reproduce across restarts,
273		!! similarly to what is done with the primary state variables.
274		logical :: remap_uv_using_old_alg !< If true, use the old "remapping via a delta z" method for
275		!! velocities. If false, remap between two grids described by thicknesses.
276
277		type(MOM_stoch_eos_CS) :: stoch_eos_CS !< structure containing random pattern for stoch EOS
278		logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction
279		!! updates occur first in directionally split parts of the calculation.
280		real :: first_dir_restart = -1.0 !< A real copy of G%first_direction for use in restart files [nondim]
281		logical :: offline_tracer_mode = .false.
282		!< If true, step_offline() is called instead of step_MOM().
283		!! This is intended for running MOM6 in offline tracer mode
284		logical :: MEKE_in_dynamics !< If .true. (default), MEKE is called in the dynamics routine otherwise
285		!! it is called during the tracer dynamics
286
287		type(time_type), pointer :: Time !< pointer to the ocean clock
288		real :: dt !< (baroclinic) dynamics time step [T ~> s]
289		real :: dt_therm !< diabatic time step [T ~> s]
290		real :: dt_tr_adv !< tracer advection time step [T ~> s]
291		logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time
292		!! steps can span multiple coupled time steps.
293		logical :: tradv_spans_coupling !< If true, thermodynamic and tracer time
294		integer :: nstep_tot = 0 !< The total number of dynamic timesteps taken
295		!! so far in this run segment
296		logical :: count_calls = .false. !< If true, count the calls to step_MOM, rather than the
297		!! number of dynamics steps in nstep_tot
298		logical :: debug !< If true, write verbose checksums for debugging purposes.
299		logical :: debug_OBCs !< If true, write verbose OBC values for debugging purposes.
300		integer :: ntrunc !< number u,v truncations since last call to write_energy
301
302		integer :: cont_stencil !< The stencil for thickness from the continuity solver.
303		integer :: dyn_h_stencil !< The stencil for thickness for the dynamics based on
304		!! the continuity solver and Coriolis schemes.
305		! These elements are used to control the dynamics updates.
306		logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an
307		!! undocumented run-time flag that is fragile.
308		logical :: split !< If true, use the split time stepping scheme.
309		logical :: use_alt_split !< If true, use a version of the split explicit time stepping
310		!! scheme that exchanges velocities with step_MOM that have the
311		!! average barotropic phase over a baroclinic timestep rather
312		!! than the instantaneous barotropic phase.
313		logical :: use_RK2 !< If true, use RK2 instead of RK3 in unsplit mode
314		!! (i.e., no split between barotropic and baroclinic).
315		logical :: interface_filter !< If true, apply an interface height filter immediately
316		!! after any calls to thickness_diffuse.
317		logical :: thickness_diffuse !< If true, diffuse interface height w/ a diffusivity KHTH.
318		logical :: thickness_diffuse_first !< If true, diffuse thickness before dynamics.
319		logical :: interface_filter_dt_bug !< If true, uses the wrong time interval in
320		!! calls to interface_filter and thickness_diffuse.
321		logical :: mixedlayer_restrat !< If true, use submesoscale mixed layer restratifying scheme.
322		logical :: useMEKE !< If true, call the MEKE parameterization.
323		logical :: use_stochastic_EOS !< If true, use the stochastic EOS parameterizations.
324		logical :: useWaves !< If true, update Stokes drift
325		real :: dtbt_reset_period !< The time interval between dynamic recalculation of the
326		!! barotropic time step [T ~> s]. If this is negative dtbt is never
327		!! calculated, and if it is 0, dtbt is calculated every step.
328		type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period.
329		type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated.
330		real :: dt_obc_seg_period !< The time interval between OBC segment updates for OBGC
331		!! tracers [T ~> s], or a negative value if the segment
332		!! data are time-invarant, or zero to update the OBGC
333		!! segment data with every call to update_OBC_segment_data.
334		type(time_type) :: dt_obc_seg_interval !< A time_time representation of dt_obc_seg_period.
335		type(time_type) :: dt_obc_seg_time !< The next time OBC segment update is applied to OBGC tracers.
336
337		real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied
338		!! by ice shelf [nondim]
339		real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2]
340		type(accel_diag_ptrs), allocatable :: ADp !< structure containing pointers to accelerations,
341		!! for derived diagnostics (e.g., energy budgets)
342		type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation
343		!! terms, for derived diagnostics (e.g., energy budgets)
344		real, dimension(:,:,:), pointer :: &
345		u_prev => NULL(), & !< previous value of u stored for diagnostics [L T-1 ~> m s-1]
346		v_prev => NULL() !< previous value of v stored for diagnostics [L T-1 ~> m s-1]
347
348		logical :: interp_p_surf !< If true, linearly interpolate surface pressure
349		!! over the coupling time step, using specified value
350		!! at the end of the coupling step. False by default.
351		logical :: p_surf_prev_set !< If true, p_surf_prev has been properly set from
352		!! a previous time-step or the ocean restart file.
353		!! This is only valid when interp_p_surf is true.
354		real, dimension(:,:), pointer :: &
355		p_surf_prev => NULL(), & !< surface pressure [R L2 T-2 ~> Pa] at end previous call to step_MOM
356		p_surf_begin => NULL(), & !< surface pressure [R L2 T-2 ~> Pa] at start of step_MOM_dyn_...
357		p_surf_end => NULL() !< surface pressure [R L2 T-2 ~> Pa] at end of step_MOM_dyn_...
358
359		! Variables needed to reach between start and finish phases of initialization
360		logical :: write_IC !< If true, then the initial conditions will be written to file
361		character(len=120) :: IC_file !< A file into which the initial conditions are
362		!! written in a new run if SAVE_INITIAL_CONDS is true.
363
364		logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level
365
366		! These elements are used to control the calculation and error checking of the surface state
367		real :: Hmix !< Diagnostic mixed layer thickness over which to
368		!! average surface tracer properties when a bulk
369		!! mixed layer is not used [H ~> m or kg m-2], or a negative value
370		!! if a bulk mixed layer is being used.
371		real :: HFrz !< If HFrz > 0, the nominal depth over which melt potential is computed
372		!! [H ~> m or kg m-2]. The actual depth over which melt potential is
373		!! computed is min(HFrz, OBLD), where OBLD is the boundary layer depth.
374		!! If HFrz <= 0 (default), melt potential will not be computed.
375		real :: Hmix_UV !< Depth scale over which to average surface flow to
376		!! feedback to the coupler/driver [H ~> m or kg m-2] when
377		!! bulk mixed layer is not used, or a negative value
378		!! if a bulk mixed layer is being used.
379		logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values.
380		real :: bad_val_ssh_max !< Maximum SSH before triggering bad value message [Z ~> m]
381		real :: bad_val_sst_max !< Maximum SST before triggering bad value message [C ~> degC]
382		real :: bad_val_sst_min !< Minimum SST before triggering bad value message [C ~> degC]
383		real :: bad_val_sss_max !< Maximum SSS before triggering bad value message [S ~> ppt]
384		real :: bad_val_col_thick !< Minimum column thickness before triggering bad value message [Z ~> m]
385		integer :: answer_date !< The vintage of the expressions for the surface properties. Values
386		!! below 20190101 recover the answers from the end of 2018, while
387		!! higher values use more appropriate expressions that differ at
388		!! roundoff for non-Boussinesq cases.
389		logical :: use_particles !< Turns on the particles package
390		logical :: use_uh_particles !< particles are advected by uh/h
391		logical :: uh_particles_bug !< If true, uses an inconsistent timestep for particle advection
392		logical :: use_dbclient !< Turns on the database client used for ML inference/analysis
393		character(len=10) :: particle_type !< Particle types include: surface(default), profiling and sail drone.
394
395		type(MOM_diag_IDs) :: IDs !< Handles used for diagnostics.
396		type(transport_diag_IDs) :: transport_IDs !< Handles used for transport diagnostics.
397		type(surface_diag_IDs) :: sfc_IDs !< Handles used for surface diagnostics.
398		type(diag_grid_storage) :: diag_pre_sync !< The grid (thicknesses) before remapping
399		type(diag_grid_storage) :: diag_pre_dyn !< The grid (thicknesses) before dynamics
400
401		! The remainder of this type provides pointers to child module control structures.
402
403		type(MOM_dyn_unsplit_CS), pointer :: dyn_unsplit_CSp => NULL()
404		!< Pointer to the control structure used for the unsplit dynamics
405		type(MOM_dyn_unsplit_RK2_CS), pointer :: dyn_unsplit_RK2_CSp => NULL()
406		!< Pointer to the control structure used for the unsplit RK2 dynamics
407		type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL()
408		!< Pointer to the control structure used for the mode-split RK2 dynamics
409		type(MOM_dyn_split_RK2b_CS), pointer :: dyn_split_RK2b_CSp => NULL()
410		!< Pointer to the control structure used for an alternate version of the mode-split RK2 dynamics
411		type(harmonic_analysis_CS), pointer :: HA_CSp => NULL()
412		!< Pointer to the control structure for harmonic analysis
413		type(thickness_diffuse_CS) :: thickness_diffuse_CSp
414		!< Pointer to the control structure used for the isopycnal height diffusive transport.
415		!! This is also common referred to as Gent-McWilliams diffusion
416		type(interface_filter_CS) :: interface_filter_CSp
417		!< Control structure used for the interface height smoothing operator.
418		type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp
419		!< Pointer to the control structure used for the mixed layer restratification
420		type(set_visc_CS), allocatable :: set_visc_CSp
421		!< Control structure used to set viscosities
422		type(diabatic_CS), pointer :: diabatic_CSp => NULL()
423		!< Pointer to the control structure for the diabatic driver
424		type(MEKE_CS) :: MEKE_CSp
425		!< Pointer to the control structure for the MEKE updates
426		type(VarMix_CS), allocatable :: VarMix
427		!< Control structure for the variable mixing module
428		type(tracer_registry_type), pointer :: tracer_Reg => NULL()
429		!< Pointer to the MOM tracer registry
430		type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL()
431		!< Pointer to the MOM tracer advection control structure
432		type(tracer_hor_diff_CS), pointer :: tracer_diff_CSp => NULL()
433		!< Pointer to the MOM along-isopycnal tracer diffusion control structure
434		type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL()
435		!< Pointer to the control structure that orchestrates the calling of tracer packages
436		! Although update_OBC_CS is not used directly outside of initialization, other modules
437		! set pointers to this type, so it should be kept for the duration of the run.
438		type(update_OBC_CS), pointer :: update_OBC_CSp => NULL()
439		!< Pointer to the control structure for updating open boundary condition properties
440		type(ocean_OBC_type), pointer :: OBC => NULL()
441		!< Pointer to the MOM open boundary condition type
442		type(sponge_CS), pointer :: sponge_CSp => NULL()
443		!< Pointer to the layered-mode sponge control structure
444		type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL()
445		!< Pointer to the ALE-mode sponge control structure
446		type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL()
447		!< Pointer to the oda incremental update control structure
448		type(int_tide_CS), pointer :: int_tide_CSp => NULL()
449		!< Pointer to the internal tides control structure
450		type(ALE_CS), pointer :: ALE_CSp => NULL()
451		!< Pointer to the Arbitrary Lagrangian Eulerian (ALE) vertical coordinate control structure
452
453		! Pointers to control structures used for diagnostics
454		type(sum_output_CS), pointer :: sum_output_CSp => NULL()
455		!< Pointer to the globally summed output control structure
456		type(diagnostics_CS) :: diagnostics_CSp
457		!< Pointer to the MOM diagnostics control structure
458		type(offline_transport_CS), pointer :: offline_CSp => NULL()
459		!< Pointer to the offline tracer transport control structure
460		type(porous_barrier_CS) :: por_bar_CS
461		!< Control structure for porous barrier
462
463		logical :: ensemble_ocean !< if true, this run is part of a
464		!! larger ensemble for the purpose of data assimilation
465		!! or statistical analysis.
466		type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling
467		!! ensemble model state vectors and data assimilation
468		!! increments and priors
469		type(dbcomms_CS_type) :: dbcomms_CS !< Control structure for database client used for online ML/AI
470		logical :: use_porbar !< If true, use porous barrier to constrain the widths and face areas
471		!! at the edges of the grid cells.
472		type(porous_barrier_type) :: pbv !< porous barrier fractional cell metrics
473		type(particles), pointer :: particles => NULL() !<Lagrangian particles
474		type(stochastic_CS), pointer :: stoch_CS => NULL() !< a pointer to the stochastics control structure
475		type(MOM_restart_CS), pointer :: restart_CS => NULL()
476		!< Pointer to MOM's restart control structure
477		end type MOM_control_struct
478
479		public initialize_MOM, finish_MOM_initialization, MOM_end
480		public step_MOM, step_offline
481		public extract_surface_state, get_ocean_stocks
482		public get_MOM_state_elements, MOM_state_is_synchronized
483		public allocate_surface_state, deallocate_surface_state
484		public save_MOM_restart
485
486		!>@{ CPU time clock IDs
487		integer :: id_clock_ocean
488		integer :: id_clock_dynamics
489		integer :: id_clock_thermo
490		integer :: id_clock_MOM_end
491		integer :: id_clock_remap
492		integer :: id_clock_tracer
493		integer :: id_clock_diabatic
494		integer :: id_clock_adiabatic
495		integer :: id_clock_continuity ! also in dynamics s/r
496		integer :: id_clock_thick_diff
497		integer :: id_clock_int_filter
498		integer :: id_clock_BBL_visc
499		integer :: id_clock_ml_restrat
500		integer :: id_clock_diagnostics
501		integer :: id_clock_Z_diag
502		integer :: id_clock_init
503		integer :: id_clock_MOM_init
504		integer :: id_clock_pass ! also in dynamics d/r
505		integer :: id_clock_pass_init ! also in dynamics d/r
506		integer :: id_clock_ALE
507		integer :: id_clock_other
508		integer :: id_clock_offline_tracer
509		integer :: id_clock_save_restart
510		integer :: id_clock_unit_tests
511		integer :: id_clock_stoch
512		integer :: id_clock_varT
513		!>@}
514
515		contains
516
517		!> This subroutine orchestrates the time stepping of MOM. The adiabatic
518		!! dynamics are stepped by calls to one of the step_MOM_dyn_...routines.
519		!! The action of lateral processes on tracers occur in calls to
520		!! advect_tracer and tracer_hordiff. Vertical mixing and possibly remapping
521		!! occur inside of diabatic.
522	12	subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, &
523		Waves, do_dynamics, do_thermodynamics, start_cycle, &
524		end_cycle, cycle_length, reset_therm)
525		type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces
526		type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic,
527		!! tracer and mass exchange forcing fields
528		type(surface), target, intent(inout) :: sfc_state !< surface ocean state
529		type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type
530		real, intent(in) :: time_int_in !< time interval covered by this run segment [T ~> s].
531		type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM
532		type(Wave_parameters_CS), &
533		optional, pointer :: Waves !< An optional pointer to a wave property CS
534		logical, optional, intent(in) :: do_dynamics !< Present and false, do not do updates due
535		!! to the dynamics.
536		logical, optional, intent(in) :: do_thermodynamics !< Present and false, do not do updates due
537		!! to the thermodynamics or remapping.
538		logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be
539		!! treated as the first call to step_MOM in a
540		!! time-stepping cycle; missing is like true.
541		logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be
542		!! treated as the last call to step_MOM in a
543		!! time-stepping cycle; missing is like true.
544		real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time
545		!! stepping cycle [T ~> s].
546		logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of
547		!! thermodynamic quantities should be reset.
548		!! If missing, this is like start_cycle.
549
550		! local variables
551		type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing
552		! metrics and related information
553		type(ocean_grid_type), pointer :: G_in => NULL() ! Input grid metric
554		type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure
555		type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing
556		! various unit conversion factors
557		integer :: ntstep ! number of time steps between diabatic forcing updates
558		integer :: ntastep ! number of time steps between tracer advection updates
559		integer :: n_max ! number of steps to take in this call
560		integer :: halo_sz, dynamics_stencil
561
562		integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n
563		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
564
565		real :: time_interval ! time interval covered by this run segment [T ~> s].
566		real :: dt ! baroclinic time step [T ~> s]
567		real :: dtdia ! time step for diabatic processes [T ~> s]
568		real :: dt_tr_adv ! time step for tracer advection [T ~> s]
569		real :: dt_therm ! a limited and quantized version of CS%dt_therm [T ~> s]
570		real :: dt_tradv_here ! a further limited value of dt_tr_adv [T ~> s]
571
572		real :: wt_end, wt_beg ! Fractional weights of the future pressure at the end
573		! and beginning of the current time step [nondim]
574		real :: bbl_time_int ! The amount of time over which the calculated BBL
575		! properties will apply, for use in diagnostics, or 0
576		! if it is not to be calculated anew [T ~> s].
577		real :: rel_time = 0.0 ! relative time since start of this call [T ~> s].
578
579		logical :: do_advection ! If true, do tracer advection.
580		logical :: do_diabatic ! If true, do diabatic update.
581		logical :: thermo_does_span_coupling ! If true,thermodynamic (diabatic) forcing spans
582		! multiple coupling timesteps.
583		logical :: tradv_does_span_coupling ! If true, tracer advection spans
584		! multiple coupling timesteps.
585		logical :: do_dyn ! If true, dynamics are updated with this call.
586		logical :: do_thermo ! If true, thermodynamics and remapping may be applied with this call.
587		logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging.
588		logical :: nonblocking_p_surf_update ! A flag to indicate whether surface properties
589		! can use nonblocking halo updates
590		logical :: cycle_start ! If true, do calculations that are only done at the start of
591		! a stepping cycle (whatever that may mean).
592		logical :: cycle_end ! If true, do calculations and diagnostics that are only done at
593		! the end of a stepping cycle (whatever that may mean).
594		logical :: therm_reset ! If true, reset running sums of thermodynamic quantities.
595		real :: cycle_time ! The length of the coupled time-stepping cycle [T ~> s].
596		real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
597	24	U_star ! The wind friction velocity, calculated using the Boussinesq reference density or
598		! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1]
599		real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
600	24	ssh ! sea surface height, which may be based on eta_av [Z ~> m]
601		real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: &
602	24	dz ! Vertical distance across layers [Z ~> m]
603
604		real, dimension(:,:,:), pointer :: &
605		u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1]
606		v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1]
607		h => NULL() ! h : layer thickness [H ~> m or kg m-2]
608		real, dimension(:,:), pointer :: &
609		p_surf => NULL() ! A pointer to the ocean surface pressure [R L2 T-2 ~> Pa].
610		real :: I_wt_ssh ! The inverse of the time weights [T-1 ~> s-1]
611
612		type(time_type) :: Time_local, end_time_thermo
613		type(time_type) :: Time_end_diag ! End time of a diagnostic segment, as a time type
614
615		type(group_pass_type) :: pass_tau_ustar_psurf
616		logical :: showCallTree
617
618		! External forcing fields on the model index map
619		type(mech_forcing), pointer :: forces ! Mechanical forcing
620		type(forcing), pointer :: fluxes ! Boundary fluxes
621		type(surface), pointer :: sfc_state_diag ! Surface boundary fields
622		integer :: turns ! Number of quarter turns from input to model indexing
623
624	12	G => CS%G ; G_in => CS%G_in ; GV => CS%GV ; US => CS%US
625	12	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
626	12	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
627	12	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
628	12	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
629	12	u => CS%u ; v => CS%v ; h => CS%h
630
631	12	time_interval = time_int_in
632	0	do_dyn = .true. ; if (present(do_dynamics)) do_dyn = do_dynamics
633	12	do_thermo = .true. ; if (present(do_thermodynamics)) do_thermo = do_thermodynamics
634	12	if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL,"Step_MOM: "//&
635	0	"Both do_dynamics and do_thermodynamics are false, which makes no sense.")
636	12	cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle
637	12	cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle
638	12	cycle_time = time_interval ; if (present(cycle_length)) cycle_time = cycle_length
639	12	therm_reset = cycle_start ; if (present(reset_therm)) therm_reset = reset_therm
640
641	12	call cpu_clock_begin(id_clock_ocean)
642	12	call cpu_clock_begin(id_clock_other)
643
644	12	if (CS%debug) then
645		!$omp target update from(u, v, h)
646	0	call query_debugging_checks(do_redundant=debug_redundant)
647	0	call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US)
648		endif
649
650	12	showCallTree = callTree_showQuery()
651	12	if (showCallTree) call callTree_enter("step_MOM(), MOM.F90")
652
653		! Rotate the forces from G_in to G
654	12	if (CS%rotate_index) then
655	0	turns = G%HI%turns
656	0	allocate(forces)
657	0	call allocate_mech_forcing(forces_in, G, forces)
658	0	call rotate_mech_forcing(forces_in, turns, forces)
659
660	0	allocate(fluxes)
661	0	call allocate_forcing_type(fluxes_in, G, fluxes, turns=turns)
662	0	call rotate_forcing(fluxes_in, fluxes, turns)
663		else
664	12	forces => forces_in
665	12	fluxes => fluxes_in
666		endif
667
668		! Homogenize the forces
669	12	if (CS%homogenize_forcings) then
670		! Homogenize all forcing and fluxes fields.
671	0	call homogenize_mech_forcing(forces, G, US, GV%Rho0, CS%update_ustar)
672		! Note the following computes the mean ustar as the mean of ustar rather than
673		! ustar of the mean of tau.
674	0	call homogenize_forcing(fluxes, G, GV, US)
675	0	if (CS%update_ustar) then
676		! These calls corrects the ustar values
677	0	call copy_common_forcing_fields(forces, fluxes, G)
678	0	call set_derived_forcing_fields(forces, fluxes, G, US, GV%Rho0)
679		endif
680		endif
681		!$omp target enter data map(to: forces, forces%taux, forces%tauy, forces%ustar)
682
683		! This will be replaced later with the pressures from forces or fluxes if they are available.
684	105276	if (associated(CS%tv%p_surf)) CS%tv%p_surf(:,:) = 0.0
685
686		! First determine the time step that is consistent with this call and an
687		! integer fraction of time_interval.
688	12	if (do_dyn) then
689	12	n_max = 1
690	12	if (time_interval > CS%dt) n_max = ceiling(time_interval/CS%dt - 0.001)
691
692	12	dt = time_interval / real(n_max)
693		thermo_does_span_coupling = (CS%thermo_spans_coupling .and. &
694	12	(CS%dt_therm > 1.5*cycle_time))
695		tradv_does_span_coupling = (CS%tradv_spans_coupling .and. &
696	12	(CS%dt_tr_adv > 1.5*cycle_time))
697	12	if (thermo_does_span_coupling) then
698		! Set dt_therm to be an integer multiple of the coupling time step.
699	0	dt_therm = cycle_time * floor(CS%dt_therm / cycle_time + 0.001)
700	0	ntstep = floor(dt_therm/dt + 0.001)
701	12	elseif (.not.do_thermo) then
702	0	dt_therm = CS%dt_therm
703	0	if (present(cycle_length)) dt_therm = min(CS%dt_therm, cycle_length)
704	0	ntstep = 1 ! ntstep is initialized to avoid an error in a secondary logical test,
705		! but the nonzero value of ntstep does not matter when do_thermo is false.
706		else
707	12	ntstep = MAX(1, MIN(n_max, floor(CS%dt_therm/dt + 0.001)))
708	12	dt_therm = dt*ntstep
709		endif
710	12	if (tradv_does_span_coupling) then
711		! Set dt_tr_adv to be an integer multiple of the coupling time step.
712	0	dt_tr_adv = cycle_time * floor(CS%dt_tr_adv / cycle_time + 0.001)
713	0	ntastep = floor(dt_tr_adv/dt + 0.001)
714	12	elseif (.not.do_thermo) then
715	0	dt_tr_adv = CS%dt_tr_adv
716	0	if (present(cycle_length)) dt_tr_adv = min(CS%dt_tr_adv, cycle_length)
717		! ntastep is not used.
718		else
719	12	ntastep = MAX(1, MIN(n_max, floor(CS%dt_tr_adv/dt + 0.001)))
720	12	dt_tr_adv = dt*ntastep
721		endif
722
723		!---------- Initiate group halo pass of the forcing fields
724	12	call cpu_clock_begin(id_clock_pass)
725		! Halo updates for surface pressure need to be completed before calling calc_resoln_function
726		! among other routines if the surface pressure is used in the equation of state.
727		nonblocking_p_surf_update = G%nonblocking_updates .and. &
728		.not.(associated(CS%tv%p_surf) .and. associated(forces%p_surf) .and. &
729	12	allocated(CS%tv%SpV_avg) .and. associated(CS%tv%T))
730	12	if (.not.associated(forces%taux) .or. .not.associated(forces%tauy)) &
731	0	call MOM_error(FATAL,'step_MOM:forces%taux,tauy not associated')
732	12	call create_group_pass(pass_tau_ustar_psurf, forces%taux, forces%tauy, G%Domain)
733	12	if (associated(forces%ustar)) &
734	12	call create_group_pass(pass_tau_ustar_psurf, forces%ustar, G%Domain)
735	12	if (associated(forces%tau_mag)) &
736	12	call create_group_pass(pass_tau_ustar_psurf, forces%tau_mag, G%Domain)
737	12	if (associated(forces%p_surf)) &
738	12	call create_group_pass(pass_tau_ustar_psurf, forces%p_surf, G%Domain)
739	12	if (nonblocking_p_surf_update) then
740	0	call start_group_pass(pass_tau_ustar_psurf, G%Domain)
741		else
742	12	call do_group_pass(pass_tau_ustar_psurf, G%Domain, omp_offload=.true.)
743		endif
744	12	call cpu_clock_end(id_clock_pass)
745
746	12	if (associated(forces%p_surf)) p_surf => forces%p_surf
747	12	if (.not.associated(forces%p_surf)) CS%interp_p_surf = .false.
748	12	if (associated(CS%tv%p_surf) .and. associated(forces%p_surf)) then
749	105276	do j=jsd,jed ; do i=isd,ied ; CS%tv%p_surf(i,j) = forces%p_surf(i,j) ; enddo ; enddo
750
751	12	if (allocated(CS%tv%SpV_avg) .and. associated(CS%tv%T)) then
752		!$omp target update from(h)
753		! The internal ocean state depends on the surface pressues, so update SpV_avg.
754	0	dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
755	0	call calc_derived_thermo(CS%tv, h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
756		endif
757		endif
758
759		else
760		! This step only updates the thermodynamics so setting timesteps is simpler.
761	0	n_max = 1
762	0	if ((time_interval > CS%dt_therm) .and. (CS%dt_therm > 0.0)) &
763	0	n_max = ceiling(time_interval/CS%dt_therm - 0.001)
764
765	0	dt = time_interval / real(n_max)
766	0	dt_therm = dt ; ntstep = 1
767
768	0	if (CS%UseWaves .and. associated(fluxes%ustar)) &
769	0	call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass, halo=1)
770	0	if (CS%UseWaves .and. associated(fluxes%tau_mag)) &
771	0	call pass_var(fluxes%tau_mag, G%Domain, clock=id_clock_pass, halo=1)
772
773	0	if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf
774	0	if (associated(CS%tv%p_surf) .and. associated(fluxes%p_surf)) then
775	0	do j=js,je ; do i=is,ie ; CS%tv%p_surf(i,j) = fluxes%p_surf(i,j) ; enddo ; enddo
776	0	if (allocated(CS%tv%SpV_avg)) then
777		!$omp target update from(h)
778	0	call pass_var(CS%tv%p_surf, G%Domain, clock=id_clock_pass)
779		! The internal ocean state depends on the surface pressues, so update SpV_avg.
780	0	call extract_diabatic_member(CS%diabatic_CSp, diabatic_halo=halo_sz)
781	0	halo_sz = max(halo_sz, 1)
782	0	call calc_derived_thermo(CS%tv, h, G, GV, US, halo=halo_sz, debug=CS%debug)
783		endif
784		endif
785		endif
786
787	12	if (therm_reset) then
788	12	CS%time_in_thermo_cycle = 0.0
789	12	if (associated(CS%tv%frazil)) then
790	105276	CS%tv%frazil(:,:) = 0.0
791	12	CS%tv%frazil_was_reset = .true.
792		endif
793	12	if (associated(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0
794	105276	if (associated(CS%tv%TempxPmE)) CS%tv%TempxPmE(:,:) = 0.0
795	105276	if (associated(CS%tv%internal_heat)) CS%tv%internal_heat(:,:) = 0.0
796		endif
797
798	12	if (cycle_start) then
799	12	CS%time_in_cycle = 0.0
800	12	do concurrent (j=js:je, i=is:ie)
801	87852	CS%ssh_rint(i,j) = 0.
802		enddo
803
804	12	if (CS%VarMix%use_variable_mixing) then
805	12	Time_end_diag = Time_start + real_to_time(cycle_time, unscale=US%T_to_s)
806	12	call enable_averages(cycle_time, Time_end_diag, CS%diag)
807	12	call calc_resoln_function(h, CS%tv, G, GV, US, CS%VarMix, CS%MEKE, CS%OBC, dt)
808	12	call calc_depth_function(G, CS%VarMix)
809	12	call disable_averaging(CS%diag)
810		endif
811		endif
812		! advance the random pattern if stochastic physics is active
813	12	if (CS%stoch_CS%do_sppt .OR. CS%stoch_CS%pert_epbl .OR. CS%stoch_CS%do_skeb) &
814	0	call update_stochastics(CS%stoch_CS)
815
816	12	if (do_dyn) then
817	12	if (nonblocking_p_surf_update) &
818	0	call complete_group_pass(pass_tau_ustar_psurf, G%Domain, clock=id_clock_pass)
819
820	12	if (CS%interp_p_surf) then
821	0	if (.not.associated(CS%p_surf_end)) allocate(CS%p_surf_end(isd:ied,jsd:jed))
822	0	if (.not.associated(CS%p_surf_begin)) allocate(CS%p_surf_begin(isd:ied,jsd:jed))
823	0	if (.not.CS%p_surf_prev_set) then
824	0	do j=jsd,jed ; do i=isd,ied
825	0	CS%p_surf_prev(i,j) = forces%p_surf(i,j)
826		enddo ; enddo
827	0	CS%p_surf_prev_set = .true.
828		endif
829		else
830	12	CS%p_surf_end => forces%p_surf
831		endif
832	12	if (CS%UseWaves) then
833		! Update wave information, which is presently kept static over each call to step_mom
834		!$omp target update from(h)
835	0	Time_end_diag = Time_start + real_to_time(time_interval, unscale=US%T_to_s)
836	0	call enable_averages(time_interval, Time_end_diag, CS%diag)
837	0	call find_ustar(forces, CS%tv, U_star, G, GV, US, halo=1)
838	0	call thickness_to_dz(h, CS%tv, dz, G, GV, US, halo_size=1)
839	0	call Update_Stokes_Drift(G, GV, US, Waves, dz, U_star, time_interval, do_dyn)
840	0	call disable_averaging(CS%diag)
841		endif
842		else ! not do_dyn.
843	0	if (CS%UseWaves) then ! Diagnostics are not enabled in this call.
844		!$omp target update from(h)
845	0	call find_ustar(fluxes, CS%tv, U_star, G, GV, US, halo=1)
846	0	call thickness_to_dz(h, CS%tv, dz, G, GV, US, halo_size=1)
847	0	call Update_Stokes_Drift(G, GV, US, Waves, dz, U_star, time_interval, do_dyn)
848		endif
849		endif
850
851	12	if (CS%debug) then
852		!$omp target update from(u, v, h)
853	0	if (cycle_start) &
854	0	call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US)
855	0	if (cycle_start .and. debug_redundant) &
856	0	call check_redundant("Before steps ", u, v, G, unscale=US%L_T_to_m_s)
857	0	if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0)
858	0	if (do_dyn .and. debug_redundant) &
859		call check_redundant("Before steps ", forces%taux, forces%tauy, G, &
860	0	unscale=US%RZ_T_to_kg_m2s*US%L_T_to_m_s)
861		endif
862	12	call cpu_clock_end(id_clock_other)
863
864	12	rel_time = 0.0
865
866		! TODO: This appears safe to remove but needs verification.
867		!**!$omp target update to(u, v, h, CS%uhtr, CS%vhtr)
868
869	36	do n=1,n_max
870	24	rel_time = rel_time + dt ! The relative time at the end of the step.
871		! Set the universally visible time to the middle of the time step.
872	24	CS%Time = Time_start + real_to_time(rel_time - 0.5*dt, unscale=US%T_to_s)
873		! Set the local time to the end of the time step.
874	24	Time_local = Time_start + real_to_time(rel_time, unscale=US%T_to_s)
875
876	24	if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n)
877
878		! Update the vertically extensive diagnostic grids so that they are
879		! referenced to the beginning timestep
880	24	call diag_update_remap_grids(CS%diag, update_intensive = .false., update_extensive = .true. )
881
882		!===========================================================================
883		! This is the first place where the diabatic processes and remapping could occur.
884	24	if (CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics.
885	0	if (.not.do_dyn) then
886	0	dtdia = dt
887	0	elseif (thermo_does_span_coupling) then
888	0	dtdia = dt_therm
889	0	if ((fluxes%dt_buoy_accum > 0.0) .and. (dtdia > time_interval) .and. &
890		(abs(fluxes%dt_buoy_accum - dtdia) > 1e-6*dtdia)) then
891		call MOM_error(FATAL, "step_MOM: Mismatch between long thermodynamic "//&
892	0	"timestep and time over which buoyancy fluxes have been accumulated.")
893		endif
894		call MOM_error(FATAL, "MOM is not yet set up to have restarts that work "//&
895	0	"with THERMO_SPANS_COUPLING and DIABATIC_FIRST.")
896		else
897	0	dtdia = dt*min(ntstep,n_max-(n-1))
898		endif
899
900	0	end_time_thermo = Time_local
901	0	if (dtdia > dt) then
902		! If necessary, temporarily reset CS%Time to the center of the period covered
903		! by the call to step_MOM_thermo, noting that they begin at the same time.
904	0	CS%Time = CS%Time + real_to_time(0.5*(dtdia-dt), unscale=US%T_to_s)
905		! The end-time of the diagnostic interval needs to be set ahead if there
906		! are multiple dynamic time steps worth of thermodynamics applied here.
907	0	end_time_thermo = Time_local + real_to_time(dtdia-dt, unscale=US%T_to_s)
908		endif
909
910		! Apply diabatic forcing, do mixing, and regrid.
911		call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, &
912	0	end_time_thermo, .true., Waves=Waves)
913
914	0	if ( CS%use_ALE_algorithm ) then
915		!$omp target update from(u, v, h)
916	0	call ALE_regridding_and_remapping(CS, G, GV, US, u, v, h, CS%tv, dtdia, Time_local)
917		!$omp target update to(u, v, h)
918		endif
919
920	0	call post_diabatic_halo_updates(CS, G, GV, US, u, v, h, CS%tv)
921
922	0	CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia
923
924		! The diabatic processes are now ahead of the dynamics by dtdia.
925	0	CS%t_dyn_rel_thermo = -dtdia
926	0	if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)")
927
928	0	if (dtdia > dt) & ! Reset CS%Time to its previous value.
929	0	CS%Time = Time_start + real_to_time(rel_time - 0.5*dt, unscale=US%T_to_s)
930		endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))"
931
932	24	if (do_dyn) then
933		! Store pre-dynamics thicknesses for proper diagnostic remapping for transports or
934		! advective tendencies. If there are more than one dynamics steps per advective
935		! step (i.e DT_THERM > DT), this needs to be stored at the first dynamics call.
936	24	if (.not.CS%preadv_h_stored .and. (CS%t_dyn_rel_adv == 0.)) then
937		!$omp target update from(h)
938	12	call diag_copy_diag_to_storage(CS%diag_pre_dyn, h, CS%diag)
939	12	CS%preadv_h_stored = .true.
940		endif
941
942		! The pre-dynamics velocities might be stored for debugging truncations.
943	24	if (associated(CS%u_prev) .and. associated(CS%v_prev)) then
944		!$omp target update from(u, v)
945	0	do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB
946	0	CS%u_prev(I,j,k) = u(I,j,k)
947		enddo ; enddo ; enddo
948	0	do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied
949	0	CS%v_prev(I,j,k) = v(i,J,k)
950		enddo ; enddo ; enddo
951		endif
952
953	24	if (CS%interface_filter_dt_bug) then
954	0	dt_tradv_here = dt_therm
955	0	if (do_thermo .and. do_dyn .and. .not.thermo_does_span_coupling) &
956	0	dt_tradv_here = dt*min(ntstep, n_max-n+1)
957		else
958	24	dt_tradv_here = dt_tr_adv
959	24	if (do_thermo .and. do_dyn .and. .not.tradv_does_span_coupling) &
960	24	dt_tradv_here = dt*min(ntstep, n_max-n+1)
961		endif
962
963		! Indicate whether the bottom boundary layer properties need to be
964		! recalculated, and if so for how long an interval they are valid.
965	24	bbl_time_int = 0.0
966	24	if (do_thermo) then
967	24	if ((CS%t_dyn_rel_adv == 0.0) .or. (n==1)) &
968	12	bbl_time_int = max(dt, min(dt_therm - CS%t_dyn_rel_adv, dt*(1+n_max-n)) )
969		else
970	0	if ((CS%t_dyn_rel_adv == 0.0) .or. ((n==1) .and. cycle_start)) &
971	0	bbl_time_int = min(dt_therm, cycle_time)
972		endif
973
974	24	if (CS%interp_p_surf) then
975	0	wt_end = real(n) / real(n_max)
976	0	wt_beg = real(n-1) / real(n_max)
977	0	do j=jsd,jed ; do i=isd,ied
978		CS%p_surf_end(i,j) = wt_end * forces%p_surf(i,j) + &
979	0	(1.0-wt_end) * CS%p_surf_prev(i,j)
980		CS%p_surf_begin(i,j) = wt_beg * forces%p_surf(i,j) + &
981	0	(1.0-wt_beg) * CS%p_surf_prev(i,j)
982		enddo ; enddo
983		endif
984
985		call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, &
986		dt_tradv_here, bbl_time_int, CS, &
987	24	Time_local, Waves=Waves)
988
989		!===========================================================================
990		! This is the start of the tracer advection part of the algorithm.
991	24	if (tradv_does_span_coupling .or. .not.do_thermo) then
992		do_advection = ((CS%t_dyn_rel_adv + 0.5*dt > dt_tr_adv) .or. &
993	0	(CS%t_dyn_rel_thermo + 0.5*dt > dt_therm))
994		else
995	24	do_advection = ((MOD(n,ntastep) == 0) .or. (n==n_max))
996		endif
997
998	24	if (do_advection) then ! Do advective transport and lateral tracer mixing.
999	12	call step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local)
1000	12	if (CS%diabatic_first .and. abs(CS%t_dyn_rel_thermo) > 1e-6*dt) call MOM_error(FATAL, &
1001		"step_MOM: Mismatch between the dynamics and diabatic times "//&
1002	0	"with DIABATIC_FIRST.")
1003		endif
1004		endif ! end of (do_dyn)
1005
1006		!===========================================================================
1007		! This is the second place where the diabatic processes and remapping could occur.
1008	24	if (thermo_does_span_coupling .or. .not.do_dyn) then
1009	0	do_diabatic = (do_thermo .and. (CS%t_dyn_rel_thermo + 0.5*dt > dt_therm))
1010		else
1011	24	do_diabatic = (do_thermo .and. ((MOD(n,ntstep) == 0) .or. (n==n_max)))
1012		endif
1013
1014	24	if ((CS%t_dyn_rel_adv==0.0) .and. (.not.CS%diabatic_first) .and. do_diabatic) then
1015	12	dtdia = CS%t_dyn_rel_thermo
1016		! If the MOM6 dynamic and thermodynamic time stepping is being orchestrated
1017		! by the coupler, the value of diabatic_first does not matter.
1018	12	if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) dtdia = dt
1019
1020	12	if (CS%thermo_spans_coupling .and. (CS%dt_therm > 1.5*cycle_time) .and. &
1021		(abs(dt_therm - dtdia) > 1e-6*dt_therm)) then
1022		call MOM_error(FATAL, "step_MOM: Mismatch between dt_therm and dtdia "//&
1023	0	"before call to diabatic.")
1024		endif
1025
1026		! If necessary, temporarily reset CS%Time to the center of the period covered
1027		! by the call to step_MOM_thermo, noting that they end at the same time.
1028	12	if (dtdia > dt) &
1029	12	CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt), unscale=US%T_to_s)
1030
1031		! Apply diabatic forcing, do mixing, and regrid.
1032		call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, &
1033	12	Time_local, .false., Waves=Waves)
1034
1035	12	if ( CS%use_ALE_algorithm ) then
1036		!$omp target update from(u, v, h)
1037	12	call ALE_regridding_and_remapping(CS, G, GV, US, u, v, h, CS%tv, dtdia, Time_local)
1038		!$omp target update to(u, v, h)
1039		endif
1040
1041		! UMW NOTE: These transfers are needed to prevent excessive transfers in the group
1042		! updates within this subroutine
1043		!$omp target enter data map(to: CS%tv, CS%tv%T, CS%tv%S)
1044	12	call post_diabatic_halo_updates(CS, G, GV, US, u, v, h, CS%tv)
1045		!$omp target exit data map(from: CS%tv%T, CS%tv%S)
1046		!$omp target exit data map(release: CS%tv)
1047
1048	12	CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia
1049
1050	12	if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then
1051		! The diabatic processes are now ahead of the dynamics by dtdia.
1052	0	CS%t_dyn_rel_thermo = -dtdia
1053		else ! The diabatic processes and the dynamics are synchronized.
1054	12	CS%t_dyn_rel_thermo = 0.0
1055		endif
1056
1057		! Reset CS%Time to its previous value.
1058	12	if (dtdia > dt) &
1059	12	CS%Time = Time_start + real_to_time(rel_time - 0.5*dt, unscale=US%T_to_s)
1060		endif
1061
1062	24	if (do_dyn) then
1063		!$omp target enter data map(alloc: ssh)
1064	24	call cpu_clock_begin(id_clock_dynamics)
1065		! Determining the time-average sea surface height is part of the algorithm.
1066		! This may be eta_av if Boussinesq, or need to be diagnosed if not.
1067	24	CS%time_in_cycle = CS%time_in_cycle + dt
1068		!$omp target enter data map(to: CS%eta_av_bc)
1069	24	call find_eta(h, CS%tv, G, GV, US, ssh, eta_bt=CS%eta_av_bc, dZref=G%Z_ref)
1070		!$omp target exit data map(release: CS%eta_av_bc)
1071
1072	24	do concurrent (j=js:je, i=is:ie)
1073	175704	CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt * ssh(i,j)
1074		enddo
1075
1076	24	if (CS%IDs%id_ssh_inst > 0) then
1077		!$omp target update from(ssh)
1078	0	call enable_averages(dt, Time_local, CS%diag)
1079	0	call post_data(CS%IDs%id_ssh_inst, ssh, CS%diag)
1080	0	call disable_averaging(CS%diag)
1081		endif
1082	24	call cpu_clock_end(id_clock_dynamics)
1083
1084		!$omp target exit data map(delete: ssh)
1085		endif
1086
1087		!===========================================================================
1088		! Calculate diagnostics at the end of the time step if the state is self-consistent.
1089	24	if (MOM_state_is_synchronized(CS)) then
1090		!### Perhaps this should be if (CS%t_dyn_rel_thermo == 0.0)
1091		!$omp target update from(u, v, h, CS%uhtr, CS%vhtr)
1092	12	call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics)
1093		! Diagnostics that require the complete state to be up-to-date can be calculated.
1094
1095	12	call enable_averages(CS%t_dyn_rel_diag, Time_local, CS%diag)
1096		call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, &
1097		CS%CDp, p_surf, CS%t_dyn_rel_diag, CS%diag_pre_sync,&
1098	12	G, GV, US, CS%diagnostics_CSp)
1099	12	call post_tracer_diagnostics_at_sync(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, CS%t_dyn_rel_diag)
1100	12	call diag_copy_diag_to_storage(CS%diag_pre_sync, h, CS%diag)
1101	12	if (showCallTree) call callTree_waypoint("finished calculate_diagnostic_fields (step_MOM)")
1102	12	call disable_averaging(CS%diag)
1103	12	CS%t_dyn_rel_diag = 0.0
1104
1105	12	call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other)
1106		endif
1107
1108	24	if (do_dyn .and. .not.CS%count_calls) CS%nstep_tot = CS%nstep_tot + 1
1109	36	if (showCallTree) call callTree_leave("DT cycles (step_MOM)")
1110		enddo
1111
1112		! TODO: This appears safe to remove but needs verification.
1113		!**!$omp target update from(u, v, h, CS%uhtr, CS%vhtr)
1114
1115	12	if (CS%count_calls .and. cycle_start) CS%nstep_tot = CS%nstep_tot + 1
1116
1117	12	call cpu_clock_begin(id_clock_other)
1118
1119	12	if (CS%time_in_cycle > 0.0) then
1120		!$omp target enter data map(alloc: ssh)
1121
1122	12	I_wt_ssh = 1.0/CS%time_in_cycle
1123	12	do concurrent (j=js:je, i=is:ie)
1124	86400	ssh(i,j) = CS%ssh_rint(i,j) * I_wt_ssh
1125	87852	CS%ave_ssh_ibc(i,j) = ssh(i,j)
1126		enddo
1127
1128	12	if (associated(CS%HA_CSp)) then
1129		!$omp target update from(ssh)
1130	0	call HA_accum('ssh', ssh, Time_local, G, CS%HA_CSp)
1131		endif
1132
1133	12	if (do_dyn) then
1134		call adjust_ssh_for_p_atm(CS%tv, G, GV, US, CS%ave_ssh_ibc, forces%p_surf_SSH, &
1135	12	CS%calc_rho_for_sea_lev)
1136	0	elseif (do_thermo) then
1137		call adjust_ssh_for_p_atm(CS%tv, G, GV, US, CS%ave_ssh_ibc, fluxes%p_surf_SSH, &
1138	0	CS%calc_rho_for_sea_lev)
1139		endif
1140		!$omp target exit data map(delete: ssh)
1141		endif
1142
1143	12	if (do_dyn .and. CS%interp_p_surf) then ; do j=jsd,jed ; do i=isd,ied
1144	0	CS%p_surf_prev(i,j) = forces%p_surf(i,j)
1145		enddo ; enddo ; endif
1146
1147	12	if (CS%ensemble_ocean) then
1148		! store ensemble vector in odaCS
1149	0	call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS)
1150		! call DA interface
1151	0	call oda(CS%Time,CS%odaCS)
1152		! update the time for the next analysis step if needed
1153	0	call set_analysis_time(CS%Time,CS%odaCS)
1154		endif
1155
1156	12	if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)")
1157		! NOTE: sfc_state uses input indexing, since it is also used by drivers.
1158	12	call extract_surface_state(CS, sfc_state)
1159
1160		! Do diagnostics that only occur at the end of a complete forcing step.
1161	12	if (cycle_end) then
1162	12	if (showCallTree) call callTree_waypoint("Do cycle end diagnostics (step_MOM)")
1163	12	if (CS%rotate_index) then
1164	0	allocate(sfc_state_diag)
1165	0	call rotate_surface_state(sfc_state, sfc_state_diag, G, turns)
1166		else
1167	12	sfc_state_diag => sfc_state
1168		endif
1169
1170	12	call cpu_clock_begin(id_clock_diagnostics)
1171
1172		!$omp target update from(ssh) &
1173		!$omp if (CS%time_in_cycle > 0. .or. CS%time_in_thermo_cycle > 0.)
1174
1175	12	if (CS%time_in_cycle > 0.0) then
1176	12	call enable_averages(CS%time_in_cycle, Time_local, CS%diag)
1177	12	call post_surface_dyn_diags(CS%sfc_IDs, G, CS%diag, sfc_state_diag, ssh)
1178		endif
1179
1180	12	if (CS%time_in_thermo_cycle > 0.0) then
1181		!$omp target update from(CS%ave_ssh_ibc)
1182	12	call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag)
1183		call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, &
1184	12	sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc)
1185		endif
1186
1187		!$omp target exit data map(delete: ssh) &
1188		!$omp if (CS%time_in_cycle > 0. .or. CS%time_in_thermo_cycle > 0.)
1189
1190	12	call disable_averaging(CS%diag)
1191	12	call cpu_clock_end(id_clock_diagnostics)
1192	12	if (CS%rotate_index) then
1193	0	call deallocate_surface_state(sfc_state_diag)
1194		endif
1195	12	if (showCallTree) call callTree_waypoint("Done with end cycle diagnostics (step_MOM)")
1196		endif
1197
1198		! Accumulate the surface fluxes for assessing conservation
1199	12	if (do_thermo .and. fluxes%fluxes_used) &
1200		call accumulate_net_input(fluxes, sfc_state, CS%tv, fluxes%dt_buoy_accum, &
1201	12	G, US, CS%sum_output_CSp)
1202
1203	12	if (MOM_state_is_synchronized(CS)) then
1204		call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, &
1205		G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, &
1206	12	dt_forcing=real_to_time(time_interval, unscale=US%T_to_s) )
1207		endif
1208	12	call cpu_clock_end(id_clock_other)
1209
1210		! De-rotate fluxes and copy back to the input, since they can be changed.
1211	12	if (CS%rotate_index) then
1212	0	call rotate_forcing(fluxes, fluxes_in, -turns)
1213	0	call rotate_mech_forcing(forces, -turns, forces_in)
1214	0	call deallocate_mech_forcing(forces)
1215	0	deallocate(forces)
1216	0	call deallocate_forcing_type(fluxes)
1217	0	deallocate(fluxes)
1218		endif
1219
1220	12	if (showCallTree) call callTree_leave("step_MOM()")
1221	12	call cpu_clock_end(id_clock_ocean)
1222
1223	12	end subroutine step_MOM
1224
1225		!> Time step the ocean dynamics, including the momentum and continuity equations
1226	24	subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_tr_adv, &
1227		bbl_time_int, CS, Time_local, Waves)
1228		type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
1229		real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface
1230		!! pressure at the beginning of this dynamic
1231		!! step, intent in [R L2 T-2 ~> Pa].
1232		real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface
1233		!! pressure at the end of this dynamic step,
1234		!! intent in [R L2 T-2 ~> Pa].
1235		real, intent(in) :: dt !< time interval covered by this call [T ~> s].
1236		real, intent(in) :: dt_tr_adv !< time interval covered by any updates that may
1237		!! span multiple dynamics steps [T ~> s].
1238		real, intent(in) :: bbl_time_int !< time interval over which updates to the
1239		!! bottom boundary layer properties will apply [T ~> s],
1240		!! or zero not to update the properties.
1241		type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM
1242		type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type
1243		type(wave_parameters_CS), &
1244		optional, pointer :: Waves !< Container for wave related parameters; the
1245		!! fields in Waves are intent in here.
1246
1247		! local variables
1248		type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing
1249		! metrics and related information
1250		type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure
1251		type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing
1252		! various unit conversion factors
1253		type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs.
1254		real, dimension(:,:,:), pointer :: &
1255		u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1]
1256		v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1]
1257		h => NULL() ! h : layer thickness [H ~> m or kg m-2]
1258
1259		type(time_type) :: Time_end_diag ! End time of a diagnostic segment, as a time type
1260		logical :: calc_dtbt ! Indicates whether the dynamically adjusted
1261		! barotropic time step needs to be updated.
1262		logical :: showCallTree
1263
1264		integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
1265		integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
1266
1267	24	G => CS%G ; GV => CS%GV ; US => CS%US ; IDs => CS%IDs
1268	24	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
1269	24	Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
1270	24	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
1271	24	IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
1272	24	u => CS%u ; v => CS%v ; h => CS%h
1273	24	showCallTree = callTree_showQuery()
1274
1275	24	call cpu_clock_begin(id_clock_dynamics)
1276
1277	24	call cpu_clock_begin(id_clock_stoch)
1278	24	if (CS%use_stochastic_EOS) call MOM_stoch_eos_run(G, u, v, dt, Time_local, CS%stoch_eos_CS)
1279	24	call cpu_clock_end(id_clock_stoch)
1280
1281	24	call cpu_clock_begin(id_clock_varT)
1282	24	if (CS%use_stochastic_EOS) then
1283	0	call MOM_calc_varT(G, GV, US, h, CS%tv, CS%stoch_eos_CS, dt)
1284	0	if (associated(CS%tv%varT)) call pass_var(CS%tv%varT, G%Domain, clock=id_clock_pass, halo=1)
1285		endif
1286	24	call cpu_clock_end(id_clock_varT)
1287
1288	24	if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse_first .and. &
1289		(CS%thickness_diffuse .or. CS%interface_filter)) then
1290
1291	12	Time_end_diag = Time_local + real_to_time(dt_tr_adv - dt, unscale=US%T_to_s)
1292	12	call enable_averages(dt_tr_adv, Time_end_diag, CS%diag)
1293	12	if (CS%thickness_diffuse) then
1294		!$omp target update from(h, CS%uhtr, CS%vhtr)
1295	12	call cpu_clock_begin(id_clock_thick_diff)
1296
1297	12	if (CS%VarMix%use_variable_mixing) &
1298	12	call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC)
1299
1300		call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_tr_adv, G, GV, US, &
1301		CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp, &
1302	12	CS%stoch_CS)
1303
1304	12	call cpu_clock_end(id_clock_thick_diff)
1305	12	call pass_var(h, G%Domain, clock=id_clock_pass, halo=CS%dyn_h_stencil)
1306		!$omp target update to(h, CS%uhtr, CS%vhtr)
1307	12	if (showCallTree) call callTree_waypoint("finished thickness_diffuse_first (step_MOM)")
1308		endif
1309
1310	12	if (CS%interface_filter) then
1311		!$omp target update from(h, CS%uhtr, CS%vhtr)
1312	0	if (allocated(CS%tv%SpV_avg)) call pass_var(CS%tv%SpV_avg, G%Domain, clock=id_clock_pass)
1313	0	CS%tv%valid_SpV_halo = min(G%Domain%nihalo, G%Domain%njhalo)
1314	0	call cpu_clock_begin(id_clock_int_filter)
1315		call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt_tr_adv, G, GV, US, &
1316	0	CS%CDp, CS%interface_filter_CSp)
1317	0	call cpu_clock_end(id_clock_int_filter)
1318	0	call pass_var(h, G%Domain, clock=id_clock_pass, halo=CS%dyn_h_stencil)
1319		!$omp target update to(h, CS%uhtr, CS%vhtr)
1320	0	if (showCallTree) call callTree_waypoint("finished interface_filter_first (step_MOM)")
1321		endif
1322
1323	12	call disable_averaging(CS%diag)
1324		! Whenever thickness changes let the diag manager know, target grids
1325		! for vertical remapping may need to be regenerated.
1326	12	call diag_update_remap_grids(CS%diag)
1327		endif
1328
1329		! Update porous barrier fractional cell metrics
1330	24	if (CS%use_porbar) then
1331		!$omp target update from(h)
1332	0	call enable_averages(dt, Time_local, CS%diag)
1333	0	call porous_widths_layer(h, CS%tv, G, GV, US, CS%pbv, CS%por_bar_CS)
1334	0	call disable_averaging(CS%diag)
1335		call pass_vector(CS%pbv%por_face_areaU, CS%pbv%por_face_areaV, &
1336	0	G%Domain, direction=To_All+SCALAR_PAIR, clock=id_clock_pass, halo=CS%cont_stencil)
1337		!$omp target update to(CS%pbv%por_face_areaU, CS%pbv%por_face_areaV)
1338		endif
1339
1340		! The bottom boundary layer properties need to be recalculated.
1341	24	if (bbl_time_int > 0.0) then
1342	12	Time_end_diag = Time_local + real_to_time(bbl_time_int - dt, unscale=US%T_to_s)
1343	12	call enable_averages(bbl_time_int, Time_end_diag, CS%diag)
1344		! Calculate the BBL properties and store them inside visc (u,h).
1345	12	call cpu_clock_begin(id_clock_BBL_visc)
1346	12	call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv)
1347	12	call cpu_clock_end(id_clock_BBL_visc)
1348	12	if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)")
1349	12	call disable_averaging(CS%diag)
1350		endif
1351
1352		!OBC segment data update for some fields can be less frequent than others
1353	24	if (associated(CS%OBC)) then
1354	0	CS%OBC%update_OBC_seg_data = .false.
1355	0	if (CS%dt_obc_seg_period == 0.0) CS%OBC%update_OBC_seg_data = .true.
1356	0	if (CS%dt_obc_seg_period > 0.0) then
1357	0	if (Time_local >= CS%dt_obc_seg_time) then
1358	0	CS%OBC%update_OBC_seg_data = .true.
1359	0	CS%dt_obc_seg_time = CS%dt_obc_seg_time + CS%dt_obc_seg_interval
1360		endif
1361		endif
1362		endif
1363		! if (CS%debug_OBCs .and. associated(CS%OBC)) call chksum_OBC_segments(CS%OBC, G, GV, US, 3)
1364
1365	24	if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT
1366		! This section uses a split time stepping scheme for the dynamic equations,
1367		! basically the stacked shallow water equations with viscosity.
1368
1369	24	calc_dtbt = .false.
1370	24	if (CS%dtbt_reset_period == 0.0) calc_dtbt = .true.
1371	24	if (CS%dtbt_reset_period > 0.0) then
1372	24	if (Time_local >= CS%dtbt_reset_time) then !### Change >= to > here.
1373	13	calc_dtbt = .true.
1374	13	CS%dtbt_reset_time = CS%dtbt_reset_time + CS%dtbt_reset_interval
1375		endif
1376		endif
1377
1378	24	if (CS%use_alt_split) then
1379		!$omp target update from(u, v, h, CS%uhtr, CS%vhtr)
1380		!$omp target update from(CS%visc%bbl_thick_u, CS%visc%bbl_thick_v)
1381		!$omp target update from(CS%visc%kv_bbl_u, CS%visc%kv_bbl_v)
1382		call step_MOM_dyn_split_RK2b(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, &
1383		p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, &
1384		CS%eta_av_bc, G, GV, US, CS%dyn_split_RK2b_CSp, calc_dtbt, CS%VarMix, &
1385	0	CS%MEKE, CS%thickness_diffuse_CSp, CS%pbv, waves=waves)
1386		!$omp target update to(u, v, h, CS%uhtr, CS%vhtr)
1387		else
1388		call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, &
1389		p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, &
1390		CS%eta_av_bc, G, GV, US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, &
1391	24	CS%MEKE, CS%thickness_diffuse_CSp, CS%pbv, CS%stoch_CS, waves=waves)
1392		! TODO: uh, vh, CS%eta_av_bc ?
1393		endif
1394
1395	24	if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)")
1396
1397	0	elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT
1398		! This section uses an unsplit stepping scheme for the dynamic
1399		! equations; basically the stacked shallow water equations with viscosity.
1400		! Because the time step is limited by CFL restrictions on the external
1401		! gravity waves, the unsplit is usually much less efficient that the split
1402		! approaches. But because of its simplicity, the unsplit method is very
1403		! useful for debugging purposes.
1404
1405	0	if (CS%use_RK2) then
1406		!$omp target update from(u, v, h, CS%uhtr, CS%vhtr)
1407		!$omp target update from(CS%visc%bbl_thick_u, CS%visc%bbl_thick_v)
1408		!$omp target update from(CS%visc%kv_bbl_u, CS%visc%kv_bbl_v)
1409		call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, &
1410		p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, &
1411		CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE, CS%pbv, &
1412	0	CS%stoch_CS)
1413		!$omp target update to(u, v, h, CS%uhtr, CS%vhtr)
1414		else
1415		!$omp target update from(u, v, h, CS%uhtr, CS%vhtr)
1416		!$omp target update from(CS%visc%bbl_thick_u, CS%visc%bbl_thick_v)
1417		!$omp target update from(CS%visc%kv_bbl_u, CS%visc%kv_bbl_v)
1418		call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, &
1419		p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, &
1420		CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, CS%pbv, &
1421	0	CS%stoch_CS, Waves=Waves)
1422		!$omp target update to(u, v, h, CS%uhtr, CS%vhtr)
1423		endif
1424
1425	0	if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)")
1426		endif
1427
1428	24	if (CS%use_particles .and. CS%do_dynamics .and. (.not. CS%use_uh_particles)) then
1429	0	if (CS%thickness_diffuse_first) call MOM_error(WARNING,"particles_run: "//&
1430		"Thickness_diffuse_first is true and use_uh_particles is false. "//&
1431	0	"This is usually a bad combination.")
1432		! Run particles using unweighted velocity
1433		!$omp target update from(u, v, h)
1434		call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, &
1435	0	CS%tv, dt, CS%use_uh_particles)
1436	0	call particles_to_z_space(CS%particles, h)
1437		endif
1438
1439		! Update the model's current to reflect wind-wave growth
1440	24	if (Waves%Stokes_DDT .and. (.not.Waves%Passive_Stokes_DDT)) then
1441		!$omp target update from(u, v)
1442	0	do J=jsq,jeq ; do i=is,ie
1443	0	v(i,J,:) = v(i,J,:) + Waves%ddt_us_y(i,J,:)*dt
1444		enddo ; enddo
1445	0	do j=js,je ; do I=isq,ieq
1446	0	u(I,j,:) = u(I,j,:) + Waves%ddt_us_x(I,j,:)*dt
1447		enddo ; enddo
1448	0	call pass_vector(u, v, G%Domain)
1449		!$omp target update to(u, v)
1450		endif
1451		! Added an additional output to track Stokes drift time tendency.
1452		! It is mostly for debugging, and perhaps doesn't need to hang
1453		! around permanently.
1454	24	if (Waves%Stokes_DDT .and. (Waves%id_3dstokes_y_from_ddt>0)) then
1455	0	do J=jsq,jeq ; do i=is,ie
1456	0	Waves%us_y_from_ddt(i,J,:) = Waves%us_y_from_ddt(i,J,:) + Waves%ddt_us_y(i,J,:)*dt
1457		enddo ; enddo
1458		endif
1459	24	if (Waves%Stokes_DDT .and. (Waves%id_3dstokes_x_from_ddt>0)) then
1460	0	do j=js,je ; do I=isq,ieq
1461	0	Waves%us_x_from_ddt(I,j,:) = Waves%us_x_from_ddt(I,j,:) + Waves%ddt_us_x(I,j,:)*dt
1462		enddo ; enddo
1463		endif
1464
1465	24	if ((CS%thickness_diffuse .or. CS%interface_filter) .and. &
1466		.not.CS%thickness_diffuse_first) then
1467
1468	0	if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, unscale=GV%H_to_MKS)
1469
1470	0	if (CS%thickness_diffuse) then
1471		!$omp target update from(h, CS%uhtr, CS%vhtr)
1472	0	call cpu_clock_begin(id_clock_thick_diff)
1473
1474	0	if (CS%VarMix%use_variable_mixing) &
1475	0	call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC)
1476
1477		call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, &
1478	0	CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp, CS%stoch_CS)
1479
1480	0	call cpu_clock_end(id_clock_thick_diff)
1481	0	call pass_var(h, G%Domain, clock=id_clock_pass, halo=CS%dyn_h_stencil)
1482	0	if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
1483		!$omp target update to(h, CS%uhtr, CS%vhtr)
1484	0	if (showCallTree) call callTree_waypoint("finished thickness_diffuse (step_MOM)")
1485		endif
1486
1487	0	if (CS%interface_filter) then
1488		!$omp target update from(h, CS%uhtr, CS%vhtr)
1489	0	if (allocated(CS%tv%SpV_avg)) call pass_var(CS%tv%SpV_avg, G%Domain, clock=id_clock_pass)
1490	0	CS%tv%valid_SpV_halo = min(G%Domain%nihalo, G%Domain%njhalo)
1491	0	call cpu_clock_begin(id_clock_int_filter)
1492	0	if (CS%interface_filter_dt_bug) then
1493		call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt_tr_adv, G, GV, US, &
1494	0	CS%CDp, CS%interface_filter_CSp)
1495		else
1496		call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, &
1497	0	CS%CDp, CS%interface_filter_CSp)
1498		endif
1499	0	call cpu_clock_end(id_clock_int_filter)
1500	0	call pass_var(h, G%Domain, clock=id_clock_pass, halo=CS%dyn_h_stencil)
1501		!$omp target update to(h, CS%uhtr, CS%vhtr)
1502	0	if (showCallTree) call callTree_waypoint("finished interface_filter (step_MOM)")
1503		endif
1504		endif
1505
1506		! apply the submesoscale mixed layer restratification parameterization
1507	24	if (CS%mixedlayer_restrat) then
1508		!$omp target update from(h, CS%uhtr, CS%vhtr)
1509	24	if (CS%debug) then
1510	0	call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
1511		call uvchksum("Pre-mixedlayer_restrat uhtr", &
1512	0	CS%uhtr, CS%vhtr, G%HI, haloshift=0, unscale=GV%H_to_MKSUS%L_to_m*2)
1513		endif
1514	24	call cpu_clock_begin(id_clock_ml_restrat)
1515		call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, CS%visc%h_ML, &
1516	24	CS%visc%sfc_buoy_flx, CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp)
1517	24	call cpu_clock_end(id_clock_ml_restrat)
1518	24	call pass_var(h, G%Domain, clock=id_clock_pass, halo=CS%dyn_h_stencil)
1519		!$omp target update to(h, CS%uhtr, CS%vhtr)
1520	24	if (CS%debug) then
1521	0	call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
1522		call uvchksum("Post-mixedlayer_restrat [uv]htr", &
1523	0	CS%uhtr, CS%vhtr, G%HI, haloshift=0, unscale=GV%H_to_MKSUS%L_to_m*2)
1524		endif
1525		endif
1526
1527		! Whenever thickness changes let the diag manager know, target grids
1528		! for vertical remapping may need to be regenerated.
1529	24	call diag_update_remap_grids(CS%diag)
1530
1531	24	if (CS%useMEKE .and. CS%MEKE_in_dynamics) then
1532		!$omp target update from(u, v, h)
1533		!$omp target update from(CS%visc%bbl_thick_u, CS%visc%bbl_thick_v)
1534		!$omp target update from(CS%visc%kv_bbl_u, CS%visc%kv_bbl_v)
1535		call step_forward_MEKE(CS%MEKE, h, CS%VarMix%SN_u, CS%VarMix%SN_v, &
1536		CS%visc, dt, G, GV, US, CS%MEKE_CSp, CS%uhtr, CS%vhtr, &
1537	24	CS%u, CS%v, CS%tv, Time_local)
1538		!$omp target update to(u, v)
1539		endif
1540	24	call disable_averaging(CS%diag)
1541
1542		! Advance the dynamics time by dt.
1543	24	CS%t_dyn_rel_adv = CS%t_dyn_rel_adv + dt
1544
1545	24	if (CS%use_particles .and. CS%do_dynamics .and. CS%use_uh_particles .and. &
1546		CS%uh_particles_bug) then
1547		!$omp target update to(h, CS%uhtr, CS%vhtr)
1548		! Run particles using thickness-weighted velocity
1549		call particles_run(CS%particles, Time_local, CS%uhtr, CS%vhtr, CS%h, &
1550	0	CS%tv, CS%t_dyn_rel_adv, CS%use_uh_particles)
1551		endif
1552
1553	24	CS%n_dyn_steps_in_adv = CS%n_dyn_steps_in_adv + 1
1554	24	if (CS%alternate_first_direction) then
1555	0	call set_first_direction(G, MODULO(G%first_direction+1,2))
1556	0	CS%first_dir_restart = real(G%first_direction)
1557	24	elseif (CS%use_particles .and. CS%do_dynamics .and. (.not.CS%use_uh_particles)) then
1558	0	call particles_to_k_space(CS%particles, h)
1559		endif
1560	24	CS%t_dyn_rel_thermo = CS%t_dyn_rel_thermo + dt
1561	24	if (abs(CS%t_dyn_rel_thermo) < 1e-6*dt) CS%t_dyn_rel_thermo = 0.0
1562	24	CS%t_dyn_rel_diag = CS%t_dyn_rel_diag + dt
1563
1564	24	call cpu_clock_end(id_clock_dynamics)
1565
1566		! Diagnostic finalization
1567
1568	24	call cpu_clock_begin(id_clock_other)
1569	24	call cpu_clock_begin(id_clock_diagnostics)
1570
1571	24	call enable_averages(dt, Time_local, CS%diag)
1572
1573		! These diagnostics are available after every time dynamics step.
1574	24	if (IDs%id_u > 0) then
1575		!$omp target update from(u)
1576	0	call post_data(IDs%id_u, u, CS%diag)
1577		endif
1578	24	if (IDs%id_v > 0) then
1579		!$omp target update from(v)
1580	0	call post_data(IDs%id_v, v, CS%diag)
1581		endif
1582	24	if (IDs%id_h > 0) then
1583		!$omp target update from(h)
1584	0	call post_data(IDs%id_h, h, CS%diag)
1585		endif
1586
1587	24	if (CS%use_stochastic_EOS) call post_stoch_EOS_diags(CS%stoch_eos_CS, CS%tv, CS%diag)
1588
1589	24	call disable_averaging(CS%diag)
1590
1591	24	call cpu_clock_end(id_clock_diagnostics)
1592	24	call cpu_clock_end(id_clock_other)
1593	24	end subroutine step_MOM_dynamics
1594
1595		!> step_MOM_tracer_dyn does tracer advection and lateral diffusion, bringing the
1596		!! tracers up to date with the changes in state due to the dynamics. Surface
1597		!! sources and sinks and remapping are handled via step_MOM_thermo.
1598	12	subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local)
1599		type(MOM_control_struct), intent(inout) :: CS !< control structure
1600		type(ocean_grid_type), intent(inout) :: G !< ocean grid structure
1601		type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
1602		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
1603		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
1604		intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2]
1605		type(time_type), intent(in) :: Time_local !< The model time at the end
1606		!! of the time step.
1607		type(group_pass_type) :: pass_T_S
1608		integer :: halo_sz ! The size of a halo where data must be valid.
1609		logical :: x_first ! If true, advect tracers first in the x-direction, then y.
1610		logical :: showCallTree
1611		integer :: i, j, k
1612
1613	12	showCallTree = callTree_showQuery()
1614
1615	12	if (CS%debug) then
1616		!$omp target update from(h, CS%uhtr, CS%vhtr)
1617	0	call cpu_clock_begin(id_clock_other)
1618	0	call hchksum(h,"Pre-advection h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
1619		call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, &
1620	0	haloshift=0, unscale=GV%H_to_MKSUS%L_to_m*2)
1621	0	if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1, unscale=US%C_to_degC)
1622	0	if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1, unscale=US%S_to_ppt)
1623	0	if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, &
1624	0	unscale=US%Q_to_J_kg*US%RZ_to_kg_m2)
1625	0	if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, &
1626	0	"Pre-advection salt deficit", G%HI, haloshift=0, unscale=US%S_to_ppt*US%RZ_to_kg_m2)
1627		! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US)
1628	0	call cpu_clock_end(id_clock_other)
1629		endif
1630
1631	12	call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer)
1632	12	call enable_averages(CS%t_dyn_rel_adv, Time_local, CS%diag)
1633
1634	12	if (CS%use_particles .and. CS%use_uh_particles .and. (.not. CS%uh_particles_bug)) then
1635		!$omp target update from(CS%uhtr, CS%vhtr, CS%h)
1636		! Run particles using thickness-weighted velocity
1637		call particles_run(CS%particles, Time_local, CS%uhtr, CS%vhtr, CS%h, &
1638	0	CS%tv, CS%t_dyn_rel_adv, CS%use_uh_particles)
1639		endif
1640
1641	12	if (CS%alternate_first_direction) then
1642		! This calculation of the value of G%first_direction from the start of the accumulation of
1643		! mass transports for use by the tracers is the equivalent to adding 2*n_dyn_steps before
1644		! subtracting n_dyn_steps so that the mod will be taken of a non-negative number.
1645	0	x_first = (MODULO(G%first_direction+CS%n_dyn_steps_in_adv,2) == 0)
1646		else
1647	12	x_first = (MODULO(G%first_direction,2) == 0)
1648		endif
1649	12	if (CS%debug) call MOM_tracer_chksum("Pre-advect ", CS%tracer_Reg, G)
1650		call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, &
1651	12	CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first)
1652	12	if (CS%debug) call MOM_tracer_chksum("Post-advect ", CS%tracer_Reg, G)
1653		call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, &
1654	12	CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv)
1655	12	if (CS%debug) call MOM_tracer_chksum("Post-diffuse ", CS%tracer_Reg, G)
1656	12	if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)")
1657	12	if (associated(CS%OBC)) then
1658		!$omp target update from(CS%uhtr, CS%vhtr)
1659	0	call pass_vector(CS%uhtr, CS%vhtr, G%Domain)
1660		call update_segment_tracer_reservoirs(G, GV, CS%uhtr, CS%vhtr, h, CS%OBC, &
1661	0	CS%tracer_Reg)
1662		!$omp target update to(CS%uhtr, CS%vhtr)
1663		endif
1664	12	call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo)
1665
1666	12	call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics)
1667		call post_transport_diagnostics(G, GV, US, CS%uhtr, CS%vhtr, h, CS%transport_IDs, &
1668	12	CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%tracer_reg)
1669		! Rebuild the remap grids now that we've posted the fields which rely on thicknesses
1670		! from before the dynamics calls
1671	12	call diag_update_remap_grids(CS%diag)
1672
1673	12	call disable_averaging(CS%diag)
1674	12	call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other)
1675
1676		! Reset the accumulated transports to 0 and record that the dynamics
1677		! and advective times now agree.
1678	12	call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer)
1679
1680	1560	do concurrent (k=1:GV%ke, j=G%jsd:G%jed, I=G%IsdB:G%IedB)
1681	8001624	CS%uhtr(I,j,k) = 0.
1682		enddo
1683	1548	do concurrent (k=1:GV%ke, J=G%JsdB:G%JedB, i=G%isd:G%ied)
1684	8056332	CS%vhtr(i,J,k) = 0.
1685		enddo
1686
1687	12	CS%n_dyn_steps_in_adv = 0
1688	12	CS%t_dyn_rel_adv = 0.0
1689	12	call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo)
1690
1691	12	if (CS%useMEKE .and. (.not. CS%MEKE_in_dynamics)) then
1692		!$omp target update from(CS%u, CS%v)
1693		!$omp target update from(CS%visc%bbl_thick_u, CS%visc%bbl_thick_v)
1694		!$omp target update from(CS%visc%kv_bbl_u, CS%visc%kv_bbl_v)
1695		call step_forward_MEKE(CS%MEKE, h, CS%VarMix%SN_u, CS%VarMix%SN_v, &
1696		CS%visc, CS%t_dyn_rel_adv, G, GV, US, CS%MEKE_CSp, CS%uhtr, CS%vhtr, &
1697	0	CS%u, CS%v, CS%tv, Time_local)
1698		!$omp target update to(CS%u, CS%v)
1699		endif
1700
1701	12	if (associated(CS%tv%T)) then
1702	12	call extract_diabatic_member(CS%diabatic_CSp, diabatic_halo=halo_sz)
1703		! The bottom boundary layer calculation may need halo values of SpV_avg, including the corners.
1704	12	if (allocated(CS%tv%SpV_avg)) halo_sz = max(halo_sz, 1)
1705	12	if (halo_sz > 0) then
1706	12	call create_group_pass(pass_T_S, CS%tv%T, G%Domain, To_All, halo=halo_sz)
1707	12	call create_group_pass(pass_T_S, CS%tv%S, G%Domain, To_All, halo=halo_sz)
1708	12	call do_group_pass(pass_T_S, G%Domain, clock=id_clock_pass)
1709	0	elseif (CS%diabatic_first) then
1710		! Temperature and salinity need halo updates because they will be used
1711		! in the dynamics before they are changed again.
1712	0	call create_group_pass(pass_T_S, CS%tv%T, G%Domain, To_All+Omit_Corners, halo=1)
1713	0	call create_group_pass(pass_T_S, CS%tv%S, G%Domain, To_All+Omit_Corners, halo=1)
1714	0	call do_group_pass(pass_T_S, G%Domain, clock=id_clock_pass)
1715	0	halo_sz = 1
1716		endif
1717
1718		! Update derived thermodynamic quantities.
1719	12	if (allocated(CS%tv%SpV_avg)) then
1720		!$omp target update from(h)
1721	0	call calc_derived_thermo(CS%tv, h, G, GV, US, halo=halo_sz, debug=CS%debug)
1722		endif
1723		endif
1724
1725	12	CS%preadv_h_stored = .false.
1726
1727	12	end subroutine step_MOM_tracer_dyn
1728
1729		!> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical
1730		!! remapping, via calls to diabatic (or adiabatic).
1731	12	subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
1732		Time_end_thermo, update_BBL, Waves)
1733		type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure
1734		type(ocean_grid_type), intent(inout) :: G !< ocean grid structure
1735		type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure
1736		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
1737		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
1738		intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1]
1739		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
1740		intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1]
1741		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
1742		intent(inout) :: h !< layer thickness [H ~> m or kg m-2]
1743		type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables
1744		type(forcing), intent(inout) :: fluxes !< pointers to forcing fields
1745		real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s]
1746		type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags
1747		logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties.
1748		type(wave_parameters_CS), &
1749		optional, pointer :: Waves !< Container for wave related parameters
1750		!! the fields in Waves are intent in here.
1751
1752		logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging.
1753		logical :: showCallTree
1754		type(group_pass_type) :: pass_T_S
1755		integer :: dynamics_stencil ! The computational stencil for the calculations
1756		! in the dynamic core.
1757		integer :: halo_sz ! The size of a halo where data must be valid.
1758
1759	12	showCallTree = callTree_showQuery()
1760	0	if (showCallTree) call callTree_enter("step_MOM_thermo(), MOM.F90")
1761	12	if (CS%debug) call query_debugging_checks(do_redundant=debug_redundant)
1762
1763	12	call enable_averages(dtdia, Time_end_thermo, CS%diag)
1764
1765	12	if (associated(CS%odaCS)) then
1766	0	if (CS%debug) then
1767	0	call MOM_thermo_chksum("Pre-oda ", tv, G, US, haloshift=0)
1768		endif
1769	0	call apply_oda_tracer_increments(dtdia, Time_end_thermo, G, GV, tv, h, CS%odaCS)
1770	0	if (CS%debug) then
1771	0	call MOM_thermo_chksum("Post-oda ", tv, G, US, haloshift=0)
1772		endif
1773		endif
1774
1775	12	if (associated(fluxes%p_surf) .or. associated(fluxes%p_surf_full)) then
1776	12	call extract_diabatic_member(CS%diabatic_CSp, diabatic_halo=halo_sz)
1777	12	if (halo_sz > 0) then
1778	12	if (associated(fluxes%p_surf_full)) &
1779		call pass_var(fluxes%p_surf_full, G%Domain, &
1780	0	clock=id_clock_pass, halo=halo_sz, complete=.not.associated(fluxes%p_surf))
1781	12	call pass_var(fluxes%p_surf, G%Domain, clock=id_clock_pass, halo=halo_sz, complete=.true.)
1782		endif
1783		endif
1784
1785	12	if (update_BBL) then
1786		! Calculate the BBL properties and store them inside visc (u,h).
1787		! This is here so that CS%visc is updated before diabatic() when
1788		! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics
1789		! and set_viscous_BBL is called as a part of the dynamic stepping.
1790	0	call cpu_clock_begin(id_clock_BBL_visc)
1791		!update porous barrier fractional cell metrics
1792	0	if (CS%use_porbar) then
1793		!$omp target update from(h)
1794	0	call porous_widths_interface(h, CS%tv, G, GV, US, CS%pbv, CS%por_bar_CS)
1795		call pass_vector(CS%pbv%por_layer_widthU, CS%pbv%por_layer_widthV, &
1796	0	G%Domain, direction=To_ALL+SCALAR_PAIR, clock=id_clock_pass, halo=CS%cont_stencil)
1797		!$omp target update to(CS%pbv%por_layer_widthU, CS%pbv%por_layer_widthV)
1798		!$omp target update to(CS%pbv%por_face_areaU, CS%pbv%por_face_areaV)
1799		endif
1800	0	call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv)
1801	0	call cpu_clock_end(id_clock_BBL_visc)
1802	0	if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)")
1803		endif
1804
1805	12	call cpu_clock_begin(id_clock_thermo)
1806	12	if (.not.CS%adiabatic) then
1807		!$omp target update from(CS%visc%Ray_u) if (allocated(CS%visc%Ray_u))
1808		!$omp target update from(CS%visc%Ray_v) if (allocated(CS%visc%Ray_v))
1809		!$omp target update from(CS%visc%bbl_thick_u) if (allocated(CS%visc%bbl_thick_u))
1810		!$omp target update from(CS%visc%bbl_thick_v) if (allocated(CS%visc%bbl_thick_v))
1811		!$omp target update from(CS%visc%Kv_bbl_u) if (allocated(CS%visc%Kv_bbl_u))
1812		!$omp target update from(CS%visc%Kv_bbl_v) if (allocated(CS%visc%Kv_bbl_v))
1813	12	if (CS%debug) then
1814	0	call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2, unscale=US%L_T_to_m_s)
1815	0	call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
1816		call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, &
1817	0	haloshift=0, unscale=GV%H_to_MKSUS%L_to_m*2)
1818		! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0)
1819	0	call MOM_thermo_chksum("Pre-diabatic ", tv, G, US, haloshift=0)
1820	0	if (debug_redundant) &
1821	0	call check_redundant("Pre-diabatic ", u, v, G, unscale=US%L_T_to_m_s)
1822	0	call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0)
1823		endif
1824
1825	12	call cpu_clock_begin(id_clock_diabatic)
1826
1827		!$omp target update from(u, v, h)
1828		call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, &
1829	12	Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS, CS%OBC, Waves)
1830		!$omp target update to (u,v,h)
1831	12	fluxes%fluxes_used = .true.
1832
1833	12	if (CS%stoch_CS%do_skeb) then
1834	0	call apply_skeb(CS%G,CS%GV,CS%stoch_CS,CS%u,CS%v,CS%h,CS%tv,dtdia,Time_end_thermo)
1835		endif
1836
1837	12	if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)")
1838
1839	12	if (CS%debug) then
1840	0	call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, unscale=US%L_T_to_m_s)
1841	0	call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
1842		call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, &
1843	0	haloshift=0, unscale=GV%H_to_MKSUS%L_to_m*2)
1844		! call MOM_state_chksum("Post-diabatic ", u, v, &
1845		! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1)
1846	0	if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1, unscale=US%C_to_degC)
1847	0	if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1, unscale=US%S_to_ppt)
1848	0	if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, &
1849	0	unscale=US%Q_to_J_kg*US%RZ_to_kg_m2)
1850	0	if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, &
1851	0	"Post-diabatic salt deficit", G%HI, haloshift=0, unscale=US%RZ_to_kg_m2)
1852		! call MOM_thermo_chksum("Post-diabatic ", tv, G, US)
1853	0	if (debug_redundant) &
1854	0	call check_redundant("Post-diabatic ", u, v, G, unscale=US%L_T_to_m_s)
1855		endif
1856	12	call disable_averaging(CS%diag)
1857
1858	12	call cpu_clock_end(id_clock_diabatic)
1859		else ! complement of "if (.not.CS%adiabatic)"
1860
1861	0	call cpu_clock_begin(id_clock_adiabatic)
1862	0	call adiabatic(h, tv, fluxes, dtdia, G, GV, US, CS%diabatic_CSp)
1863	0	fluxes%fluxes_used = .true.
1864	0	call cpu_clock_end(id_clock_adiabatic)
1865
1866	0	if (associated(tv%T)) then
1867	0	dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
1868	0	call create_group_pass(pass_T_S, tv%T, G%Domain, To_All+Omit_Corners, halo=dynamics_stencil)
1869	0	call create_group_pass(pass_T_S, tv%S, G%Domain, To_All+Omit_Corners, halo=dynamics_stencil)
1870	0	call do_group_pass(pass_T_S, G%Domain, clock=id_clock_pass)
1871	0	if (CS%debug) then
1872	0	if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1, unscale=US%C_to_degC)
1873	0	if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1, unscale=US%S_to_ppt)
1874		endif
1875
1876		! Update derived thermodynamic quantities.
1877	0	if (allocated(tv%SpV_avg)) then
1878	0	call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
1879		endif
1880		endif
1881
1882		endif ! endif for the block "if (.not.CS%adiabatic)"
1883	12	call cpu_clock_end(id_clock_thermo)
1884
1885	12	call disable_averaging(CS%diag)
1886
1887		! This works in general:
1888		! if (associated(tv%T)) &
1889		! call totalTandS(G%HI, h, G%areaT, tv%T, tv%S, "End of step_MOM", US, GV%H_to_mks)
1890		! This works only if there is no rescaling being used:
1891		! if (associated(tv%T)) &
1892		! call totalTandS(G%HI, h, G%areaT, tv%T, tv%S, "End of step_MOM")
1893
1894	12	if (showCallTree) call callTree_leave("step_MOM_thermo(), MOM.F90")
1895
1896	12	end subroutine step_MOM_thermo
1897
1898		!> ALE_regridding_and_remapping does regridding (the generation of a new grid) and remapping
1899		!! (from the old grid to the new grid). This is done after the themrodynamic step.
1900	12	subroutine ALE_regridding_and_remapping(CS, G, GV, US, u, v, h, tv, dtdia, Time_end_thermo)
1901		type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure
1902		type(ocean_grid_type), intent(inout) :: G !< ocean grid structure
1903		type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure
1904		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
1905		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
1906		intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1]
1907		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
1908		intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1]
1909		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
1910		intent(inout) :: h !< layer thickness [H ~> m or kg m-2]
1911		type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables
1912		real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s]
1913		type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags
1914
1915	24	real :: h_new(SZI_(G),SZJ_(G),SZK_(GV)) ! Layer thicknesses after regridding [H ~> m or kg m-2]
1916	24	real :: dzRegrid(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The change in grid interface positions due to regridding,
1917		! in the same units as thicknesses [H ~> m or kg m-2]
1918	24	real :: h_old_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! Source grid thickness at zonal
1919		! velocity points [H ~> m or kg m-2]
1920	24	real :: h_old_v(SZI_(G),SZJB_(G),SZK_(GV)) ! Source grid thickness at meridional
1921		! velocity points [H ~> m or kg m-2]
1922	24	real :: h_new_u(SZIB_(G),SZJ_(G),SZK_(GV)) ! Destination grid thickness at zonal
1923		! velocity points [H ~> m or kg m-2]
1924	24	real :: h_new_v(SZI_(G),SZJB_(G),SZK_(GV)) ! Destination grid thickness at meridional
1925		! velocity points [H ~> m or kg m-2]
1926	24	logical :: PCM_cell(SZI_(G),SZJ_(G),SZK_(GV)) ! If true, PCM remapping should be used in a cell.
1927		logical :: use_ice_shelf ! Needed for selecting the right ALE interface.
1928		logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging.
1929		logical :: showCallTree
1930		type(group_pass_type) :: pass_T_S_h
1931		integer :: i, j, k, is, ie, js, je, nz
1932
1933	12	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
1934	12	use_ice_shelf = .false.
1935	0	if (associated(CS%frac_shelf_h)) use_ice_shelf = .true.
1936	12	showCallTree = callTree_showQuery()
1937	12	if (showCallTree) call callTree_enter("ALE_regridding_and_remapping(), MOM.F90")
1938	12	if (CS%debug) call query_debugging_checks(do_redundant=debug_redundant)
1939
1940	12	call cpu_clock_begin(id_clock_remap)
1941
1942		! Regridding/remapping is done here, at end of thermodynamics time step
1943		! (that may comprise several dynamical time steps)
1944		! The routine 'ALE_regrid' can be found in 'MOM_ALE.F90'.
1945	12	call enable_averages(dtdia, Time_end_thermo, CS%diag)
1946
1947	12	call cpu_clock_begin(id_clock_pass)
1948	12	if (associated(tv%T)) &
1949	12	call create_group_pass(pass_T_S_h, tv%T, G%Domain, To_All+Omit_Corners, halo=1)
1950	12	if (associated(tv%S)) &
1951	12	call create_group_pass(pass_T_S_h, tv%S, G%Domain, To_All+Omit_Corners, halo=1)
1952	12	call create_group_pass(pass_T_S_h, h, G%Domain, To_All+Omit_Corners, halo=1)
1953	12	call do_group_pass(pass_T_S_h, G%Domain)
1954	12	call cpu_clock_end(id_clock_pass)
1955
1956	12	call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV)
1957
1958	12	if (CS%use_particles) then
1959	0	call particles_to_z_space(CS%particles, h)
1960		endif
1961
1962	12	if (CS%debug) then
1963	0	call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, omit_corners=.true.)
1964	0	call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, omit_corners=.true., unscale=US%C_to_degC)
1965	0	call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, omit_corners=.true., unscale=US%S_to_ppt)
1966	0	if (debug_redundant) &
1967	0	call check_redundant("Pre-ALE ", u, v, G, unscale=US%L_T_to_m_s)
1968		endif
1969	12	call cpu_clock_begin(id_clock_ALE)
1970
1971	12	call pre_ALE_diagnostics(G, GV, US, h, u, v, tv, CS%ALE_CSp)
1972	12	call ALE_update_regrid_weights(dtdia, CS%ALE_CSp)
1973		! Do any necessary adjustments ot the state prior to remapping.
1974	12	call pre_ALE_adjustments(G, GV, US, h, tv, CS%tracer_Reg, CS%ALE_CSp, u, v)
1975		! Adjust the target grids for diagnostics, in case there have been thickness adjustments.
1976	12	call diag_update_remap_grids(CS%diag)
1977
1978	12	if (use_ice_shelf) then
1979	0	call ALE_regrid(G, GV, US, h, h_new, dzRegrid, tv, CS%ALE_CSp, CS%frac_shelf_h, PCM_cell)
1980		else
1981	12	call ALE_regrid(G, GV, US, h, h_new, dzRegrid, tv, CS%ALE_CSp, PCM_cell=PCM_cell)
1982		endif
1983
1984	12	if (showCallTree) call callTree_waypoint("new grid generated")
1985		! Remap all variables from the old grid h onto the new grid h_new
1986	12	call ALE_remap_tracers(CS%ALE_CSp, G, GV, h, h_new, CS%tracer_Reg, showCallTree, dtdia, PCM_cell)
1987
1988		! Determine the old and new grid thicknesses at velocity points.
1989	12	call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, h, h_old_u, h_old_v, CS%OBC, debug=showCallTree)
1990	12	if (CS%remap_uv_using_old_alg) then
1991	0	call ALE_remap_set_h_vel_via_dz(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, h, dzRegrid, showCallTree)
1992		else
1993	12	call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, debug=showCallTree)
1994		endif
1995
1996		! Remap the velocity components.
1997		call ALE_remap_velocities(CS%ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u, v, showCallTree, &
1998	12	dtdia, allow_preserve_variance=.true.)
1999
2000	12	if (allocated(tv%SpV_avg)) tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
2001
2002	12	if (CS%remap_aux_vars) then
2003	0	if (CS%split .and. CS%use_alt_split) then
2004		call remap_dyn_split_RK2b_aux_vars(G, GV, CS%dyn_split_RK2b_CSp, h_old_u, h_old_v, &
2005	0	h_new_u, h_new_v, CS%ALE_CSp)
2006	0	elseif (CS%split) then
2007	0	call remap_dyn_split_RK2_aux_vars(G, GV, CS%dyn_split_RK2_CSp, h_old_u, h_old_v, h_new_u, h_new_v, CS%ALE_CSp)
2008		endif
2009
2010	0	if (associated(CS%OBC)) then
2011	0	call pass_var(h, G%Domain, complete=.false.)
2012	0	call pass_var(h_new, G%Domain, complete=.true.)
2013	0	call remap_OBC_fields(G, GV, h, h_new, CS%OBC, PCM_cell=PCM_cell)
2014		endif
2015
2016	0	call remap_vertvisc_aux_vars(G, GV, CS%visc, h, h_new, CS%ALE_CSp, CS%OBC)
2017	0	if (associated(CS%visc%Kv_shear)) &
2018	0	call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, clock=id_clock_pass, halo=1)
2019		endif
2020
2021		! Replace the old grid with new one. All remapping must be done by this point in the code.
2022		!$OMP parallel do default(shared)
2023	6864312	do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
2024	6863400	h(i,j,k) = h_new(i,j,k)
2025		enddo ; enddo ; enddo
2026
2027	12	if (showCallTree) call callTree_waypoint("finished ALE_regrid (ALE_regridding_and_remapping)")
2028	12	call cpu_clock_end(id_clock_ALE)
2029
2030		! Update derived thermodynamic quantities.
2031	12	if (allocated(CS%tv%SpV_avg)) then
2032	0	call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=1, debug=CS%debug)
2033		endif
2034
2035		! Whenever thickness changes let the diag manager know, target grids
2036		! for vertical remapping may need to be regenerated. In non-Boussinesq mode,
2037		! calc_derived_thermo needs to be called before diag_update_remap_grids.
2038		! This needs to happen after the H update and before the next post_data.
2039	12	call diag_update_remap_grids(CS%diag)
2040
2041	12	call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, dtdia)
2042
2043	12	if (CS%debug .and. CS%use_ALE_algorithm) then
2044	0	call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US)
2045	0	call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1, unscale=US%C_to_degC)
2046	0	call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1, unscale=US%S_to_ppt)
2047	0	if (debug_redundant) &
2048	0	call check_redundant("Post-ALE ", u, v, G, unscale=US%L_T_to_m_s)
2049		endif
2050	12	if (CS%debug) then
2051	0	call uvchksum("Post-ALE, Post-diabatic u", u, v, G%HI, haloshift=2, unscale=US%L_T_to_m_s)
2052	0	call hchksum(h, "Post-ALE, Post-diabatic h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
2053		call uvchksum("Post-ALE, Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, &
2054	0	haloshift=0, unscale=GV%H_to_MKSUS%L_to_m*2)
2055		! call MOM_state_chksum("Post-diabatic ", u, v, &
2056		! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1)
2057	0	if (associated(tv%T)) call hchksum(tv%T, "Post-ALE, Post-diabatic T", G%HI, haloshift=1, unscale=US%C_to_degC)
2058	0	if (associated(tv%S)) call hchksum(tv%S, "Post-ALE, Post-diabatic S", G%HI, haloshift=1, unscale=US%S_to_ppt)
2059	0	if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-ALE, Post-diabatic frazil", G%HI, haloshift=0, &
2060	0	unscale=US%Q_to_J_kg*US%RZ_to_kg_m2)
2061	0	if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, &
2062	0	"Post-ALE, Post-diabatic salt deficit", G%HI, haloshift=0, unscale=US%RZ_to_kg_m2)
2063		! call MOM_thermo_chksum("Post-diabatic ", tv, G, US)
2064	0	if (debug_redundant) &
2065	0	call check_redundant("Post-ALE, Post-diabatic ", u, v, G, unscale=US%L_T_to_m_s)
2066		endif
2067	12	call disable_averaging(CS%diag)
2068
2069	12	call cpu_clock_end(id_clock_remap)
2070
2071	12	if (showCallTree) call callTree_leave("ALE_regridding_and_remapping(), MOM.F90")
2072
2073	12	end subroutine ALE_regridding_and_remapping
2074
2075		!> post_diabatic_halo_updates does halo updates and calculates derived thermodynamic quantities
2076		!! (e.g. specific volume). This must be done after the diabatic step regardless of is ALE
2077		!! cooridinates are used or not.
2078	12	subroutine post_diabatic_halo_updates(CS, G, GV, US, u, v, h, tv)
2079		type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure
2080		type(ocean_grid_type), intent(inout) :: G !< ocean grid structure
2081		type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure
2082		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
2083		real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), &
2084		intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1]
2085		real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), &
2086		intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1]
2087		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
2088		intent(inout) :: h !< layer thickness [H ~> m or kg m-2]
2089		type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables
2090
2091		logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging.
2092		logical :: showCallTree
2093		type(group_pass_type) :: pass_uv_T_S_h
2094		integer :: dynamics_stencil ! The computational stencil for the calculations
2095		! in the dynamic core.
2096
2097	12	showCallTree = callTree_showQuery()
2098	0	if (showCallTree) call callTree_enter("post_diabatic_halo_updates, MOM.F90")
2099	12	if (CS%debug) call query_debugging_checks(do_redundant=debug_redundant)
2100
2101	12	if (CS%use_particles) then
2102	0	call particles_to_k_space(CS%particles, h)
2103		endif
2104
2105	12	dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
2106	12	call create_group_pass(pass_uv_T_S_h, u, v, G%Domain, halo=dynamics_stencil)
2107	12	if (associated(tv%T)) &
2108	12	call create_group_pass(pass_uv_T_S_h, tv%T, G%Domain, halo=dynamics_stencil)
2109	12	if (associated(tv%S)) &
2110	12	call create_group_pass(pass_uv_T_S_h, tv%S, G%Domain, halo=dynamics_stencil)
2111	12	call create_group_pass(pass_uv_T_S_h, h, G%Domain, halo=dynamics_stencil)
2112	12	call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass, omp_offload=.true.)
2113
2114	12	if (associated(tv%frazil) .and. (.not.tv%frazil_was_reset) .and. CS%vertex_shear) &
2115	12	call pass_var(tv%frazil, G%Domain, halo=1)
2116
2117		! Update derived thermodynamic quantities.
2118	12	if (allocated(tv%SpV_avg)) then
2119	0	call calc_derived_thermo(tv, h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
2120		endif
2121	12	if (showCallTree) call callTree_leave("post_diabatic_halo_updates, MOM.F90")
2122	12	end subroutine post_diabatic_halo_updates
2123
2124		!> step_offline is the main driver for running tracers offline in MOM6. This has been primarily
2125		!! developed with ALE configurations in mind. Some work has been done in isopycnal configuration, but
2126		!! the work is very preliminary. Some more detail about this capability along with some of the subroutines
2127		!! called here can be found in tracers/MOM_offline_control.F90
2128	0	subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS)
2129		type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
2130		type(forcing), intent(inout) :: fluxes !< pointers to forcing fields
2131		type(surface), intent(inout) :: sfc_state !< surface ocean state
2132		type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type
2133		real, intent(in) :: time_interval !< time interval [T ~> s]
2134		type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM
2135
2136		! Local pointers
2137		type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing
2138		! metrics and related information
2139		type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information
2140		! about the vertical grid
2141		type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing
2142		! various unit conversion factors
2143
2144		logical :: first_iter !< True if this is the first time step_offline has been called in a given interval
2145		logical :: last_iter !< True if this is the last time step_tracer is to be called in an offline interval
2146		logical :: do_vertical !< If enough time has elapsed, do the diabatic tracer sources/sinks
2147		logical :: adv_converged !< True if all the horizontal fluxes have been used
2148
2149	0	real, allocatable, dimension(:,:,:) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2]
2150	0	real, allocatable, dimension(:,:,:) :: dzRegrid ! The change in grid interface positions due to regridding,
2151		! in the same units as thicknesses [H ~> m or kg m-2]
2152		real :: dt_offline ! The offline timestep for advection [T ~> s]
2153		real :: dt_offline_vertical ! The offline timestep for vertical fluxes and remapping [T ~> s]
2154		logical :: skip_diffusion
2155
2156		type(time_type), pointer :: accumulated_time => NULL()
2157		type(time_type), pointer :: vertical_time => NULL()
2158		integer :: dynamics_stencil ! The computational stencil for the calculations
2159		! in the dynamic core.
2160		integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
2161
2162		! 3D pointers
2163		real, dimension(:,:,:), pointer :: &
2164		uhtr => NULL(), & ! Accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg]
2165		vhtr => NULL(), & ! Accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg]
2166		eatr => NULL(), & ! Layer entrainment rates across the interface above [H ~> m or kg m-2]
2167		ebtr => NULL(), & ! Layer entrainment rates across the interface below [H ~> m or kg m-2]
2168		h_end => NULL() ! Layer thicknesses at the end of a step [H ~> m or kg m-2]
2169
2170		type(time_type) :: Time_end ! End time of a segment, as a time type
2171
2172		! Grid-related pointer assignments
2173	0	G => CS%G ; GV => CS%GV ; US => CS%US
2174
2175	0	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
2176	0	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
2177
2178	0	call cpu_clock_begin(id_clock_offline_tracer)
2179		call extract_offline_main(CS%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, &
2180	0	vertical_time, dt_offline, dt_offline_vertical, skip_diffusion)
2181	0	Time_end = increment_date(Time_start, seconds=floor(US%T_to_s*time_interval+0.001))
2182
2183	0	call enable_averages(time_interval, Time_end, CS%diag)
2184
2185		! Check to see if this is the first iteration of the offline interval
2186	0	first_iter = (accumulated_time == real_to_time(0.0))
2187
2188		! Check to see if vertical tracer functions should be done
2189	0	do_vertical = (first_iter .or. (accumulated_time >= vertical_time))
2190	0	if (do_vertical) vertical_time = accumulated_time + real_to_time(dt_offline_vertical, unscale=US%T_to_s)
2191
2192		! Increment the amount of time elapsed since last read and check if it's time to roll around
2193	0	accumulated_time = accumulated_time + real_to_time(time_interval, unscale=US%T_to_s)
2194
2195	0	last_iter = (accumulated_time >= real_to_time(dt_offline, unscale=US%T_to_s))
2196
2197	0	if (CS%use_ALE_algorithm) then
2198		! If this is the first iteration in the offline timestep, then we need to read in fields and
2199		! perform the main advection.
2200	0	if (first_iter) then
2201	0	call MOM_mesg("Reading in new offline fields")
2202		! Read in new transport and other fields
2203		! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, &
2204		! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm)
2205		! call update_transport_from_arrays(CS%offline_CSp)
2206	0	call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm)
2207
2208		! Apply any fluxes into the ocean
2209	0	call offline_fw_fluxes_into_ocean(G, GV, CS%offline_CSp, fluxes, CS%h)
2210
2211	0	if (.not.CS%diabatic_first) then
2212		call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, &
2213	0	id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged)
2214
2215		! Redistribute any remaining transport
2216	0	call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged)
2217
2218		! Perform offline diffusion if requested
2219	0	if (.not. skip_diffusion) then
2220	0	if (CS%VarMix%use_variable_mixing) then
2221	0	call pass_var(CS%h, G%Domain)
2222	0	call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix, CS%MEKE, CS%OBC, dt_offline)
2223	0	call calc_depth_function(G, CS%VarMix)
2224	0	call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC)
2225		endif
2226		call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, &
2227	0	CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv)
2228		endif
2229		endif
2230		endif
2231		! The functions related to column physics of tracers is performed separately in ALE mode
2232	0	if (do_vertical) then
2233		call offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS%offline_CSp, &
2234	0	CS%h, CS%tv, eatr, ebtr)
2235		endif
2236
2237		! Last thing that needs to be done is the final ALE remapping
2238	0	if (last_iter) then
2239	0	if (CS%diabatic_first) then
2240		call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, &
2241	0	id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged)
2242
2243		! Redistribute any remaining transport and perform the remaining advection
2244	0	call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged)
2245		! Perform offline diffusion if requested
2246	0	if (.not. skip_diffusion) then
2247	0	if (CS%VarMix%use_variable_mixing) then
2248	0	call pass_var(CS%h, G%Domain)
2249	0	call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix, CS%MEKE, CS%OBC, dt_offline)
2250	0	call calc_depth_function(G, CS%VarMix)
2251	0	call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC)
2252		endif
2253		call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, &
2254	0	CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv)
2255		endif
2256		endif
2257
2258	0	call MOM_mesg("Last iteration of offline interval")
2259
2260		! Apply freshwater fluxes out of the ocean
2261	0	call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h)
2262		! These diagnostic can be used to identify which grid points did not converge within
2263		! the specified number of advection sub iterations
2264	0	call post_offline_convergence_diags(G, GV, CS%offline_CSp, CS%h, h_end, uhtr, vhtr)
2265
2266		! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses
2267		! stored from the forward run
2268	0	call cpu_clock_begin(id_clock_ALE)
2269
2270		! Do any necessary adjustments ot the state prior to remapping.
2271	0	call pre_ALE_adjustments(G, GV, US, h_end, CS%tv, CS%tracer_Reg, CS%ALE_CSp)
2272
2273	0	allocate(h_new(isd:ied, jsd:jed, nz), source=0.0)
2274	0	allocate(dzRegrid(isd:ied, jsd:jed, nz+1), source=0.0)
2275
2276		! Generate the new grid based on the tracer grid at the end of the interval.
2277	0	call ALE_regrid(G, GV, US, h_end, h_new, dzRegrid, CS%tv, CS%ALE_CSp)
2278
2279		! Remap the tracers from the previous tracer grid onto the new grid. The thicknesses that
2280		! are used are intended to ensure that in the case where transports don't quite conserve,
2281		! the offline layer thicknesses do not drift too far away from the online model.
2282	0	call ALE_remap_tracers(CS%ALE_CSp, G, GV, CS%h, h_new, CS%tracer_Reg, debug=CS%debug)
2283	0	if (allocated(CS%tv%SpV_avg)) CS%tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
2284
2285		! Update the tracer grid.
2286	0	do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
2287	0	CS%h(i,j,k) = h_new(i,j,k)
2288		enddo ; enddo ; enddo
2289
2290	0	deallocate(h_new, dzRegrid)
2291
2292	0	call cpu_clock_end(id_clock_ALE)
2293	0	call pass_var(CS%h, G%Domain)
2294		endif
2295		else ! NON-ALE MODE...NOT WELL TESTED
2296		call MOM_error(WARNING, &
2297	0	"Offline tracer mode in non-ALE configuration has not been thoroughly tested")
2298		! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in
2299		! main_offline_advection_layer. Warning: this may not be appropriate for tracers that
2300		! exchange with the atmosphere
2301	0	if (abs(time_interval - dt_offline) > 1.0e-6*US%s_to_T) then
2302		call MOM_error(FATAL, &
2303	0	"For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval")
2304		endif
2305	0	call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm)
2306		call offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, &
2307	0	CS%h, eatr, ebtr, uhtr, vhtr)
2308		! Perform offline diffusion if requested
2309	0	if (.not. skip_diffusion) then
2310		call tracer_hordiff(h_end, dt_offline, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, &
2311	0	CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv)
2312		endif
2313
2314	0	CS%h = h_end
2315
2316	0	call pass_var(CS%tv%T, G%Domain)
2317	0	call pass_var(CS%tv%S, G%Domain)
2318	0	call pass_var(CS%h, G%Domain)
2319
2320		endif
2321
2322		call adjust_ssh_for_p_atm(CS%tv, G, GV, US, CS%ave_ssh_ibc, forces%p_surf_SSH, &
2323	0	CS%calc_rho_for_sea_lev)
2324	0	call extract_surface_state(CS, sfc_state)
2325
2326	0	call disable_averaging(CS%diag)
2327	0	call pass_var(CS%tv%T, G%Domain)
2328	0	call pass_var(CS%tv%S, G%Domain)
2329	0	call pass_var(CS%h, G%Domain)
2330
2331	0	fluxes%fluxes_used = .true.
2332
2333		! Update derived thermodynamic quantities.
2334	0	if (allocated(CS%tv%SpV_avg)) then
2335	0	dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
2336	0	call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=dynamics_stencil)
2337		endif
2338
2339	0	if (last_iter) then
2340	0	accumulated_time = real_to_time(0.0)
2341		endif
2342
2343	0	call cpu_clock_end(id_clock_offline_tracer)
2344
2345	0	end subroutine step_offline
2346
2347		!> Initialize MOM, including memory allocation, setting up parameters and diagnostics,
2348		!! initializing the ocean state variables, and initializing subsidiary modules
2349	11	subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, &
2350		Time_in, offline_tracer_mode, input_restart_file, diag_ptr, &
2351		count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp, ensemble_num, &
2352		calve_ice_shelf_bergs)
2353		type(time_type), target, intent(inout) :: Time !< model time, set in this routine
2354		type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar
2355		type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse
2356		type(directories), intent(out) :: dirs !< structure with directory paths
2357		type(MOM_control_struct), intent(inout), target :: CS !< pointer set in this routine to MOM control structure
2358		type(time_type), optional, intent(in) :: Time_in !< time passed to MOM_initialize_state when
2359		!! model is not being started from a restart file
2360		logical, optional, intent(out) :: offline_tracer_mode !< True is returned if tracers are being run offline
2361		character(len=*),optional, intent(in) :: input_restart_file !< If present, name of restart file to read
2362		type(diag_ctrl), optional, pointer :: diag_ptr !< A pointer set in this routine to the diagnostic
2363		!! regulatory structure
2364		type(tracer_flow_control_CS), &
2365		optional, pointer :: tracer_flow_CSp !< A pointer set in this routine to
2366		!! the tracer flow control structure.
2367		logical, optional, intent(in) :: count_calls !< If true, nstep_tot counts the number of
2368		!! calls to step_MOM instead of the number of
2369		!! dynamics timesteps.
2370		type(ice_shelf_CS), optional, pointer :: ice_shelf_CSp !< A pointer to an ice shelf control structure
2371		type(Wave_parameters_CS), &
2372		optional, pointer :: Waves_CSp !< An optional pointer to a wave property CS
2373		integer, optional :: ensemble_num !< Ensemble index provided by the cap (instead of FMS
2374		!! ensemble manager)
2375		logical, optional :: calve_ice_shelf_bergs !< If true, will add point iceberg calving variables to the ice
2376		!! shelf restart
2377		! local variables
2378		type(ocean_grid_type), pointer :: G => NULL() ! A pointer to the metric grid use for the run
2379		type(ocean_grid_type), pointer :: G_in => NULL() ! Pointer to the input grid
2380		type(hor_index_type), pointer :: HI => NULL() ! A hor_index_type for array extents
2381		type(hor_index_type), target :: HI_in ! HI on the input grid
2382		type(hor_index_type) :: HI_in_unmasked ! HI on the unmasked input grid
2383		type(verticalGrid_type), pointer :: GV => NULL()
2384		type(dyn_horgrid_type), pointer :: dG => NULL(), test_dG => NULL()
2385		type(dyn_horgrid_type), pointer :: dG_in => NULL()
2386		type(dyn_horgrid_type), pointer :: dG_unmasked_in => NULL()
2387		type(diag_ctrl), pointer :: diag => NULL()
2388		type(unit_scale_type), pointer :: US => NULL()
2389		type(MOM_restart_CS), pointer :: restart_CSp => NULL()
2390		character(len=4), parameter :: vers_num = 'v2.0'
2391		integer :: turns ! Number of grid quarter-turns
2392		logical :: point_calving
2393
2394		! Initial state on the input index map
2395	1	real, allocatable :: u_in(:,:,:) ! Initial zonal velocities [L T-1 ~> m s-1]
2396	1	real, allocatable :: v_in(:,:,:) ! Initial meridional velocities [L T-1 ~> m s-1]
2397	1	real, allocatable :: h_in(:,:,:) ! Initial layer thicknesses [H ~> m or kg m-2]
2398	1	real, allocatable, target :: frac_shelf_in(:,:) ! Initial fraction of the total cell area occupied
2399		! by an ice shelf [nondim]
2400	1	real, allocatable, target :: mass_shelf_in(:,:) ! Initial mass of ice shelf contained within a grid cell
2401		! [R Z ~> kg m-2]
2402	1	real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [C ~> degC]
2403	1	real, allocatable, target :: S_in(:,:,:) ! Initial salinities [S ~> ppt]
2404
2405		type(ocean_OBC_type), pointer :: OBC_in => NULL()
2406		type(sponge_CS), pointer :: sponge_in_CSp => NULL()
2407		type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL()
2408		type(oda_incupd_CS),pointer :: oda_incupd_in_CSp => NULL()
2409		! This include declares and sets the variable "version".
2410		# include "version_variable.h"
2411
2412		integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
2413		integer :: IsdB, IedB, JsdB, JedB
2414		real :: dtbt ! If negative, this specifies the barotropic timestep as a fraction
2415		! of the maximum stable value [nondim].
2416
2417	1	real, allocatable, dimension(:,:) :: eta ! free surface height or column mass [H ~> m or kg m-2]
2418	1	real, allocatable, dimension(:,:,:) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2]
2419	1	real, allocatable, dimension(:,:,:) :: dzRegrid ! The change in grid interface positions due to regridding,
2420		! in the same units as thicknesses [H ~> m or kg m-2]
2421	1	real, allocatable, dimension(:,:,:) :: h_old_u ! Source grid thickness at zonal velocity points [H ~> m or kg m-2]
2422	1	real, allocatable, dimension(:,:,:) :: h_old_v ! Source grid thickness at meridional velocity
2423		! points [H ~> m or kg m-2]
2424	1	real, allocatable, dimension(:,:,:) :: h_new_u ! Destination grid thickness at zonal
2425		! velocity points [H ~> m or kg m-2]
2426	1	real, allocatable, dimension(:,:,:) :: h_new_v ! Destination grid thickness at meridional
2427		! velocity points [H ~> m or kg m-2]
2428	1	logical, allocatable, dimension(:,:,:) :: PCM_cell ! If true, PCM remapping should be used in a cell.
2429		type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h
2430
2431		real :: Hmix_z, Hmix_UV_z ! Temporary variables with averaging depths [Z ~> m]
2432		real :: HFrz_z ! Temporary variable with the melt potential depth [Z ~> m]
2433		real :: default_val ! The default value for DTBT_RESET_PERIOD [s]
2434		logical :: write_geom_files ! If true, write out the grid geometry files.
2435		logical :: new_sim ! If true, this has been determined to be a new simulation
2436		logical :: use_geothermal ! If true, apply geothermal heating.
2437		logical :: use_EOS ! If true, density calculated from T & S using an equation of state.
2438		logical :: symmetric ! If true, use symmetric memory allocation.
2439		logical :: save_IC ! If true, save the initial conditions.
2440		logical :: do_unit_tests ! If true, call unit tests.
2441		logical :: fpmix ! Needed to decide if BLD should be passed to RK2.
2442		logical :: test_grid_copy = .false.
2443
2444		logical :: bulkmixedlayer ! If true, a refined bulk mixed layer scheme is used
2445		! with nkml sublayers and nkbl buffer layer.
2446		logical :: use_temperature ! If true, temperature and salinity used as state variables.
2447		logical :: use_p_surf_in_EOS ! If true, always include the surface pressure contributions
2448		! in equation of state calculations.
2449		logical :: use_frazil ! If true, liquid seawater freezes if temp below freezing,
2450		! with accumulated heat deficit returned to surface ocean.
2451		logical :: bound_salinity ! If true, salt is added to keep salinity above
2452		! a minimum value, and the deficit is reported.
2453		integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
2454		logical :: use_conT_absS ! If true, the prognostics T & S are conservative temperature
2455		! and absolute salinity. Care should be taken to convert them
2456		! to potential temperature and practical salinity before
2457		! exchanging them with the coupler and/or reporting T&S diagnostics.
2458		logical :: advect_TS ! If false, then no horizontal advection of temperature
2459		! and salnity is performed
2460		logical :: use_ice_shelf ! Needed for ALE
2461		logical :: global_indexing ! If true use global horizontal index values instead
2462		! of having the data domain on each processor start at 1.
2463		logical :: bathy_at_vel ! If true, also define bathymetric fields at the
2464		! the velocity points.
2465		logical :: calc_dtbt ! Indicates whether the dynamically adjusted barotropic
2466		! time step needs to be updated before it is used.
2467		logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations.
2468		integer :: first_direction ! An integer that indicates which direction is to be
2469		! updated first in directionally split parts of the
2470		! calculation.
2471		logical :: enable_bugs ! If true, the defaults for certain recently added bug-fix flags are
2472		! set to recreate the bugs so that the code can be moved forward
2473		! without changing answers for existing configurations. When this is
2474		! false, bugs are only used if they are actively selected.
2475		logical :: non_Bous ! If true, this run is fully non-Boussinesq
2476		logical :: Boussinesq ! If true, this run is fully Boussinesq
2477		logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq
2478		logical :: use_KPP ! If true, diabatic is using KPP vertical mixing
2479		logical :: MLE_use_PBL_MLD ! If true, use stored boundary layer depths for submesoscale restratification.
2480		logical :: OBC_reservoir_init_bug
2481		integer :: nkml, nkbl, verbosity, write_geom, number_of_OBC_segments
2482		integer :: dynamics_stencil ! The computational stencil for the calculations
2483		! in the dynamic core.
2484		real :: salin_underflow ! A tiny value of salinity below which the it is set to 0 [S ~> ppt]
2485		real :: temp_underflow ! A tiny magnitude of temperatures below which they are set to 0 [C ~> degC]
2486		real :: conv2watt ! A conversion factor from temperature fluxes to heat
2487		! fluxes [J m-2 H-1 C-1 ~> J m-3 degC-1 or J kg-1 degC-1]
2488		real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1]
2489		character(len=48) :: S_flux_units
2490
2491	11	type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables.
2492		type(time_type) :: Start_time
2493		type(ocean_internal_state) :: MOM_internal_state
2494		type(MOM_domain_type), pointer :: MOM_dom_unmasked => null() ! Unmasked MOM domain instance
2495		! (To be used for writing out ocean geometry)
2496		character(len=240) :: geom_file ! Name of the ocean geometry file
2497
2498	1	CS%Time => Time
2499
2500	1	id_clock_ocean = cpu_clock_id('Ocean', grain=CLOCK_COMPONENT)
2501	1	id_clock_init = cpu_clock_id('Ocean Initialization', grain=CLOCK_SUBCOMPONENT)
2502	1	call cpu_clock_begin(id_clock_ocean) ; call cpu_clock_begin(id_clock_init)
2503
2504	1	Start_time = Time ; if (present(Time_in)) Start_time = Time_in
2505
2506		! Read paths and filenames from namelist and store in "dirs".
2507		! Also open the parsed input parameter file(s) and setup param_file.
2508	1	call get_MOM_input(param_file, dirs, default_input_filename=input_restart_file, ensemble_num=ensemble_num)
2509
2510	1	verbosity = 2 ; call read_param(param_file, "VERBOSITY", verbosity)
2511	1	call MOM_set_verbosity(verbosity)
2512	1	call callTree_enter("initialize_MOM(), MOM.F90")
2513
2514	1	call find_obsolete_params(param_file)
2515
2516		! Determining the internal unit scaling factors for this run.
2517	1	call unit_scaling_init(param_file, CS%US)
2518	1	US => CS%US
2519		!$omp target enter data map(to: CS%US)
2520
2521		! Read relevant parameters and write them to the model log.
2522	1	call log_version(param_file, "MOM", version, "", log_to_all=.true., layout=.true., debugging=.true.)
2523		call get_param(param_file, "MOM", "VERBOSITY", verbosity, &
2524		"Integer controlling level of messaging\n" // &
2525		"\t0 = Only FATAL messages\n" // &
2526		"\t2 = Only FATAL, WARNING, NOTE [default]\n" // &
2527	1	"\t9 = All)", default=2, debuggingParam=.true.)
2528		call get_param(param_file, "MOM", "DO_UNIT_TESTS", do_unit_tests, &
2529		"If True, exercises unit tests at model start up.", &
2530	1	default=.false., debuggingParam=.true.)
2531	1	if (do_unit_tests) then
2532	0	id_clock_unit_tests = cpu_clock_id('(Ocean unit tests)', grain=CLOCK_MODULE)
2533	0	call cpu_clock_begin(id_clock_unit_tests)
2534	0	call unit_tests(verbosity)
2535	0	call cpu_clock_end(id_clock_unit_tests)
2536		endif
2537
2538		call get_param(param_file, "MOM", "SPLIT", CS%split, &
2539	1	"Use the split time stepping if true.", default=.true.)
2540		call get_param(param_file, "MOM", "SPLIT_RK2B", CS%use_alt_split, &
2541		"If true, use a version of the split explicit time stepping scheme that "//&
2542		"exchanges velocities with step_MOM that have the average barotropic phase over "//&
2543		"a baroclinic timestep rather than the instantaneous barotropic phase.", &
2544	1	default=.false., do_not_log=.not.CS%split)
2545	1	if (CS%split) then
2546	1	CS%use_RK2 = .false.
2547		else
2548		call get_param(param_file, "MOM", "USE_RK2", CS%use_RK2, &
2549		"If true, use RK2 instead of RK3 in the unsplit time stepping.", &
2550	0	default=.false.)
2551		endif
2552
2553		! FPMIX is needed to decide if boundary layer depth should be passed to RK2
2554		call get_param(param_file, '', "FPMIX", fpmix, &
2555		"If true, add non-local momentum flux increments and diffuse down the Eulerian gradient.", &
2556	1	default=.false., do_not_log=.true.)
2557
2558	1	if (fpmix .and. .not. CS%split) then
2559		call MOM_error(FATAL, "initialize_MOM: "//&
2560	0	"FPMIX=True only works when SPLIT=True.")
2561		endif
2562
2563		! NOTE: tv is used, even if there is no thermodynamics
2564	1	allocate(CS%tv)
2565
2566		call get_param(param_file, "MOM", "BOUSSINESQ", Boussinesq, &
2567	1	"If true, make the Boussinesq approximation.", default=.true., do_not_log=.true.)
2568		call get_param(param_file, "MOM", "SEMI_BOUSSINESQ", semi_Boussinesq, &
2569		"If true, do non-Boussinesq pressure force calculations and use mass-based "//&
2570		"thicknesses, but use RHO_0 to convert layer thicknesses into certain "//&
2571		"height changes. This only applies if BOUSSINESQ is false.", &
2572	1	default=.true., do_not_log=.true.)
2573	1	non_Bous = .not.(Boussinesq .or. semi_Boussinesq)
2574		call get_param(param_file, "MOM", "CALC_RHO_FOR_SEA_LEVEL", CS%calc_rho_for_sea_lev, &
2575		"If true, the in-situ density is used to calculate the "//&
2576		"effective sea level that is returned to the coupler. If false, "//&
2577	1	"the Boussinesq parameter RHO_0 is used.", default=non_Bous)
2578		call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", use_temperature, &
2579		"If true, Temperature and salinity are used as state "//&
2580	1	"variables.", default=.true.)
2581		call get_param(param_file, "MOM", "USE_EOS", use_EOS, &
2582		"If true, density is calculated from temperature and "//&
2583		"salinity with an equation of state. If USE_EOS is "//&
2584		"true, ENABLE_THERMODYNAMICS must be true as well.", &
2585	1	default=use_temperature)
2586		call get_param(param_file, "MOM", "DIABATIC_FIRST", CS%diabatic_first, &
2587		"If true, apply diabatic and thermodynamic processes, "//&
2588		"including buoyancy forcing and mass gain or loss, "//&
2589	1	"before stepping the dynamics forward.", default=.false.)
2590		call get_param(param_file, "MOM", "USE_CONTEMP_ABSSAL", use_conT_absS, &
2591		"If true, the prognostics T&S are the conservative temperature "//&
2592		"and absolute salinity. Care should be taken to convert them "//&
2593		"to potential temperature and practical salinity before "//&
2594		"exchanging them with the coupler and/or reporting T&S diagnostics.", &
2595	1	default=.false.)
2596	1	CS%tv%T_is_conT = use_conT_absS ; CS%tv%S_is_absS = use_conT_absS
2597		call get_param(param_file, "MOM", "ADIABATIC", CS%adiabatic, &
2598		"There are no diapycnal mass fluxes if ADIABATIC is true. "//&
2599		"This assumes that KD = 0.0 and that there is no buoyancy forcing, "//&
2600	1	"but makes the model faster by eliminating subroutine calls.", default=.false.)
2601		call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, &
2602		"If False, skips the dynamics calls that update u & v, as well as "//&
2603		"the gravity wave adjustment to h. This may be a fragile feature, "//&
2604	1	"but can be useful during development", default=.true.)
2605		call get_param(param_file, "MOM", "ADVECT_TS", advect_TS, &
2606		"If True, advect temperature and salinity horizontally "//&
2607		"If False, T/S are registered for advection. "//&
2608		"This is intended only to be used in offline tracer mode "//&
2609		"and is by default false in that case.", &
2610	1	do_not_log=.true., default=.true.)
2611	1	if (present(offline_tracer_mode)) then ! Only read this parameter in enabled modes
2612		call get_param(param_file, "MOM", "OFFLINE_TRACER_MODE", CS%offline_tracer_mode, &
2613		"If true, barotropic and baroclinic dynamics, thermodynamics "//&
2614		"are all bypassed with all the fields necessary to integrate "//&
2615		"the tracer advection and diffusion equation are read in from "//&
2616		"files stored from a previous integration of the prognostic model. "//&
2617	1	"NOTE: This option only used in the ocean_solo_driver.", default=.false.)
2618	1	if (CS%offline_tracer_mode) then
2619		call get_param(param_file, "MOM", "ADVECT_TS", advect_TS, &
2620		"If True, advect temperature and salinity horizontally "//&
2621		"If False, T/S are registered for advection. "//&
2622		"This is intended only to be used in offline tracer mode, "//&
2623		"and is by default false in that case", &
2624	0	default=.false. )
2625		endif
2626		endif
2627		call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm, &
2628		"If True, use the ALE algorithm (regridding/remapping). "//&
2629	1	"If False, use the layered isopycnal algorithm.", default=.false. )
2630		call get_param(param_file, "MOM", "REMAP_UV_USING_OLD_ALG", CS%remap_uv_using_old_alg, &
2631		"If true, uses the old remapping-via-a-delta-z method for "//&
2632		"remapping u and v. If false, uses the new method that remaps "//&
2633		"between grids described by an old and new thickness.", &
2634	1	default=.false., do_not_log=.not.CS%use_ALE_algorithm)
2635		call get_param(param_file, "MOM", "REMAP_AUXILIARY_VARS", CS%remap_aux_vars, &
2636		"If true, apply ALE remapping to all of the auxiliary 3-dimensional "//&
2637		"variables that are needed to reproduce across restarts, similarly to "//&
2638		"what is already being done with the primary state variables. "//&
2639		"The default should be changed to true.", default=.false., &
2640	1	do_not_log=.not.CS%use_ALE_algorithm)
2641		call get_param(param_file, "MOM", "BULKMIXEDLAYER", bulkmixedlayer, &
2642		"If true, use a Kraus-Turner-like bulk mixed layer "//&
2643		"with transitional buffer layers. Layers 1 through "//&
2644		"NKML+NKBL have variable densities. There must be at "//&
2645		"least NKML+NKBL+1 layers if BULKMIXEDLAYER is true. "//&
2646		"BULKMIXEDLAYER can not be used with USE_REGRIDDING. "//&
2647		"The default is influenced by ENABLE_THERMODYNAMICS.", &
2648	1	default=use_temperature .and. .not.CS%use_ALE_algorithm)
2649		call get_param(param_file, "MOM", "USE_POROUS_BARRIER", CS%use_porbar, &
2650		"If true, use porous barrier to constrain the widths "//&
2651		"and face areas at the edges of the grid cells. ", &
2652	1	default=.false.)
2653		call get_param(param_file, "MOM", "BATHYMETRY_AT_VEL", bathy_at_vel, &
2654		"If true, there are separate values for the basin depths "//&
2655		"at velocity points. Otherwise the effects of topography "//&
2656		"are entirely determined from thickness points.", &
2657	1	default=.false.)
2658		call get_param(param_file, "MOM", "USE_WAVES", CS%UseWaves, default=.false., &
2659	1	do_not_log=.true.)
2660
2661		call get_param(param_file, "MOM", "DEBUG", CS%debug, &
2662		"If true, write out verbose debugging data.", &
2663	1	default=.false., debuggingParam=.true.)
2664		call get_param(param_file, "MOM", "DEBUG_TRUNCATIONS", debug_truncations, &
2665		"If true, calculate all diagnostics that are useful for "//&
2666	1	"debugging truncations.", default=.false., debuggingParam=.true.)
2667		call get_param(param_file, "MOM", "OBC_NUMBER_OF_SEGMENTS", number_of_OBC_segments, &
2668	1	default=0, do_not_log=.true.)
2669		call get_param(param_file, "MOM", "DEBUG_OBCS", CS%debug_OBCs, &
2670		"If true, write out verbose debugging data about OBCs.", &
2671	1	default=.false., debuggingParam=.true., do_not_log=(number_of_OBC_segments<=0))
2672		call get_param(param_file, "MOM", "ENABLE_BUGS_BY_DEFAULT", enable_bugs, &
2673		"If true, the defaults for certain recently added bug-fix flags are set to "//&
2674		"recreate the bugs so that the code can be moved forward without changing "//&
2675		"answers for existing configurations. The defaults for groups of bug-fix "//&
2676		"flags are periodically changed to correct the bugs, at which point this "//&
2677		"parameter will no longer be used to set their default. Setting this to false "//&
2678		"means that bugs are only used if they are actively selected, but it also "//&
2679		"means that answers may change when code is updated due to newly found bugs.", &
2680	1	default=.true.)
2681
2682		call get_param(param_file, "MOM", "DT", CS%dt, &
2683		"The (baroclinic) dynamics time step. The time-step that "//&
2684		"is actually used will be an integer fraction of the "//&
2685		"forcing time-step (DT_FORCING in ocean-only mode or the "//&
2686		"coupling timestep in coupled mode.)", units="s", scale=US%s_to_T, &
2687	1	fail_if_missing=.true.)
2688		call get_param(param_file, "MOM", "DT_THERM", CS%dt_therm, &
2689		"The thermodynamic time step. Ideally DT_THERM should be an "//&
2690		"integer multiple of DT and of DT_TRACER_ADVECT "//&
2691		"and less than the forcing or coupling time-step. However, if "//&
2692		"THERMO_SPANS_COUPLING is true, DT_THERM can be an integer multiple "//&
2693		"of the coupling timestep. By default DT_THERM is set to DT.", &
2694	1	units="s", scale=US%s_to_T, default=US%T_to_s*CS%dt)
2695		call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", CS%thermo_spans_coupling, &
2696		"If true, the MOM will take thermodynamic "//&
2697		"timesteps that can be longer than the coupling timestep. "//&
2698		"The actual thermodynamic timestep that is used in this "//&
2699		"case is the largest integer multiple of the coupling "//&
2700	1	"timestep that is less than or equal to DT_THERM.", default=.false.)
2701		call get_param(param_file, "MOM", "DT_TRACER_ADVECT", CS%dt_tr_adv, &
2702		"The tracer advection time step. Ideally DT_TRACER_ADVECT should be an "//&
2703		"integer multiple of DT, less than DT_THERM, and less than the forcing "//&
2704		"or coupling time-step. However, if TRADV_SPANS_COUPLING is true, "//&
2705		"DT_TRACER_ADVECT can be longer than the coupling timestep. By "//&
2706		"default DT_TRACER_ADVECT is set to DT_THERM.", &
2707	1	units="s", scale=US%s_to_T, default=US%T_to_s*CS%dt_therm)
2708		call get_param(param_file, "MOM", "TRADV_SPANS_COUPLING", CS%tradv_spans_coupling, &
2709		"If true, the MOM will take tracer advection "//&
2710		"timesteps that can be longer than the coupling timestep. "//&
2711		"The actual tracer advection timestep that is used in this "//&
2712		"case is the largest integer multiple of the coupling "//&
2713		"timestep that is less than or equal to DT_TRACER_ADVECT.", &
2714	1	default=CS%thermo_spans_coupling)
2715	1	if ( CS%diabatic_first .and. (CS%dt_tr_adv /= CS%dt_therm) ) then
2716	0	call MOM_error(FATAL,"MOM: If using DIABATIC_FIRST, DT_TRACER_ADVECT must equal DT_THERM.")
2717		endif
2718		call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, &
2719		"If true, isopycnal surfaces are diffused with a Laplacian "//&
2720	1	"coefficient of KHTH.", default=.false.)
2721		call get_param(param_file, "MOM", "APPLY_INTERFACE_FILTER", CS%interface_filter, &
2722		"If true, model interface heights are subjected to a grid-scale "//&
2723	1	"dependent spatial smoothing, often with biharmonic filter.", default=.false.)
2724		call get_param(param_file, "MOM", "THICKNESSDIFFUSE_FIRST", CS%thickness_diffuse_first, &
2725		"If true, do thickness diffusion or interface height smoothing before dynamics. "//&
2726		"This is only used if THICKNESSDIFFUSE or APPLY_INTERFACE_FILTER is true.", &
2727	1	default=.false., do_not_log=.not.(CS%thickness_diffuse.or.CS%interface_filter))
2728	1	CS%interface_filter_dt_bug = .false.
2729	1	if ((.not.CS%thickness_diffuse_first .and. CS%interface_filter) .or. &
2730		(CS%thickness_diffuse_first .and. (CS%thickness_diffuse .or. CS%interface_filter) &
2731		.and. (CS%dt_tr_adv /= CS%dt_therm))) then
2732		call get_param(param_file, "MOM", "INTERFACE_FILTER_DT_BUG", CS%interface_filter_dt_bug, &
2733		"If true, uses the wrong time interval in calls to interface_filter "//&
2734		"and thickness_diffuse. Has no effect when THICKNESSDIFFUSE_FIRST is "//&
2735		"true and DT_TRACER_ADVECT = DT_THERMO or when THICKNESSDIFFUSE_FIRST "//&
2736	0	"is false and APPLY_INTERFACE_FILTER is false. ", default=.false.)
2737		endif
2738
2739	1	if (bulkmixedlayer) then
2740	0	CS%Hmix = -1.0 ; CS%Hmix_UV = -1.0
2741		else
2742		call get_param(param_file, "MOM", "HMIX_SFC_PROP", Hmix_z, &
2743		"If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth "//&
2744		"over which to average to find surface properties like "//&
2745		"SST and SSS or density (but not surface velocities).", &
2746	1	units="m", default=1.0, scale=US%m_to_Z)
2747		call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", Hmix_UV_z, &
2748		"If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth "//&
2749		"over which to average to find surface flow properties, "//&
2750		"SSU, SSV. A non-positive value indicates no averaging.", &
2751	1	units="m", default=0.0, scale=US%m_to_Z)
2752		endif
2753		call get_param(param_file, "MOM", "HFREEZE", HFrz_z, &
2754		"If HFREEZE > 0, melt potential will be computed. The actual depth "//&
2755		"over which melt potential is computed will be min(HFREEZE, OBLD), "//&
2756		"where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//&
2757		"melt potential will not be computed.", &
2758	1	units="m", default=-1.0, scale=US%m_to_Z)
2759		call get_param(param_file, "MOM", "INTERPOLATE_P_SURF", CS%interp_p_surf, &
2760		"If true, linearly interpolate the surface pressure "//&
2761		"over the coupling time step, using the specified value "//&
2762	1	"at the end of the step.", default=.false.)
2763
2764	1	if (CS%split) then
2765	1	call get_param(param_file, "MOM", "DTBT", dtbt, units="s or nondim", default=-0.98)
2766	1	default_val = US%T_to_s*CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0
2767	1	CS%dtbt_reset_period = -1.0
2768		call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, &
2769		"The period between recalculations of DTBT (if DTBT <= 0). "//&
2770		"If DTBT_RESET_PERIOD is negative, DTBT is set based "//&
2771		"only on information available at initialization. If 0, "//&
2772		"DTBT will be set every dynamics time step. The default "//&
2773		"is set by DT_THERM. This is only used if SPLIT is true.", &
2774	1	units="s", default=default_val, scale=US%s_to_T, do_not_read=(dtbt > 0.0))
2775		endif
2776
2777		call get_param(param_file, "MOM", "DT_OBC_SEG_UPDATE_OBGC", CS%dt_obc_seg_period, &
2778		"The time between OBC segment data updates for OBGC tracers. "//&
2779		"This must be an integer multiple of DT and DT_THERM. "//&
2780		"The default is set to DT.", &
2781	1	units="s", default=US%T_to_s*CS%dt, scale=US%s_to_T, do_not_log=.not.associated(OBC_in))
2782
2783		! This is here in case these values are used inappropriately.
2784	1	use_frazil = .false. ; bound_salinity = .false. ; use_p_surf_in_EOS = .false.
2785	1	CS%tv%P_Ref = 2.0e7*US%Pa_to_RL2_T2
2786	1	if (use_temperature) then
2787		call get_param(param_file, "MOM", "FRAZIL", use_frazil, &
2788		"If true, water freezes if it gets too cold, and the "//&
2789		"accumulated heat deficit is returned in the "//&
2790		"surface state. FRAZIL is only used if "//&
2791	1	"ENABLE_THERMODYNAMICS is true.", default=.false.)
2792		call get_param(param_file, "MOM", "DO_GEOTHERMAL", use_geothermal, &
2793	1	"If true, apply geothermal heating.", default=.false.)
2794		call get_param(param_file, "MOM", "BOUND_SALINITY", bound_salinity, &
2795		"If true, limit salinity to being positive. (The sea-ice "//&
2796		"model may ask for more salt than is available and "//&
2797	1	"drive the salinity negative otherwise.)", default=.false.)
2798		call get_param(param_file, "MOM", "MIN_SALINITY", CS%tv%min_salinity, &
2799		"The minimum value of salinity when BOUND_SALINITY=True.", &
2800	1	units="PPT", default=0.0, scale=US%ppt_to_S, do_not_log=.not.bound_salinity)
2801		call get_param(param_file, "MOM", "SALINITY_UNDERFLOW", salin_underflow, &
2802		"A tiny value of salinity below which the it is set to 0. For reference, "//&
2803		"one molecule of salt per square meter of ocean is of order 1e-29 ppt.", &
2804	1	units="PPT", default=0.0, scale=US%ppt_to_S)
2805		call get_param(param_file, "MOM", "TEMPERATURE_UNDERFLOW", temp_underflow, &
2806		"A tiny magnitude of temperatures below which they are set to 0.", &
2807	1	units="degC", default=0.0, scale=US%degC_to_C)
2808		call get_param(param_file, "MOM", "C_P", CS%tv%C_p, &
2809		"The heat capacity of sea water, approximated as a constant. "//&
2810		"This is only used if ENABLE_THERMODYNAMICS is true. The default "//&
2811		"value is from the TEOS-10 definition of conservative temperature.", &
2812	1	units="J kg-1 K-1", default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC)
2813		call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", use_p_surf_in_EOS, &
2814		"If true, always include the surface pressure contributions "//&
2815	1	"in equation of state calculations.", default=.true.)
2816		endif
2817	1	if (use_EOS) call get_param(param_file, "MOM", "P_REF", CS%tv%P_Ref, &
2818		"The pressure that is used for calculating the coordinate "//&
2819		"density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//&
2820		"This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", &
2821	1	units="Pa", default=2.0e7, scale=US%Pa_to_RL2_T2)
2822
2823	1	if (bulkmixedlayer) then
2824		call get_param(param_file, "MOM", "NKML", nkml, &
2825		"The number of sublayers within the mixed layer if "//&
2826	0	"BULKMIXEDLAYER is true.", units="nondim", default=2)
2827		call get_param(param_file, "MOM", "NKBL", nkbl, &
2828		"The number of layers that are used as variable density buffer "//&
2829	0	"layers if BULKMIXEDLAYER is true.", units="nondim", default=2)
2830		endif
2831
2832		call get_param(param_file, "MOM", "GLOBAL_INDEXING", global_indexing, &
2833		"If true, use a global lateral indexing convention, so "//&
2834		"that corresponding points on different processors have "//&
2835		"the same index. This does not work with static memory.", &
2836	1	default=.false., layoutParam=.true.)
2837		#ifdef STATIC_MEMORY_
2838		if (global_indexing) call MOM_error(FATAL, "initialize_MOM: "//&
2839		"GLOBAL_INDEXING can not be true with STATIC_MEMORY.")
2840		#endif
2841		call get_param(param_file, "MOM", "FIRST_DIRECTION", first_direction, &
2842		"An integer that indicates which direction goes first "//&
2843		"in parts of the code that use directionally split "//&
2844		"updates, with even numbers (or 0) used for x- first "//&
2845	1	"and odd numbers used for y-first.", default=0)
2846		call get_param(param_file, "MOM", "ALTERNATE_FIRST_DIRECTION", CS%alternate_first_direction, &
2847		"If true, after every dynamic timestep alternate whether the x- or y- "//&
2848		"direction updates occur first in directionally split parts of the calculation. "//&
2849		"If this is true, FIRST_DIRECTION applies at the start of a new run or if "//&
2850	1	"the next first direction can not be found in the restart file.", default=.false.)
2851		call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", CS%check_bad_sfc_vals, &
2852		"If true, check the surface state for ridiculous values.", &
2853	1	default=.false.)
2854	1	if (CS%check_bad_sfc_vals) then
2855		call get_param(param_file, "MOM", "BAD_VAL_SSH_MAX", CS%bad_val_ssh_max, &
2856		"The value of SSH above which a bad value message is "//&
2857		"triggered, if CHECK_BAD_SURFACE_VALS is true.", &
2858	0	units="m", default=20.0, scale=US%m_to_Z)
2859		call get_param(param_file, "MOM", "BAD_VAL_SSS_MAX", CS%bad_val_sss_max, &
2860		"The value of SSS above which a bad value message is "//&
2861		"triggered, if CHECK_BAD_SURFACE_VALS is true.", &
2862	0	units="PPT", default=45.0, scale=US%ppt_to_S)
2863		call get_param(param_file, "MOM", "BAD_VAL_SST_MAX", CS%bad_val_sst_max, &
2864		"The value of SST above which a bad value message is "//&
2865		"triggered, if CHECK_BAD_SURFACE_VALS is true.", &
2866	0	units="deg C", default=45.0, scale=US%degC_to_C)
2867		call get_param(param_file, "MOM", "BAD_VAL_SST_MIN", CS%bad_val_sst_min, &
2868		"The value of SST below which a bad value message is "//&
2869		"triggered, if CHECK_BAD_SURFACE_VALS is true.", &
2870	0	units="deg C", default=-2.1, scale=US%degC_to_C)
2871		call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", CS%bad_val_col_thick, &
2872		"The value of column thickness below which a bad value message is "//&
2873		"triggered, if CHECK_BAD_SURFACE_VALS is true.", &
2874	0	units="m", default=0.0, scale=US%m_to_Z)
2875		endif
2876		call get_param(param_file, "MOM", "DEFAULT_ANSWER_DATE", default_answer_date, &
2877		"This sets the default value for the various _ANSWER_DATE parameters.", &
2878	1	default=99991231)
2879		call get_param(param_file, "MOM", "SURFACE_ANSWER_DATE", CS%answer_date, &
2880		"The vintage of the expressions for the surface properties. Values below "//&
2881		"20190101 recover the answers from the end of 2018, while higher values "//&
2882		"use updated and more robust forms of the same expressions.", &
2883	1	default=default_answer_date, do_not_log=non_Bous)
2884	1	if (non_Bous) CS%answer_date = 99991231
2885
2886		call get_param(param_file, "MOM", "SAVE_INITIAL_CONDS", save_IC, &
2887		"If true, write the initial conditions to a file given "//&
2888	1	"by IC_OUTPUT_FILE.", default=.false.)
2889		call get_param(param_file, "MOM", "IC_OUTPUT_FILE", CS%IC_file, &
2890		"The file into which to write the initial conditions.", &
2891	1	default="MOM_IC")
2892		call get_param(param_file, "MOM", "WRITE_GEOM", write_geom, &
2893		"If =0, never write the geometry and vertical grid files. "//&
2894		"If =1, write the geometry and vertical grid files only for "//&
2895		"a new simulation. If =2, always write the geometry and "//&
2896	1	"vertical grid files. Other values are invalid.", default=1)
2897	1	if (write_geom<0 .or. write_geom>2) call MOM_error(FATAL,"MOM: "//&
2898	0	"WRITE_GEOM must be equal to 0, 1 or 2.")
2899		call get_param(param_file, "MOM", "GEOM_FILE", geom_file, &
2900		"The file into which to write the ocean geometry.", &
2901	1	default="ocean_geometry")
2902		call get_param(param_file, "MOM", "USE_DBCLIENT", CS%use_dbclient, &
2903		"If true, initialize a client to a remote database that can "//&
2904		"be used for online analysis and machine-learning inference.",&
2905	1	default=.false.)
2906
2907		! Check for inconsistent parameter settings.
2908	1	if (CS%use_ALE_algorithm .and. bulkmixedlayer) call MOM_error(FATAL, &
2909	0	"MOM: BULKMIXEDLAYER can not currently be used with the ALE algorithm.")
2910	1	if (CS%use_ALE_algorithm .and. .not.use_temperature) call MOM_error(FATAL, &
2911	0	"MOM: At this time, USE_EOS should be True when using the ALE algorithm.")
2912	1	if (CS%adiabatic .and. use_temperature) call MOM_error(WARNING, &
2913	0	"MOM: ADIABATIC and ENABLE_THERMODYNAMICS both defined is usually unwise.")
2914	1	if (use_EOS .and. .not.use_temperature) call MOM_error(FATAL, &
2915	0	"MOM: ENABLE_THERMODYNAMICS must be defined to use USE_EOS.")
2916	1	if (CS%adiabatic .and. bulkmixedlayer) call MOM_error(FATAL, &
2917	0	"MOM: ADIABATIC and BULKMIXEDLAYER can not both be defined.")
2918	1	if (bulkmixedlayer .and. .not.use_EOS) call MOM_error(FATAL, &
2919		"initialize_MOM: A bulk mixed layer can only be used with T & S as "//&
2920	0	"state variables. Add USE_EOS = True to MOM_input.")
2921
2922	1	use_ice_shelf = .false.
2923	1	if (present(ice_shelf_CSp)) then
2924		call get_param(param_file, "MOM", "ICE_SHELF", use_ice_shelf, &
2925	1	"If true, enables the ice shelf model.", default=.false.)
2926		endif
2927
2928		call get_param(param_file, "MOM", "USE_PARTICLES", CS%use_particles, &
2929	1	"If true, use the particles package.", default=.false.)
2930		call get_param(param_file, "MOM", "USE_UH_PARTICLES", CS%use_uh_particles, &
2931		"If true, use the uh velocity in the particles package.", &
2932	1	default=.false., do_not_log=.not.CS%use_particles)
2933		call get_param(param_file, "MOM", "UH_PARTICLES_BUG", CS%uh_particles_bug, &
2934		"If true, use a bug in which the particles are advected inconsistently"//&
2935		"with the dynamics timestep instead of the tracer timestep.", &
2936	1	default=enable_bugs, do_not_log=.not.CS%use_uh_particles)
2937	1	CS%ensemble_ocean=.false.
2938		call get_param(param_file, "MOM", "ENSEMBLE_OCEAN", CS%ensemble_ocean, &
2939		"If False, The model is being run in serial mode as a single realization. "//&
2940		"If True, The current model realization is part of a larger ensemble "//&
2941		"and at the end of step MOM, we will perform a gather of the ensemble "//&
2942	1	"members for statistical evaluation and/or data assimilation.", default=.false.)
2943
2944	1	call callTree_waypoint("MOM parameters read (initialize_MOM)")
2945
2946		call get_param(param_file, "MOM", "HOMOGENIZE_FORCINGS", CS%homogenize_forcings, &
2947	1	"If True, homogenize the forces and fluxes.", default=.false.)
2948		call get_param(param_file, "MOM", "UPDATE_USTAR",CS%update_ustar, &
2949		"If True, update ustar from homogenized tau when using the "//&
2950		"HOMOGENIZE_FORCINGS option. Note that this will not work "//&
2951		"with a non-zero gustiness factor.", default=.false., &
2952	1	do_not_log=.not.CS%homogenize_forcings)
2953
2954		! Grid rotation test
2955		call get_param(param_file, "MOM", "ROTATE_INDEX", CS%rotate_index, &
2956		"Enable rotation of the horizontal indices.", default=.false., &
2957	1	debuggingParam=.true.)
2958	1	if (CS%rotate_index) then
2959		! TODO: Index rotation currently only works when index rotation does not
2960		! change the MPI rank of each domain. Resolving this will require a
2961		! modification to FMS PE assignment.
2962		! For now, we only permit single-core runs.
2963
2964	0	if (num_PEs() /= 1) &
2965	0	call MOM_error(FATAL, "Index rotation is only supported on one PE.")
2966
2967		! Alternate_first_direction is not permitted with index rotation.
2968		! This feature can be added later in the future if needed.
2969	0	if (CS%alternate_first_direction) &
2970	0	call MOM_error(FATAL, "Alternating_first_direction is not compatible with index rotation.")
2971
2972		call get_param(param_file, "MOM", "INDEX_TURNS", turns, &
2973		"Number of counterclockwise quarter-turn index rotations.", &
2974	0	default=1, debuggingParam=.true.)
2975		else
2976	1	turns = 0
2977		endif
2978
2979		! Set up the model domain and grids.
2980		#ifdef SYMMETRIC_MEMORY_
2981	1	symmetric = .true.
2982		#else
2983		symmetric = .false.
2984		#endif
2985	1	allocate(CS%G_in)
2986	1	G_in => CS%G_in
2987		#ifdef STATIC_MEMORY_
2988		call MOM_domains_init(G_in%domain, param_file, symmetric=symmetric, &
2989		static_memory=.true., NIHALO=NIHALO_, NJHALO=NJHALO_, &
2990		NIGLOBAL=NIGLOBAL_, NJGLOBAL=NJGLOBAL_, NIPROC=NIPROC_, &
2991		NJPROC=NJPROC_, US=US, MOM_dom_unmasked=MOM_dom_unmasked)
2992		#else
2993		call MOM_domains_init(G_in%domain, param_file, symmetric=symmetric, &
2994	1	domain_name="MOM_in", US=US, MOM_dom_unmasked=MOM_dom_unmasked)
2995		#endif
2996
2997		! Copy input grid (G_in) domain to active grid G
2998		! Swap axes for quarter and 3-quarter turns
2999	1	if (CS%rotate_index) then
3000	0	allocate(CS%G)
3001	0	call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, domain_name="MOM_rot")
3002		else
3003	1	CS%G => G_in
3004		endif
3005
3006		! TODO: It is unlikely that test_grid_copy and rotate_index would work at the
3007		! same time. It may be possible to enable both but for now we prevent it.
3008	1	if (test_grid_copy .and. CS%rotate_index) &
3009	0	call MOM_error(FATAL, "Grid cannot be copied during index rotation.")
3010
3011	1	if (test_grid_copy) then ; allocate(G)
3012	1	else ; G => CS%G ; endif
3013
3014	1	call callTree_waypoint("domains initialized (initialize_MOM)")
3015
3016	1	call MOM_debugging_init(param_file)
3017	1	call diag_mediator_infrastructure_init()
3018	1	call MOM_io_init(param_file)
3019
3020		! Create HI and dG on the input index map.
3021		call hor_index_init(G_in%Domain, HI_in, param_file, &
3022	1	local_indexing=.not.global_indexing)
3023	1	call create_dyn_horgrid(dG_in, HI_in, bathymetry_at_vel=bathy_at_vel)
3024	1	call clone_MOM_domain(G_in%Domain, dG_in%Domain)
3025		! Also allocate the input ocean_grid_type type at this point based on the same information.
3026	1	call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel)
3027
3028		! Allocate initialize time-invariant MOM variables.
3029	1	call MOM_initialize_fixed(dG_in, US, OBC_in, param_file)
3030
3031		! Copy the grid metrics and bathymetry to the ocean_grid_type
3032	1	call copy_dyngrid_to_MOM_grid(dG_in, G_in, US)
3033
3034		!$omp target enter data map(to: CS%G_in)
3035		!$omp target enter data map(to: G%dxT, G%dxCu, G%dxCv, G%dxBu)
3036		!$omp target enter data map(to: G%dyT, G%dyCu, G%dyCv, G%dyBu)
3037		!$omp target enter data map(to: G%dx_Cv, G%dy_Cu)
3038		!$omp target enter data map(to: G%IdxT, G%IdxCu, G%IdxCv, G%IdxBu)
3039		!$omp target enter data map(to: G%IdyT, G%IdyCu, G%IdyCv, G%IdyBu)
3040		!$omp target enter data map(to: G%mask2dBu, G%mask2dT)
3041		!$omp target enter data map(to: G%areaT, G%areaCu, G%areaCv)
3042		!$omp target enter data map(to: G%IareaT, G%IareaCu, G%IareaCv, G%IareaBu)
3043		!$omp target enter data map(to: G%bathyT)
3044		!$omp target enter data map(to: G%CoriolisBu, G%Coriolis2Bu)
3045		!$omp target enter data map(to: G%mask2dCu, G%mask2dCv)
3046		!$omp target enter data map(to: G%OBCmaskCu, G%OBCmaskCv)
3047		!$omp target enter data map(to: G%IdxCu_OBCmask, G%IdyCv_OBCmask)
3048		! NOTE: This may be time dependent
3049		!$omp target enter data map(to: G%meanSL)
3050
3051	1	call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)")
3052
3053	1	call verticalGridInit( param_file, CS%GV, US )
3054	1	GV => CS%GV
3055
3056		! This does not work. GV%RLay changes sometime later.
3057		!!!$omp target enter data map(to: GV, GV%Rlay, GV%g_prime)
3058
3059		! Now that the vertical grid has been initialized, rescale parameters that depend on factors
3060		! that are set with the vertical grid to their desired units. This added rescaling step would
3061		! be unnecessary if the vertical grid were initialized earlier in this routine.
3062	1	if (.not.bulkmixedlayer) then
3063	1	CS%Hmix = (US%Z_to_m * GV%m_to_H) * Hmix_z
3064	1	CS%Hmix_UV = (US%Z_to_m * GV%m_to_H) * Hmix_UV_z
3065		endif
3066	1	CS%HFrz = (US%Z_to_m * GV%m_to_H) * HFrz_z
3067
3068		! Shift from using the temporary dynamic grid type to using the final (potentially static)
3069		! and properly rotated ocean-specific grid type and horizontal index type.
3070	1	if (CS%rotate_index) then
3071	0	allocate(HI)
3072	0	call rotate_hor_index(HI_in, turns, HI)
3073		! NOTE: If indices are rotated, then G and G_in must both be initialized separately, and
3074		! the dynamic grid must be created to handle the grid rotation. G%domain has already been
3075		! initialized above.
3076	0	call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel)
3077	0	call create_dyn_horgrid(dG, HI, bathymetry_at_vel=bathy_at_vel)
3078	0	call clone_MOM_domain(G%Domain, dG%Domain)
3079	0	call rotate_dyn_horgrid(dG_in, dG, US, turns)
3080	0	call copy_dyngrid_to_MOM_grid(dG, G, US)
3081
3082	0	if (associated(OBC_in)) then
3083	0	allocate(CS%OBC)
3084	0	call rotate_OBC_config(OBC_in, dG_in, CS%OBC, dG, turns)
3085		endif
3086
3087	0	call destroy_dyn_horgrid(dG)
3088		else
3089		! If not rotated, then G_in and G are the same grid.
3090	1	HI => HI_in
3091	1	G => G_in
3092	1	CS%OBC => OBC_in
3093		endif
3094		! dG_in is retained for now so that it can be used with write_ocean_geometry_file() below.
3095
3096	1	if (is_root_PE()) call check_MOM6_scaling_factors(CS%GV, US)
3097
3098	1	call callTree_waypoint("grids initialized (initialize_MOM)")
3099
3100	1	call MOM_timing_init(CS)
3101
3102	1	call tracer_registry_init(param_file, CS%tracer_Reg)
3103
3104		!$omp target update to(CS)
3105
3106		! Allocate and initialize space for the primary time-varying MOM variables.
3107	1	is = HI%isc ; ie = HI%iec ; js = HI%jsc ; je = HI%jec ; nz = GV%ke
3108	1	isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed
3109	1	IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB
3110	663076	ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0
3111	667651	ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0
3112	657976	ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H
3113	663076	ALLOC_(CS%uh(IsdB:IedB,jsd:jed,nz)) ; CS%uh(:,:,:) = 0.0
3114	667651	ALLOC_(CS%vh(isd:ied,JsdB:JedB,nz)) ; CS%vh(:,:,:) = 0.0
3115		!$omp target enter data map(to: CS%u, CS%v, CS%h, CS%uh, CS%vh)
3116	1	if (use_temperature) then
3117	657976	ALLOC_(CS%T(isd:ied,jsd:jed,nz)) ; CS%T(:,:,:) = 0.0
3118	657976	ALLOC_(CS%S(isd:ied,jsd:jed,nz)) ; CS%S(:,:,:) = 0.0
3119	1	CS%tv%T => CS%T ; CS%tv%S => CS%S
3120	1	if (CS%tv%T_is_conT) then
3121		vd_T = var_desc(name="contemp", units="Celsius", longname="Conservative Temperature", &
3122		cmor_field_name="bigthetao", cmor_longname="Sea Water Conservative Temperature", &
3123	0	conversion=US%C_to_degC)
3124		else
3125		vd_T = var_desc(name="temp", units="degC", longname="Potential Temperature", &
3126		cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", &
3127	6	conversion=US%C_to_degC)
3128		endif
3129	1	if (CS%tv%S_is_absS) then
3130		vd_S = var_desc(name="abssalt", units="g kg-1", longname="Absolute Salinity", &
3131		cmor_field_name="absso", cmor_longname="Sea Water Absolute Salinity", &
3132	0	conversion=US%S_to_ppt)
3133		else
3134		vd_S = var_desc(name="salt", units="psu", longname="Salinity", &
3135		cmor_field_name="so", cmor_longname="Sea Water Salinity", &
3136	6	conversion=US%S_to_ppt)
3137		endif
3138
3139	1	if (advect_TS) then
3140	1	S_flux_units = get_tr_flux_units(GV, "psu") ! Could change to "kg m-2 s-1"?
3141	1	conv2watt = GV%H_to_kg_m2 * US%Q_to_J_kg*CS%tv%C_p
3142	1	if (GV%Boussinesq) then
3143	1	conv2salt = US%S_to_pptGV%H_to_m ! Could change to US%S_to_pptGV%H_to_kg_m2 * 0.001?
3144		else
3145	0	conv2salt = US%S_to_ppt*GV%H_to_kg_m2
3146		endif
3147		call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, &
3148		tr_desc=vd_T, registry_diags=.true., conc_scale=US%C_to_degC, &
3149		flux_nameroot='T', flux_units='W', flux_longname='Heat', &
3150		net_surfflux_name='KPP_QminusSW', NLT_budget_name='KPP_NLT_temp_budget', &
3151		net_surfflux_longname='Net temperature flux ignoring short-wave, as used by [CVMix] KPP', &
3152		flux_scale=conv2watt, convergence_units='W m-2', &
3153		convergence_scale=conv2watt, CMOR_tendprefix="opottemp", &
3154	1	diag_form=2, underflow_conc=temp_underflow, Tr_out=CS%tv%tr_T)
3155		call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, &
3156		tr_desc=vd_S, registry_diags=.true., conc_scale=US%S_to_ppt, &
3157		flux_nameroot='S', flux_units=S_flux_units, flux_longname='Salt', &
3158		net_surfflux_name='KPP_netSalt', NLT_budget_name='KPP_NLT_saln_budget', &
3159		flux_scale=conv2salt, convergence_units='kg m-2 s-1', &
3160		convergence_scale=0.001US%S_to_pptGV%H_to_kg_m2, CMOR_tendprefix="osalt", &
3161	1	diag_form=2, underflow_conc=salin_underflow, Tr_out=CS%tv%tr_S)
3162		endif
3163		endif
3164
3165	8773	if (use_p_surf_in_EOS) allocate(CS%tv%p_surf(isd:ied,jsd:jed), source=0.0)
3166	1	if (use_frazil) then
3167	8773	allocate(CS%tv%frazil(isd:ied,jsd:jed), source=0.0)
3168	1	CS%tv%frazil_was_reset = .true.
3169		endif
3170	1	if (bound_salinity) allocate(CS%tv%salt_deficit(isd:ied,jsd:jed), source=0.0)
3171
3172	8773	allocate(CS%Hml(isd:ied,jsd:jed), source=0.0)
3173
3174	1	if (bulkmixedlayer) then
3175	0	GV%nkml = nkml ; GV%nk_rho_varies = nkml + nkbl
3176		else
3177	1	GV%nkml = 0 ; GV%nk_rho_varies = 0
3178		endif
3179	1	if (CS%use_ALE_algorithm) then
3180	1	call get_param(param_file, "MOM", "NK_RHO_VARIES", GV%nk_rho_varies, default=0) ! Will default to nz later... -AJA
3181		endif
3182
3183	663076	ALLOC_(CS%uhtr(IsdB:IedB,jsd:jed,nz)) ; CS%uhtr(:,:,:) = 0.0
3184	667651	ALLOC_(CS%vhtr(isd:ied,JsdB:JedB,nz)) ; CS%vhtr(:,:,:) = 0.0
3185		!$omp target enter data map(to: CS%uhtr, CS%vhtr)
3186	1	CS%t_dyn_rel_adv = 0.0 ; CS%t_dyn_rel_thermo = 0.0 ; CS%t_dyn_rel_diag = 0.0
3187	1	CS%n_dyn_steps_in_adv = 0
3188
3189	1	allocate(CS%ADp)
3190		!$omp target enter data map(alloc: CS%ADp)
3191
3192	1	if (debug_truncations) then
3193	0	allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz), source=0.0)
3194	0	allocate(CS%v_prev(isd:ied,JsdB:JedB,nz), source=0.0)
3195	0	MOM_internal_state%u_prev => CS%u_prev
3196	0	MOM_internal_state%v_prev => CS%v_prev
3197	0	call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz)
3198	0	call safe_alloc_ptr(CS%ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz)
3199	0	if (.not.CS%adiabatic) then
3200	0	call safe_alloc_ptr(CS%ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz)
3201	0	call safe_alloc_ptr(CS%ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz)
3202		endif
3203		endif
3204
3205	1	MOM_internal_state%u => CS%u ; MOM_internal_state%v => CS%v
3206	1	MOM_internal_state%h => CS%h
3207	1	MOM_internal_state%uh => CS%uh ; MOM_internal_state%vh => CS%vh
3208	1	if (use_temperature) then
3209	1	MOM_internal_state%T => CS%T ; MOM_internal_state%S => CS%S
3210		endif
3211
3212	1	CS%CDp%uh => CS%uh ; CS%CDp%vh => CS%vh
3213
3214	1	if (CS%interp_p_surf) allocate(CS%p_surf_prev(isd:ied,jsd:jed), source=0.0)
3215
3216	8773	ALLOC_(CS%ssh_rint(isd:ied,jsd:jed)) ; CS%ssh_rint(:,:) = 0.0
3217		!$omp target enter data map(to: CS%ssh_rint)
3218	8773	ALLOC_(CS%ave_ssh_ibc(isd:ied,jsd:jed)) ; CS%ave_ssh_ibc(:,:) = 0.0
3219		!$omp target enter data map(to: CS%ave_ssh_ibc)
3220	8773	ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 ! -G%Z_ref
3221		!$omp target enter data map(to: CS%eta_av_bc)
3222	1	CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0
3223
3224		!allocate porous topography variables
3225	663076	allocate(CS%pbv%por_face_areaU(IsdB:IedB,jsd:jed,nz), source=1.0)
3226	667651	allocate(CS%pbv%por_face_areaV(isd:ied,JsdB:JedB,nz), source=1.0)
3227	671917	allocate(CS%pbv%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1), source=1.0)
3228	676553	allocate(CS%pbv%por_layer_widthV(isd:ied,JsdB:JedB,nz+1), source=1.0)
3229		!$omp target enter data map(to: CS%pbv)
3230		!$omp target enter data map(to: CS%pbv%por_face_areaU, CS%pbv%por_face_areaV)
3231		!$omp target enter data map(to: CS%pbv%por_layer_widthU, CS%pbv%por_layer_widthV)
3232
3233		! Use the Wright equation of state by default, unless otherwise specified
3234		! Note: this line and the following block ought to be in a separate
3235		! initialization routine for tv.
3236	1	if (use_EOS) then
3237	1	allocate(CS%tv%eqn_of_state)
3238	1	call EOS_init(param_file, CS%tv%eqn_of_state, US, use_conT_absS)
3239		endif
3240	1	if (use_temperature) then
3241	8773	allocate(CS%tv%TempxPmE(isd:ied,jsd:jed), source=0.0)
3242	1	if (use_geothermal) then
3243	8773	allocate(CS%tv%internal_heat(isd:ied,jsd:jed), source=0.0)
3244		endif
3245		endif
3246	1	call callTree_waypoint("state variables allocated (initialize_MOM)")
3247
3248		! Set the fields that are needed for bitwise identical restarting
3249		! the time stepping scheme.
3250	1	call restart_init(param_file, CS%restart_CS)
3251	1	restart_CSp => CS%restart_CS
3252
3253	1	call set_restart_fields(GV, US, param_file, CS, restart_CSp)
3254	1	if (CS%split .and. CS%use_alt_split) then
3255		call register_restarts_dyn_split_RK2b(HI, GV, US, param_file, &
3256	0	CS%dyn_split_RK2b_CSp, restart_CSp, CS%uh, CS%vh)
3257	1	elseif (CS%split) then
3258	1	allocate(CS%dyn_split_RK2_CSp)
3259		!$omp target enter data map(alloc: CS%dyn_split_RK2_CSp)
3260		call register_restarts_dyn_split_RK2(HI, GV, US, param_file, &
3261	1	CS%dyn_split_RK2_CSp, restart_CSp, CS%uh, CS%vh)
3262	0	elseif (CS%use_RK2) then
3263		call register_restarts_dyn_unsplit_RK2(HI, GV, param_file, &
3264	0	CS%dyn_unsplit_RK2_CSp)
3265		else
3266		call register_restarts_dyn_unsplit(HI, GV, param_file, &
3267	0	CS%dyn_unsplit_CSp)
3268		endif
3269
3270		! This subroutine calls user-specified tracer registration routines.
3271		! Additional calls can be added to MOM_tracer_flow_control.F90.
3272		call call_tracer_register(G, GV, US, param_file, CS%tracer_flow_CSp, &
3273	1	CS%tracer_Reg, restart_CSp)
3274
3275	1	call MEKE_alloc_register_restart(HI, US, param_file, CS%MEKE, restart_CSp)
3276
3277	1	allocate(CS%visc)
3278		!$omp target enter data map(alloc: CS%visc)
3279	1	call set_visc_register_restarts(HI, G, GV, US, param_file, CS%visc, restart_CSp, use_ice_shelf)
3280
3281		call mixedlayer_restrat_register_restarts(HI, GV, US, param_file, &
3282	1	CS%mixedlayer_restrat_CSp, restart_CSp)
3283
3284	1	if (associated(CS%OBC)) then
3285		! This call initializes the relevant vertical remapping structures.
3286	0	call open_boundary_setup_vert(GV, US, CS%OBC)
3287
3288		! Set up remaining information about open boundary conditions that is needed for OBCs.
3289		! Package specific changes to OBCs occur here.
3290	0	call call_OBC_register(G, GV, US, param_file, CS%update_OBC_CSp, CS%OBC, CS%tracer_Reg)
3291
3292		! This is the equivalent to 2 calls to register_segment_tracer (per segment), which
3293		! could occur with the call to update_OBC_data or after the main initialization.
3294	0	if (use_temperature) &
3295	0	call register_temp_salt_segments(GV, US, CS%OBC, CS%tracer_Reg, param_file)
3296		! This is the equivalent call to register_temp_salt_segments for external tracers with OBC
3297	0	call call_tracer_register_obc_segments(GV, param_file, CS%tracer_flow_CSp, CS%tracer_Reg, CS%OBC)
3298
3299		! Set up the thickness reservoirs if using them.
3300	0	if (CS%OBC%use_h_res) &
3301	0	call segment_thickness_reservoir_init(GV, US, CS%OBC, param_file)
3302
3303		! This needs the number of tracers and to have called any code that sets whether
3304		! reservoirs are used.
3305		call open_boundary_register_restarts(HI, GV, US, CS%OBC, CS%tracer_Reg, &
3306	0	param_file, restart_CSp, use_temperature)
3307
3308		! This call allocates the arrays on the segments for open boundary data, but it must occur
3309		! after any calls to call_tracer_register_obc_segments.
3310	0	call initialize_segment_data(GV, US, CS%OBC, param_file, turns, use_temperature)
3311
3312	0	if (CS%debug_OBCs) call write_OBC_info(CS%OBC, G, GV, US)
3313		endif
3314
3315	1	if (present(waves_CSp)) then
3316	1	call waves_register_restarts(waves_CSp, HI, GV, US, param_file, restart_CSp)
3317		endif
3318
3319	1	if (use_temperature) then
3320	1	call stoch_EOS_register_restarts(HI, param_file, CS%stoch_eos_CS, restart_CSp)
3321		endif
3322
3323	1	if (.not. CS%adiabatic) then
3324	1	call register_diabatic_restarts(G, GV, US, param_file, CS%int_tide_CSp, restart_CSp, CS%diabatic_CSp)
3325		endif
3326
3327	1	call callTree_waypoint("restart registration complete (initialize_MOM)")
3328	1	call restart_registry_lock(restart_CSp)
3329
3330		! Write out all of the grid data used by this run.
3331	1	new_sim = determine_is_new_run(dirs%input_filename, dirs%restart_input_dir, G_in, restart_CSp)
3332	1	write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. new_sim))
3333	1	if (write_geom_files) then
3334	0	if (associated(MOM_dom_unmasked)) then
3335		call hor_index_init(MOM_dom_unmasked, HI_in_unmasked, param_file, &
3336	0	local_indexing=.not.global_indexing)
3337	0	call create_dyn_horgrid(dG_unmasked_in, HI_in_unmasked, bathymetry_at_vel=bathy_at_vel)
3338	0	call clone_MOM_domain(MOM_dom_unmasked, dG_unmasked_in%Domain)
3339	0	call MOM_initialize_fixed(dG_unmasked_in, US, OBC_in, param_file)
3340	0	call write_ocean_geometry_file(dG_unmasked_in, param_file, dirs%output_directory, US=US, geom_file=geom_file)
3341	0	call deallocate_MOM_domain(MOM_dom_unmasked)
3342	0	call destroy_dyn_horgrid(dG_unmasked_in)
3343		else
3344	0	call write_ocean_geometry_file(dG_in, param_file, dirs%output_directory, US=US, geom_file=geom_file)
3345		endif
3346		endif
3347	1	call destroy_dyn_horgrid(dG_in)
3348
3349		! Initialize dynamically evolving fields, perhaps from restart files.
3350	1	call cpu_clock_begin(id_clock_MOM_init)
3351	1	call MOM_initialize_coord(GV, US, param_file, CS%tv, G%max_depth)
3352	1	call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)")
3353
3354	1	if (CS%use_ALE_algorithm) then
3355	1	call ALE_init(param_file, G, GV, US, G%max_depth, CS%ALE_CSp)
3356	1	call callTree_waypoint("returned from ALE_init() (initialize_MOM)")
3357		endif
3358
3359		! Set a few remaining fields that are specific to the ocean grid type.
3360	1	if (CS%rotate_index) then
3361	0	call set_first_direction(G, modulo(first_direction + turns, 2))
3362		else
3363	1	call set_first_direction(G, modulo(first_direction, 2))
3364		endif
3365		! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
3366	1	if (CS%debug .or. G%symmetric) then
3367	1	call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.)
3368	0	else ; G%Domain_aux => G%Domain ; endif
3369		! Copy common variables from the vertical grid to the horizontal grid.
3370		! Consider removing this later?
3371	1	G%ke = GV%ke
3372
3373	1	if (use_ice_shelf) then
3374	0	point_calving = .false. ; if (present(calve_ice_shelf_bergs)) point_calving = calve_ice_shelf_bergs
3375		endif
3376
3377	1	if (CS%rotate_index) then
3378	0	G_in%ke = GV%ke
3379
3380		! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
3381	0	if (CS%debug .or. G_in%symmetric) then
3382	0	call clone_MOM_domain(G_in%Domain, G_in%Domain_aux, symmetric=.false.)
3383	0	else ; G_in%Domain_aux => G_in%Domain ; endif
3384
3385	0	allocate(u_in(G_in%IsdB:G_in%IedB, G_in%jsd:G_in%jed, nz), source=0.0)
3386	0	allocate(v_in(G_in%isd:G_in%ied, G_in%JsdB:G_in%JedB, nz), source=0.0)
3387	0	allocate(h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=GV%Angstrom_H)
3388
3389	0	if (use_temperature) then
3390	0	allocate(T_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=0.0)
3391	0	allocate(S_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=0.0)
3392
3393	0	CS%tv%T => T_in
3394	0	CS%tv%S => S_in
3395
3396	0	if (associated(CS%OBC)) then
3397		! Log this parameter in MOM_initialize_state
3398		call get_param(param_file, "MOM", "OBC_RESERVOIR_INIT_BUG", OBC_reservoir_init_bug, &
3399		"If true, set the OBC tracer reservoirs at the startup of a new run from the "//&
3400		"interior tracer concentrations regardless of properties that may be explicitly "//&
3401	0	"specified for the reservoir concentrations.", default=enable_bugs, do_not_log=.true.)
3402	0	if (OBC_reservoir_init_bug .and. (allocated(CS%OBC%tres_x) .or. allocated(CS%OBC%tres_y))) &
3403	0	call MOM_error(FATAL, "OBC_RESERVOIR_INIT_BUG can not be set to true with grid rotation.")
3404		endif
3405		endif
3406
3407	0	if (use_ice_shelf) then
3408		! These arrays are not initialized in most solo cases, but are needed
3409		! when using an ice shelf. Passing the ice shelf diagnostics CS from MOM
3410		! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf
3411		call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr, &
3412	0	Time_init, dirs%output_directory, calve_ice_shelf_bergs=point_calving)
3413	0	allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0)
3414	0	allocate(mass_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0)
3415	0	allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0)
3416	0	allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0)
3417	0	call ice_shelf_query(ice_shelf_CSp, G, CS%frac_shelf_h, CS%mass_shelf)
3418		! MOM_initialize_state is using the unrotated metric
3419	0	call rotate_array(CS%frac_shelf_h, -turns, frac_shelf_in)
3420	0	call rotate_array(CS%mass_shelf, -turns, mass_shelf_in)
3421		call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, &
3422		param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, &
3423		sponge_in_CSp, ALE_sponge_in_CSp, oda_incupd_in_CSp, OBC_in, Time_in, &
3424	0	frac_shelf_h=frac_shelf_in, mass_shelf=mass_shelf_in)
3425		else
3426		call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, &
3427		param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, &
3428	0	sponge_in_CSp, ALE_sponge_in_CSp, oda_incupd_in_CSp, OBC_in, Time_in)
3429		endif
3430
3431	0	if (use_temperature) then
3432	0	CS%tv%T => CS%T
3433	0	CS%tv%S => CS%S
3434		endif
3435
3436		! Reset the first direction if it was found in a restart file
3437	0	if (CS%first_dir_restart > -1.0) then
3438	0	call set_first_direction(G, modulo(NINT(CS%first_dir_restart) + turns, 2))
3439		else
3440	0	CS%first_dir_restart = real(modulo(first_direction, 2))
3441		endif
3442
3443		call rotate_initial_state(u_in, v_in, h_in, T_in, S_in, use_temperature, &
3444	0	turns, CS%u, CS%v, CS%h, CS%T, CS%S)
3445
3446	0	if (associated(sponge_in_CSp)) then
3447		! TODO: Implementation and testing of non-ALE sponge rotation
3448	0	call MOM_error(FATAL, "Index rotation of non-ALE sponge is not yet implemented.")
3449		endif
3450
3451	0	if (associated(ALE_sponge_in_CSp)) then
3452	0	call rotate_ALE_sponge(ALE_sponge_in_CSp, G_in, CS%ALE_sponge_CSp, G, GV, US, turns, param_file)
3453	0	call update_ALE_sponge_field(CS%ALE_sponge_CSp, T_in, G, GV, CS%T)
3454	0	call update_ALE_sponge_field(CS%ALE_sponge_CSp, S_in, G, GV, CS%S)
3455		endif
3456
3457		! Deallocate the unrotated arrays and types that are no longer needed.
3458	0	deallocate(u_in)
3459	0	deallocate(v_in)
3460	0	deallocate(h_in)
3461	0	if (use_temperature) then
3462	0	deallocate(T_in)
3463	0	deallocate(S_in)
3464		endif
3465	0	if (use_ice_shelf) deallocate(frac_shelf_in, mass_shelf_in)
3466	0	if (associated(OBC_in)) call open_boundary_end(OBC_in)
3467
3468		else ! The model is being run without grid rotation. This is true of all production runs.
3469	1	if (use_ice_shelf) then
3470		call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr, Time_init, &
3471	0	dirs%output_directory, calve_ice_shelf_bergs=point_calving)
3472	0	allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0)
3473	0	allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0)
3474	0	call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf)
3475		call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, &
3476		param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, &
3477		CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp, CS%OBC, Time_in, &
3478	0	frac_shelf_h=CS%frac_shelf_h, mass_shelf=CS%mass_shelf, OBC_for_bug=CS%OBC)
3479		else
3480		call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, &
3481		param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, &
3482	1	CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp, CS%OBC, Time_in, OBC_for_bug=CS%OBC)
3483		endif
3484
3485		! Reset the first direction if it was found in a restart file.
3486	1	if (CS%first_dir_restart > -1.0) then
3487	0	call set_first_direction(G, NINT(CS%first_dir_restart))
3488		else
3489	1	CS%first_dir_restart = real(modulo(first_direction, 2))
3490		endif
3491		endif
3492
3493		! Allocate any derived densities or other equation of state derived fields.
3494	1	if (.not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then
3495	0	allocate(CS%tv%SpV_avg(isd:ied,jsd:jed,nz), source=0.0)
3496	0	CS%tv%valid_SpV_halo = -1 ! This array does not yet have any valid data.
3497		endif
3498
3499	1	if (associated(CS%OBC)) then
3500	0	call MOM_initialize_OBCs(CS%h, CS%tv, CS%OBC, Time, G, GV, US, param_file, restart_CSp, CS%tracer_Reg)
3501
3502	0	if (use_temperature) then
3503	0	call pass_var(CS%tv%T, G%Domain, complete=.false.)
3504	0	call pass_var(CS%tv%S, G%Domain, complete=.true.)
3505		endif
3506	0	call calc_derived_thermo(CS%tv, CS%h, G, GV, US)
3507
3508		! Call this during initialization to fill boundary arrays from fixed values
3509	0	call read_OBC_segment_data(G, GV, US, CS%OBC, CS%tv, CS%h, Time)
3510	0	call update_OBC_segment_data(G, GV, US, CS%OBC, CS%h, Time)
3511	0	call initialize_OBC_segment_reservoirs(GV, CS%OBC)
3512		endif
3513
3514	1	if (use_ice_shelf .and. CS%debug) then
3515	0	call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0)
3516	0	call hchksum(CS%mass_shelf, "MOM:mass_shelf", G%HI, haloshift=0, unscale=US%RZ_to_kg_m2)
3517		endif
3518
3519	1	call cpu_clock_end(id_clock_MOM_init)
3520	1	call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)")
3521
3522		! From this point, there may be pointers being set, so the final grid type
3523		! that will persist throughout the run has to be used.
3524
3525	1	if (test_grid_copy) then
3526		! Copy the data from the temporary grid to the dyn_hor_grid to CS%G.
3527	0	call create_dyn_horgrid(test_dG, G%HI)
3528	0	call clone_MOM_domain(G%Domain, test_dG%Domain)
3529
3530	0	call clone_MOM_domain(G%Domain, CS%G%Domain)
3531	0	call MOM_grid_init(CS%G, param_file, US)
3532
3533	0	call copy_MOM_grid_to_dyngrid(G, test_dG, US)
3534	0	call copy_dyngrid_to_MOM_grid(test_dG, CS%G, US)
3535
3536	0	call destroy_dyn_horgrid(test_dG)
3537	0	call MOM_grid_end(G) ; deallocate(G)
3538
3539	0	G => CS%G
3540	0	if (CS%debug .or. CS%G%symmetric) then
3541	0	call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.)
3542	0	else ; CS%G%Domain_aux => CS%G%Domain ; endif
3543	0	G%ke = GV%ke
3544		endif
3545
3546		! At this point, all user-modified initialization code has been called. The
3547		! remainder of this subroutine is controlled by the parameters that have
3548		! have already been set.
3549
3550	1	if (ALE_remap_init_conds(CS%ALE_CSp) .and. .not. query_initialized(CS%h,"h",restart_CSp)) then
3551		! This block is controlled by the ALE parameter REMAP_AFTER_INITIALIZATION.
3552		! \todo This block exists for legacy reasons and we should phase it out of all examples. !###
3553	1	if (CS%debug) then
3554	0	call uvchksum("Pre ALE adjust init cond [uv]", CS%u, CS%v, G%HI, haloshift=1, unscale=US%L_T_to_m_s)
3555	0	call hchksum(CS%h,"Pre ALE adjust init cond h", G%HI, haloshift=1, unscale=GV%H_to_MKS)
3556		endif
3557	1	call callTree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)")
3558	1	call adjustGridForIntegrity(CS%ALE_CSp, G, GV, CS%h )
3559	1	if (allocated(CS%tv%SpV_avg)) call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=1)
3560	1	call pre_ALE_adjustments(G, GV, US, CS%h, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%u, CS%v)
3561
3562	1	call callTree_waypoint("Calling ALE_regrid() to remap initial conditions (initialize_MOM)")
3563	657976	allocate(h_new(isd:ied, jsd:jed, nz), source=0.0)
3564	666749	allocate(dzRegrid(isd:ied, jsd:jed, nz+1), source=0.0)
3565	657976	allocate(PCM_cell(isd:ied, jsd:jed, nz), source=.false.)
3566	663076	allocate(h_old_u(IsdB:IedB, jsd:jed, nz), source=0.0)
3567	663076	allocate(h_new_u(IsdB:IedB, jsd:jed, nz), source=0.0)
3568	667651	allocate(h_old_v(isd:ied, JsdB:JedB, nz), source=0.0)
3569	667651	allocate(h_new_v(isd:ied, JsdB:JedB, nz), source=0.0)
3570	1	if (use_ice_shelf) then
3571	0	call ALE_regrid(G, GV, US, CS%h, h_new, dzRegrid, CS%tv, CS%ALE_CSp, CS%frac_shelf_h, PCM_cell)
3572		else
3573	1	call ALE_regrid(G, GV, US, CS%h, h_new, dzRegrid, CS%tv, CS%ALE_CSp, PCM_cell=PCM_cell)
3574		endif
3575
3576	1	if (callTree_showQuery()) call callTree_waypoint("new grid generated")
3577		! Remap all variables from the old grid h onto the new grid h_new
3578	1	call ALE_remap_tracers(CS%ALE_CSp, G, GV, CS%h, h_new, CS%tracer_Reg, CS%debug, PCM_cell=PCM_cell)
3579
3580		! Determine the old and new grid thicknesses at velocity points.
3581	1	call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, CS%h, h_old_u, h_old_v, CS%OBC, debug=CS%debug)
3582	1	if (CS%remap_uv_using_old_alg) then
3583	0	call ALE_remap_set_h_vel_via_dz(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, CS%h, dzRegrid, CS%debug)
3584		else
3585	1	call ALE_remap_set_h_vel(CS%ALE_CSp, G, GV, h_new, h_new_u, h_new_v, CS%OBC, debug=CS%debug)
3586		endif
3587
3588		! Remap the velocity components.
3589	1	call ALE_remap_velocities(CS%ALE_CSp, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, CS%u, CS%v, CS%debug)
3590
3591	1	if (allocated(CS%tv%SpV_avg)) CS%tv%valid_SpV_halo = -1 ! Record that SpV_avg is no longer valid.
3592
3593		! Replace the old grid with new one. All remapping must be done at this point.
3594		!$OMP parallel do default(shared)
3595	572026	do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1
3596	571950	CS%h(i,j,k) = h_new(i,j,k)
3597		enddo ; enddo ; enddo
3598
3599	1	deallocate(h_new, dzRegrid, PCM_cell, h_old_u, h_new_u, h_old_v, h_new_v)
3600
3601	1	call cpu_clock_begin(id_clock_pass_init)
3602	1	call create_group_pass(tmp_pass_uv_T_S_h, CS%u, CS%v, G%Domain)
3603	1	if (use_temperature) then
3604	1	call create_group_pass(tmp_pass_uv_T_S_h, CS%tv%T, G%Domain)
3605	1	call create_group_pass(tmp_pass_uv_T_S_h, CS%tv%S, G%Domain)
3606		endif
3607	1	call create_group_pass(tmp_pass_uv_T_S_h, CS%h, G%Domain)
3608	1	call do_group_pass(tmp_pass_uv_T_S_h, G%Domain)
3609	1	call cpu_clock_end(id_clock_pass_init)
3610
3611	1	if (CS%debug) then
3612	0	call uvchksum("Post ALE adjust init cond [uv]", CS%u, CS%v, G%HI, haloshift=1, unscale=US%L_T_to_m_s)
3613	0	call hchksum(CS%h, "Post ALE adjust init cond h", G%HI, haloshift=2, unscale=GV%H_to_MKS)
3614	0	if (use_temperature) then
3615	0	call hchksum(CS%tv%T, "Post ALE adjust init cond T", G%HI, haloshift=2, unscale=US%C_to_degC)
3616	0	call hchksum(CS%tv%S, "Post ALE adjust init cond S", G%HI, haloshift=2, unscale=US%S_to_ppt)
3617		endif
3618		endif
3619		endif
3620	1	if ( CS%use_ALE_algorithm ) then
3621	1	call ALE_set_extrap_boundaries (param_file, CS%ALE_CSp)
3622	1	call callTree_waypoint("returned from ALE_init() (initialize_MOM)")
3623	1	call ALE_updateVerticalGridType( CS%ALE_CSp, GV )
3624		endif
3625		! The basic state variables have now been fully initialized, so update their halos and
3626		! calculate any derived thermodynmics quantities.
3627
3628		!--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM
3629	1	call cpu_clock_begin(id_clock_pass_init)
3630	1	dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo)
3631	1	call create_group_pass(pass_uv_T_S_h, CS%u, CS%v, G%Domain, halo=dynamics_stencil)
3632	1	if (use_temperature) then
3633	1	call create_group_pass(pass_uv_T_S_h, CS%tv%T, G%Domain, halo=dynamics_stencil)
3634	1	call create_group_pass(pass_uv_T_S_h, CS%tv%S, G%Domain, halo=dynamics_stencil)
3635		endif
3636	1	call create_group_pass(pass_uv_T_S_h, CS%h, G%Domain, halo=dynamics_stencil)
3637
3638	1	call do_group_pass(pass_uv_T_S_h, G%Domain)
3639	1	if (associated(CS%tv%p_surf)) call pass_var(CS%tv%p_surf, G%Domain, halo=dynamics_stencil)
3640	1	call cpu_clock_end(id_clock_pass_init)
3641
3642		! Update derived thermodynamic quantities.
3643	1	if (allocated(CS%tv%SpV_avg)) then
3644	0	call calc_derived_thermo(CS%tv, CS%h, G, GV, US, halo=dynamics_stencil, debug=CS%debug)
3645		endif
3646
3647		! XXX: Where to put this??
3648		! XXX: G transfer should possibly also be here.
3649
3650		!$omp target enter data map(to: GV, GV%Rlay, GV%g_prime)
3651
3652	1	diag => CS%diag
3653		! Initialize the diag mediator.
3654	1	call diag_mediator_init(G, GV, US, GV%ke, param_file, diag, doc_file_dir=dirs%output_directory)
3655	1	if (present(diag_ptr)) diag_ptr => CS%diag
3656
3657		! Initialize the diagnostics masks for native arrays.
3658		! This step has to be done after call to MOM_initialize_state
3659		! and before MOM_diagnostics_init
3660	1	call diag_masks_set(G, GV%ke, diag)
3661
3662		! Set up pointers within diag mediator control structure,
3663		! this needs to occur _after_ CS%h etc. have been allocated.
3664	1	call diag_set_state_ptrs(CS%h, CS%tv, diag)
3665
3666		! This call sets up the diagnostic axes. These are needed,
3667		! e.g. to generate the target grids below.
3668	1	call set_axes_info(G, GV, US, param_file, diag)
3669
3670		! Whenever thickness/T/S changes let the diag manager know, target grids
3671		! for vertical remapping may need to be regenerated. In non-Boussinesq mode,
3672		! calc_derived_thermo needs to be called before diag_update_remap_grids.
3673	1	call diag_update_remap_grids(diag)
3674
3675		! Setup the diagnostic grid storage types
3676	1	call diag_grid_storage_init(CS%diag_pre_sync, G, GV, diag)
3677	1	call diag_grid_storage_init(CS%diag_pre_dyn, G, GV, diag)
3678
3679		! Calculate masks for diagnostics arrays in non-native coordinates
3680		! This step has to be done after set_axes_info() because the axes needed
3681		! to be configured, and after diag_update_remap_grids() because the grids
3682		! must be defined.
3683	1	call set_masks_for_axes(G, diag)
3684
3685		! Register the volume cell measure (must be one of first diagnostics)
3686	1	call register_cell_measure(G, CS%diag, Time)
3687
3688	1	call cpu_clock_begin(id_clock_MOM_init)
3689		! Diagnose static fields AND associate areas/volumes with axes
3690	1	call write_static_fields(G, GV, US, CS%tv, CS%diag)
3691	1	call callTree_waypoint("static fields written (initialize_MOM)")
3692
3693	1	if (CS%use_ALE_algorithm) then
3694	1	call ALE_writeCoordinateFile( CS%ALE_CSp, GV, dirs%output_directory )
3695	1	call callTree_waypoint("ALE initialized (initialize_MOM)")
3696	0	elseif (write_geom_files) then
3697	0	call write_vertgrid_file(GV, US, param_file, dirs%output_directory)
3698		endif
3699	1	call cpu_clock_end(id_clock_MOM_init)
3700
3701	1	if (CS%use_dbclient) call database_comms_init(param_file, CS%dbcomms_CS)
3702		CS%useMEKE = MEKE_init(Time, G, GV, US, param_file, diag, CS%dbcomms_CS, CS%MEKE_CSp, CS%MEKE, &
3703	1	restart_CSp, CS%MEKE_in_dynamics)
3704
3705	1	allocate(CS%VarMix)
3706		!$omp target enter data map(alloc: CS%VarMix)
3707	1	call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix)
3708
3709	1	allocate(CS%set_visc_CSp)
3710		!$omp target enter data map(alloc: CS%set_visc_CSp)
3711	1	call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC)
3712
3713	1	call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp)
3714	1	if (CS%interface_filter) &
3715	0	call interface_filter_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%interface_filter_CSp)
3716
3717	1	new_sim = is_new_run(restart_CSp)
3718	1	if (use_temperature) then
3719	1	CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS%stoch_eos_CS, restart_CSp)
3720		else
3721	0	CS%use_stochastic_EOS = .false.
3722		endif
3723
3724	1	if (CS%use_porbar) &
3725	0	call porous_barriers_init(Time, GV, US, param_file, diag, CS%por_bar_CS)
3726
3727	1	if (CS%split) then
3728	8773	allocate(eta(SZI_(G),SZJ_(G)), source=0.0)
3729	1	if (CS%use_alt_split) then
3730		call initialize_dyn_split_RK2b(CS%u, CS%v, CS%h, CS%tv, CS%uh, CS%vh, eta, Time, &
3731		G, GV, US, param_file, diag, CS%dyn_split_RK2b_CSp, CS%HA_CSp, restart_CSp, &
3732		CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, &
3733		CS%thickness_diffuse_CSp, CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, &
3734		CS%visc, dirs, CS%ntrunc, CS%pbv, calc_dtbt=calc_dtbt, &
3735	0	cont_stencil=CS%cont_stencil, dyn_h_stencil=CS%dyn_h_stencil)
3736		else
3737		call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%tv, CS%uh, CS%vh, eta, Time, &
3738		G, GV, US, param_file, diag, CS%dyn_split_RK2_CSp, CS%HA_CSp, restart_CSp, &
3739		CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, &
3740		CS%thickness_diffuse_CSp, CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, &
3741		CS%visc, dirs, CS%ntrunc, CS%pbv, calc_dtbt=calc_dtbt, &
3742	1	cont_stencil=CS%cont_stencil, dyn_h_stencil=CS%dyn_h_stencil)
3743		endif
3744	1	if (CS%dtbt_reset_period > 0.0) then
3745	1	CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period, unscale=US%T_to_s)
3746		! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval.
3747		CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * &
3748	1	((Time - Time_init) / CS%dtbt_reset_interval)
3749	1	if ((CS%dtbt_reset_time > Time) .and. calc_dtbt) then
3750		! Back up dtbt_reset_time one interval to force dtbt to be calculated,
3751		! because the restart was not aligned with the interval to recalculate
3752		! dtbt, and dtbt was not read from a restart file.
3753	0	CS%dtbt_reset_time = CS%dtbt_reset_time - CS%dtbt_reset_interval
3754		endif
3755		endif
3756	0	elseif (CS%use_RK2) then
3757		call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, &
3758		US, param_file, diag, CS%dyn_unsplit_RK2_CSp, &
3759		CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, &
3760		CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, &
3761	0	CS%ntrunc, cont_stencil=CS%cont_stencil, dyn_h_stencil=CS%dyn_h_stencil)
3762		else
3763		call initialize_dyn_unsplit(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, &
3764		US, param_file, diag, CS%dyn_unsplit_CSp, &
3765		CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, &
3766		CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, &
3767	0	CS%ntrunc, cont_stencil=CS%cont_stencil, dyn_h_stencil=CS%dyn_h_stencil)
3768		endif
3769	1	CS%dyn_h_stencil = max(2, CS%dyn_h_stencil)
3770
3771		!Set OBC segment data update period
3772	1	if (associated(CS%OBC) .and. CS%dt_obc_seg_period > 0.0) then
3773	0	CS%dt_obc_seg_interval = real_to_time(CS%dt_obc_seg_period, unscale=US%T_to_s)
3774	0	CS%dt_obc_seg_time = Time + CS%dt_obc_seg_interval
3775		endif
3776
3777	1	call callTree_waypoint("dynamics initialized (initialize_MOM)")
3778
3779		CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, &
3780	1	CS%mixedlayer_restrat_CSp, restart_CSp)
3781
3782	1	if (GV%Boussinesq .and. associated(CS%visc%h_ML)) then
3783		! This is here to allow for a transition of restart files between model versions.
3784		call get_param(param_file, "MOM", "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, &
3785	1	default=.false., do_not_log=.true.)
3786	1	if (MLE_use_PBL_MLD .and. .not.query_initialized(CS%visc%h_ML, "h_ML", restart_CSp) .and. &
3787		associated(CS%visc%MLD)) then
3788	7261	do j=js,je ; do i=is,ie ; CS%visc%h_ML(i,j) = GV%Z_to_H * CS%visc%MLD(i,j) ; enddo ; enddo
3789		endif
3790		endif
3791
3792	1	if (CS%mixedlayer_restrat) then
3793	1	if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) &
3794	0	call MOM_error(FATAL, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.")
3795		! When DIABATIC_FIRST=False and using CS%visc%ML in mixedlayer_restrat we need to update after a restart
3796	1	if (.not. CS%diabatic_first .and. associated(CS%visc%MLD)) &
3797	1	call pass_var(CS%visc%MLD, G%domain, halo=1)
3798	1	if (.not. CS%diabatic_first .and. associated(CS%visc%h_ML)) &
3799	1	call pass_var(CS%visc%h_ML, G%domain, halo=1)
3800		endif
3801
3802		call MOM_diagnostics_init(MOM_internal_state, CS%ADp, CS%CDp, Time, G, GV, US, &
3803	1	param_file, diag, CS%diagnostics_CSp, CS%tv)
3804	1	call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag)
3805
3806
3807	1	if (CS%adiabatic) then
3808		call adiabatic_driver_init(Time, G, param_file, diag, CS%diabatic_CSp, &
3809	0	CS%tracer_flow_CSp)
3810		else
3811		call diabatic_driver_init(Time, G, GV, US, param_file, CS%use_ALE_algorithm, diag, &
3812		CS%ADp, CS%CDp, CS%diabatic_CSp, CS%tracer_flow_CSp, &
3813	1	CS%sponge_CSp, CS%ALE_sponge_CSp, CS%oda_incupd_CSp, CS%int_tide_CSp)
3814		endif
3815
3816	1	CS%vertex_shear = kappa_shear_at_vertex(param_file)
3817
3818		! GMM, the following is needed to get BLDs into the dynamics module
3819	1	if (CS%split .and. fpmix) then
3820	0	call init_dyn_split_RK2_diabatic(CS%diabatic_CSp, CS%dyn_split_RK2_CSp)
3821		endif
3822
3823	1	if (associated(CS%sponge_CSp)) &
3824	0	call init_sponge_diags(Time, G, GV, US, diag, CS%sponge_CSp)
3825
3826	1	if (associated(CS%oda_incupd_CSp)) &
3827	0	call init_oda_incupd_diags(Time, G, GV, diag, CS%oda_incupd_CSp, US)
3828
3829	1	call tracer_advect_init(Time, G, US, param_file, diag, CS%tracer_adv_CSp)
3830		call tracer_hor_diff_init(Time, G, GV, US, param_file, diag, CS%tv%eqn_of_state, CS%diabatic_CSp, &
3831	1	CS%tracer_diff_CSp)
3832
3833	1	call lock_tracer_registry(CS%tracer_Reg)
3834	1	call callTree_waypoint("tracer registry now locked (initialize_MOM)")
3835
3836		! now register some diagnostics since the tracer registry is now locked
3837	1	call register_surface_diags(Time, G, US, CS%sfc_IDs, CS%diag, CS%tv)
3838	1	call register_diags(Time, G, GV, US, CS%IDs, CS%diag)
3839	1	call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag)
3840	1	call extract_diabatic_member(CS%diabatic_CSp, use_KPP=use_KPP)
3841		call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, US, &
3842	1	CS%use_ALE_algorithm, use_KPP)
3843	1	if (CS%use_ALE_algorithm) then
3844	1	call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp)
3845		endif
3846
3847		! Do any necessary halo updates on any auxiliary variables that have been initialized.
3848	1	call cpu_clock_begin(id_clock_pass_init)
3849	1	if (associated(CS%visc%Kv_shear)) &
3850	1	call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1)
3851
3852	1	if (associated(CS%visc%Kv_slow)) &
3853	0	call pass_var(CS%visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1)
3854	1	call cpu_clock_end(id_clock_pass_init)
3855
3856		! This subroutine initializes any tracer packages.
3857		call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, &
3858		CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, &
3859	1	CS%ALE_sponge_CSp, CS%tv)
3860	1	if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp
3861
3862	1	if (associated(CS%ALE_sponge_CSp)) &
3863	0	call init_ALE_sponge_diags(Time, G, diag, CS%ALE_sponge_CSp, US)
3864
3865		! If running in offline tracer mode, initialize the necessary control structure and
3866		! parameters
3867	1	if (present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode
3868
3869	1	if (CS%offline_tracer_mode) then
3870		! Setup some initial parameterizations and also assign some of the subtypes
3871	0	call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US)
3872		call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, &
3873		diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, &
3874		tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, &
3875	0	tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug )
3876	0	call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US)
3877		endif
3878
3879	1	if (associated(CS%OBC)) then
3880		! At this point any information related to the tracer reservoirs has either been read from
3881		! the restart file or has been specified in the segments. Initialize the tracer reservoir
3882		! values from the segments if they have not been set via the restart file.
3883	0	call setup_OBC_tracer_reservoirs(G, GV, CS%OBC, restart_CSp)
3884	0	call setup_OBC_thickness_reservoirs(G, GV, CS%OBC, restart_CSp)
3885	0	call open_boundary_halo_update(G, CS%OBC)
3886		endif
3887
3888	1	call register_obsolete_diagnostics(param_file, CS%diag)
3889
3890	1	if (use_frazil) then
3891	1	if (.not.query_initialized(CS%tv%frazil, "frazil", restart_CSp)) then
3892	8773	CS%tv%frazil(:,:) = 0.0
3893	1	call set_initialized(CS%tv%frazil, "frazil", restart_CSp)
3894		endif
3895		endif
3896
3897	1	if (CS%interp_p_surf) then
3898	0	CS%p_surf_prev_set = query_initialized(CS%p_surf_prev, "p_surf_prev", restart_CSp)
3899
3900	0	if (CS%p_surf_prev_set) then
3901	0	call pass_var(CS%p_surf_prev, G%domain)
3902		endif
3903		endif
3904
3905	1	if (.not.query_initialized(CS%ave_ssh_ibc, "ave_ssh", restart_CSp)) then
3906		!$omp target update to(CS%h)
3907	1	if (CS%split) then
3908		!$omp target enter data map(to: eta)
3909	1	call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_bt=eta, dZref=G%Z_ref)
3910		!$omp target exit data map(release: eta)
3911		else
3912	0	call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, dZref=G%Z_ref)
3913		endif
3914		!$omp target update from(CS%ave_ssh_ibc)
3915	1	call set_initialized(CS%ave_ssh_ibc, "ave_ssh", restart_CSp)
3916		endif
3917	1	if (CS%split) deallocate(eta)
3918
3919	1	CS%nstep_tot = 0
3920	1	if (present(count_calls)) CS%count_calls = count_calls
3921		call MOM_sum_output_init(G_in, GV, US, param_file, dirs%output_directory, &
3922	1	CS%ntrunc, Time_init, CS%sum_output_CSp)
3923
3924		! Flag whether to save initial conditions in finish_MOM_initialization() or not.
3925		CS%write_IC = save_IC .and. &
3926		.not.((dirs%input_filename(1:1) == 'r') .and. &
3927	1	(LEN_TRIM(dirs%input_filename) == 1))
3928
3929	1	if (CS%ensemble_ocean) then
3930	0	call init_oda(Time, G, GV, US, CS%diag, CS%odaCS)
3931		endif
3932
3933		! initialize stochastic physics
3934	1	call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time)
3935
3936	1	call callTree_leave("initialize_MOM()")
3937	1	call cpu_clock_end(id_clock_init) ; call cpu_clock_end(id_clock_ocean)
3938
3939	13	end subroutine initialize_MOM
3940
3941		!> Finishes initializing MOM and writes out the initial conditions.
3942	1	subroutine finish_MOM_initialization(Time, dirs, CS)
3943		type(time_type), intent(in) :: Time !< model time, used in this routine
3944		type(directories), intent(in) :: dirs !< structure with directory paths
3945		type(MOM_control_struct), intent(inout) :: CS !< MOM control structure
3946
3947		type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing
3948		! metrics and related information
3949		type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure
3950		type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing
3951		! various unit conversion factors
3952		type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL()
3953	1	real, allocatable :: z_interface(:,:,:) ! Interface heights [Z ~> m]
3954
3955	1	call cpu_clock_begin(id_clock_init)
3956	1	call callTree_enter("finish_MOM_initialization()")
3957
3958		! Pointers for convenience
3959	1	G => CS%G ; GV => CS%GV ; US => CS%US
3960
3961	1	if (CS%use_particles) then
3962	0	call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v, CS%h)
3963		endif
3964
3965		! Write initial conditions
3966	1	if (CS%write_IC) then
3967	1	allocate(restart_CSp_tmp)
3968	1	restart_CSp_tmp = CS%restart_CS
3969	1	call restart_registry_lock(restart_CSp_tmp, unlocked=.true.)
3970	1	allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1))
3971		!$omp target update to(CS%h)
3972		!$omp target enter data map(alloc: z_interface)
3973	1	call find_eta(CS%h, CS%tv, G, GV, US, z_interface, dZref=G%Z_ref)
3974		!$omp target exit data map(from: z_interface)
3975		call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, &
3976	1	"Interface heights", "meter", z_grid='i', conversion=US%Z_to_m)
3977		! NOTE: write_ic=.true. routes routine to fms2 IO write_initial_conditions interface
3978		call save_restart(dirs%output_directory, Time, CS%G_in, &
3979	1	restart_CSp_tmp, filename=CS%IC_file, GV=GV, write_ic=.true.)
3980	1	deallocate(z_interface)
3981	1	deallocate(restart_CSp_tmp)
3982		endif
3983
3984		!$omp target update to(CS%u, CS%v, CS%h)
3985		call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, US, &
3986	1	CS%sum_output_CSp, CS%tracer_flow_CSp)
3987
3988	1	call callTree_leave("finish_MOM_initialization()")
3989	1	call cpu_clock_end(id_clock_init)
3990
3991	1	end subroutine finish_MOM_initialization
3992
3993		!> Register certain diagnostics
3994	1	subroutine register_diags(Time, G, GV, US, IDs, diag)
3995		type(time_type), intent(in) :: Time !< current model time
3996		type(ocean_grid_type), intent(in) :: G !< ocean grid structure
3997		type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
3998		type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type
3999		type(MOM_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs.
4000		type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output
4001
4002		character(len=48) :: thickness_units
4003
4004	1	thickness_units = get_thickness_units(GV)
4005
4006		! Diagnostics of the rapidly varying dynamic state
4007		IDs%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, Time, &
4008	1	'Zonal velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s)
4009		IDs%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, Time, &
4010	1	'Meridional velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s)
4011		IDs%id_h = register_diag_field('ocean_model', 'h_dyn', diag%axesTL, Time, &
4012		'Layer Thickness after the dynamics update', thickness_units, conversion=GV%H_to_MKS, &
4013	1	v_extensive=.true.)
4014		IDs%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, &
4015	1	Time, 'Instantaneous Sea Surface Height', 'm', conversion=US%Z_to_m)
4016
4017	1	end subroutine register_diags
4018
4019		!> Set up CPU clock IDs for timing various subroutines.
4020	1	subroutine MOM_timing_init(CS)
4021		type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM.
4022
4023	1	id_clock_dynamics = cpu_clock_id('Ocean dynamics', grain=CLOCK_SUBCOMPONENT)
4024	1	id_clock_thermo = cpu_clock_id('Ocean thermodynamics and tracers', grain=CLOCK_SUBCOMPONENT)
4025	1	id_clock_remap = cpu_clock_id('Ocean grid generation and remapping', grain=CLOCK_SUBCOMPONENT)
4026	1	id_clock_other = cpu_clock_id('Ocean Other', grain=CLOCK_SUBCOMPONENT)
4027	1	id_clock_MOM_end = cpu_clock_id('Ocean MOM_end', grain=CLOCK_SUBCOMPONENT)
4028	1	id_clock_tracer = cpu_clock_id('(Ocean tracer advection)', grain=CLOCK_MODULE_DRIVER)
4029	1	if (.not.CS%adiabatic) then
4030	1	id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER)
4031		else
4032	0	id_clock_adiabatic = cpu_clock_id('(Ocean adiabatic driver)', grain=CLOCK_MODULE_DRIVER)
4033		endif
4034
4035	1	id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE)
4036	1	id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE)
4037	1	id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE)
4038	1	id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE)
4039	1	id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE)
4040	1	if (CS%thickness_diffuse) &
4041	1	id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=CLOCK_MODULE)
4042	1	if (CS%interface_filter) &
4043	0	id_clock_int_filter = cpu_clock_id('(Ocean interface height filter *)', grain=CLOCK_MODULE)
4044		!if (CS%mixedlayer_restrat) &
4045	1	id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=CLOCK_MODULE)
4046	1	id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE)
4047	1	id_clock_Z_diag = cpu_clock_id('(Ocean Z-space diagnostics)', grain=CLOCK_MODULE)
4048	1	id_clock_ALE = cpu_clock_id('(Ocean ALE)', grain=CLOCK_MODULE)
4049	1	if (CS%offline_tracer_mode) then
4050	0	id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT)
4051		endif
4052	1	id_clock_stoch = cpu_clock_id('(Stochastic EOS)', grain=CLOCK_MODULE)
4053	1	id_clock_varT = cpu_clock_id('(SGS Temperature Variance)', grain=CLOCK_MODULE)
4054
4055	1	id_clock_save_restart = cpu_clock_id('(Ocean MOM save_restart)', grain=CLOCK_MODULE)
4056
4057	1	end subroutine MOM_timing_init
4058
4059		!> Set the fields that are needed for bitwise identical restarting
4060		!! the time stepping scheme. In addition to those specified here
4061		!! directly, there may be fields related to the forcing or to the
4062		!! barotropic solver that are needed; these are specified in sub-
4063		!! routines that are called from this one.
4064		!!
4065		!! This routine should be altered if there are any changes to the
4066		!! time stepping scheme. The CHECK_RESTART facility may be used to
4067		!! confirm that all needed restart fields have been included.
4068	1	subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp)
4069		type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure
4070		type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type
4071		type(param_file_type), intent(in) :: param_file !< opened file for parsing to get parameters
4072		type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM
4073		type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control
4074		!! structure that will be used for MOM.
4075		! Local variables
4076		logical :: use_ice_shelf ! Needed to determine whether to add CS%Hml to restarts
4077		character(len=48) :: thickness_units, flux_units
4078	11	type(vardesc) :: u_desc, v_desc
4079
4080	1	thickness_units = get_thickness_units(GV)
4081	1	flux_units = get_flux_units(GV)
4082
4083	1	if (associated(CS%tv%T)) &
4084		call register_restart_field(CS%tv%T, "Temp", .true., restart_CSp, &
4085	1	"Potential Temperature", "degC", conversion=US%C_to_degC)
4086	1	if (associated(CS%tv%S)) &
4087		call register_restart_field(CS%tv%S, "Salt", .true., restart_CSp, &
4088	1	"Salinity", "PPT", conversion=US%S_to_ppt)
4089
4090		call register_restart_field(CS%h, "h", .true., restart_CSp, &
4091	1	"Layer Thickness", thickness_units, conversion=GV%H_to_MKS)
4092
4093	6	u_desc = var_desc("u", "m s-1", "Zonal velocity", hor_grid='Cu')
4094	6	v_desc = var_desc("v", "m s-1", "Meridional velocity", hor_grid='Cv')
4095	1	call register_restart_pair(CS%u, CS%v, u_desc, v_desc, .true., restart_CSp, conversion=US%L_T_to_m_s)
4096
4097	1	if (associated(CS%tv%frazil)) &
4098		call register_restart_field(CS%tv%frazil, "frazil", .false., restart_CSp, &
4099		"Frazil heat flux into ocean", &
4100	1	"J m-2", conversion=US%Q_to_J_kg*US%RZ_to_kg_m2)
4101
4102	1	if (CS%interp_p_surf) then
4103		call register_restart_field(CS%p_surf_prev, "p_surf_prev", .false., restart_CSp, &
4104	0	"Previous ocean surface pressure", "Pa", conversion=US%RL2_T2_to_Pa)
4105		endif
4106
4107	1	if (associated(CS%tv%p_surf)) &
4108		call register_restart_field(CS%tv%p_surf, "p_surf_EOS", .false., restart_CSp, &
4109	1	"Ocean surface pressure used in EoS", "Pa", conversion=US%RL2_T2_to_Pa)
4110
4111		call register_restart_field(CS%ave_ssh_ibc, "ave_ssh", .false., restart_CSp, &
4112	1	"Time average sea surface height", "meter", conversion=US%Z_to_m)
4113
4114		! hML is needed when using the ice shelf module
4115		call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., &
4116	1	do_not_log=.true.)
4117	1	if (use_ice_shelf .and. associated(CS%Hml)) then
4118		call register_restart_field(CS%Hml, "hML", .false., restart_CSp, &
4119	0	"Mixed layer thickness", "m", conversion=US%Z_to_m)
4120		endif
4121
4122		! Register scalar unit conversion factors.
4123		call register_restart_field(CS%first_dir_restart, "First_direction", .false., restart_CSp, &
4124	1	"Indicator of the first direction in split calculations.", "nondim")
4125
4126	11	end subroutine set_restart_fields
4127
4128		!> Apply a correction to the sea surface height to compensate
4129		!! for the atmospheric pressure (the inverse barometer).
4130	12	subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS)
4131		type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
4132		type(ocean_grid_type), intent(in) :: G !< ocean grid structure
4133		type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
4134		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
4135		real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [Z ~> m]
4136		real, dimension(:,:), pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa]
4137		logical, intent(in) :: use_EOS !< If true, calculate the density for
4138		!! the SSH correction using the equation of state.
4139
4140	24	real :: Rho_conv(SZI_(G)) ! The density used to convert surface pressure to
4141		! a corrected effective SSH [R ~> kg m-3].
4142		real :: IgR0 ! The SSH conversion factor from R L2 T-2 to Z [Z T2 R-1 L-2 ~> m Pa-1].
4143		logical :: calc_rho
4144		integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
4145		integer :: i, j, is, ie, js, je
4146
4147	12	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
4148	12	EOSdom(:) = EOS_domain(G%HI)
4149	12	if (associated(p_atm)) then
4150		!$omp target update from(ssh)
4151	0	calc_rho = use_EOS .and. associated(tv%eqn_of_state)
4152		! Correct the output sea surface height for the contribution from the ice pressure.
4153	0	do j=js,je
4154	0	if (calc_rho) then
4155		call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, &
4156	0	tv%eqn_of_state, EOSdom)
4157	0	do i=is,ie
4158	0	IgR0 = 1.0 / (Rho_conv(i) * GV%g_Earth)
4159	0	ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0
4160		enddo
4161		else
4162	0	IgR0 = 1.0 / (GV%Rho0 * GV%g_Earth)
4163	0	do i=is,ie
4164	0	ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0
4165		enddo
4166		endif
4167		enddo
4168		!$omp target update to(ssh)
4169		endif
4170	12	end subroutine adjust_ssh_for_p_atm
4171
4172		!> Set the surface (return) properties of the ocean model by
4173		!! setting the appropriate fields in sfc_state. Unused fields
4174		!! are set to NULL or are unallocated.
4175	13	subroutine extract_surface_state(CS, sfc_state_in)
4176		type(MOM_control_struct), intent(inout), target :: CS !< Master MOM control structure
4177		type(surface), target, intent(inout) :: sfc_state_in !< transparent ocean surface state
4178		!! structure shared with the calling routine
4179		!! data in this structure is intent out.
4180
4181		! Local variables
4182		real :: hu, hv ! Thicknesses interpolated to velocity points [H ~> m or kg m-2]
4183		type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing
4184		!! metrics and related information
4185		type(ocean_grid_type), pointer :: G_in => NULL() !< Input grid metric
4186		type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info
4187		type(unit_scale_type), pointer :: US => NULL() !< structure containing various unit conversion factors
4188		type(surface), pointer :: sfc_state => NULL() ! surface state on the model grid
4189		real, dimension(:,:,:), pointer :: h => NULL() !< h : layer thickness [H ~> m or kg m-2]
4190	26	real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] or [H ~> m or kg m-2]
4191		real :: depth_ml !< Depth over which to average to determine mixed
4192		!! layer properties [Z ~> m] or [H ~> m or kg m-2]
4193		real :: dh !< Thickness of a layer within the mixed layer [Z ~> m] or [H ~> m or kg m-2]
4194		real :: mass !< Mass per unit area of a layer [R Z ~> kg m-2]
4195		real :: I_depth !< The inverse of depth [Z-1 ~> m-1] or [H-1 ~> m-1 or m2 kg-1]
4196		real :: missing_depth !< The portion of depth_ml that can not be found in a column [H ~> m or kg m-2]
4197		real :: H_rescale !< A conversion factor from thickness units to the units used in the
4198		!! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1]
4199		! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1.
4200	26	real :: T_freeze(SZI_(CS%G)) !< freezing temperature [C ~> degC]
4201	26	real :: pres(SZI_(CS%G)) !< Pressure to use for the freezing temperature calculation [R L2 T-2 ~> Pa]
4202	26	real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [H C ~> m degC or degC kg m-2]
4203		logical :: use_temperature !< If true, temperature and salinity are used as state variables.
4204		integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg
4205		integer :: isd, ied, jsd, jed
4206		integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB
4207		logical :: localError
4208		logical :: use_iceshelves
4209		character(240) :: msg
4210		integer :: turns ! Number of quarter turns
4211
4212	13	call callTree_enter("extract_surface_state(), MOM.F90")
4213	13	G => CS%G ; G_in => CS%G_in ; GV => CS%GV ; US => CS%US
4214	13	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
4215	13	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
4216	13	iscB = G%iscB ; iecB = G%iecB ; jscB = G%jscB ; jecB = G%jecB
4217	13	isdB = G%isdB ; iedB = G%iedB ; jsdB = G%jsdB ; jedB = G%jedB
4218	13	h => CS%h
4219
4220	13	use_temperature = associated(CS%tv%T)
4221
4222	13	use_iceshelves=.false.
4223	13	if (associated(CS%frac_shelf_h)) use_iceshelves = .true.
4224
4225	13	turns = 0
4226	13	if (CS%rotate_index) &
4227	0	turns = G%HI%turns
4228
4229	13	if (.not.sfc_state_in%arrays_allocated) then
4230		! Consider using a run-time flag to determine whether to do the vertical
4231		! integrals, since the 3-d sums are not negligible in cost.
4232		call allocate_surface_state(sfc_state_in, G_in, use_temperature, &
4233		do_integrals=.true., omit_frazil=.not.associated(CS%tv%frazil),&
4234	1	use_iceshelves=use_iceshelves)
4235		endif
4236
4237	13	if (CS%rotate_index) then
4238	0	allocate(sfc_state)
4239		call allocate_surface_state(sfc_state, G, use_temperature, &
4240		do_integrals=.true., omit_frazil=.not.associated(CS%tv%frazil),&
4241	0	use_iceshelves=use_iceshelves, sfc_state_in=sfc_state_in, turns=turns)
4242		else
4243	13	sfc_state => sfc_state_in
4244		endif
4245
4246	13	sfc_state%T_is_conT = CS%tv%T_is_conT
4247	13	sfc_state%S_is_absS = CS%tv%S_is_absS
4248
4249	94393	do j=js,je ; do i=is,ie
4250	94380	sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j)
4251		enddo ; enddo
4252
4253	94393	if (allocated(sfc_state%frazil) .and. associated(CS%tv%frazil)) then ; do j=js,je ; do i=is,ie
4254	94380	sfc_state%frazil(i,j) = CS%tv%frazil(i,j)
4255		enddo ; enddo ; endif
4256
4257		! copy Hml into sfc_state, so that caps can access it
4258	94393	do j=js,je ; do i=is,ie
4259	94380	sfc_state%Hml(i,j) = CS%Hml(i,j)
4260		enddo ; enddo
4261
4262	13	if (CS%Hmix < 0.0) then ! A bulk mixed layer is in use, so layer 1 has the properties
4263	0	if (use_temperature) then ; do j=js,je ; do i=is,ie
4264	0	sfc_state%SST(i,j) = CS%tv%T(i,j,1)
4265	0	sfc_state%SSS(i,j) = CS%tv%S(i,j,1)
4266		enddo ; enddo ; endif
4267	0	do j=js,je ; do I=is-1,ie
4268	0	sfc_state%u(I,j) = CS%u(I,j,1)
4269		enddo ; enddo
4270	0	do J=js-1,je ; do i=is,ie
4271	0	sfc_state%v(i,J) = CS%v(i,J,1)
4272		enddo ; enddo
4273
4274		else ! (CS%Hmix >= 0.0)
4275	13	H_rescale = 1.0
4276	13	depth_ml = CS%Hmix
4277	13	if (CS%answer_date < 20190101) then
4278	0	H_rescale = GV%H_to_Z
4279	0	depth_ml = GV%H_to_Z*CS%Hmix
4280		endif
4281		! Determine the mean tracer properties of the uppermost depth_ml fluid.
4282
4283		!$OMP parallel do default(shared) private(depth,dh)
4284	793	do j=js,je
4285	94380	do i=is,ie
4286	93600	depth(i) = 0.0
4287	94380	if (use_temperature) then
4288	93600	sfc_state%SST(i,j) = 0.0 ; sfc_state%SSS(i,j) = 0.0
4289		else
4290	0	sfc_state%sfc_density(i,j) = 0.0
4291		endif
4292		enddo
4293
4294	7079280	do k=1,nz ; do i=is,ie
4295	7020000	if (depth(i) + h(i,j,k)*H_rescale < depth_ml) then
4296	2131350	dh = h(i,j,k)*H_rescale
4297	4888650	elseif (depth(i) < depth_ml) then
4298	65182	dh = depth_ml - depth(i)
4299		else
4300	4823468	dh = 0.0
4301		endif
4302	7020000	if (use_temperature) then
4303	7020000	sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * CS%tv%T(i,j,k)
4304	7020000	sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * CS%tv%S(i,j,k)
4305		else
4306	0	sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) + dh * GV%Rlay(k)
4307		endif
4308	7078500	depth(i) = depth(i) + dh
4309		enddo ; enddo
4310		! Calculate the average properties of the mixed layer depth.
4311	94393	do i=is,ie
4312	94380	if (CS%answer_date < 20190101) then
4313	0	if (depth(i) < GV%H_subroundoff*H_rescale) &
4314	0	depth(i) = GV%H_subroundoff*H_rescale
4315	0	if (use_temperature) then
4316	0	sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i)
4317	0	sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i)
4318		else
4319	0	sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i)
4320		endif
4321		else
4322	93600	if (depth(i) < GV%H_subroundoff*H_rescale) then
4323	0	I_depth = 1.0 / (GV%H_subroundoff*H_rescale)
4324	0	missing_depth = GV%H_subroundoff*H_rescale - depth(i)
4325	0	if (use_temperature) then
4326	0	sfc_state%SST(i,j) = (sfc_state%SST(i,j) + missing_depthCS%tv%T(i,j,1)) I_depth
4327	0	sfc_state%SSS(i,j) = (sfc_state%SSS(i,j) + missing_depthCS%tv%S(i,j,1)) I_depth
4328		else
4329		sfc_state%sfc_density(i,j) = (sfc_state%sfc_density(i,j) + &
4330	0	missing_depthGV%Rlay(1)) I_depth
4331		endif
4332		else
4333	93600	I_depth = 1.0 / depth(i)
4334	93600	if (use_temperature) then
4335	93600	sfc_state%SST(i,j) = sfc_state%SST(i,j) * I_depth
4336	93600	sfc_state%SSS(i,j) = sfc_state%SSS(i,j) * I_depth
4337		else
4338	0	sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) * I_depth
4339		endif
4340		endif
4341		endif
4342		enddo
4343		enddo ! end of j loop
4344
4345		! Determine the mean velocities in the uppermost depth_ml fluid.
4346		! NOTE: Velocity loops start on `[ij]s-1` in order to update halo values
4347		! required by the speed diagnostic on the non-symmetric grid.
4348		! This assumes that u and v halos have already been updated.
4349	13	if (CS%Hmix_UV>0.) then
4350	0	depth_ml = CS%Hmix_UV
4351	0	if (CS%answer_date < 20190101) depth_ml = GV%H_to_Z*CS%Hmix_UV
4352		!$OMP parallel do default(shared) private(depth,dh,hv)
4353	0	do J=js-1,je
4354	0	do i=is,ie
4355	0	depth(i) = 0.0
4356	0	sfc_state%v(i,J) = 0.0
4357		enddo
4358	0	do k=1,nz ; do i=is,ie
4359	0	hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * H_rescale
4360	0	if (depth(i) + hv < depth_ml) then
4361	0	dh = hv
4362	0	elseif (depth(i) < depth_ml) then
4363	0	dh = depth_ml - depth(i)
4364		else
4365	0	dh = 0.0
4366		endif
4367	0	sfc_state%v(i,J) = sfc_state%v(i,J) + dh * CS%v(i,J,k)
4368	0	depth(i) = depth(i) + dh
4369		enddo ; enddo
4370		! Calculate the average properties of the mixed layer depth.
4371	0	do i=is,ie
4372	0	sfc_state%v(i,J) = sfc_state%v(i,J) / max(depth(i), GV%H_subroundoff*H_rescale)
4373		enddo
4374		enddo ! end of j loop
4375
4376		!$OMP parallel do default(shared) private(depth,dh,hu)
4377	0	do j=js,je
4378	0	do I=is-1,ie
4379	0	depth(I) = 0.0
4380	0	sfc_state%u(I,j) = 0.0
4381		enddo
4382	0	do k=1,nz ; do I=is-1,ie
4383	0	hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * H_rescale
4384	0	if (depth(i) + hu < depth_ml) then
4385	0	dh = hu
4386	0	elseif (depth(I) < depth_ml) then
4387	0	dh = depth_ml - depth(I)
4388		else
4389	0	dh = 0.0
4390		endif
4391	0	sfc_state%u(I,j) = sfc_state%u(I,j) + dh * CS%u(I,j,k)
4392	0	depth(I) = depth(I) + dh
4393		enddo ; enddo
4394		! Calculate the average properties of the mixed layer depth.
4395	0	do I=is-1,ie
4396	0	sfc_state%u(I,j) = sfc_state%u(I,j) / max(depth(I), GV%H_subroundoff*H_rescale)
4397		enddo
4398		enddo ! end of j loop
4399		else ! Hmix_UV<=0.
4400	95173	do j=js,je ; do I=is-1,ie
4401	95160	sfc_state%u(I,j) = CS%u(I,j,1)
4402		enddo ; enddo
4403	95966	do J=js-1,je ; do i=is,ie
4404	95953	sfc_state%v(i,J) = CS%v(i,J,1)
4405		enddo ; enddo
4406		endif
4407		endif ! (CS%Hmix >= 0.0)
4408
4409
4410	13	if (allocated(sfc_state%melt_potential)) then
4411		!$OMP parallel do default(shared) private(depth_ml, dh, T_freeze, depth, pres, delT)
4412	0	do j=js,je
4413	0	do i=is,ie
4414	0	depth(i) = 0.0
4415	0	delT(i) = 0.0
4416	0	pres(i) = 0.0
4417		! Here it is assumed that p=0 is OK, since HFrz ~ 10 to 20m, but under ice-shelves this
4418		! can be a very bad assumption. ###To fix this, uncomment the following...
4419		! pres(i) = p_surface(i) + 0.5(GV%g_EarthGV%H_to_RZ)*h(i,j,1)
4420		enddo
4421
4422	0	do k=1,nz
4423	0	call calculate_TFreeze(CS%tv%S(is:ie,j,k), pres(is:ie), T_freeze(is:ie), CS%tv%eqn_of_state)
4424	0	do i=is,ie
4425	0	depth_ml = min(CS%HFrz, CS%visc%h_ML(i,j))
4426	0	if (depth(i) + h(i,j,k) < depth_ml) then
4427	0	dh = h(i,j,k)
4428	0	elseif (depth(i) < depth_ml) then
4429	0	dh = depth_ml - depth(i)
4430		else
4431	0	dh = 0.0
4432		endif
4433
4434	0	depth(i) = depth(i) + dh
4435	0	delT(i) = delT(i) + dh * (CS%tv%T(i,j,k) - T_freeze(i))
4436		enddo
4437		! If there is a pressure-dependent freezing point calculation uncomment the following.
4438		! if (k<nz) then ; do i=is,ie
4439		! pres(i) = pres(i) + 0.5(GV%g_EarthGV%H_to_RZ) * (h(i,j,k) + h(i,j,k+1))
4440		! enddo ; endif
4441		enddo
4442
4443	0	do i=is,ie
4444		! set melt_potential to zero to avoid passing previous values
4445	0	sfc_state%melt_potential(i,j) = 0.0
4446
4447	0	if (G%mask2dT(i,j)>0.) then
4448		! instantaneous melt_potential [Q R Z ~> J m-2]
4449	0	sfc_state%melt_potential(i,j) = CS%tv%C_p * GV%H_to_RZ * delT(i)
4450		endif
4451		enddo
4452		enddo ! end of j loop
4453		endif ! melt_potential
4454
4455	13	if (allocated(sfc_state%taux_shelf) .and. allocated(CS%visc%taux_shelf)) then
4456		!$OMP parallel do default(shared)
4457	0	do j=js,je ; do I=is-1,ie
4458	0	sfc_state%taux_shelf(I,j) = CS%visc%taux_shelf(I,j)
4459		enddo ; enddo
4460		endif
4461	13	if (allocated(sfc_state%tauy_shelf) .and. allocated(CS%visc%tauy_shelf)) then
4462		!$OMP parallel do default(shared)
4463	0	do J=js-1,je ; do i=is,ie
4464	0	sfc_state%tauy_shelf(i,J) = CS%visc%tauy_shelf(i,J)
4465		enddo ; enddo
4466		endif
4467
4468	13	if (allocated(sfc_state%ocean_mass) .and. allocated(sfc_state%ocean_heat) .and. &
4469		allocated(sfc_state%ocean_salt)) then
4470		!$OMP parallel do default(shared)
4471	94393	do j=js,je ; do i=is,ie
4472	93600	sfc_state%ocean_mass(i,j) = 0.0
4473	94380	sfc_state%ocean_heat(i,j) = 0.0 ; sfc_state%ocean_salt(i,j) = 0.0
4474		enddo ; enddo
4475		!$OMP parallel do default(shared) private(mass)
4476	7079293	do j=js,je ; do k=1,nz ; do i=is,ie
4477	7020000	mass = GV%H_to_RZ*h(i,j,k)
4478	7020000	sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + mass
4479	7020000	sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * CS%tv%T(i,j,k)
4480	7078500	sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*CS%tv%S(i,j,k))
4481		enddo ; enddo ; enddo
4482		else
4483	0	if (allocated(sfc_state%ocean_mass)) then
4484		!$OMP parallel do default(shared)
4485	0	do j=js,je ; do i=is,ie ; sfc_state%ocean_mass(i,j) = 0.0 ; enddo ; enddo
4486		!$OMP parallel do default(shared)
4487	0	do j=js,je ; do k=1,nz ; do i=is,ie
4488	0	sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + GV%H_to_RZ*h(i,j,k)
4489		enddo ; enddo ; enddo
4490		endif
4491	0	if (allocated(sfc_state%ocean_heat)) then
4492		!$OMP parallel do default(shared)
4493	0	do j=js,je ; do i=is,ie ; sfc_state%ocean_heat(i,j) = 0.0 ; enddo ; enddo
4494		!$OMP parallel do default(shared) private(mass)
4495	0	do j=js,je ; do k=1,nz ; do i=is,ie
4496	0	mass = GV%H_to_RZ*h(i,j,k)
4497	0	sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * CS%tv%T(i,j,k)
4498		enddo ; enddo ; enddo
4499		endif
4500	0	if (allocated(sfc_state%ocean_salt)) then
4501		!$OMP parallel do default(shared)
4502	0	do j=js,je ; do i=is,ie ; sfc_state%ocean_salt(i,j) = 0.0 ; enddo ; enddo
4503		!$OMP parallel do default(shared) private(mass)
4504	0	do j=js,je ; do k=1,nz ; do i=is,ie
4505	0	mass = GV%H_to_RZ*h(i,j,k)
4506	0	sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*CS%tv%S(i,j,k))
4507		enddo ; enddo ; enddo
4508		endif
4509		endif
4510
4511	13	if (associated(CS%tracer_flow_CSp)) then
4512	13	call call_tracer_surface_state(sfc_state, h, G, GV, US, CS%tracer_flow_CSp)
4513		endif
4514
4515	13	if (CS%check_bad_sfc_vals) then
4516	0	numberOfErrors=0 ! count number of errors
4517	0	do j=js,je ; do i=is,ie
4518	0	if (G%mask2dT(i,j)>0.) then
4519		localError = sfc_state%sea_lev(i,j) < -G%bathyT(i,j) - G%Z_ref &
4520		.or. sfc_state%sea_lev(i,j) >= CS%bad_val_ssh_max + (G%meanSL(i,j) - G%Z_ref) &
4521		.or. sfc_state%sea_lev(i,j) <= -CS%bad_val_ssh_max + (G%meanSL(i,j) - G%Z_ref) &
4522	0	.or. sfc_state%sea_lev(i,j) + G%bathyT(i,j) + G%Z_ref < CS%bad_val_col_thick
4523	0	if (use_temperature) localError = localError &
4524		.or. sfc_state%SSS(i,j)<0. &
4525		.or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max &
4526		.or. sfc_state%SST(i,j)< CS%bad_val_sst_min &
4527	0	.or. sfc_state%SST(i,j)>=CS%bad_val_sst_max
4528	0	if (localError) then
4529	0	numberOfErrors=numberOfErrors+1
4530	0	if (numberOfErrors<9) then ! Only report details for the first few errors
4531	0	ig = i + G%HI%idg_offset ! Global i-index
4532	0	jg = j + G%HI%jdg_offset ! Global j-index
4533	0	if (use_temperature) then
4534		write(msg(1:240),'(2(a,I0,1x),4(a,f8.3,1x),8(a,es11.4,1x))') &
4535	0	'Extreme surface sfc_state detected: i=',ig,'j=',jg, &
4536	0	'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), &
4537	0	'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), &
4538	0	'D=',US%Z_to_m(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_msfc_state%sea_lev(i,j), &
4539	0	'SST=',US%C_to_degCsfc_state%SST(i,j), 'SSS=',US%S_to_pptsfc_state%SSS(i,j), &
4540	0	'U-=',US%L_T_to_m_ssfc_state%u(I-1,j), 'U+=',US%L_T_to_m_ssfc_state%u(I,j), &
4541	0	'V-=',US%L_T_to_m_ssfc_state%v(i,J-1), 'V+=',US%L_T_to_m_ssfc_state%v(i,J)
4542		else
4543		write(msg(1:240),'(2(a,I0,1x),4(a,f8.3,1x),6(a,es11.4))') &
4544	0	'Extreme surface sfc_state detected: i=',ig,'j=',jg, &
4545	0	'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), &
4546	0	'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), &
4547	0	'D=',US%Z_to_m(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_msfc_state%sea_lev(i,j), &
4548	0	'U-=',US%L_T_to_m_ssfc_state%u(I-1,j), 'U+=',US%L_T_to_m_ssfc_state%u(I,j), &
4549	0	'V-=',US%L_T_to_m_ssfc_state%v(i,J-1), 'V+=',US%L_T_to_m_ssfc_state%v(i,J)
4550		endif
4551	0	call MOM_error(WARNING, trim(msg), all_print=.true.)
4552	0	elseif (numberOfErrors==9) then ! Indicate once that there are more errors
4553	0	call MOM_error(WARNING, 'There were more unreported extreme events!', all_print=.true.)
4554		endif ! numberOfErrors
4555		endif ! localError
4556		endif ! mask2dT
4557		enddo ; enddo
4558	0	call sum_across_PEs(numberOfErrors)
4559	0	if (numberOfErrors>0) then
4560	0	write(msg(1:240),'(a,i0,a)') 'There were a total of ',numberOfErrors, &
4561	0	' locations detected with extreme surface values!'
4562	0	call MOM_error(FATAL, trim(msg))
4563		endif
4564		endif
4565
4566	13	if (CS%debug) call MOM_surface_chksum("Post extract_sfc", sfc_state, G, US, haloshift=0, symmetric=.true.)
4567
4568		! Rotate sfc_state back onto the input grid, sfc_state_in
4569	13	if (CS%rotate_index) then
4570	0	call rotate_surface_state(sfc_state, sfc_state_in, G_in, -turns)
4571	0	call deallocate_surface_state(sfc_state)
4572		endif
4573
4574	13	call callTree_leave("extract_surface_sfc_state()")
4575	13	end subroutine extract_surface_state
4576
4577		!> Rotate initialization fields from input to rotated arrays.
4578	0	subroutine rotate_initial_state(u_in, v_in, h_in, T_in, S_in, &
4579	0	use_temperature, turns, u, v, h, T, S)
4580		real, dimension(:,:,:), intent(in) :: u_in !< Zonal velocity on the initial grid [L T-1 ~> m s-1]
4581		real, dimension(:,:,:), intent(in) :: v_in !< Meridional velocity on the initial grid [L T-1 ~> m s-1]
4582		real, dimension(:,:,:), intent(in) :: h_in !< Layer thickness on the initial grid [H ~> m or kg m-2]
4583		real, dimension(:,:,:), intent(in) :: T_in !< Temperature on the initial grid [C ~> degC]
4584		real, dimension(:,:,:), intent(in) :: S_in !< Salinity on the initial grid [S ~> ppt]
4585		logical, intent(in) :: use_temperature !< If true, temperature and salinity are active
4586		integer, intent(in) :: turns !< The number quarter-turns to apply
4587		real, dimension(:,:,:), intent(out) :: u !< Zonal velocity on the rotated grid [L T-1 ~> m s-1]
4588		real, dimension(:,:,:), intent(out) :: v !< Meridional velocity on the rotated grid [L T-1 ~> m s-1]
4589		real, dimension(:,:,:), intent(out) :: h !< Layer thickness on the rotated grid [H ~> m or kg m-2]
4590		real, dimension(:,:,:), intent(out) :: T !< Temperature on the rotated grid [C ~> degC]
4591		real, dimension(:,:,:), intent(out) :: S !< Salinity on the rotated grid [S ~> ppt]
4592
4593	0	call rotate_vector(u_in, v_in, turns, u, v)
4594	0	call rotate_array(h_in, turns, h)
4595	0	if (use_temperature) then
4596	0	call rotate_array(T_in, turns, T)
4597	0	call rotate_array(S_in, turns, S)
4598		endif
4599	0	end subroutine rotate_initial_state
4600
4601		!> Return true if all phases of step_MOM are at the same point in time.
4602	37	function MOM_state_is_synchronized(CS, adv_dyn) result(in_synch)
4603		type(MOM_control_struct), intent(inout) :: CS !< MOM control structure
4604		logical, optional, intent(in) :: adv_dyn !< If present and true, only check
4605		!! whether the advection is up-to-date with
4606		!! the dynamics.
4607		logical :: in_synch !< True if all phases of the update are synchronized.
4608
4609		logical :: adv_only
4610
4611	37	adv_only = .false. ; if (present(adv_dyn)) adv_only = adv_dyn
4612
4613	37	if (adv_only) then
4614	0	in_synch = (CS%t_dyn_rel_adv == 0.0)
4615		else
4616	37	in_synch = ((CS%t_dyn_rel_adv == 0.0) .and. (CS%t_dyn_rel_thermo == 0.0))
4617		endif
4618
4619	37	end function MOM_state_is_synchronized
4620
4621		!> This subroutine offers access to values or pointers to other types from within
4622		!! the MOM_control_struct, allowing the MOM_control_struct to be opaque.
4623	1	subroutine get_MOM_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp)
4624		type(MOM_control_struct), intent(inout), target :: CS !< MOM control structure
4625		type(ocean_grid_type), optional, pointer :: G !< structure containing metrics and grid info
4626		type(verticalGrid_type), optional, pointer :: GV !< structure containing vertical grid info
4627		type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type
4628		real, optional, intent(out) :: C_p !< The heat capacity [J kg degC-1]
4629		real, optional, intent(out) :: C_p_scaled !< The heat capacity in scaled
4630		!! units [Q C-1 ~> J kg-1 degC-1]
4631		logical, optional, intent(out) :: use_temp !< True if temperature is a state variable
4632
4633	1	if (present(G)) G => CS%G_in
4634	1	if (present(GV)) GV => CS%GV
4635	1	if (present(US)) US => CS%US
4636	1	if (present(C_p)) C_p = CS%US%Q_to_J_kgUS%degC_to_C CS%tv%C_p
4637	1	if (present(C_p_scaled)) C_p_scaled = CS%tv%C_p
4638	1	if (present(use_temp)) use_temp = associated(CS%tv%T)
4639	1	end subroutine get_MOM_state_elements
4640
4641		!> Find the global integrals of various quantities.
4642	0	subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only)
4643		type(MOM_control_struct), intent(inout) :: CS !< MOM control structure
4644		real, optional, intent(out) :: heat !< The globally integrated integrated ocean heat [J].
4645		real, optional, intent(out) :: salt !< The globally integrated integrated ocean salt [kg].
4646		real, optional, intent(out) :: mass !< The globally integrated integrated ocean mass [kg].
4647		logical, optional, intent(in) :: on_PE_only !< If present and true, only sum on the local PE.
4648
4649	0	if (present(mass)) &
4650	0	mass = global_mass_integral(CS%h, CS%G, CS%GV, on_PE_only=on_PE_only)
4651	0	if (present(heat)) &
4652		heat = CS%US%Q_to_J_kgCS%US%RZL2_to_kg CS%tv%C_p * &
4653	0	global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%T, on_PE_only=on_PE_only, tmp_scale=CS%US%C_to_degC)
4654	0	if (present(salt)) &
4655	0	salt = 1.0e-3 * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%S, on_PE_only=on_PE_only, unscale=CS%US%S_to_ppt)
4656
4657	0	end subroutine get_ocean_stocks
4658
4659
4660		!> Save restart/pickup files required to initialize the MOM6 internal state.
4661	1	subroutine save_MOM_restart(CS, directory, time, G, time_stamped, filename, &
4662		GV, num_rest_files, write_IC)
4663		type(MOM_control_struct), intent(inout) :: CS
4664		!< MOM control structure
4665		character(len=*), intent(in) :: directory
4666		!< The directory where the restart files are to be written
4667		type(time_type), intent(in) :: time
4668		!< The current model time
4669		type(ocean_grid_type), intent(inout) :: G
4670		!< The ocean's grid structure
4671		logical, optional, intent(in) :: time_stamped
4672		!< If present and true, add time-stamp to the restart file names
4673		character(len=*), optional, intent(in) :: filename
4674		!< A filename that overrides the name in CS%restartfile
4675		type(verticalGrid_type), optional, intent(in) :: GV
4676		!< The ocean's vertical grid structure
4677		integer, optional, intent(out) :: num_rest_files
4678		!< number of restart files written
4679		logical, optional, intent(in) :: write_IC
4680		!< If present and true, initial conditions are being written
4681
4682		logical :: showCallTree
4683	1	showCallTree = callTree_showQuery()
4684
4685	1	call cpu_clock_begin(id_clock_ocean) ; call cpu_clock_begin(id_clock_save_restart)
4686	1	if (showCallTree) call callTree_waypoint("About to call save_restart (step_MOM)")
4687		call save_restart(directory, time, G, CS%restart_CS, &
4688		time_stamped=time_stamped, filename=filename, GV=GV, &
4689	1	num_rest_files=num_rest_files, write_IC=write_IC)
4690	1	if (showCallTree) call callTree_waypoint("Done with call to save_restart (step_MOM)")
4691
4692	1	if (CS%use_particles) call particles_save_restart(CS%particles, CS%h, directory, time, time_stamped)
4693	1	call cpu_clock_end(id_clock_save_restart) ; call cpu_clock_end(id_clock_ocean)
4694	1	end subroutine save_MOM_restart
4695
4696
4697		!> End of ocean model, including memory deallocation
4698	1	subroutine MOM_end(CS)
4699		type(MOM_control_struct), intent(inout) :: CS !< MOM control structure
4700
4701	1	call cpu_clock_begin(id_clock_ocean) ; call cpu_clock_begin(id_clock_MOM_end)
4702
4703	1	call MOM_sum_output_end(CS%sum_output_CSp)
4704
4705	1	if (CS%use_ALE_algorithm) call ALE_end(CS%ALE_CSp)
4706
4707		!deallocate porous topography variables
4708		!$omp target exit data map(delete: CS%pbv%por_face_areaU, CS%pbv%por_face_areaV)
4709	1	deallocate(CS%pbv%por_face_areaU) ; deallocate(CS%pbv%por_face_areaV)
4710		!$omp target exit data map(delete: CS%pbv%por_layer_widthU, CS%pbv%por_layer_widthV)
4711	1	deallocate(CS%pbv%por_layer_widthU) ; deallocate(CS%pbv%por_layer_widthV)
4712
4713		! NOTE: Allocated in PressureForce_FV_Bouss
4714	1	if (associated(CS%tv%varT)) deallocate(CS%tv%varT)
4715
4716	1	call tracer_advect_end(CS%tracer_adv_CSp)
4717	1	call tracer_hor_diff_end(CS%tracer_diff_CSp)
4718	1	call tracer_registry_end(CS%tracer_Reg)
4719	1	call tracer_flow_control_end(CS%tracer_flow_CSp)
4720
4721	1	if (.not. CS%adiabatic) then
4722	1	call diabatic_driver_end(CS%diabatic_CSp)
4723	3	deallocate(CS%diabatic_CSp)
4724		endif
4725
4726	1	call MOM_diagnostics_end(CS%diagnostics_CSp, CS%ADp, CS%CDp)
4727
4728	1	if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp)
4729
4730	1	if (CS%split .and. CS%use_alt_split) then
4731	0	call end_dyn_split_RK2b(CS%dyn_split_RK2b_CSp)
4732	1	elseif (CS%split) then
4733	1	call end_dyn_split_RK2(CS%dyn_split_RK2_CSp)
4734	0	elseif (CS%use_RK2) then
4735	0	call end_dyn_unsplit_RK2(CS%dyn_unsplit_RK2_CSp)
4736		else
4737	0	call end_dyn_unsplit(CS%dyn_unsplit_CSp)
4738		endif
4739
4740	1	if (CS%use_particles) then
4741	0	call particles_end(CS%particles, CS%h)
4742	0	deallocate(CS%particles)
4743		endif
4744
4745	1	call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp)
4746	1	if (CS%interface_filter) call interface_filter_end(CS%interface_filter_CSp, CS%CDp)
4747	1	call VarMix_end(CS%VarMix)
4748
4749	1	call set_visc_end(CS%visc, CS%set_visc_CSp)
4750		!$omp target exit data map(delete: CS%visc, CS%set_visc_CSp)
4751	1	deallocate(CS%set_visc_CSp)
4752	1	deallocate(CS%visc)
4753
4754	1	call MEKE_end(CS%MEKE)
4755
4756	1	if (associated(CS%tv%internal_heat)) deallocate(CS%tv%internal_heat)
4757	1	if (associated(CS%tv%TempxPmE)) deallocate(CS%tv%TempxPmE)
4758
4759	1	DEALLOC_(CS%ave_ssh_ibc) ; DEALLOC_(CS%ssh_rint) ; DEALLOC_(CS%eta_av_bc)
4760		!$omp target exit data map(delete: CS%ave_ssh_ibc)
4761		!$omp target exit data map(delete: CS%ssh_rint)
4762		!$omp target exit data map(delete: CS%eta_av_bc)
4763
4764		! TODO: debug_truncations deallocation
4765
4766	1	DEALLOC_(CS%uhtr) ; DEALLOC_(CS%vhtr)
4767		!$omp target exit data map(delete: CS%uhtr, CS%vhtr)
4768
4769	1	if (associated(CS%Hml)) deallocate(CS%Hml)
4770	1	if (associated(CS%tv%salt_deficit)) deallocate(CS%tv%salt_deficit)
4771	1	if (associated(CS%tv%frazil)) deallocate(CS%tv%frazil)
4772	1	if (allocated(CS%tv%SpV_avg)) deallocate(CS%tv%SpV_avg)
4773
4774	1	if (associated(CS%tv%T)) then
4775	1	DEALLOC_(CS%T) ; CS%tv%T => NULL() ; DEALLOC_(CS%S) ; CS%tv%S => NULL()
4776		endif
4777
4778	1	DEALLOC_(CS%u) ; DEALLOC_(CS%v) ; DEALLOC_(CS%h)
4779	1	DEALLOC_(CS%uh) ; DEALLOC_(CS%vh)
4780		!$omp target exit data map(delete: CS%u, CS%v, CS%h, CS%uh, CS%vh)
4781
4782	1	if (associated(CS%update_OBC_CSp)) call OBC_register_end(CS%update_OBC_CSp)
4783	1	if (associated(CS%OBC)) call open_boundary_end(CS%OBC)
4784
4785	1	call verticalGridEnd(CS%GV)
4786	1	call MOM_grid_end(CS%G)
4787
4788	1	if (CS%debug .or. CS%G%symmetric) &
4789	1	call deallocate_MOM_domain(CS%G%Domain_aux)
4790
4791	1	if (CS%rotate_index) &
4792	0	call deallocate_MOM_domain(CS%G%Domain)
4793
4794		! The MPP domains may be needed by an external coupler, so use `cursory`.
4795		! TODO: This may create a domain memory leak, and needs investigation.
4796	1	call deallocate_MOM_domain(CS%G_in%domain, cursory=.true.)
4797
4798	1	call unit_scaling_end(CS%US)
4799
4800	1	call cpu_clock_end(id_clock_MOM_end) ; call cpu_clock_end(id_clock_ocean)
4801
4802	1	end subroutine MOM_end
4803
4804		!> \namespace mom
4805		!!
4806		!! Modular Ocean Model (MOM) Version 6.0 (MOM6)
4807		!!
4808		!! \authors Alistair Adcroft, Robert Hallberg, and Stephen Griffies
4809		!!
4810		!! Additional contributions from:
4811		!! * Whit Anderson
4812		!! * Brian Arbic
4813		!! * Will Cooke
4814		!! * Anand Gnanadesikan
4815		!! * Matthew Harrison
4816		!! * Mehmet Ilicak
4817		!! * Laura Jackson
4818		!! * Jasmine John
4819		!! * John Krasting
4820		!! * Zhi Liang
4821		!! * Bonnie Samuels
4822		!! * Harper Simmons
4823		!! * Laurent White
4824		!! * Niki Zadeh
4825		!!
4826		!! MOM ice-shelf code was developed by
4827		!! * Daniel Goldberg
4828		!! * Robert Hallberg
4829		!! * Chris Little
4830		!! * Olga Sergienko
4831		!!
4832		!! \section section_overview Overview of MOM
4833		!!
4834		!! This program (MOM) simulates the ocean by numerically solving
4835		!! the hydrostatic primitive equations in generalized Lagrangian
4836		!! vertical coordinates, typically tracking stretched pressure (p*)
4837		!! surfaces or following isopycnals in the ocean's interior, and
4838		!! general orthogonal horizontal coordinates. Unlike earlier versions
4839		!! of MOM, in MOM6 these equations are horizontally discretized on an
4840		!! Arakawa C-grid. (It remains to be seen whether a B-grid dynamic
4841		!! core will be revived in MOM6 at a later date; for now applications
4842		!! requiring a B-grid discretization should use MOM5.1.) MOM6 offers
4843		!! a range of options for the physical parameterizations, from those
4844		!! most appropriate to highly idealized models for geophysical fluid
4845		!! dynamics studies to a rich suite of processes appropriate for
4846		!! realistic ocean simulations. The thermodynamic options typically
4847		!! use conservative temperature and preformed salinity as conservative
4848		!! state variables and a full nonlinear equation of state, but there
4849		!! are also idealized adiabatic configurations of the model that use
4850		!! fixed density layers. Version 6.0 of MOM continues in the long
4851		!! tradition of a commitment to climate-quality ocean simulations
4852		!! embodied in previous versions of MOM, even as it draws extensively
4853		!! on the lessons learned in the development of the Generalized Ocean
4854		!! Layered Dynamics (GOLD) ocean model, which was also primarily
4855		!! developed at NOAA/GFDL. MOM has also benefited tremendously from
4856		!! the FMS infrastructure, which it utilizes and shares with other
4857		!! component models developed at NOAA/GFDL.
4858		!!
4859		!! When run is isopycnal-coordinate mode, the uppermost few layers
4860		!! are often used to describe a bulk mixed layer, including the
4861		!! effects of penetrating shortwave radiation. Either a split-
4862		!! explicit time stepping scheme or a non-split scheme may be used
4863		!! for the dynamics, while the time stepping may be split (and use
4864		!! different numbers of steps to cover the same interval) for the
4865		!! forcing, the thermodynamics, and for the dynamics. Most of the
4866		!! numerics are second order accurate in space. MOM can run with an
4867		!! absurdly thin minimum layer thickness. A variety of non-isopycnal
4868		!! vertical coordinate options are under development, but all exploit
4869		!! the advantages of a Lagrangian vertical coordinate, as discussed
4870		!! in detail by Adcroft and Hallberg (Ocean Modelling, 2006).
4871		!!
4872		!! Details of the numerics and physical parameterizations are
4873		!! provided in the appropriate source files. All of the available
4874		!! options are selected at run-time by parsing the input files,
4875		!! usually MOM_input and MOM_override, and the options choices are
4876		!! then documented for each run in MOM_param_docs.
4877		!!
4878		!! MOM6 integrates the equations forward in time in three distinct
4879		!! phases. In one phase, the dynamic equations for the velocities
4880		!! and layer thicknesses are advanced, capturing the propagation of
4881		!! external and internal inertia-gravity waves, Rossby waves, and
4882		!! other strictly adiabatic processes, including lateral stresses,
4883		!! vertical viscosity and momentum forcing, and interface height
4884		!! diffusion (commonly called Gent-McWilliams diffusion in depth-
4885		!! coordinate models). In the second phase, all tracers are advected
4886		!! and diffused along the layers. The third phase applies diabatic
4887		!! processes, vertical mixing of water properties, and perhaps
4888		!! vertical remapping to cause the layers to track the desired
4889		!! vertical coordinate.
4890		!!
4891		!! The present file (MOM.F90) orchestrates the main time stepping
4892		!! loops. One time integration option for the dynamics uses a split
4893		!! explicit time stepping scheme to rapidly step the barotropic
4894		!! pressure and velocity fields. The barotropic velocities are
4895		!! averaged over the baroclinic time step before they are used to
4896		!! advect thickness and determine the baroclinic accelerations. As
4897		!! described in Hallberg and Adcroft (2009), a barotropic correction
4898		!! is applied to the time-mean layer velocities to ensure that the
4899		!! sum of the layer transports agrees with the time-mean barotropic
4900		!! transport, thereby ensuring that the estimates of the free surface
4901		!! from the sum of the layer thicknesses agrees with the final free
4902		!! surface height as calculated by the barotropic solver. The
4903		!! barotropic and baroclinic velocities are kept consistent by
4904		!! recalculating the barotropic velocities from the baroclinic
4905		!! transports each time step. This scheme is described in Hallberg,
4906		!! 1997, J. Comp. Phys. 135, 54-65 and in Hallberg and Adcroft, 2009,
4907		!! Ocean Modelling, 29, 15-26.
4908		!!
4909		!! The other time integration options use non-split time stepping
4910		!! schemes based on the 3-step third order Runge-Kutta scheme
4911		!! described in Matsuno, 1966, J. Met. Soc. Japan, 44, 85-88, or on
4912		!! a two-step quasi-2nd order Runge-Kutta scheme. These are much
4913		!! slower than the split time-stepping scheme, but they are useful
4914		!! for providing a more robust solution for debugging cases where the
4915		!! more complicated split time-stepping scheme may be giving suspect
4916		!! solutions.
4917		!!
4918		!! There are a range of closure options available. Horizontal
4919		!! velocities are subject to a combination of horizontal biharmonic
4920		!! and Laplacian friction (based on a stress tensor formalism) and a
4921		!! vertical Fickian viscosity (perhaps using the kinematic viscosity
4922		!! of water). The horizontal viscosities may be constant, spatially
4923		!! varying or may be dynamically calculated using Smagorinsky's
4924		!! approach. A diapycnal diffusion of density and thermodynamic
4925		!! quantities is also allowed, but not required, as is horizontal
4926		!! diffusion of interface heights (akin to the Gent-McWilliams
4927		!! closure of geopotential coordinate models). The diapycnal mixing
4928		!! may use a fixed diffusivity or it may use the shear Richardson
4929		!! number dependent closure, like that described in Jackson et al.
4930		!! (JPO, 2008). When there is diapycnal diffusion, it applies to
4931		!! momentum as well. As this is in addition to the vertical viscosity,
4932		!! the vertical Prandtl always exceeds 1. A refined bulk-mixed layer
4933		!! is often used to describe the planetary boundary layer in realistic
4934		!! ocean simulations.
4935		!!
4936		!! MOM has a number of noteworthy debugging capabilities.
4937		!! Excessively large velocities are truncated and MOM will stop
4938		!! itself after a number of such instances to keep the model from
4939		!! crashing altogether. This is useful in diagnosing failures,
4940		!! or (by accepting some truncations) it may be useful for getting
4941		!! the model past the adjustment from an ill-balanced initial
4942		!! condition. In addition, all of the accelerations in the columns
4943		!! with excessively large velocities may be directed to a text file.
4944		!! Parallelization errors may be diagnosed using the DEBUG option,
4945		!! which causes extensive checksums to be written out along with
4946		!! comments indicating where in the algorithm the sums originate and
4947		!! what variable is being summed. The point where these checksums
4948		!! differ between runs is usually a good indication of where in the
4949		!! code the problem lies. All of the test cases provided with MOM
4950		!! are routinely tested to ensure that they give bitwise identical
4951		!! results regardless of the domain decomposition, or whether they
4952		!! use static or dynamic memory allocation.
4953		!!
4954		!! \section section_structure Structure of MOM
4955		!!
4956		!! About 115 other files of source code and 4 header files comprise
4957		!! the MOM code, although there are several hundred more files that
4958		!! make up the FMS infrastructure upon which MOM is built. Each of
4959		!! the MOM files contains comments documenting what it does, and
4960		!! most of the file names are fairly self-evident. In addition, all
4961		!! subroutines and data types are referenced via a module use, only
4962		!! statement, and the module names are consistent with the file names,
4963		!! so it is not too hard to find the source file for a subroutine.
4964		!!
4965		!! The typical MOM directory tree is as follows:
4966		!!
4967		!! \verbatim
4968		!! ../MOM
4969		!! \|-- ac
4970		!! \|-- config_src
4971		!! \| \|-- drivers
4972		!! \| ! \|-- FMS_cap
4973		!! \| ! \|-- ice_solo_driver
4974		!! \| ! \|-- mct_cap
4975		!! \| ! \|-- nuopc_cap
4976		!! \| ! \|-- solo_driver
4977		!! \| ! `-- unit_drivers
4978		!! \| \|-- external
4979		!! \| ! \|-- drifters
4980		!! \| ! \|-- GFDL_ocean_BGC
4981		!! \| ! `-- ODA_hooks
4982		!! \| \|-- infra
4983		!! \| ! \|-- FMS1
4984		!! \| ! `-- FMS2
4985		!! \| `-- memory
4986		!! \| ! \|-- dynamic_nonsymmetric
4987		!! \| ! `-- dynamic_symmetric
4988		!! \|-- docs
4989		!! \|-- pkg
4990		!! \| \|-- CVMix-src
4991		!! \| \|-- ...
4992		!! \| `-- MOM6_DA_hooks
4993		!! `-- src
4994		!! \|-- ALE
4995		!! \|-- core
4996		!! \|-- diagnostics
4997		!! \|-- equation_of_state
4998		!! \|-- framework
4999		!! \|-- ice_shelf
5000		!! \|-- initialization
5001		!! \|-- ocean_data_assim
5002		!! \|-- parameterizations
5003		!! \| \|-- CVMix
5004		!! \| \|-- lateral
5005		!! \| `-- vertical
5006		!! \|-- tracer
5007		!! `-- user
5008		!! \endverbatim
5009		!!
5010		!! Rather than describing each file here, selected directory contents
5011		!! will be described to give a broad overview of the MOM code
5012		!! structure.
5013		!!
5014		!! The directories under config_src contain files that are used for
5015		!! configuring the code, for instance for coupled or ocean-only runs.
5016		!! Only one or two of these directories are used in compiling any,
5017		!! particular run.
5018		!!
5019		!! * config_src/drivers/FMS-cap:
5020		!! The files here are used to couple MOM as a component in a larger
5021		!! run driven by the FMS coupler. This includes code that converts
5022		!! various forcing fields into the code structures and flux and unit
5023		!! conventions used by MOM, and converts the MOM surface fields
5024		!! back to the forms used by other FMS components.
5025		!!
5026		!! * config_src/drivers/nuopc-cap:
5027		!! The files here are used to couple MOM as a component in a larger
5028		!! run driven by the NUOPC coupler. This includes code that converts
5029		!! various forcing fields into the code structures and flux and unit
5030		!! conventions used by MOM, and converts the MOM surface fields
5031		!! back to the forms used by other NUOPC components.
5032		!!
5033		!! * config_src/drivers/solo_driver:
5034		!! The files here are include the _main driver that is used when
5035		!! MOM is configured as an ocean-only model, as well as the files
5036		!! that specify the surface forcing in this configuration.
5037		!!
5038		!! * config_src/external:
5039		!! The files here are mostly just stubs, so that MOM6 can compile
5040		!! with calls to the public interfaces external packages, but
5041		!! without actually requiring those packages themselves. In more
5042		!! elaborate configurations, would be linked to the actual code for
5043		!! those external packages rather than these simple stubs.
5044		!!
5045		!! * config_src/memory/dynamic-symmetric:
5046		!! The only file here is the version of MOM_memory.h that is used
5047		!! for dynamic memory configurations of MOM.
5048		!!
5049		!! The directories under src contain most of the MOM files. These
5050		!! files are used in every configuration using MOM.
5051		!!
5052		!! * src/core:
5053		!! The files here constitute the MOM dynamic core. This directory
5054		!! also includes files with the types that describe the model's
5055		!! lateral grid and have defined types that are shared across
5056		!! various MOM modules to allow for more succinct and flexible
5057		!! subroutine argument lists.
5058		!!
5059		!! * src/diagnostics:
5060		!! The files here calculate various diagnostics that are ancilliary
5061		!! to the model itself. While most of these diagnostics do not
5062		!! directly affect the model's solution, there are some, like the
5063		!! calculation of the deformation radius, that are used in some
5064		!! of the process parameterizations.
5065		!!
5066		!! * src/equation_of_state:
5067		!! These files describe the physical properties of sea-water,
5068		!! including both the equation of state and when it freezes.
5069		!!
5070		!! * src/framework:
5071		!! These files provide infrastructure utilities for MOM. Many are
5072		!! simply wrappers for capabilities provided by FMS, although others
5073		!! provide capabilities (like the file_parser) that are unique to
5074		!! MOM. When MOM is adapted to use a modeling infrastructure
5075		!! distinct from FMS, most of the required changes are in this
5076		!! directory.
5077		!!
5078		!! * src/initialization:
5079		!! These are the files that are used to initialize the MOM grid
5080		!! or provide the initial physical state for MOM. These files are
5081		!! not intended to be modified, but provide a means for calling
5082		!! user-specific initialization code like the examples in src/user.
5083		!!
5084		!! * src/parameterizations/lateral:
5085		!! These files implement a number of quasi-lateral (along-layer)
5086		!! process parameterizations, including lateral viscosities,
5087		!! parameterizations of eddy effects, and the calculation of tidal
5088		!! forcing.
5089		!!
5090		!! * src/parameterizations/vertical:
5091		!! These files implement a number of vertical mixing or diabatic
5092		!! processes, including the effects of vertical viscosity and
5093		!! code to parameterize the planetary boundary layer. There is a
5094		!! separate driver that orchestrates this portion of the algorithm,
5095		!! and there is a diversity of parameterizations to be found here.
5096		!!
5097		!! * src/tracer:
5098		!! These files handle the lateral transport and diffusion of
5099		!! tracers, or are the code to implement various passive tracer
5100		!! packages. Additional tracer packages are readily accommodated.
5101		!!
5102		!! * src/user:
5103		!! These are either stub routines that a user could use to change
5104		!! the model's initial conditions or forcing, or are examples that
5105		!! implement specific test cases. These files can easily be hand
5106		!! edited to create new analytically specified configurations.
5107		!!
5108		!!
5109		!! Most simulations can be set up by modifying only the files
5110		!! MOM_input, and possibly one or two of the files in src/user.
5111		!! In addition, the diag_table (MOM_diag_table) will commonly be
5112		!! modified to tailor the output to the needs of the question at
5113		!! hand. The FMS utility mkmf works with a file called path_names
5114		!! to build an appropriate makefile, and path_names should be edited
5115		!! to reflect the actual location of the desired source code.
5116		!!
5117		!! The separate MOM-examples git repository provides a large number
5118		!! of working configurations of MOM, along with reference solutions for several
5119		!! different compilers on GFDL's latest large computer. The versions
5120		!! of MOM_memory.h in these directories need not be used if dynamic
5121		!! memory allocation is desired, and the answers should be unchanged.
5122		!!
5123		!!
5124		!! There are 3 publicly visible subroutines in this file (MOM.F90).
5125		!! * step_MOM steps MOM over a specified interval of time.
5126		!! * MOM_initialize calls initialize and does other initialization
5127		!! that does not warrant user modification.
5128		!! * extract_surface_state determines the surface (bulk mixed layer
5129		!! if traditional isopycnal vertical coordinate) properties of the
5130		!! current model state and packages pointers to these fields into an
5131		!! exported structure.
5132		!!
5133		!! The remaining subroutines in this file (src/core/MOM.F90) are:
5134		!! * find_total_transport determines the barotropic mass transport.
5135		!! * register_diags registers many diagnostic fields for the dynamic
5136		!! solver, or of the main model variables.
5137		!! * MOM_timing_init initializes various CPU time clocks.
5138		!! * write_static_fields writes out various time-invariant fields.
5139		!! * set_restart_fields is used to specify those fields that are
5140		!! written to and read from the restart file.
5141		!!
5142		!! \section section_heat_budget Diagnosing MOM heat budget
5143		!!
5144		!! Here are some example heat budgets for the ALE version of MOM6.
5145		!!
5146		!! \subsection subsection_2d_heat_budget Depth integrated heat budget
5147		!!
5148		!! Depth integrated heat budget diagnostic for MOM.
5149		!!
5150		!! * OPOTTEMPTEND_2d = T_ADVECTION_XY_2d + OPOTTEMPPMDIFF_2d + HFDS + HFGEOU
5151		!!
5152		!! * T_ADVECTION_XY_2d = horizontal advection
5153		!! * OPOTTEMPPMDIFF_2d = neutral diffusion
5154		!! * HFDS = net surface boundary heat flux
5155		!! * HFGEOU = geothermal heat flux
5156		!!
5157		!! * HFDS = net surface boundary heat flux entering the ocean
5158		!! = rsntds + rlntds + hfls + hfss + heat_pme + hfsifrazil
5159		!!
5160		!! * More heat flux cross-checks
5161		!! * hfds = net_heat_coupler + hfsifrazil + heat_pme
5162		!! * heat_pme = heat_content_surfwater
5163		!! = heat_content_massin + heat_content_massout
5164		!! = heat_content_fprec + heat_content_cond + heat_content_vprec
5165		!! + hfrunoffds + hfevapds + hfrainds
5166		!!
5167		!! \subsection subsection_3d_heat_budget Depth integrated heat budget
5168		!!
5169		!! Here is an example 3d heat budget diagnostic for MOM.
5170		!!
5171		!! * OPOTTEMPTEND = T_ADVECTION_XY + TH_TENDENCY_VERT_REMAP + OPOTTEMPDIFF + OPOTTEMPPMDIFF
5172		!! + BOUNDARY_FORCING_HEAT_TENDENCY + FRAZIL_HEAT_TENDENCY
5173		!!
5174		!! * OPOTTEMPTEND = net tendency of heat as diagnosed in MOM.F90
5175		!! * T_ADVECTION_XY = heating of a cell from lateral advection
5176		!! * TH_TENDENCY_VERT_REMAP = heating of a cell from vertical remapping
5177		!! * OPOTTEMPDIFF = heating of a cell from diabatic diffusion
5178		!! * OPOTTEMPPMDIFF = heating of a cell from neutral diffusion
5179		!! * BOUNDARY_FORCING_HEAT_TENDENCY = heating of cell from boundary fluxes
5180		!! * FRAZIL_HEAT_TENDENCY = heating of cell from frazil
5181		!!
5182		!! * TH_TENDENCY_VERT_REMAP has zero vertical sum, as it redistributes heat in vertical.
5183		!!
5184		!! * OPOTTEMPDIFF has zero vertical sum, as it redistributes heat in the vertical.
5185		!!
5186		!! * BOUNDARY_FORCING_HEAT_TENDENCY generally has 3d structure, with k > 1 contributions from
5187		!! penetrative shortwave, and from other fluxes for the case when layers are tiny, in which
5188		!! case MOM6 partitions tendencies into k > 1 layers.
5189		!!
5190		!! * FRAZIL_HEAT_TENDENCY generally has 3d structure, since MOM6 frazil calculation checks the
5191		!! full ocean column.
5192		!!
5193		!! * FRAZIL_HEAT_TENDENCY[k=\@sum] = HFSIFRAZIL = column integrated frazil heating.
5194		!!
5195		!! * HFDS = FRAZIL_HEAT_TENDENCY[k=\@sum] + BOUNDARY_FORCING_HEAT_TENDENCY[k=\@sum]
5196		!!
5197		!! Here is an example 2d heat budget (depth summed) diagnostic for MOM.
5198		!!
5199		!! * OPOTTEMPTEND_2d = T_ADVECTION_XY_2d + OPOTTEMPPMDIFF_2d + HFDS
5200		!!
5201		!!
5202		!! Here is an example 3d salt budget diagnostic for MOM.
5203		!!
5204		!! * OSALTTEND = S_ADVECTION_XY + SH_TENDENCY_VERT_REMAP + OSALTDIFF + OSALTPMDIFF
5205		!! + BOUNDARY_FORCING_SALT_TENDENCY
5206		!!
5207		!! * OSALTTEND = net tendency of salt as diagnosed in MOM.F90
5208		!! * S_ADVECTION_XY = salt convergence to cell from lateral advection
5209		!! * SH_TENDENCY_VERT_REMAP = salt convergence to cell from vertical remapping
5210		!! * OSALTDIFF = salt convergence to cell from diabatic diffusion
5211		!! * OSALTPMDIFF = salt convergence to cell from neutral diffusion
5212		!! * BOUNDARY_FORCING_SALT_TENDENCY = salt convergence to cell from boundary fluxes
5213		!!
5214		!! * SH_TENDENCY_VERT_REMAP has zero vertical sum, as it redistributes salt in vertical.
5215		!!
5216		!! * OSALTDIFF has zero vertical sum, as it redistributes salt in the vertical.
5217		!!
5218		!! * BOUNDARY_FORCING_SALT_TENDENCY generally has 3d structure, with k > 1 contributions from
5219		!! the case when layers are tiny, in which case MOM6 partitions tendencies into k > 1 layers.
5220		!!
5221		!! * SFDSI = BOUNDARY_FORCING_SALT_TENDENCY[k=\@sum]
5222		!!
5223		!! Here is an example 2d salt budget (depth summed) diagnostic for MOM.
5224		!!
5225		!! * OSALTTEND_2d = S_ADVECTION_XY_2d + OSALTPMDIFF_2d + SFDSI (+ SALT_FLUX_RESTORE)
5226		!!
5227		!!
5228		!!
5229	0	end module MOM