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