MOM.F90

!> The central module of the MOM6 ocean model
module mom
 
! This file is part of MOM6. See LICENSE.md for the license.
 
! Infrastructure modules
use mom_array_transform,      only : rotate_array, rotate_vector
use mom_debugging,            only : mom_debugging_init, hchksum, uvchksum
use mom_debugging,            only : check_redundant
use mom_checksum_packages,    only : mom_thermo_chksum, mom_state_chksum
use mom_checksum_packages,    only : mom_accel_chksum, mom_surface_chksum
use mom_coms,                 only : num_pes
use mom_cpu_clock,            only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
use mom_cpu_clock,            only : clock_component, clock_subcomponent
use mom_cpu_clock,            only : clock_module_driver, clock_module, clock_routine
use mom_diag_mediator,        only : diag_mediator_init, enable_averaging, enable_averages
use mom_diag_mediator,        only : diag_mediator_infrastructure_init
use mom_diag_mediator,        only : diag_set_state_ptrs, diag_update_remap_grids
use mom_diag_mediator,        only : disable_averaging, post_data, safe_alloc_ptr
use mom_diag_mediator,        only : register_diag_field, register_cell_measure
use mom_diag_mediator,        only : set_axes_info, diag_ctrl, diag_masks_set
use mom_diag_mediator,        only : set_masks_for_axes
use mom_diag_mediator,        only : diag_grid_storage, diag_grid_storage_init
use mom_diag_mediator,        only : diag_save_grids, diag_restore_grids
use mom_diag_mediator,        only : diag_copy_storage_to_diag, diag_copy_diag_to_storage
use mom_domains,              only : mom_domains_init, clone_mom_domain
use mom_domains,              only : sum_across_pes, pass_var, pass_vector
use mom_domains,              only : to_north, to_east, to_south, to_west
use mom_domains,              only : to_all, omit_corners, cgrid_ne, scalar_pair
use mom_domains,              only : create_group_pass, do_group_pass, group_pass_type
use mom_domains,              only : start_group_pass, complete_group_pass, omit_corners
use mom_error_handler,        only : mom_error, mom_mesg, fatal, warning, is_root_pe
use mom_error_handler,        only : mom_set_verbosity, calltree_showquery
use mom_error_handler,        only : calltree_enter, calltree_leave, calltree_waypoint
use mom_file_parser,          only : read_param, get_param, log_version, param_file_type
use mom_forcing_type,         only : forcing, mech_forcing
use mom_forcing_type,         only : mom_forcing_chksum, mom_mech_forcing_chksum
use mom_get_input,            only : get_mom_input, directories
use mom_io,                   only : mom_io_init, vardesc, var_desc
use mom_io,                   only : slasher, file_exists, mom_read_data
use mom_obsolete_params,      only : find_obsolete_params
use mom_restart,              only : register_restart_field, register_restart_pair
use mom_restart,              only : query_initialized, save_restart
use mom_restart,              only : restart_init, is_new_run, mom_restart_cs
use mom_spatial_means,        only : global_mass_integral
use mom_time_manager,         only : time_type, real_to_time, time_type_to_real, operator(+)
use mom_time_manager,         only : operator(-), operator(>), operator(*), operator(/)
use mom_time_manager,         only : operator(>=), operator(==), increment_date
use mom_unit_tests,           only : unit_tests
use coupler_types_mod,        only : coupler_type_send_data, coupler_1d_bc_type, coupler_type_spawn
 
! MOM core modules
use mom_ale,                   only : ale_init, ale_end, ale_main, ale_cs, adjustgridforintegrity
use mom_ale,                   only : ale_getcoordinate, ale_getcoordinateunits, ale_writecoordinatefile
use mom_ale,                   only : ale_updateverticalgridtype, ale_remap_init_conds, ale_register_diags
use mom_ale_sponge,            only : rotate_ale_sponge, update_ale_sponge_field
use mom_barotropic,            only : barotropic_cs
use mom_boundary_update,       only : call_obc_register, obc_register_end, update_obc_cs
use mom_coord_initialization,  only : mom_initialize_coord
use mom_diabatic_driver,       only : diabatic, diabatic_driver_init, diabatic_cs, extract_diabatic_member
use mom_diabatic_driver,       only : adiabatic, adiabatic_driver_init, diabatic_driver_end
use mom_diagnostics,           only : calculate_diagnostic_fields, mom_diagnostics_init
use mom_diagnostics,           only : register_transport_diags, post_transport_diagnostics
use mom_diagnostics,           only : register_surface_diags, write_static_fields
use mom_diagnostics,           only : post_surface_dyn_diags, post_surface_thermo_diags
use mom_diagnostics,           only : diagnostics_cs, surface_diag_ids, transport_diag_ids
use mom_dynamics_unsplit,      only : step_mom_dyn_unsplit, register_restarts_dyn_unsplit
use mom_dynamics_unsplit,      only : initialize_dyn_unsplit, end_dyn_unsplit
use mom_dynamics_unsplit,      only : mom_dyn_unsplit_cs
use mom_dynamics_split_rk2,    only : step_mom_dyn_split_rk2, register_restarts_dyn_split_rk2
use mom_dynamics_split_rk2,    only : initialize_dyn_split_rk2, end_dyn_split_rk2
use mom_dynamics_split_rk2,    only : mom_dyn_split_rk2_cs
use mom_dynamics_unsplit_rk2,  only : step_mom_dyn_unsplit_rk2, register_restarts_dyn_unsplit_rk2
use mom_dynamics_unsplit_rk2,  only : initialize_dyn_unsplit_rk2, end_dyn_unsplit_rk2
use mom_dynamics_unsplit_rk2,  only : mom_dyn_unsplit_rk2_cs
use mom_dyn_horgrid,           only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid
use mom_eos,                   only : eos_init, calculate_density, calculate_tfreeze, eos_domain
use mom_fixed_initialization,  only : mom_initialize_fixed
use mom_forcing_type,          only : allocate_forcing_type, allocate_mech_forcing
use mom_forcing_type,          only : deallocate_mech_forcing, deallocate_forcing_type
use mom_forcing_type,          only : rotate_forcing, rotate_mech_forcing
use mom_grid,                  only : ocean_grid_type, mom_grid_init, mom_grid_end
use mom_grid,                  only : set_first_direction, rescale_grid_bathymetry
use mom_hor_index,             only : hor_index_type, hor_index_init
use mom_hor_index,             only : rotate_hor_index
use mom_interface_heights,     only : find_eta
use mom_lateral_mixing_coeffs, only : calc_slope_functions, varmix_init
use mom_lateral_mixing_coeffs, only : calc_resoln_function, calc_depth_function, varmix_cs
use mom_meke,                  only : meke_init, meke_alloc_register_restart, step_forward_meke, meke_cs
use mom_meke_types,            only : meke_type
use mom_mixed_layer_restrat,   only : mixedlayer_restrat, mixedlayer_restrat_init, mixedlayer_restrat_cs
use mom_mixed_layer_restrat,   only : mixedlayer_restrat_register_restarts
use mom_obsolete_diagnostics,  only : register_obsolete_diagnostics
use mom_open_boundary,         only : ocean_obc_type, obc_registry_type
use mom_open_boundary,         only : register_temp_salt_segments
use mom_open_boundary,         only : open_boundary_register_restarts
use mom_open_boundary,         only : update_segment_tracer_reservoirs
use mom_open_boundary,         only : rotate_obc_config, rotate_obc_init
use mom_set_visc,              only : set_viscous_bbl, set_viscous_ml, set_visc_init
use mom_set_visc,              only : set_visc_register_restarts, set_visc_cs
use mom_sponge,                only : init_sponge_diags, sponge_cs
use mom_state_initialization,  only : mom_initialize_state
use mom_sum_output,            only : write_energy, accumulate_net_input
use mom_sum_output,            only : mom_sum_output_init, sum_output_cs
use mom_ale_sponge,            only : init_ale_sponge_diags, ale_sponge_cs
use mom_thickness_diffuse,     only : thickness_diffuse, thickness_diffuse_init, thickness_diffuse_cs
use mom_tracer_advect,         only : advect_tracer, tracer_advect_init
use mom_tracer_advect,         only : tracer_advect_end, tracer_advect_cs
use mom_tracer_hor_diff,       only : tracer_hordiff, tracer_hor_diff_init
use mom_tracer_hor_diff,       only : tracer_hor_diff_end, tracer_hor_diff_cs
use mom_tracer_registry,       only : tracer_registry_type, register_tracer, tracer_registry_init
use mom_tracer_registry,       only : register_tracer_diagnostics, post_tracer_diagnostics_at_sync
use mom_tracer_registry,       only : post_tracer_transport_diagnostics
use mom_tracer_registry,       only : preale_tracer_diagnostics, postale_tracer_diagnostics
use mom_tracer_registry,       only : lock_tracer_registry, tracer_registry_end
use mom_tracer_flow_control,   only : call_tracer_register, tracer_flow_control_cs
use mom_tracer_flow_control,   only : tracer_flow_control_init, call_tracer_surface_state
use mom_tracer_flow_control,   only : tracer_flow_control_end
use mom_transcribe_grid,       only : copy_dyngrid_to_mom_grid, copy_mom_grid_to_dyngrid
use mom_transcribe_grid,       only : rotate_dyngrid
use mom_unit_scaling,          only : unit_scale_type, unit_scaling_init
use mom_unit_scaling,          only : unit_scaling_end, fix_restart_unit_scaling
use mom_variables,             only : surface, allocate_surface_state, deallocate_surface_state
use mom_variables,             only : thermo_var_ptrs, vertvisc_type
use mom_variables,             only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state
use mom_variables,             only : rotate_surface_state
use mom_verticalgrid,          only : verticalgrid_type, verticalgridinit, verticalgridend
use mom_verticalgrid,          only : fix_restart_scaling
use mom_verticalgrid,          only : get_thickness_units, get_flux_units, get_tr_flux_units
use mom_wave_interface,        only : wave_parameters_cs, waves_end
use mom_wave_interface,        only : update_stokes_drift
 
! ODA modules
use mom_oda_driver_mod,        only : oda_cs, oda, init_oda, oda_end
use mom_oda_driver_mod,        only : set_prior_tracer, set_analysis_time, apply_oda_tracer_increments
! Offline modules
use mom_offline_main,          only : offline_transport_cs, offline_transport_init, update_offline_fields
use mom_offline_main,          only : insert_offline_main, extract_offline_main, post_offline_convergence_diags
use mom_offline_main,          only : register_diags_offline_transport, offline_advection_ale
use mom_offline_main,          only : offline_redistribute_residual, offline_diabatic_ale
use mom_offline_main,          only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean
use mom_offline_main,          only : offline_advection_layer, offline_transport_end
use mom_ale,                   only : ale_offline_tracer_final, ale_main_offline
 
implicit none ; private
 
#include <MOM_memory.h>
 
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]".  If the units
! vary with the Boussinesq approximation, the Boussinesq variant is given first.
 
!> A structure with diagnostic IDs of the state variables
type mom_diag_ids
  !>@{ 3-d state field diagnostic IDs
  integer :: id_u  = -1, id_v  = -1, id_h  = -1
  !>@}
  !> 2-d state field diagnotic ID
  integer :: id_ssh_inst = -1
end type mom_diag_ids
 
!> Control structure for the MOM module, including the variables that describe
!! the state of the ocean.
type, public :: mom_control_struct ; private
  real allocable_, dimension(NIMEM_,NJMEM_,NKMEM_) :: &
    h, &            !< layer thickness [H ~> m or kg m-2]
    t, &            !< potential temperature [degC]
    s               !< salinity [ppt]
  real allocable_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
    u,  &           !< zonal velocity component [L T-1 ~> m s-1]
    uh, &           !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1]
    uhtr            !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg]
  real allocable_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
    v,  &           !< meridional velocity [L T-1 ~> m s-1]
    vh, &           !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1]
    vhtr            !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg]
  real allocable_, dimension(NIMEM_,NJMEM_) :: ssh_rint
                    !< A running time integral of the sea surface height [T m ~> s m].
  real allocable_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc
                    !< time-averaged (over a forcing time step) sea surface height
                    !! with a correction for the inverse barometer [m]
  real allocable_, dimension(NIMEM_,NJMEM_) :: eta_av_bc
                    !< free surface height or column mass time averaged over the last
                    !! baroclinic dynamics time step [H ~> m or kg m-2]
  real, dimension(:,:), pointer :: &
    hml => null()   !< active mixed layer depth [Z ~> m]
  real :: time_in_cycle !< The running time of the current time-stepping cycle
                    !! in calls that step the dynamics, and also the length of
                    !! the time integral of ssh_rint [T ~> s].
  real :: time_in_thermo_cycle !< The running time of the current time-stepping
                    !! cycle in calls that step the thermodynamics [T ~> s].
 
  type(ocean_grid_type) :: g_in                   !< Input grid metric
  type(ocean_grid_type), pointer :: g => null()   !< Model grid metric
  logical :: rotate_index = .false.   !< True if index map is rotated
 
  type(verticalgrid_type), pointer :: &
    gv => null()    !< structure containing vertical grid info
  type(unit_scale_type), pointer :: &
    us => null()    !< structure containing various unit conversion factors
  type(thermo_var_ptrs) :: tv !< structure containing pointers to available thermodynamic fields
  real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer advection and lateral mixing
                    !! [T ~> s], or equivalently the elapsed time since advectively updating the
                    !! tracers.  t_dyn_rel_adv is invariably positive and may span multiple coupling timesteps.
  real :: t_dyn_rel_thermo  !< The time of the dynamics relative to diabatic  processes and remapping
                    !! [T ~> s].  t_dyn_rel_thermo can be negative or positive depending on whether
                    !! the diabatic processes are applied before or after the dynamics and may span
                    !! multiple coupling timesteps.
  real :: t_dyn_rel_diag !< The time of the diagnostics relative to diabatic processes and remapping
                    !!  [T ~> s].  t_dyn_rel_diag is always positive, since the diagnostics must lag.
  logical :: preadv_h_stored = .false. !< If true, the thicknesses from before the advective cycle
                    !! have been stored for use in diagnostics.
 
  type(diag_ctrl)     :: diag !< structure to regulate diagnostic output timing
  type(vertvisc_type) :: visc !< structure containing vertical viscosities,
                    !! bottom drag viscosities, and related fields
  type(meke_type), pointer :: meke => null() !<  structure containing fields
                    !! related to the Mesoscale Eddy Kinetic Energy
  logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls
                    !! to routines to calculate or apply diapycnal fluxes.
  logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time
                    !! stepping the dynamics.
  logical :: use_ale_algorithm  !< If true, use the ALE algorithm rather than layered
                    !! isopycnal/stacked shallow water mode. This logical is set by calling the
                    !! function useRegridding() from the MOM_regridding module.
  logical :: offline_tracer_mode = .false.
                    !< If true, step_offline() is called instead of step_MOM().
                    !! This is intended for running MOM6 in offline tracer mode
 
  type(time_type), pointer :: time   !< pointer to the ocean clock
  real    :: dt                      !< (baroclinic) dynamics time step [T ~> s]
  real    :: dt_therm                !< thermodynamics time step [T ~> s]
  logical :: thermo_spans_coupling   !< If true, thermodynamic and tracer time
                                     !! steps can span multiple coupled time steps.
  integer :: nstep_tot = 0           !< The total number of dynamic timesteps tcaaken
                                     !! so far in this run segment
  logical :: count_calls = .false.   !< If true, count the calls to step_MOM, rather than the
                                     !! number of dynamics steps in nstep_tot
  logical :: debug                   !< If true, write verbose checksums for debugging purposes.
  integer :: ntrunc                  !< number u,v truncations since last call to write_energy
 
  integer :: cont_stencil            !< The stencil for thickness from the continuity solver.
  ! These elements are used to control the dynamics updates.
  logical :: do_dynamics             !< If false, does not call step_MOM_dyn_*. This is an
                                     !! undocumented run-time flag that is fragile.
  logical :: split                   !< If true, use the split time stepping scheme.
  logical :: use_rk2                 !< If true, use RK2 instead of RK3 in unsplit mode
                                     !! (i.e., no split between barotropic and baroclinic).
  logical :: thickness_diffuse       !< If true, diffuse interface height w/ a diffusivity KHTH.
  logical :: thickness_diffuse_first !< If true, diffuse thickness before dynamics.
  logical :: mixedlayer_restrat      !< If true, use submesoscale mixed layer restratifying scheme.
  logical :: usemeke                 !< If true, call the MEKE parameterization.
  logical :: usewaves                !< If true, update Stokes drift
  logical :: use_p_surf_in_eos       !< If true, always include the surface pressure contributions
                                     !! in equation of state calculations.
  real :: dtbt_reset_period          !< The time interval between dynamic recalculation of the
                                     !! barotropic time step [s]. If this is negative dtbt is never
                                     !! calculated, and if it is 0, dtbt is calculated every step.
  type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period.
  type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated.
 
 
  real, dimension(:,:,:), pointer :: &
    h_pre_dyn => null(), &      !< The thickness before the transports [H ~> m or kg m-2].
    t_pre_dyn => null(), &      !< Temperature before the transports [degC].
    s_pre_dyn => null()         !< Salinity before the transports [ppt].
  type(accel_diag_ptrs) :: adp  !< structure containing pointers to accelerations,
                                !! for derived diagnostics (e.g., energy budgets)
  type(cont_diag_ptrs)  :: cdp  !< structure containing pointers to continuity equation
                                !! terms, for derived diagnostics (e.g., energy budgets)
  real, dimension(:,:,:), pointer :: &
    u_prev => null(), &         !< previous value of u stored for diagnostics [L T-1 ~> m s-1]
    v_prev => null()            !< previous value of v stored for diagnostics [L T-1 ~> m s-1]
 
  logical :: interp_p_surf      !< If true, linearly interpolate surface pressure
                                !! over the coupling time step, using specified value
                                !! at the end of the coupling step. False by default.
  logical :: p_surf_prev_set    !< If true, p_surf_prev has been properly set from
                                !! a previous time-step or the ocean restart file.
                                !! This is only valid when interp_p_surf is true.
  real, dimension(:,:), pointer :: &
    p_surf_prev  => null(), &   !< surface pressure [R L2 T-2 ~> Pa] at end  previous call to step_MOM
    p_surf_begin => null(), &   !< surface pressure [R L2 T-2 ~> Pa] at start of step_MOM_dyn_...
    p_surf_end   => null()      !< surface pressure [R L2 T-2 ~> Pa] at end   of step_MOM_dyn_...
 
  ! Variables needed to reach between start and finish phases of initialization
  logical :: write_ic           !< If true, then the initial conditions will be written to file
  character(len=120) :: ic_file !< A file into which the initial conditions are
                                !! written in a new run if SAVE_INITIAL_CONDS is true.
 
  logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level
 
  ! These elements are used to control the calculation and error checking of the surface state
  real :: hmix                  !< Diagnostic mixed layer thickness over which to
                                !! average surface tracer properties when a bulk
                                !! mixed layer is not used [Z ~> m], or a negative value
                                !! if a bulk mixed layer is being used.
  real :: hfrz                  !< If HFrz > 0, the nominal depth over which melt potential is
                                !! computed [Z ~> m]. The actual depth over which melt potential is
                                !! computed is min(HFrz, OBLD), where OBLD is the boundary layer depth.
                                !! If HFrz <= 0 (default), melt potential will not be computed.
  real :: hmix_uv               !< Depth scale over which to average surface flow to
                                !! feedback to the coupler/driver [Z ~> m] when
                                !! bulk mixed layer is not used, or a negative value
                                !! if a bulk mixed layer is being used.
  logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values.
  real    :: bad_val_ssh_max    !< Maximum SSH before triggering bad value message [Z ~> m]
  real    :: bad_val_sst_max    !< Maximum SST before triggering bad value message [degC]
  real    :: bad_val_sst_min    !< Minimum SST before triggering bad value message [degC]
  real    :: bad_val_sss_max    !< Maximum SSS before triggering bad value message [ppt]
  real    :: bad_val_col_thick  !< Minimum column thickness before triggering bad value message [Z ~> m]
  logical :: answers_2018       !< If true, use expressions for the surface properties that recover
                                !! the answers from the end of 2018. Otherwise, use more appropriate
                                !! expressions that differ at roundoff for non-Boussinsq cases.
 
  type(mom_diag_ids)       :: ids      !<  Handles used for diagnostics.
  type(transport_diag_ids) :: transport_ids  !< Handles used for transport diagnostics.
  type(surface_diag_ids)   :: sfc_ids  !< Handles used for surface diagnostics.
  type(diag_grid_storage)  :: diag_pre_sync !< The grid (thicknesses) before remapping
  type(diag_grid_storage)  :: diag_pre_dyn  !< The grid (thicknesses) before dynamics
 
  ! The remainder of this type provides pointers to child module control structures.
 
  type(mom_dyn_unsplit_cs),      pointer :: dyn_unsplit_csp => null()
    !< Pointer to the control structure used for the unsplit dynamics
  type(mom_dyn_unsplit_rk2_cs),  pointer :: dyn_unsplit_rk2_csp => null()
    !< Pointer to the control structure used for the unsplit RK2 dynamics
  type(mom_dyn_split_rk2_cs),    pointer :: dyn_split_rk2_csp => null()
    !< Pointer to the control structure used for the mode-split RK2 dynamics
  type(thickness_diffuse_cs),    pointer :: thickness_diffuse_csp => null()
    !< Pointer to the control structure used for the isopycnal height diffusive transport.
    !! This is also common referred to as Gent-McWilliams diffusion
  type(mixedlayer_restrat_cs),   pointer :: mixedlayer_restrat_csp => null()
    !< Pointer to the control structure used for the mixed layer restratification
  type(set_visc_cs),             pointer :: set_visc_csp => null()
    !< Pointer to the control structure used to set viscosities
  type(diabatic_cs),             pointer :: diabatic_csp => null()
    !< Pointer to the control structure for the diabatic driver
  type(meke_cs),                 pointer :: meke_csp => null()
    !< Pointer to the control structure for the MEKE updates
  type(varmix_cs),               pointer :: varmix => null()
    !< Pointer to the control structure for the variable mixing module
  type(barotropic_cs),           pointer :: barotropic_csp => null()
    !< Pointer to the control structure for the barotropic module
  type(tracer_registry_type),    pointer :: tracer_reg => null()
    !< Pointer to the MOM tracer registry
  type(tracer_advect_cs),        pointer :: tracer_adv_csp => null()
    !< Pointer to the MOM tracer advection control structure
  type(tracer_hor_diff_cs),      pointer :: tracer_diff_csp => null()
    !< Pointer to the MOM along-isopycnal tracer diffusion control structure
  type(tracer_flow_control_cs),  pointer :: tracer_flow_csp => null()
    !< Pointer to the control structure that orchestrates the calling of tracer packages
    ! Although update_OBC_CS is not used directly outside of initialization, other modules
    ! set pointers to this type, so it should be kept for the duration of the run.
  type(update_obc_cs),           pointer :: update_obc_csp => null()
    !< Pointer to the control structure for updating open boundary condition properties
  type(ocean_obc_type),          pointer :: obc => null()
    !< Pointer to the MOM open boundary condition type
  type(sponge_cs),               pointer :: sponge_csp => null()
    !< Pointer to the layered-mode sponge control structure
  type(ale_sponge_cs),           pointer :: ale_sponge_csp => null()
    !< Pointer to the ALE-mode sponge control structure
  type(ale_cs),                  pointer :: ale_csp => null()
    !< Pointer to the Arbitrary Lagrangian Eulerian (ALE) vertical coordinate control structure
 
  ! Pointers to control structures used for diagnostics
  type(sum_output_cs),           pointer :: sum_output_csp => null()
    !< Pointer to the globally summed output control structure
  type(diagnostics_cs),          pointer :: diagnostics_csp => null()
    !< Pointer to the MOM diagnostics control structure
  type(offline_transport_cs),    pointer :: offline_csp => null()
    !< Pointer to the offline tracer transport control structure
 
  logical               :: ensemble_ocean !< if true, this run is part of a
                                !! larger ensemble for the purpose of data assimilation
                                !! or statistical analysis.
  type(oda_cs), pointer :: odacs => null() !< a pointer to the control structure for handling
                                !! ensemble model state vectors and data assimilation
                                !! increments and priors
end type mom_control_struct
 
public initialize_mom, finish_mom_initialization, mom_end
public step_mom, step_offline
public extract_surface_state, get_ocean_stocks
public get_mom_state_elements, mom_state_is_synchronized
public allocate_surface_state, deallocate_surface_state
 
!>@{ CPU time clock IDs
integer :: id_clock_ocean
integer :: id_clock_dynamics
integer :: id_clock_thermo
integer :: id_clock_tracer
integer :: id_clock_diabatic
integer :: id_clock_adiabatic
integer :: id_clock_continuity  ! also in dynamics s/r
integer :: id_clock_thick_diff
integer :: id_clock_bbl_visc
integer :: id_clock_ml_restrat
integer :: id_clock_diagnostics
integer :: id_clock_z_diag
integer :: id_clock_init
integer :: id_clock_mom_init
integer :: id_clock_pass       ! also in dynamics d/r
integer :: id_clock_pass_init  ! also in dynamics d/r
integer :: id_clock_ale
integer :: id_clock_other
integer :: id_clock_offline_tracer
integer :: id_clock_unit_tests
!>@}
 
contains
 
!> This subroutine orchestrates the time stepping of MOM.  The adiabatic
!! dynamics are stepped by calls to one of the step_MOM_dyn_...routines.
!! The action of lateral processes on tracers occur in calls to
!! advect_tracer and tracer_hordiff.  Vertical mixing and possibly remapping
!! occur inside of diabatic.
subroutine step_mom(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, &
                    Waves, do_dynamics, do_thermodynamics, start_cycle, &
                    end_cycle, cycle_length, reset_therm)
  type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces
  type(forcing), target, intent(inout) :: fluxes_in  !< A structure with pointers to themodynamic,
                                                     !! tracer and mass exchange forcing fields
  type(surface), target, intent(inout) :: sfc_state  !< surface ocean state
  type(time_type),    intent(in)    :: time_start    !< starting time of a segment, as a time type
  real,               intent(in)    :: time_int_in   !< time interval covered by this run segment [s].
  type(mom_control_struct), pointer :: cs            !< control structure from initialize_MOM
  type(wave_parameters_cs), &
            optional, pointer       :: waves         !< An optional pointer to a wave property CS
  logical,  optional, intent(in)    :: do_dynamics   !< Present and false, do not do updates due
                                                     !! to the dynamics.
  logical,  optional, intent(in)    :: do_thermodynamics  !< Present and false, do not do updates due
                                                     !! to the thermodynamics or remapping.
  logical,  optional, intent(in)    :: start_cycle   !< This indicates whether this call is to be
                                                     !! treated as the first call to step_MOM in a
                                                     !! time-stepping cycle; missing is like true.
  logical,  optional, intent(in)    :: end_cycle     !< This indicates whether this call is to be
                                                     !! treated as the last call to step_MOM in a
                                                     !! time-stepping cycle; missing is like true.
  real,     optional, intent(in)    :: cycle_length  !< The amount of time in a coupled time
                                                     !! stepping cycle [s].
  logical,  optional, intent(in)    :: reset_therm   !< This indicates whether the running sums of
                                                     !! thermodynamic quantities should be reset.
                                                     !! If missing, this is like start_cycle.
 
  ! local variables
  type(ocean_grid_type),   pointer :: g => null()  ! pointer to a structure containing
                                                   ! metrics and related information
  type(ocean_grid_type),   pointer :: g_in => null()  ! Input grid metric
  type(verticalgrid_type), pointer :: gv => null() ! Pointer to the vertical grid structure
  type(unit_scale_type),   pointer :: us => null() ! Pointer to a structure containing
                                                   ! various unit conversion factors
  integer       :: ntstep ! time steps between tracer updates or diabatic forcing
  integer       :: n_max  ! number of steps to take in this call
 
  integer :: i, j, k, is, ie, js, je, isq, ieq, jsq, jeq, nz, n
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
 
  real :: time_interval   ! time interval covered by this run segment [T ~> s].
  real :: dt              ! baroclinic time step [T ~> s]
  real :: dtdia           ! time step for diabatic processes [T ~> s]
  real :: dt_therm        ! a limited and quantized version of CS%dt_therm [T ~> s]
  real :: dt_therm_here   ! a further limited value of dt_therm [T ~> s]
 
  real :: wt_end, wt_beg
  real :: bbl_time_int    ! The amount of time over which the calculated BBL
                          ! properties will apply, for use in diagnostics, or 0
                          ! if it is not to be calculated anew [T ~> s].
  real :: rel_time = 0.0  ! relative time since start of this call [T ~> s].
 
  logical :: calc_dtbt                 ! Indicates whether the dynamically adjusted
                                       ! barotropic time step needs to be updated.
  logical :: do_advection              ! If true, it is time to advect tracers.
  logical :: do_calc_bbl               ! If true, calculate the boundary layer properties.
  logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans
                                       ! multiple dynamic timesteps.
  logical :: do_dyn     ! If true, dynamics are updated with this call.
  logical :: do_thermo  ! If true, thermodynamics and remapping may be applied with this call.
  logical :: cycle_start ! If true, do calculations that are only done at the start of
                        ! a stepping cycle (whatever that may mean).
  logical :: cycle_end  ! If true, do calculations and diagnostics that are only done at
                        ! the end of a stepping cycle (whatever that may mean).
  logical :: therm_reset ! If true, reset running sums of thermodynamic quantities.
  real :: cycle_time    ! The length of the coupled time-stepping cycle [T ~> s].
  real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
    ssh         ! sea surface height, which may be based on eta_av [m]
 
  real, dimension(:,:,:), pointer :: &
    u => null(), & ! u : zonal velocity component [L T-1 ~> m s-1]
    v => null(), & ! v : meridional velocity component [L T-1 ~> m s-1]
    h => null()    ! h : layer thickness [H ~> m or kg m-2]
  real, dimension(:,:), pointer :: &
    p_surf => null() ! A pointer to the ocean surface pressure [R L2 T-2 ~> Pa].
  real :: i_wt_ssh  ! The inverse of the time weights [T-1 ~> s-1]
 
  type(time_type) :: time_local, end_time_thermo, time_temp
  type(group_pass_type) :: pass_tau_ustar_psurf
  logical :: showcalltree
 
  ! External forcing fields on the model index map
  type(mech_forcing), pointer :: forces     ! Mechanical forcing
  type(forcing), pointer :: fluxes          ! Boundary fluxes
  type(surface), pointer :: sfc_state_diag  ! Surface boundary fields
  integer :: turns  ! Number of quarter turns from input to model indexing
 
  g => cs%G ; g_in => cs%G_in ; gv => cs%GV ; us => cs%US
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec ; nz = g%ke
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  u => cs%u ; v => cs%v ; h => cs%h
 
  time_interval = us%s_to_T*time_int_in
  do_dyn = .true. ; if (present(do_dynamics)) do_dyn = do_dynamics
  do_thermo = .true. ; if (present(do_thermodynamics)) do_thermo = do_thermodynamics
  if (.not.(do_dyn .or. do_thermo)) call mom_error(fatal,"Step_MOM: "//&
    "Both do_dynamics and do_thermodynamics are false, which makes no sense.")
  cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle
  cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle
  cycle_time = time_interval ; if (present(cycle_length)) cycle_time = us%s_to_T*cycle_length
  therm_reset = cycle_start ; if (present(reset_therm)) therm_reset = reset_therm
 
  call cpu_clock_begin(id_clock_ocean)
  call cpu_clock_begin(id_clock_other)
 
  if (cs%debug) then
    call mom_state_chksum("Beginning of step_MOM ", u, v, h, cs%uh, cs%vh, g, gv, us)
  endif
 
  showcalltree = calltree_showquery()
  if (showcalltree) call calltree_enter("step_MOM(), MOM.F90")
 
  ! Rotate the forces from G_in to G
  if (cs%rotate_index) then
    turns = g%HI%turns
    allocate(forces)
    call allocate_mech_forcing(forces_in, g, forces)
    call rotate_mech_forcing(forces_in, turns, forces)
 
    allocate(fluxes)
    call allocate_forcing_type(fluxes_in, g, fluxes)
    call rotate_forcing(fluxes_in, fluxes, turns)
  else
    forces => forces_in
    fluxes => fluxes_in
  endif
 
  ! First determine the time step that is consistent with this call and an
  ! integer fraction of time_interval.
  if (do_dyn) then
    n_max = 1
    if (time_interval > cs%dt) n_max = ceiling(time_interval/cs%dt - 0.001)
    dt = time_interval / real(n_max)
    thermo_does_span_coupling = (cs%thermo_spans_coupling .and. &
                                (cs%dt_therm > 1.5*cycle_time))
    if (thermo_does_span_coupling) then
      ! Set dt_therm to be an integer multiple of the coupling time step.
      dt_therm = cycle_time * floor(cs%dt_therm / cycle_time + 0.001)
      ntstep = floor(dt_therm/dt + 0.001)
    elseif (.not.do_thermo) then
      dt_therm = cs%dt_therm
      if (present(cycle_length)) dt_therm = min(cs%dt_therm, us%s_to_T*cycle_length)
      ! ntstep is not used.
    else
      ntstep = max(1, min(n_max, floor(cs%dt_therm/dt + 0.001)))
      dt_therm = dt*ntstep
    endif
 
    if (associated(forces%p_surf)) p_surf => forces%p_surf
    if (.not.associated(forces%p_surf)) cs%interp_p_surf = .false.
    cs%tv%p_surf => null()
    if (cs%use_p_surf_in_EOS .and. associated(forces%p_surf)) cs%tv%p_surf => forces%p_surf
 
    !---------- Initiate group halo pass of the forcing fields
    call cpu_clock_begin(id_clock_pass)
    call create_group_pass(pass_tau_ustar_psurf, forces%taux, forces%tauy, g%Domain)
    if (associated(forces%ustar)) &
      call create_group_pass(pass_tau_ustar_psurf, forces%ustar, g%Domain)
    if (associated(forces%p_surf)) &
      call create_group_pass(pass_tau_ustar_psurf, forces%p_surf, g%Domain)
    if (g%nonblocking_updates) then
      call start_group_pass(pass_tau_ustar_psurf, g%Domain)
    else
      call do_group_pass(pass_tau_ustar_psurf, g%Domain)
    endif
    call cpu_clock_end(id_clock_pass)
  else
    ! This step only updates the thermodynamics so setting timesteps is simpler.
    n_max = 1
    if ((time_interval > cs%dt_therm) .and. (cs%dt_therm > 0.0)) &
      n_max = ceiling(time_interval/cs%dt_therm - 0.001)
 
    dt = time_interval / real(n_max)
    dt_therm = dt ; ntstep = 1
    if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf
    cs%tv%p_surf => null()
    if (associated(fluxes%p_surf)) then
      if (cs%use_p_surf_in_EOS) cs%tv%p_surf => fluxes%p_surf
    endif
    if (cs%UseWaves) call pass_var(fluxes%ustar, g%Domain, clock=id_clock_pass)
  endif
 
  if (therm_reset) then
    cs%time_in_thermo_cycle = 0.0
    if (associated(cs%tv%frazil))        cs%tv%frazil(:,:)        = 0.0
    if (associated(cs%tv%salt_deficit))  cs%tv%salt_deficit(:,:)  = 0.0
    if (associated(cs%tv%TempxPmE))      cs%tv%TempxPmE(:,:)      = 0.0
    if (associated(cs%tv%internal_heat)) cs%tv%internal_heat(:,:) = 0.0
  endif
 
  if (cycle_start) then
    cs%time_in_cycle = 0.0
    do j=js,je ; do i=is,ie ; cs%ssh_rint(i,j) = 0.0 ; enddo ; enddo
 
    if (associated(cs%VarMix)) then
      call enable_averages(cycle_time, time_start + real_to_time(us%T_to_s*cycle_time), cs%diag)
      call calc_resoln_function(h, cs%tv, g, gv, us, cs%VarMix)
      call calc_depth_function(g, cs%VarMix)
      call disable_averaging(cs%diag)
    endif
  endif
 
  if (do_dyn) then
    if (g%nonblocking_updates) &
      call complete_group_pass(pass_tau_ustar_psurf, g%Domain, clock=id_clock_pass)
 
    if (cs%interp_p_surf) then
      if (.not.associated(cs%p_surf_end))   allocate(cs%p_surf_end(isd:ied,jsd:jed))
      if (.not.associated(cs%p_surf_begin)) allocate(cs%p_surf_begin(isd:ied,jsd:jed))
      if (.not.cs%p_surf_prev_set) then
        do j=jsd,jed ; do i=isd,ied
          cs%p_surf_prev(i,j) = forces%p_surf(i,j)
        enddo ; enddo
        cs%p_surf_prev_set = .true.
      endif
    else
      cs%p_surf_end  => forces%p_surf
    endif
 
    if (cs%UseWaves) then
      ! Update wave information, which is presently kept static over each call to step_mom
      call enable_averages(time_interval, time_start + real_to_time(us%T_to_s*time_interval), cs%diag)
      call update_stokes_drift(g, gv, us, waves, h, forces%ustar)
      call disable_averaging(cs%diag)
    endif
  else ! not do_dyn.
    if (cs%UseWaves) & ! Diagnostics are not enabled in this call.
      call update_stokes_drift(g, gv, us, waves, h, fluxes%ustar)
  endif
 
  if (cs%debug) then
    if (cycle_start) &
      call mom_state_chksum("Before steps ", u, v, h, cs%uh, cs%vh, g, gv, us)
    if (cycle_start) call check_redundant("Before steps ", u, v, g)
    if (do_dyn) call mom_mech_forcing_chksum("Before steps", forces, g, us, haloshift=0)
    if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, g)
  endif
  call cpu_clock_end(id_clock_other)
 
  rel_time = 0.0
  do n=1,n_max
    rel_time = rel_time + dt ! The relative time at the end of the step.
    ! Set the universally visible time to the middle of the time step.
    cs%Time = time_start + real_to_time(us%T_to_s*(rel_time - 0.5*dt))
    ! Set the local time to the end of the time step.
    time_local = time_start + real_to_time(us%T_to_s*rel_time)
 
    if (showcalltree) call calltree_enter("DT cycles (step_MOM) n=",n)
 
    ! Update the vertically extensive diagnostic grids so that they are
    ! referenced to the beginning timestep
    call diag_update_remap_grids(cs%diag, update_intensive = .false., update_extensive = .true. )
 
    !===========================================================================
    ! This is the first place where the diabatic processes and remapping could occur.
    if (cs%diabatic_first .and. (cs%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics.
 
      if (.not.do_dyn) then
        dtdia = dt
      elseif (thermo_does_span_coupling) then
        dtdia = dt_therm
        if ((fluxes%dt_buoy_accum > 0.0) .and. (dtdia > time_interval) .and. &
            (abs(fluxes%dt_buoy_accum - dtdia) > 1e-6*dtdia)) then
          call mom_error(fatal, "step_MOM: Mismatch between long thermodynamic "//&
            "timestep and time over which buoyancy fluxes have been accumulated.")
        endif
        call mom_error(fatal, "MOM is not yet set up to have restarts that work "//&
          "with THERMO_SPANS_COUPLING and DIABATIC_FIRST.")
      else
        dtdia = dt*min(ntstep,n_max-(n-1))
      endif
 
      end_time_thermo = time_local
      if (dtdia > dt) then
        ! If necessary, temporarily reset CS%Time to the center of the period covered
        ! by the call to step_MOM_thermo, noting that they begin at the same time.
        cs%Time = cs%Time + real_to_time(0.5*us%T_to_s*(dtdia-dt))
        ! The end-time of the diagnostic interval needs to be set ahead if there
        ! are multiple dynamic time steps worth of thermodynamics applied here.
        end_time_thermo = time_local + real_to_time(us%T_to_s*(dtdia-dt))
      endif
 
      ! Apply diabatic forcing, do mixing, and regrid.
      call step_mom_thermo(cs, g, gv, us, u, v, h, cs%tv, fluxes, dtdia, &
                           end_time_thermo, .true., waves=waves)
      cs%time_in_thermo_cycle = cs%time_in_thermo_cycle + dtdia
 
      ! The diabatic processes are now ahead of the dynamics by dtdia.
      cs%t_dyn_rel_thermo = -dtdia
      if (showcalltree) call calltree_waypoint("finished diabatic_first (step_MOM)")
 
      if (dtdia > dt) & ! Reset CS%Time to its previous value.
        cs%Time = time_start + real_to_time(us%T_to_s*(rel_time - 0.5*dt))
    endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))"
 
    if (do_dyn) then
      ! Store pre-dynamics thicknesses for proper diagnostic remapping for transports or
      ! advective tendencies.  If there are more than one dynamics steps per advective
      ! step (i.e DT_THERM > DT), this needs to be stored at the first dynamics call.
      if (.not.cs%preadv_h_stored .and. (cs%t_dyn_rel_adv == 0.)) then
        call diag_copy_diag_to_storage(cs%diag_pre_dyn, h, cs%diag)
        cs%preadv_h_stored = .true.
      endif
 
      ! The pre-dynamics velocities might be stored for debugging truncations.
      if (associated(cs%u_prev) .and. associated(cs%v_prev)) then
        do k=1,nz ; do j=jsd,jed ; do i=isdb,iedb
          cs%u_prev(i,j,k) = u(i,j,k)
        enddo ; enddo ; enddo
        do k=1,nz ; do j=jsdb,jedb ; do i=isd,ied
          cs%v_prev(i,j,k) = v(i,j,k)
        enddo ; enddo ; enddo
      endif
 
      dt_therm_here = dt_therm
      if (do_thermo .and. do_dyn .and. .not.thermo_does_span_coupling) &
        dt_therm_here = dt*min(ntstep, n_max-n+1)
 
      ! Indicate whether the bottom boundary layer properties need to be
      ! recalculated, and if so for how long an interval they are valid.
      bbl_time_int = 0.0
      if (do_thermo) then
        if ((cs%t_dyn_rel_adv == 0.0) .or. (n==1)) &
          bbl_time_int = max(dt, min(dt_therm - cs%t_dyn_rel_adv, dt*(1+n_max-n)) )
      else
        if ((cs%t_dyn_rel_adv == 0.0) .or. ((n==1) .and. cycle_start)) &
          bbl_time_int = min(dt_therm, cycle_time)
      endif
 
      if (cs%interp_p_surf) then
        wt_end = real(n) / real(n_max)
        wt_beg = real(n-1) / real(n_max)
        do j=jsd,jed ; do i=isd,ied
          cs%p_surf_end(i,j) = wt_end * forces%p_surf(i,j) + &
                          (1.0-wt_end) * cs%p_surf_prev(i,j)
          cs%p_surf_begin(i,j) = wt_beg * forces%p_surf(i,j) + &
                          (1.0-wt_beg) * cs%p_surf_prev(i,j)
        enddo ; enddo
      endif
 
      call step_mom_dynamics(forces, cs%p_surf_begin, cs%p_surf_end, dt, &
                             dt_therm_here, bbl_time_int, cs, &
                             time_local, waves=waves)
 
      !===========================================================================
      ! This is the start of the tracer advection part of the algorithm.
 
      if (thermo_does_span_coupling .or. .not.do_thermo) then
        do_advection = (cs%t_dyn_rel_adv + 0.5*dt > dt_therm)
      else
        do_advection = ((mod(n,ntstep) == 0) .or. (n==n_max))
      endif
 
      if (do_advection) then ! Do advective transport and lateral tracer mixing.
        call step_mom_tracer_dyn(cs, g, gv, us, h, time_local)
        if (cs%diabatic_first .and. abs(cs%t_dyn_rel_thermo) > 1e-6*dt) call mom_error(fatal, &
                "step_MOM: Mismatch between the dynamics and diabatic times "//&
                "with DIABATIC_FIRST.")
      endif
    endif ! end of (do_dyn)
 
    !===========================================================================
    ! This is the second place where the diabatic processes and remapping could occur.
    if ((cs%t_dyn_rel_adv==0.0) .and. do_thermo .and. (.not.cs%diabatic_first)) then
 
      dtdia = cs%t_dyn_rel_thermo
      ! If the MOM6 dynamic and thermodynamic time stepping is being orchestrated
      ! by the coupler, the value of diabatic_first does not matter.
      if ((cs%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) dtdia = dt
 
      if (cs%thermo_spans_coupling .and. (cs%dt_therm > 1.5*cycle_time) .and. &
          (abs(dt_therm - dtdia) > 1e-6*dt_therm)) then
        call mom_error(fatal, "step_MOM: Mismatch between dt_therm and dtdia "//&
                       "before call to diabatic.")
      endif
 
      ! If necessary, temporarily reset CS%Time to the center of the period covered
      ! by the call to step_MOM_thermo, noting that they end at the same time.
      if (dtdia > dt) cs%Time = cs%Time - real_to_time(0.5*us%T_to_s*(dtdia-dt))
 
      ! Apply diabatic forcing, do mixing, and regrid.
      call step_mom_thermo(cs, g, gv, us, u, v, h, cs%tv, fluxes, dtdia, &
                           time_local, .false., waves=waves)
      cs%time_in_thermo_cycle = cs%time_in_thermo_cycle + dtdia
 
      if ((cs%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then
        ! The diabatic processes are now ahead of the dynamics by dtdia.
        cs%t_dyn_rel_thermo = -dtdia
      else ! The diabatic processes and the dynamics are synchronized.
        cs%t_dyn_rel_thermo = 0.0
      endif
 
      if (dtdia > dt) & ! Reset CS%Time to its previous value.
        cs%Time = time_start + real_to_time(us%T_to_s*(rel_time - 0.5*dt))
    endif
 
    if (do_dyn) then
      call cpu_clock_begin(id_clock_dynamics)
      ! Determining the time-average sea surface height is part of the algorithm.
      ! This may be eta_av if Boussinesq, or need to be diagnosed if not.
      cs%time_in_cycle = cs%time_in_cycle + dt
      call find_eta(h, cs%tv, g, gv, us, ssh, cs%eta_av_bc, eta_to_m=1.0)
      do j=js,je ; do i=is,ie
        cs%ssh_rint(i,j) = cs%ssh_rint(i,j) + dt*ssh(i,j)
      enddo ; enddo
      if (cs%IDs%id_ssh_inst > 0) call post_data(cs%IDs%id_ssh_inst, ssh, cs%diag)
      call cpu_clock_end(id_clock_dynamics)
    endif
 
    !===========================================================================
    ! Calculate diagnostics at the end of the time step if the state is self-consistent.
    if (mom_state_is_synchronized(cs)) then
    !### Perhaps this should be if (CS%t_dyn_rel_thermo == 0.0)
      call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics)
      ! Diagnostics that require the complete state to be up-to-date can be calculated.
 
      call enable_averages(cs%t_dyn_rel_diag, time_local, cs%diag)
      call calculate_diagnostic_fields(u, v, h, cs%uh, cs%vh, cs%tv, cs%ADp,  &
                          cs%CDp, p_surf, cs%t_dyn_rel_diag, cs%diag_pre_sync,&
                          g, gv, us, cs%diagnostics_CSp)
      call post_tracer_diagnostics_at_sync(cs%Tracer_reg, h, cs%diag_pre_sync, cs%diag, g, gv, cs%t_dyn_rel_diag)
      call diag_copy_diag_to_storage(cs%diag_pre_sync, h, cs%diag)
      if (showcalltree) call calltree_waypoint("finished calculate_diagnostic_fields (step_MOM)")
      call disable_averaging(cs%diag)
      cs%t_dyn_rel_diag = 0.0
 
      call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other)
    endif
 
    if (do_dyn .and. .not.cs%count_calls) cs%nstep_tot = cs%nstep_tot + 1
    if (showcalltree) call calltree_leave("DT cycles (step_MOM)")
 
  enddo ! complete the n loop
 
  if (cs%count_calls .and. cycle_start) cs%nstep_tot = cs%nstep_tot + 1
 
  call cpu_clock_begin(id_clock_other)
 
  if (cs%time_in_cycle > 0.0) then
    i_wt_ssh = 1.0/cs%time_in_cycle
    do j=js,je ; do i=is,ie
      ssh(i,j) = cs%ssh_rint(i,j)*i_wt_ssh
      cs%ave_ssh_ibc(i,j) = ssh(i,j)
    enddo ; enddo
    if (do_dyn) then
      call adjust_ssh_for_p_atm(cs%tv, g, gv, us, cs%ave_ssh_ibc, forces%p_surf_SSH, &
                                cs%calc_rho_for_sea_lev)
    elseif (do_thermo) then
      call adjust_ssh_for_p_atm(cs%tv, g, gv, us, cs%ave_ssh_ibc, fluxes%p_surf_SSH, &
                                cs%calc_rho_for_sea_lev)
    endif
  endif
 
  if (do_dyn .and. cs%interp_p_surf) then ; do j=jsd,jed ; do i=isd,ied
    cs%p_surf_prev(i,j) = forces%p_surf(i,j)
  enddo ; enddo ; endif
 
  if (cs%ensemble_ocean) then
    ! update the time for the next analysis step if needed
    call set_analysis_time(cs%Time,cs%odaCS)
    ! store ensemble vector in odaCS
    call set_prior_tracer(cs%Time, g, gv, cs%h, cs%tv, cs%odaCS)
    ! call DA interface
    call oda(cs%Time,cs%odaCS)
  endif
 
  if (showcalltree) call calltree_waypoint("calling extract_surface_state (step_MOM)")
  ! NOTE: sfc_state uses input indexing, since it is also used by drivers.
  call extract_surface_state(cs, sfc_state)
 
  ! Do diagnostics that only occur at the end of a complete forcing step.
  if (cycle_end) then
    if (cs%rotate_index) then
      allocate(sfc_state_diag)
      call rotate_surface_state(sfc_state, g_in, sfc_state_diag, g, turns)
    else
      sfc_state_diag => sfc_state
    endif
 
    call cpu_clock_begin(id_clock_diagnostics)
    if (cs%time_in_cycle > 0.0) then
      call enable_averages(cs%time_in_cycle, time_local, cs%diag)
      call post_surface_dyn_diags(cs%sfc_IDs, g, cs%diag, sfc_state_diag, ssh)
    endif
    if (cs%time_in_thermo_cycle > 0.0) then
      call enable_averages(cs%time_in_thermo_cycle, time_local, cs%diag)
      call post_surface_thermo_diags(cs%sfc_IDs, g, gv, us, cs%diag, cs%time_in_thermo_cycle, &
                                     sfc_state_diag, cs%tv, ssh, cs%ave_ssh_ibc)
    endif
    call disable_averaging(cs%diag)
    call cpu_clock_end(id_clock_diagnostics)
  endif
 
  ! Accumulate the surface fluxes for assessing conservation
  if (do_thermo .and. fluxes%fluxes_used) &
    call accumulate_net_input(fluxes, sfc_state, cs%tv, fluxes%dt_buoy_accum, &
                              g, us, cs%sum_output_CSp)
 
  if (mom_state_is_synchronized(cs)) &
    call write_energy(cs%u, cs%v, cs%h, cs%tv, time_local, cs%nstep_tot, &
                      g, gv, us, cs%sum_output_CSp, cs%tracer_flow_CSp, &
                      dt_forcing=real_to_time(us%T_to_s*time_interval) )
 
  call cpu_clock_end(id_clock_other)
 
  ! De-rotate fluxes and copy back to the input, since they can be changed.
  if (cs%rotate_index) then
    call rotate_forcing(fluxes, fluxes_in, -turns)
 
    call deallocate_mech_forcing(forces)
    deallocate(forces)
 
    call deallocate_forcing_type(fluxes)
    deallocate(fluxes)
  endif
 
  if (showcalltree) call calltree_leave("step_MOM()")
  call cpu_clock_end(id_clock_ocean)
 
end subroutine step_mom
 
!> Time step the ocean dynamics, including the momentum and continuity equations
subroutine step_mom_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
                             bbl_time_int, CS, Time_local, Waves)
  type(mech_forcing), intent(in)    :: forces     !< A structure with the driving mechanical forces
  real, dimension(:,:), pointer     :: p_surf_begin !< A pointer (perhaps NULL) to the surface
                                                  !! pressure at the beginning of this dynamic
                                                  !! step, intent in [R L2 T-2 ~> Pa].
  real, dimension(:,:), pointer     :: p_surf_end !< A pointer (perhaps NULL) to the surface
                                                  !! pressure at the end of this dynamic step,
                                                  !! intent in [R L2 T-2 ~> Pa].
  real,               intent(in)    :: dt         !< time interval covered by this call [T ~> s].
  real,               intent(in)    :: dt_thermo  !< time interval covered by any updates that may
                                                  !! span multiple dynamics steps [T ~> s].
  real,               intent(in)    :: bbl_time_int !< time interval over which updates to the
                                                  !! bottom boundary layer properties will apply [T ~> s],
                                                  !! or zero not to update the properties.
  type(mom_control_struct), pointer :: CS         !< control structure from initialize_MOM
  type(time_type),    intent(in)    :: Time_local !< End time of a segment, as a time type
  type(wave_parameters_cs), &
            optional, pointer       :: Waves      !< Container for wave related parameters; the
                                                  !! fields in Waves are intent in here.
 
  ! local variables
  type(ocean_grid_type),   pointer :: G => null()  ! pointer to a structure containing
                                                   ! metrics and related information
  type(verticalgrid_type), pointer :: GV => null() ! Pointer to the vertical grid structure
  type(unit_scale_type),   pointer :: US => null() ! Pointer to a structure containing
                                                   ! various unit conversion factors
  type(mom_diag_ids), pointer :: IDs => null() ! A structure with the diagnostic IDs.
  real, dimension(:,:,:), pointer :: &
    u => null(), & ! u : zonal velocity component [L T-1 ~> m s-1]
    v => null(), & ! v : meridional velocity component [L T-1 ~> m s-1]
    h => null()    ! h : layer thickness [H ~> m or kg m-2]
 
  logical :: calc_dtbt  ! Indicates whether the dynamically adjusted
                        ! barotropic time step needs to be updated.
  logical :: showCallTree
 
  integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
  integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
 
  g => cs%G ; gv => cs%GV ; us => cs%US ; ids => cs%IDs
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec ; nz = g%ke
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
  u => cs%u ; v => cs%v ; h => cs%h
  showcalltree = calltree_showquery()
 
  call cpu_clock_begin(id_clock_dynamics)
 
  if ((cs%t_dyn_rel_adv == 0.0) .and. cs%thickness_diffuse .and. cs%thickness_diffuse_first) then
 
    call enable_averages(dt_thermo, time_local+real_to_time(us%T_to_s*(dt_thermo-dt)), cs%diag)
    call cpu_clock_begin(id_clock_thick_diff)
    if (associated(cs%VarMix)) &
      call calc_slope_functions(h, cs%tv, dt, g, gv, us, cs%VarMix, obc=cs%OBC)
    call thickness_diffuse(h, cs%uhtr, cs%vhtr, cs%tv, dt_thermo, g, gv, us, &
                           cs%MEKE, cs%VarMix, cs%CDp, cs%thickness_diffuse_CSp)
    call cpu_clock_end(id_clock_thick_diff)
    call pass_var(h, g%Domain, clock=id_clock_pass, halo=max(2,cs%cont_stencil))
    call disable_averaging(cs%diag)
    if (showcalltree) call calltree_waypoint("finished thickness_diffuse_first (step_MOM)")
 
    ! Whenever thickness changes let the diag manager know, target grids
    ! for vertical remapping may need to be regenerated.
    call diag_update_remap_grids(cs%diag)
  endif
 
  ! The bottom boundary layer properties need to be recalculated.
  if (bbl_time_int > 0.0) then
    call enable_averages(bbl_time_int, &
              time_local + real_to_time(us%T_to_s*(bbl_time_int-dt)), cs%diag)
    ! Calculate the BBL properties and store them inside visc (u,h).
    call cpu_clock_begin(id_clock_bbl_visc)
    call set_viscous_bbl(cs%u, cs%v, cs%h, cs%tv, cs%visc, g, gv, us, &
                         cs%set_visc_CSp, symmetrize=.true.)
    call cpu_clock_end(id_clock_bbl_visc)
    if (showcalltree) call calltree_waypoint("done with set_viscous_BBL (step_MOM)")
    call disable_averaging(cs%diag)
  endif
 
 
  if (cs%do_dynamics .and. cs%split) then !--------------------------- start SPLIT
    ! This section uses a split time stepping scheme for the dynamic equations,
    ! basically the stacked shallow water equations with viscosity.
 
    calc_dtbt = .false.
    if (cs%dtbt_reset_period == 0.0) calc_dtbt = .true.
    if (cs%dtbt_reset_period > 0.0) then
      if (time_local >= cs%dtbt_reset_time) then  !### Change >= to > here.
        calc_dtbt = .true.
        cs%dtbt_reset_time = cs%dtbt_reset_time + cs%dtbt_reset_interval
      endif
    endif
 
    call step_mom_dyn_split_rk2(u, v, h, cs%tv, cs%visc, time_local, dt, forces, &
                p_surf_begin, p_surf_end, cs%uh, cs%vh, cs%uhtr, cs%vhtr, &
                cs%eta_av_bc, g, gv, us, cs%dyn_split_RK2_CSp, calc_dtbt, cs%VarMix, &
                cs%MEKE, cs%thickness_diffuse_CSp, waves=waves)
    if (showcalltree) call calltree_waypoint("finished step_MOM_dyn_split (step_MOM)")
 
  elseif (cs%do_dynamics) then ! ------------------------------------ not SPLIT
    !   This section uses an unsplit stepping scheme for the dynamic
    ! equations; basically the stacked shallow water equations with viscosity.
    ! Because the time step is limited by CFL restrictions on the external
    ! gravity waves, the unsplit is usually much less efficient that the split
    ! approaches. But because of its simplicity, the unsplit method is very
    ! useful for debugging purposes.
 
    if (cs%use_RK2) then
      call step_mom_dyn_unsplit_rk2(u, v, h, cs%tv, cs%visc, time_local, dt, forces, &
               p_surf_begin, p_surf_end, cs%uh, cs%vh, cs%uhtr, cs%vhtr, &
               cs%eta_av_bc, g, gv, us, cs%dyn_unsplit_RK2_CSp, cs%VarMix, cs%MEKE)
    else
      call step_mom_dyn_unsplit(u, v, h, cs%tv, cs%visc, time_local, dt, forces, &
               p_surf_begin, p_surf_end, cs%uh, cs%vh, cs%uhtr, cs%vhtr, &
               cs%eta_av_bc, g, gv, us, cs%dyn_unsplit_CSp, cs%VarMix, cs%MEKE, waves=waves)
    endif
    if (showcalltree) call calltree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)")
 
  endif ! -------------------------------------------------- end SPLIT
 
  if (cs%thickness_diffuse .and. .not.cs%thickness_diffuse_first) then
    call cpu_clock_begin(id_clock_thick_diff)
 
    if (cs%debug) call hchksum(h,"Pre-thickness_diffuse h", g%HI, haloshift=0, scale=gv%H_to_m)
 
    if (associated(cs%VarMix)) &
      call calc_slope_functions(h, cs%tv, dt, g, gv, us, cs%VarMix, obc=cs%OBC)
    call thickness_diffuse(h, cs%uhtr, cs%vhtr, cs%tv, dt, g, gv, us, &
                           cs%MEKE, cs%VarMix, cs%CDp, cs%thickness_diffuse_CSp)
 
    if (cs%debug) call hchksum(h,"Post-thickness_diffuse h", g%HI, haloshift=1, scale=gv%H_to_m)
    call cpu_clock_end(id_clock_thick_diff)
    call pass_var(h, g%Domain, clock=id_clock_pass, halo=max(2,cs%cont_stencil))
    if (showcalltree) call calltree_waypoint("finished thickness_diffuse (step_MOM)")
  endif
 
  ! apply the submesoscale mixed layer restratification parameterization
  if (cs%mixedlayer_restrat) then
    if (cs%debug) then
      call hchksum(h,"Pre-mixedlayer_restrat h", g%HI, haloshift=1, scale=gv%H_to_m)
      call uvchksum("Pre-mixedlayer_restrat uhtr", &
                    cs%uhtr, cs%vhtr, g%HI, haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
    endif
    call cpu_clock_begin(id_clock_ml_restrat)
    call mixedlayer_restrat(h, cs%uhtr, cs%vhtr, cs%tv, forces, dt, cs%visc%MLD, &
                            cs%VarMix, g, gv, us, cs%mixedlayer_restrat_CSp)
    call cpu_clock_end(id_clock_ml_restrat)
    call pass_var(h, g%Domain, clock=id_clock_pass, halo=max(2,cs%cont_stencil))
    if (cs%debug) then
      call hchksum(h,"Post-mixedlayer_restrat h", g%HI, haloshift=1, scale=gv%H_to_m)
      call uvchksum("Post-mixedlayer_restrat [uv]htr", &
                    cs%uhtr, cs%vhtr, g%HI, haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
    endif
  endif
 
  ! Whenever thickness changes let the diag manager know, target grids
  ! for vertical remapping may need to be regenerated.
  call diag_update_remap_grids(cs%diag)
 
  if (cs%useMEKE) call step_forward_meke(cs%MEKE, h, cs%VarMix%SN_u, cs%VarMix%SN_v, &
                                         cs%visc, dt, g, gv, us, cs%MEKE_CSp, cs%uhtr, cs%vhtr)
  call disable_averaging(cs%diag)
 
  ! Advance the dynamics time by dt.
  cs%t_dyn_rel_adv = cs%t_dyn_rel_adv + dt
  cs%t_dyn_rel_thermo = cs%t_dyn_rel_thermo + dt
  if (abs(cs%t_dyn_rel_thermo) < 1e-6*dt) cs%t_dyn_rel_thermo = 0.0
  cs%t_dyn_rel_diag = cs%t_dyn_rel_diag + dt
 
  call cpu_clock_end(id_clock_dynamics)
 
  call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics)
  call enable_averages(dt, time_local, cs%diag)
  ! These diagnostics are available after every time dynamics step.
  if (ids%id_u > 0) call post_data(ids%id_u, u, cs%diag)
  if (ids%id_v > 0) call post_data(ids%id_v, v, cs%diag)
  if (ids%id_h > 0) call post_data(ids%id_h, h, cs%diag)
  call disable_averaging(cs%diag)
  call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other)
 
end subroutine step_mom_dynamics
 
!> step_MOM_tracer_dyn does tracer advection and lateral diffusion, bringing the
!! tracers up to date with the changes in state due to the dynamics.  Surface
!! sources and sinks and remapping are handled via step_MOM_thermo.
subroutine step_mom_tracer_dyn(CS, G, GV, US, h, Time_local)
  type(mom_control_struct), intent(inout) :: CS     !< control structure
  type(ocean_grid_type),    intent(inout) :: G      !< ocean grid structure
  type(verticalgrid_type),  intent(in)    :: GV     !< ocean vertical grid structure
  type(unit_scale_type),    intent(in)    :: US     !< A dimensional unit scaling type
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)),  &
                            intent(in)    :: h      !< layer thicknesses after the transports [H ~> m or kg m-2]
  type(time_type),          intent(in)    :: Time_local !< The model time at the end
                                                    !! of the time step.
  type(group_pass_type) :: pass_T_S
  integer :: halo_sz ! The size of a halo where data must be valid.
  logical :: showCallTree
  showcalltree = calltree_showquery()
 
  if (cs%debug) then
    call cpu_clock_begin(id_clock_other)
    call hchksum(h,"Pre-advection h", g%HI, haloshift=1, scale=gv%H_to_m)
    call uvchksum("Pre-advection uhtr", cs%uhtr, cs%vhtr, g%HI, &
                  haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
    if (associated(cs%tv%T)) call hchksum(cs%tv%T, "Pre-advection T", g%HI, haloshift=1)
    if (associated(cs%tv%S)) call hchksum(cs%tv%S, "Pre-advection S", g%HI, haloshift=1)
    if (associated(cs%tv%frazil)) call hchksum(cs%tv%frazil, "Pre-advection frazil", g%HI, haloshift=0, &
                                               scale=g%US%Q_to_J_kg*g%US%RZ_to_kg_m2)
    if (associated(cs%tv%salt_deficit)) call hchksum(cs%tv%salt_deficit, &
                   "Pre-advection salt deficit", g%HI, haloshift=0, scale=us%RZ_to_kg_m2)
  ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US)
    call cpu_clock_end(id_clock_other)
  endif
 
  call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer)
  call enable_averages(cs%t_dyn_rel_adv, time_local, cs%diag)
 
  call advect_tracer(h, cs%uhtr, cs%vhtr, cs%OBC, cs%t_dyn_rel_adv, g, gv, us, &
                     cs%tracer_adv_CSp, cs%tracer_Reg)
  call tracer_hordiff(h, cs%t_dyn_rel_adv, cs%MEKE, cs%VarMix, g, gv, us, &
                      cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
  if (showcalltree) call calltree_waypoint("finished tracer advection/diffusion (step_MOM)")
  call update_segment_tracer_reservoirs(g, gv, cs%uhtr, cs%vhtr, h, cs%OBC, &
                     cs%t_dyn_rel_adv, cs%tracer_Reg)
  call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo)
 
  call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics)
  call post_transport_diagnostics(g, gv, us, cs%uhtr, cs%vhtr, h, cs%transport_IDs, &
           cs%diag_pre_dyn, cs%diag, cs%t_dyn_rel_adv, cs%tracer_reg)
  ! Rebuild the remap grids now that we've posted the fields which rely on thicknesses
  ! from before the dynamics calls
  call diag_update_remap_grids(cs%diag)
 
  call disable_averaging(cs%diag)
  call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other)
 
  ! Reset the accumulated transports to 0 and record that the dynamics
  ! and advective times now agree.
  call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer)
  cs%uhtr(:,:,:) = 0.0
  cs%vhtr(:,:,:) = 0.0
  cs%t_dyn_rel_adv = 0.0
  call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo)
 
  if (associated(cs%tv%T)) then
    call extract_diabatic_member(cs%diabatic_CSp, diabatic_halo=halo_sz)
    if (halo_sz > 0) then
      call create_group_pass(pass_t_s, cs%tv%T, g%Domain, to_all, halo=halo_sz)
      call create_group_pass(pass_t_s, cs%tv%S, g%Domain, to_all, halo=halo_sz)
      call do_group_pass(pass_t_s, g%Domain, clock=id_clock_pass)
    elseif (cs%diabatic_first) then
      ! Temperature and salinity need halo updates because they will be used
      ! in the dynamics before they are changed again.
      call create_group_pass(pass_t_s, cs%tv%T, g%Domain, to_all+omit_corners, halo=1)
      call create_group_pass(pass_t_s, cs%tv%S, g%Domain, to_all+omit_corners, halo=1)
      call do_group_pass(pass_t_s, g%Domain, clock=id_clock_pass)
    endif
  endif
 
  cs%preadv_h_stored = .false.
 
end subroutine step_mom_tracer_dyn
 
!> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical
!! remapping, via calls to diabatic (or adiabatic) and ALE_main.
subroutine step_mom_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
                           Time_end_thermo, update_BBL, Waves)
  type(mom_control_struct), intent(inout) :: CS     !< Master MOM control structure
  type(ocean_grid_type),    intent(inout) :: G      !< ocean grid structure
  type(verticalgrid_type),  intent(inout) :: GV     !< ocean vertical grid structure
  type(unit_scale_type),    intent(in)    :: US     !< A dimensional unit scaling type
  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
                            intent(inout) :: u      !< zonal velocity [L T-1 ~> m s-1]
  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
                            intent(inout) :: v      !< meridional velocity [L T-1 ~> m s-1]
  real, dimension(SZI_(G),SZJ_(G),SZK_(G)),  &
                            intent(inout) :: h      !< layer thickness [H ~> m or kg m-2]
  type(thermo_var_ptrs),    intent(inout) :: tv     !< A structure pointing to various thermodynamic variables
  type(forcing),            intent(inout) :: fluxes !< pointers to forcing fields
  real,                     intent(in)    :: dtdia  !< The time interval over which to advance [T ~> s]
  type(time_type),          intent(in)    :: Time_end_thermo !< End of averaging interval for thermo diags
  logical,                  intent(in)    :: update_BBL !< If true, calculate the bottom boundary layer properties.
  type(wave_parameters_cs), &
                  optional, pointer       :: Waves  !< Container for wave related parameters
                                                    !! the fields in Waves are intent in here.
 
  logical :: use_ice_shelf ! Needed for selecting the right ALE interface.
  logical :: showCallTree
  type(group_pass_type) :: pass_T_S, pass_T_S_h, pass_uv_T_S_h
  integer :: dynamics_stencil  ! The computational stencil for the calculations
                               ! in the dynamic core.
  integer :: halo_sz ! The size of a halo where data must be valid.
  integer :: i, j, k, is, ie, js, je, nz
 
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
  showcalltree = calltree_showquery()
  if (showcalltree) call calltree_enter("step_MOM_thermo(), MOM.F90")
 
  use_ice_shelf = .false.
  if (associated(fluxes%frac_shelf_h)) use_ice_shelf = .true.
 
  call enable_averages(dtdia, time_end_thermo, cs%diag)
 
  if (associated(cs%odaCS)) then
    call apply_oda_tracer_increments(us%T_to_s*dtdia,g,tv,h,cs%odaCS)
  endif
 
  if (associated(fluxes%p_surf) .or. associated(fluxes%p_surf_full)) then
    call extract_diabatic_member(cs%diabatic_CSp, diabatic_halo=halo_sz)
    if (halo_sz > 0) then
      if (associated(fluxes%p_surf_full)) &
        call pass_var(fluxes%p_surf_full, g%Domain, &
                      clock=id_clock_pass, halo=halo_sz, complete=.not.associated(fluxes%p_surf))
      call pass_var(fluxes%p_surf, g%Domain, clock=id_clock_pass, halo=halo_sz, complete=.true.)
    endif
  endif
 
  if (update_bbl) then
    !   Calculate the BBL properties and store them inside visc (u,h).
    ! This is here so that CS%visc is updated before diabatic() when
    ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics
    ! and set_viscous_BBL is called as a part of the dynamic stepping.
    call cpu_clock_begin(id_clock_bbl_visc)
    call set_viscous_bbl(u, v, h, tv, cs%visc, g, gv, us, cs%set_visc_CSp, symmetrize=.true.)
    call cpu_clock_end(id_clock_bbl_visc)
    if (showcalltree) call calltree_waypoint("done with set_viscous_BBL (step_MOM_thermo)")
  endif
 
  call cpu_clock_begin(id_clock_thermo)
  if (.not.cs%adiabatic) then
    if (cs%debug) then
      call uvchksum("Pre-diabatic [uv]", u, v, g%HI, haloshift=2, scale=us%L_T_to_m_s)
      call hchksum(h,"Pre-diabatic h", g%HI, haloshift=1, scale=gv%H_to_m)
      call uvchksum("Pre-diabatic [uv]h", cs%uhtr, cs%vhtr, g%HI, &
                    haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
    ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0)
      call mom_thermo_chksum("Pre-diabatic ", tv, g, us, haloshift=0)
      call check_redundant("Pre-diabatic ", u, v, g)
      call mom_forcing_chksum("Pre-diabatic", fluxes, g, us, haloshift=0)
    endif
 
    call cpu_clock_begin(id_clock_diabatic)
 
    call diabatic(u, v, h, tv, cs%Hml, fluxes, cs%visc, cs%ADp, cs%CDp, dtdia, &
                  time_end_thermo, g, gv, us, cs%diabatic_CSp, obc=cs%OBC, waves=waves)
    fluxes%fluxes_used = .true.
 
    if (showcalltree) call calltree_waypoint("finished diabatic (step_MOM_thermo)")
 
    ! Regridding/remapping is done here, at end of thermodynamics time step
    ! (that may comprise several dynamical time steps)
    ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'.
    if ( cs%use_ALE_algorithm ) then
      call enable_averages(dtdia, time_end_thermo, cs%diag)
!         call pass_vector(u, v, G%Domain)
      call cpu_clock_begin(id_clock_pass)
      if (associated(tv%T)) &
        call create_group_pass(pass_t_s_h, tv%T, g%Domain, to_all+omit_corners, halo=1)
      if (associated(tv%S)) &
        call create_group_pass(pass_t_s_h, tv%S, g%Domain, to_all+omit_corners, halo=1)
      call create_group_pass(pass_t_s_h, h, g%Domain, to_all+omit_corners, halo=1)
      call do_group_pass(pass_t_s_h, g%Domain)
      call cpu_clock_end(id_clock_pass)
 
      call preale_tracer_diagnostics(cs%tracer_Reg, g, gv)
 
      if (cs%debug) then
        call mom_state_chksum("Pre-ALE ", u, v, h, cs%uh, cs%vh, g, gv, us)
        call hchksum(tv%T,"Pre-ALE T", g%HI, haloshift=1)
        call hchksum(tv%S,"Pre-ALE S", g%HI, haloshift=1)
        call check_redundant("Pre-ALE ", u, v, g)
      endif
      call cpu_clock_begin(id_clock_ale)
      if (use_ice_shelf) then
        call ale_main(g, gv, us, h, u, v, tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC, &
                      dtdia, fluxes%frac_shelf_h)
      else
        call ale_main(g, gv, us, h, u, v, tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC, dtdia)
      endif
 
      if (showcalltree) call calltree_waypoint("finished ALE_main (step_MOM_thermo)")
      call cpu_clock_end(id_clock_ale)
    endif   ! endif for the block "if ( CS%use_ALE_algorithm )"
 
    dynamics_stencil = min(3, g%Domain%nihalo, g%Domain%njhalo)
    call create_group_pass(pass_uv_t_s_h, u, v, g%Domain, halo=dynamics_stencil)
    if (associated(tv%T)) &
      call create_group_pass(pass_uv_t_s_h, tv%T, g%Domain, halo=dynamics_stencil)
    if (associated(tv%S)) &
      call create_group_pass(pass_uv_t_s_h, tv%S, g%Domain, halo=dynamics_stencil)
    call create_group_pass(pass_uv_t_s_h, h, g%Domain, halo=dynamics_stencil)
    call do_group_pass(pass_uv_t_s_h, g%Domain, clock=id_clock_pass)
 
    if (cs%debug .and. cs%use_ALE_algorithm) then
      call mom_state_chksum("Post-ALE ", u, v, h, cs%uh, cs%vh, g, gv, us)
      call hchksum(tv%T, "Post-ALE T", g%HI, haloshift=1)
      call hchksum(tv%S, "Post-ALE S", g%HI, haloshift=1)
      call check_redundant("Post-ALE ", u, v, g)
    endif
 
    ! Whenever thickness changes let the diag manager know, target grids
    ! for vertical remapping may need to be regenerated. This needs to
    ! happen after the H update and before the next post_data.
    call diag_update_remap_grids(cs%diag)
 
    !### Consider moving this up into the if ALE block.
    call postale_tracer_diagnostics(cs%tracer_Reg, g, gv, cs%diag, dtdia)
 
    if (cs%debug) then
      call uvchksum("Post-diabatic u", u, v, g%HI, haloshift=2, scale=us%L_T_to_m_s)
      call hchksum(h, "Post-diabatic h", g%HI, haloshift=1, scale=gv%H_to_m)
      call uvchksum("Post-diabatic [uv]h", cs%uhtr, cs%vhtr, g%HI, &
                    haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
    ! call MOM_state_chksum("Post-diabatic ", u, v, &
    !                       h, CS%uhtr, CS%vhtr, G, GV, haloshift=1)
      if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", g%HI, haloshift=1)
      if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", g%HI, haloshift=1)
      if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", g%HI, haloshift=0, &
                                              scale=g%US%Q_to_J_kg*g%US%RZ_to_kg_m2)
      if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, &
                               "Post-diabatic salt deficit", g%HI, haloshift=0, scale=us%RZ_to_kg_m2)
    ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US)
      call check_redundant("Post-diabatic ", u, v, g)
    endif
    call disable_averaging(cs%diag)
 
    call cpu_clock_end(id_clock_diabatic)
  else   ! complement of "if (.not.CS%adiabatic)"
 
    call cpu_clock_begin(id_clock_adiabatic)
    call adiabatic(h, tv, fluxes, dtdia, g, gv, us, cs%diabatic_CSp)
    fluxes%fluxes_used = .true.
    call cpu_clock_end(id_clock_adiabatic)
 
    if (associated(tv%T)) then
      call create_group_pass(pass_t_s, tv%T, g%Domain, to_all+omit_corners, halo=1)
      call create_group_pass(pass_t_s, tv%S, g%Domain, to_all+omit_corners, halo=1)
      call do_group_pass(pass_t_s, g%Domain, clock=id_clock_pass)
      if (cs%debug) then
        if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", g%HI, haloshift=1)
        if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", g%HI, haloshift=1)
      endif
    endif
 
  endif   ! endif for the block "if (.not.CS%adiabatic)"
  call cpu_clock_end(id_clock_thermo)
 
  call disable_averaging(cs%diag)
 
  if (showcalltree) call calltree_leave("step_MOM_thermo(), MOM.F90")
 
end subroutine step_mom_thermo
 
 
!> step_offline is the main driver for running tracers offline in MOM6. This has been primarily
!! developed with ALE configurations in mind. Some work has been done in isopycnal configuration, but
!! the work is very preliminary. Some more detail about this capability along with some of the subroutines
!! called here can be found in tracers/MOM_offline_control.F90
subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS)
  type(mech_forcing), intent(in)    :: forces        !< A structure with the driving mechanical forces
  type(forcing),      intent(inout) :: fluxes        !< pointers to forcing fields
  type(surface),      intent(inout) :: sfc_state     !< surface ocean state
  type(time_type),    intent(in)    :: time_start    !< starting time of a segment, as a time type
  real,               intent(in)    :: time_interval !< time interval
  type(mom_control_struct), pointer :: cs            !< control structure from initialize_MOM
 
  ! Local pointers
  type(ocean_grid_type),      pointer :: g  => null() ! Pointer to a structure containing
                                                      ! metrics and related information
  type(verticalgrid_type),    pointer :: gv => null() ! Pointer to structure containing information
                                                      ! about the vertical grid
  type(unit_scale_type),      pointer :: us => null() ! Pointer to a structure containing
                                                      ! various unit conversion factors
 
  logical :: first_iter    !< True if this is the first time step_offline has been called in a given interval
  logical :: last_iter     !< True if this is the last time step_tracer is to be called in an offline interval
  logical :: do_vertical   !< If enough time has elapsed, do the diabatic tracer sources/sinks
  logical :: adv_converged !< True if all the horizontal fluxes have been used
 
  real :: dt_offline          ! The offline timestep for advection [T ~> s]
  real :: dt_offline_vertical ! The offline timestep for vertical fluxes and remapping [T ~> s]
  logical :: skip_diffusion
  integer :: id_eta_diff_end
 
  type(time_type), pointer :: accumulated_time => null()
  type(time_type), pointer :: vertical_time => null()
  integer :: i,j,k
  integer :: is, ie, js, je, isd, ied, jsd, jed
 
  ! 3D pointers
  real, dimension(:,:,:), pointer :: &
    uhtr => null(), vhtr => null(), &
    eatr => null(), ebtr => null(), &
    h_end => null()
 
  ! 2D Array for diagnostics
  real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end
  type(time_type) :: time_end    ! End time of a segment, as a time type
 
  ! Grid-related pointer assignments
  g => cs%G ; gv => cs%GV ; us => cs%US
 
  is  = g%isc  ; ie  = g%iec  ; js  = g%jsc  ; je  = g%jec
  isd = g%isd  ; ied = g%ied  ; jsd = g%jsd  ; jed = g%jed
 
  call cpu_clock_begin(id_clock_offline_tracer)
  call extract_offline_main(cs%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, &
                            vertical_time, dt_offline, dt_offline_vertical, skip_diffusion)
  time_end = increment_date(time_start, seconds=floor(time_interval+0.001))
 
  call enable_averaging(time_interval, time_end, cs%diag)
 
  ! Check to see if this is the first iteration of the offline interval
  if (accumulated_time == real_to_time(0.0)) then
    first_iter = .true.
  else ! This is probably unnecessary but is used to guard against unwanted behavior
    first_iter = .false.
  endif
 
  ! Check to see if vertical tracer functions should be done
  if (first_iter .or. (accumulated_time >= vertical_time)) then
    do_vertical = .true.
    vertical_time = accumulated_time + real_to_time(us%T_to_s*dt_offline_vertical)
  else
    do_vertical = .false.
  endif
 
  ! Increment the amount of time elapsed since last read and check if it's time to roll around
  accumulated_time = accumulated_time + real_to_time(time_interval)
 
  last_iter = (accumulated_time >= real_to_time(us%T_to_s*dt_offline))
 
  if (cs%use_ALE_algorithm) then
    ! If this is the first iteration in the offline timestep, then we need to read in fields and
    ! perform the main advection.
    if (first_iter) then
      call mom_mesg("Reading in new offline fields")
      ! Read in new transport and other fields
      ! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, &
      !     CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm)
      ! call update_transport_from_arrays(CS%offline_CSp)
      call update_offline_fields(cs%offline_CSp, cs%h, fluxes, cs%use_ALE_algorithm)
 
      ! Apply any fluxes into the ocean
      call offline_fw_fluxes_into_ocean(g, gv, cs%offline_CSp, fluxes, cs%h)
 
      if (.not.cs%diabatic_first) then
        call offline_advection_ale(fluxes, time_start, time_interval, cs%offline_CSp, id_clock_ale, &
            cs%h, uhtr, vhtr, converged=adv_converged)
 
        ! Redistribute any remaining transport
        call offline_redistribute_residual(cs%offline_CSp, cs%h, uhtr, vhtr, adv_converged)
 
        ! Perform offline diffusion if requested
        if (.not. skip_diffusion) then
          if (associated(cs%VarMix)) then
            call pass_var(cs%h, g%Domain)
            call calc_resoln_function(cs%h, cs%tv, g, gv, us, cs%VarMix)
            call calc_depth_function(g, cs%VarMix)
            call calc_slope_functions(cs%h, cs%tv, dt_offline, g, gv, us, cs%VarMix, obc=cs%OBC)
          endif
          call tracer_hordiff(cs%h, dt_offline, cs%MEKE, cs%VarMix, g, gv, us, &
              cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
        endif
      endif
    endif
    ! The functions related to column physics of tracers is performed separately in ALE mode
    if (do_vertical) then
      call offline_diabatic_ale(fluxes, time_start, time_end, cs%offline_CSp, cs%h, eatr, ebtr)
    endif
 
    ! Last thing that needs to be done is the final ALE remapping
    if (last_iter) then
      if (cs%diabatic_first) then
        call offline_advection_ale(fluxes, time_start, time_interval, cs%offline_CSp, id_clock_ale, &
            cs%h, uhtr, vhtr, converged=adv_converged)
 
        ! Redistribute any remaining transport and perform the remaining advection
        call offline_redistribute_residual(cs%offline_CSp, cs%h, uhtr, vhtr, adv_converged)
                ! Perform offline diffusion if requested
        if (.not. skip_diffusion) then
          if (associated(cs%VarMix)) then
            call pass_var(cs%h, g%Domain)
            call calc_resoln_function(cs%h, cs%tv, g, gv, us, cs%VarMix)
            call calc_depth_function(g, cs%VarMix)
            call calc_slope_functions(cs%h, cs%tv, dt_offline, g, gv, us, cs%VarMix, obc=cs%OBC)
          endif
          call tracer_hordiff(cs%h, dt_offline, cs%MEKE, cs%VarMix, g, gv, us, &
              cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
        endif
      endif
 
      call mom_mesg("Last iteration of offline interval")
 
      ! Apply freshwater fluxes out of the ocean
      call offline_fw_fluxes_out_ocean(g, gv, cs%offline_CSp, fluxes, cs%h)
      ! These diagnostic can be used to identify which grid points did not converge within
      ! the specified number of advection sub iterations
      call post_offline_convergence_diags(cs%offline_CSp, cs%h, h_end, uhtr, vhtr)
 
      ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses
      ! stored from the forward run
      call cpu_clock_begin(id_clock_ale)
      call ale_offline_tracer_final( g, gv, cs%h, cs%tv, h_end, cs%tracer_Reg, cs%ALE_CSp, cs%OBC)
      call cpu_clock_end(id_clock_ale)
      call pass_var(cs%h, g%Domain)
    endif
  else ! NON-ALE MODE...NOT WELL TESTED
    call mom_error(warning, &
        "Offline tracer mode in non-ALE configuration has not been thoroughly tested")
    ! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in
    ! main_offline_advection_layer. Warning: this may not be appropriate for tracers that
    ! exchange with the atmosphere
    if (abs(time_interval - us%T_to_s*dt_offline) > 1.0e-6) then
      call mom_error(fatal, &
          "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval")
    endif
    call update_offline_fields(cs%offline_CSp, cs%h, fluxes, cs%use_ALE_algorithm)
    call offline_advection_layer(fluxes, time_start, time_interval, cs%offline_CSp, &
        cs%h, eatr, ebtr, uhtr, vhtr)
    ! Perform offline diffusion if requested
    if (.not. skip_diffusion) then
      call tracer_hordiff(h_end, dt_offline, cs%MEKE, cs%VarMix, g, gv, us, &
                          cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
    endif
 
    cs%h = h_end
 
    call pass_var(cs%tv%T, g%Domain)
    call pass_var(cs%tv%S, g%Domain)
    call pass_var(cs%h, g%Domain)
 
  endif
 
  call adjust_ssh_for_p_atm(cs%tv, g, gv, us, cs%ave_ssh_ibc, forces%p_surf_SSH, &
                            cs%calc_rho_for_sea_lev)
  call extract_surface_state(cs, sfc_state)
 
  call disable_averaging(cs%diag)
  call pass_var(cs%tv%T, g%Domain)
  call pass_var(cs%tv%S, g%Domain)
  call pass_var(cs%h, g%Domain)
 
  fluxes%fluxes_used = .true.
 
  if (last_iter) then
    accumulated_time = real_to_time(0.0)
  endif
 
  call cpu_clock_end(id_clock_offline_tracer)
 
end subroutine step_offline
 
!> Initialize MOM, including memory allocation, setting up parameters and diagnostics,
!! initializing the ocean state variables, and initializing subsidiary modules
subroutine initialize_mom(Time, Time_init, param_file, dirs, CS, restart_CSp, &
                          Time_in, offline_tracer_mode, input_restart_file, diag_ptr, &
                          count_calls, tracer_flow_CSp)
  type(time_type), target,   intent(inout) :: time        !< model time, set in this routine
  type(time_type),           intent(in)    :: time_init   !< The start time for the coupled model's calendar
  type(param_file_type),     intent(out)   :: param_file  !< structure indicating parameter file to parse
  type(directories),         intent(out)   :: dirs        !< structure with directory paths
  type(mom_control_struct),  pointer       :: cs          !< pointer set in this routine to MOM control structure
  type(mom_restart_cs),      pointer       :: restart_csp !< pointer set in this routine to the
                                                          !! restart control structure that will
                                                          !! be used for MOM.
  type(time_type), optional, intent(in)    :: time_in     !< time passed to MOM_initialize_state when
                                                          !! model is not being started from a restart file
  logical,         optional, intent(out)   :: offline_tracer_mode !< True is returned if tracers are being run offline
  character(len=*),optional, intent(in)    :: input_restart_file !< If present, name of restart file to read
  type(diag_ctrl), optional, pointer       :: diag_ptr    !< A pointer set in this routine to the diagnostic
                                                          !! regulatory structure
  type(tracer_flow_control_cs), &
                   optional, pointer       :: tracer_flow_csp !< A pointer set in this routine to
                                                          !! the tracer flow control structure.
  logical,         optional, intent(in)    :: count_calls !< If true, nstep_tot counts the number of
                                                          !! calls to step_MOM instead of the number of
                                                          !! dynamics timesteps.
  ! local variables
  type(ocean_grid_type),  pointer :: g => null()    ! A pointer to the metric grid use for the run
  type(ocean_grid_type),  pointer :: g_in => null() ! Pointer to the input grid
  type(hor_index_type),   pointer :: hi => null()   ! A hor_index_type for array extents
  type(hor_index_type),   target  :: hi_in          ! HI on the input grid
  type(verticalgrid_type), pointer :: gv => null()
  type(dyn_horgrid_type), pointer :: dg => null()
  type(dyn_horgrid_type), pointer :: dg_in => null()
  type(diag_ctrl),        pointer :: diag => null()
  type(unit_scale_type),  pointer :: us => null()
  character(len=4), parameter :: vers_num = 'v2.0'
  integer :: turns   ! Number of grid quarter-turns
 
  ! Initial state on the input index map
  real, allocatable, dimension(:,:,:) :: u_in, v_in, h_in
  real, allocatable, dimension(:,:,:), target :: t_in, s_in
  type(ocean_obc_type), pointer :: obc_in => null()
  type(sponge_cs), pointer :: sponge_in_csp => null()
  type(ale_sponge_cs), pointer :: ale_sponge_in_csp => null()
 
  ! This include declares and sets the variable "version".
# include "version_variable.h"
 
  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
  integer :: isdb, iedb, jsdb, jedb
  real    :: dtbt        ! The barotropic timestep [s]
 
  real, allocatable, dimension(:,:)   :: eta ! free surface height or column mass [H ~> m or kg m-2]
  real, allocatable, dimension(:,:)   :: area_shelf_h ! area occupied by ice shelf [L2 ~> m2]
  real, dimension(:,:), allocatable, target  :: frac_shelf_h ! fraction of total area occupied by ice shelf [nondim]
  real, dimension(:,:), pointer :: shelf_area => null()
  type(mom_restart_cs),  pointer      :: restart_csp_tmp => null()
  type(group_pass_type) :: tmp_pass_uv_t_s_h, pass_uv_t_s_h
 
  real    :: default_val       ! default value for a parameter
  logical :: write_geom_files  ! If true, write out the grid geometry files.
  logical :: ensemble_ocean    ! If true, perform an ensemble gather at the end of step_MOM
  logical :: new_sim
  logical :: use_geothermal    ! If true, apply geothermal heating.
  logical :: use_eos           ! If true, density calculated from T & S using an equation of state.
  logical :: symmetric         ! If true, use symmetric memory allocation.
  logical :: save_ic           ! If true, save the initial conditions.
  logical :: do_unit_tests     ! If true, call unit tests.
  logical :: test_grid_copy = .false.
 
  logical :: bulkmixedlayer    ! If true, a refined bulk mixed layer scheme is used
                               ! with nkml sublayers and nkbl buffer layer.
  logical :: use_temperature   ! If true, temp and saln used as state variables.
  logical :: use_frazil        ! If true, liquid seawater freezes if temp below freezing,
                               ! with accumulated heat deficit returned to surface ocean.
  logical :: bound_salinity    ! If true, salt is added to keep salinity above
                               ! a minimum value, and the deficit is reported.
  logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
  logical :: use_cont_abss     ! If true, the prognostics T & S are conservative temperature
                               ! and absolute salinity. Care should be taken to convert them
                               ! to potential temperature and practical salinity before
                               ! exchanging them with the coupler and/or reporting T&S diagnostics.
  logical :: advect_ts         ! If false, then no horizontal advection of temperature
                               ! and salnity is performed
  logical :: use_ice_shelf     ! Needed for ALE
  logical :: global_indexing   ! If true use global horizontal index values instead
                               ! of having the data domain on each processor start at 1.
  logical :: bathy_at_vel      ! If true, also define bathymetric fields at the
                               ! the velocity points.
  logical :: calc_dtbt         ! Indicates whether the dynamically adjusted barotropic
                               ! time step needs to be updated before it is used.
  logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations.
  integer :: first_direction   ! An integer that indicates which direction is to be
                               ! updated first in directionally split parts of the
                               ! calculation.  This can be altered during the course
                               ! of the run via calls to set_first_direction.
  integer :: nkml, nkbl, verbosity, write_geom
  integer :: dynamics_stencil  ! The computational stencil for the calculations
                               ! in the dynamic core.
  real :: conv2watt, conv2salt
  real :: rl2_t2_rescale, z_rescale, qrz_rescale ! Unit conversion factors
  character(len=48) :: flux_units, s_flux_units
 
  type(vardesc) :: vd_t, vd_s  ! Structures describing temperature and salinity variables.
  type(time_type)                 :: start_time
  type(ocean_internal_state)      :: mom_internal_state
  character(len=200) :: area_varname, ice_shelf_file, inputdir, filename
 
  if (associated(cs)) then
    call mom_error(warning, "initialize_MOM called with an associated "// &
                            "control structure.")
    return
  endif
  allocate(cs)
 
  cs%Time => time
 
  id_clock_init = cpu_clock_id('Ocean Initialization', grain=clock_subcomponent)
  call cpu_clock_begin(id_clock_init)
 
  start_time = time ; if (present(time_in)) start_time = time_in
 
  ! Read paths and filenames from namelist and store in "dirs".
  ! Also open the parsed input parameter file(s) and setup param_file.
  call get_mom_input(param_file, dirs, default_input_filename=input_restart_file)
 
  verbosity = 2 ; call read_param(param_file, "VERBOSITY", verbosity)
  call mom_set_verbosity(verbosity)
  call calltree_enter("initialize_MOM(), MOM.F90")
 
  call find_obsolete_params(param_file)
 
  ! Determining the internal unit scaling factors for this run.
  call unit_scaling_init(param_file, cs%US)
  us => cs%US
 
  ! Read relevant parameters and write them to the model log.
  call log_version(param_file, "MOM", version, "", log_to_all=.true., layout=.true., debugging=.true.)
  call get_param(param_file, "MOM", "VERBOSITY", verbosity,  &
                 "Integer controlling level of messaging\n" // &
                 "\t0 = Only FATAL messages\n" // &
                 "\t2 = Only FATAL, WARNING, NOTE [default]\n" // &
                 "\t9 = All)", default=2, debuggingparam=.true.)
  call get_param(param_file, "MOM", "DO_UNIT_TESTS", do_unit_tests, &
                 "If True, exercises unit tests at model start up.", &
                 default=.false., debuggingparam=.true.)
  if (do_unit_tests) then
    id_clock_unit_tests = cpu_clock_id('(Ocean unit tests)', grain=clock_module)
    call cpu_clock_begin(id_clock_unit_tests)
    call unit_tests(verbosity)
    call cpu_clock_end(id_clock_unit_tests)
  endif
 
  call get_param(param_file, "MOM", "SPLIT", cs%split, &
                 "Use the split time stepping if true.", default=.true.)
  if (cs%split) then
    cs%use_RK2 = .false.
  else
    call get_param(param_file, "MOM", "USE_RK2", cs%use_RK2, &
                 "If true, use RK2 instead of RK3 in the unsplit time stepping.", &
                 default=.false.)
  endif
 
  call get_param(param_file, "MOM", "CALC_RHO_FOR_SEA_LEVEL", cs%calc_rho_for_sea_lev, &
                 "If true, the in-situ density is used to calculate the "//&
                 "effective sea level that is returned to the coupler. If false, "//&
                 "the Boussinesq parameter RHO_0 is used.", default=.false.)
  call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", use_temperature, &
                 "If true, Temperature and salinity are used as state "//&
                 "variables.", default=.true.)
  call get_param(param_file, "MOM", "USE_EOS", use_eos, &
                 "If true,  density is calculated from temperature and "//&
                 "salinity with an equation of state.  If USE_EOS is "//&
                 "true, ENABLE_THERMODYNAMICS must be true as well.", &
                 default=use_temperature)
  call get_param(param_file, "MOM", "DIABATIC_FIRST", cs%diabatic_first, &
                 "If true, apply diabatic and thermodynamic processes, "//&
                 "including buoyancy forcing and mass gain or loss, "//&
                 "before stepping the dynamics forward.", default=.false.)
  call get_param(param_file, "MOM", "USE_CONTEMP_ABSSAL", use_cont_abss, &
                 "If true, the prognostics T&S are the conservative temperature "//&
                 "and absolute salinity. Care should be taken to convert them "//&
                 "to potential temperature and practical salinity before "//&
                 "exchanging them with the coupler and/or reporting T&S diagnostics.", &
                 default=.false.)
  cs%tv%T_is_conT = use_cont_abss ; cs%tv%S_is_absS = use_cont_abss
  call get_param(param_file, "MOM", "ADIABATIC", cs%adiabatic, &
                 "There are no diapycnal mass fluxes if ADIABATIC is "//&
                 "true. This assumes that KD = KDML = 0.0 and that "//&
                 "there is no buoyancy forcing, but makes the model "//&
                 "faster by eliminating subroutine calls.", default=.false.)
  call get_param(param_file, "MOM", "DO_DYNAMICS", cs%do_dynamics, &
                 "If False, skips the dynamics calls that update u & v, as well as "//&
                 "the gravity wave adjustment to h. This may be a fragile feature, "//&
                 "but can be useful during development", default=.true.)
  call get_param(param_file, "MOM", "ADVECT_TS", advect_ts, &
                 "If True, advect temperature and salinity horizontally "//&
                 "If False, T/S are registered for advection. "//&
                 "This is intended only to be used in offline tracer mode "//&
                 "and is by default false in that case.", &
                 do_not_log = .true., default=.true. )
  if (present(offline_tracer_mode)) then ! Only read this parameter in enabled modes
    call get_param(param_file, "MOM", "OFFLINE_TRACER_MODE", cs%offline_tracer_mode, &
                 "If true, barotropic and baroclinic dynamics, thermodynamics "//&
                 "are all bypassed with all the fields necessary to integrate "//&
                 "the tracer advection and diffusion equation are read in from "//&
                 "files stored from a previous integration of the prognostic model. "//&
                 "NOTE: This option only used in the ocean_solo_driver.", default=.false.)
    if (cs%offline_tracer_mode) then
      call get_param(param_file, "MOM", "ADVECT_TS", advect_ts, &
                   "If True, advect temperature and salinity horizontally "//&
                   "If False, T/S are registered for advection. "//&
                   "This is intended only to be used in offline tracer mode."//&
                   "and is by default false in that case", &
                   default=.false. )
    endif
  endif
  call get_param(param_file, "MOM", "USE_REGRIDDING", cs%use_ALE_algorithm, &
                 "If True, use the ALE algorithm (regridding/remapping). "//&
                 "If False, use the layered isopycnal algorithm.", default=.false. )
  call get_param(param_file, "MOM", "BULKMIXEDLAYER", bulkmixedlayer, &
                 "If true, use a Kraus-Turner-like bulk mixed layer "//&
                 "with transitional buffer layers.  Layers 1 through "//&
                 "NKML+NKBL have variable densities. There must be at "//&
                 "least NKML+NKBL+1 layers if BULKMIXEDLAYER is true. "//&
                 "BULKMIXEDLAYER can not be used with USE_REGRIDDING. "//&
                 "The default is influenced by ENABLE_THERMODYNAMICS.", &
                 default=use_temperature .and. .not.cs%use_ALE_algorithm)
  call get_param(param_file, "MOM", "THICKNESSDIFFUSE", cs%thickness_diffuse, &
                 "If true, interface heights are diffused with a "//&
                 "coefficient of KHTH.", default=.false.)
  call get_param(param_file, "MOM",  "THICKNESSDIFFUSE_FIRST", &
                                      cs%thickness_diffuse_first, &
                 "If true, do thickness diffusion before dynamics. "//&
                 "This is only used if THICKNESSDIFFUSE is true.", &
                 default=.false.)
  if (.not.cs%thickness_diffuse) cs%thickness_diffuse_first = .false.
  call get_param(param_file, "MOM", "BATHYMETRY_AT_VEL", bathy_at_vel, &
                 "If true, there are separate values for the basin depths "//&
                 "at velocity points.  Otherwise the effects of topography "//&
                 "are entirely determined from thickness points.", &
                 default=.false.)
  call get_param(param_file, "MOM", "USE_WAVES", cs%UseWaves, default=.false., &
                 do_not_log=.true.)
 
  call get_param(param_file, "MOM", "DEBUG", cs%debug, &
                 "If true, write out verbose debugging data.", &
                 default=.false., debuggingparam=.true.)
  call get_param(param_file, "MOM", "DEBUG_TRUNCATIONS", debug_truncations, &
                 "If true, calculate all diagnostics that are useful for "//&
                 "debugging truncations.", default=.false., debuggingparam=.true.)
 
  call get_param(param_file, "MOM", "DT", cs%dt, &
                 "The (baroclinic) dynamics time step.  The time-step that "//&
                 "is actually used will be an integer fraction of the "//&
                 "forcing time-step (DT_FORCING in ocean-only mode or the "//&
                 "coupling timestep in coupled mode.)", units="s", scale=us%s_to_T, &
                 fail_if_missing=.true.)
  call get_param(param_file, "MOM", "DT_THERM", cs%dt_therm, &
                 "The thermodynamic and tracer advection time step. "//&
                 "Ideally DT_THERM should be an integer multiple of DT "//&
                 "and less than the forcing or coupling time-step, unless "//&
                 "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//&
                 "can be an integer multiple of the coupling timestep.  By "//&
                 "default DT_THERM is set to DT.", &
                 units="s", scale=us%s_to_T, default=us%T_to_s*cs%dt)
  call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", cs%thermo_spans_coupling, &
                 "If true, the MOM will take thermodynamic and tracer "//&
                 "timesteps that can be longer than the coupling timestep. "//&
                 "The actual thermodynamic timestep that is used in this "//&
                 "case is the largest integer multiple of the coupling "//&
                 "timestep that is less than or equal to DT_THERM.", default=.false.)
 
  if (bulkmixedlayer) then
    cs%Hmix = -1.0 ; cs%Hmix_UV = -1.0
  else
    call get_param(param_file, "MOM", "HMIX_SFC_PROP", cs%Hmix, &
                 "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth "//&
                 "over which to average to find surface properties like "//&
                 "SST and SSS or density (but not surface velocities).", &
                 units="m", default=1.0, scale=us%m_to_Z)
    call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", cs%Hmix_UV, &
                 "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth "//&
                 "over which to average to find surface flow properties, "//&
                 "SSU, SSV. A non-positive value indicates no averaging.", &
                 units="m", default=0.0, scale=us%m_to_Z)
  endif
  call get_param(param_file, "MOM", "HFREEZE", cs%HFrz, &
                 "If HFREEZE > 0, melt potential will be computed. The actual depth "//&
                 "over which melt potential is computed will be min(HFREEZE, OBLD), "//&
                 "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//&
                 "melt potential will not be computed.", units="m", default=-1.0, scale=us%m_to_Z)
  call get_param(param_file, "MOM", "INTERPOLATE_P_SURF", cs%interp_p_surf, &
                 "If true, linearly interpolate the surface pressure "//&
                 "over the coupling time step, using the specified value "//&
                 "at the end of the step.", default=.false.)
 
  if (cs%split) then
    call get_param(param_file, "MOM", "DTBT", dtbt, default=-0.98)
    default_val = us%T_to_s*cs%dt_therm ; if (dtbt > 0.0) default_val = -1.0
    cs%dtbt_reset_period = -1.0
    call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", cs%dtbt_reset_period, &
                 "The period between recalculations of DTBT (if DTBT <= 0). "//&
                 "If DTBT_RESET_PERIOD is negative, DTBT is set based "//&
                 "only on information available at initialization.  If 0, "//&
                 "DTBT will be set every dynamics time step. The default "//&
                 "is set by DT_THERM.  This is only used if SPLIT is true.", &
                 units="s", default=default_val, do_not_read=(dtbt > 0.0))
  endif
 
  ! This is here in case these values are used inappropriately.
  use_frazil = .false. ; bound_salinity = .false.
  cs%tv%P_Ref = 2.0e7*us%kg_m3_to_R*us%m_s_to_L_T**2
  if (use_temperature) then
    call get_param(param_file, "MOM", "FRAZIL", use_frazil, &
                 "If true, water freezes if it gets too cold, and the "//&
                 "accumulated heat deficit is returned in the "//&
                 "surface state.  FRAZIL is only used if "//&
                 "ENABLE_THERMODYNAMICS is true.", default=.false.)
    call get_param(param_file, "MOM", "DO_GEOTHERMAL", use_geothermal, &
                 "If true, apply geothermal heating.", default=.false.)
    call get_param(param_file, "MOM", "BOUND_SALINITY", bound_salinity, &
                 "If true, limit salinity to being positive. (The sea-ice "//&
                 "model may ask for more salt than is available and "//&
                 "drive the salinity negative otherwise.)", default=.false.)
    call get_param(param_file, "MOM", "MIN_SALINITY", cs%tv%min_salinity, &
                 "The minimum value of salinity when BOUND_SALINITY=True.", &
                 units="PPT", default=0.0, do_not_log=.not.bound_salinity)
    call get_param(param_file, "MOM", "C_P", cs%tv%C_p, &
                 "The heat capacity of sea water, approximated as a "//&
                 "constant. This is only used if ENABLE_THERMODYNAMICS is "//&
                 "true. The default value is from the TEOS-10 definition "//&
                 "of conservative temperature.", units="J kg-1 K-1", &
                 default=3991.86795711963, scale=us%J_kg_to_Q)
    call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", cs%use_p_surf_in_EOS, &
                 "If true, always include the surface pressure contributions "//&
                 "in equation of state calculations.", default=.true.)
  endif
  if (use_eos) call get_param(param_file, "MOM", "P_REF", cs%tv%P_Ref, &
                 "The pressure that is used for calculating the coordinate "//&
                 "density.  (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//&
                 "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", &
                 units="Pa", default=2.0e7, scale=us%kg_m3_to_R*us%m_s_to_L_T**2)
 
  if (bulkmixedlayer) then
    call get_param(param_file, "MOM", "NKML", nkml, &
                 "The number of sublayers within the mixed layer if "//&
                 "BULKMIXEDLAYER is true.", units="nondim", default=2)
    call get_param(param_file, "MOM", "NKBL", nkbl, &
                 "The number of layers that are used as variable density "//&
                 "buffer layers if BULKMIXEDLAYER is true.", units="nondim", &
                 default=2)
  endif
 
  call get_param(param_file, "MOM", "GLOBAL_INDEXING", global_indexing, &
                 "If true, use a global lateral indexing convention, so "//&
                 "that corresponding points on different processors have "//&
                 "the same index. This does not work with static memory.", &
                 default=.false., layoutparam=.true.)
#ifdef STATIC_MEMORY_
  if (global_indexing) call mom_error(fatal, "initialize_MOM: "//&
       "GLOBAL_INDEXING can not be true with STATIC_MEMORY.")
#endif
  call get_param(param_file, "MOM", "FIRST_DIRECTION", first_direction, &
                 "An integer that indicates which direction goes first "//&
                 "in parts of the code that use directionally split "//&
                 "updates, with even numbers (or 0) used for x- first "//&
                 "and odd numbers used for y-first.", default=0)
 
  call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", cs%check_bad_sfc_vals, &
                 "If true, check the surface state for ridiculous values.", &
                 default=.false.)
  if (cs%check_bad_sfc_vals) then
    call get_param(param_file, "MOM", "BAD_VAL_SSH_MAX", cs%bad_val_ssh_max, &
                 "The value of SSH above which a bad value message is "//&
                 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
                 units="m", default=20.0, scale=us%m_to_Z)
    call get_param(param_file, "MOM", "BAD_VAL_SSS_MAX", cs%bad_val_sss_max, &
                 "The value of SSS above which a bad value message is "//&
                 "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="PPT", &
                 default=45.0)
    call get_param(param_file, "MOM", "BAD_VAL_SST_MAX", cs%bad_val_sst_max, &
                 "The value of SST above which a bad value message is "//&
                 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
                 units="deg C", default=45.0)
    call get_param(param_file, "MOM", "BAD_VAL_SST_MIN", cs%bad_val_sst_min, &
                 "The value of SST below which a bad value message is "//&
                 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
                 units="deg C", default=-2.1)
    call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", cs%bad_val_col_thick, &
                 "The value of column thickness below which a bad value message is "//&
                 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
                 units="m", default=0.0, scale=us%m_to_Z)
  endif
  call get_param(param_file, "MOM", "DEFAULT_2018_ANSWERS", default_2018_answers, &
                 "This sets the default value for the various _2018_ANSWERS parameters.", &
                 default=.false.)
  call get_param(param_file, "MOM", "SURFACE_2018_ANSWERS", cs%answers_2018, &
                 "If true, use expressions for the surface properties that recover the answers "//&
                 "from the end of 2018. Otherwise, use more appropriate expressions that differ "//&
                 "at roundoff for non-Boussinesq cases.", default=default_2018_answers)
 
  call get_param(param_file, "MOM", "SAVE_INITIAL_CONDS", save_ic, &
                 "If true, write the initial conditions to a file given "//&
                 "by IC_OUTPUT_FILE.", default=.false.)
  call get_param(param_file, "MOM", "IC_OUTPUT_FILE", cs%IC_file, &
                 "The file into which to write the initial conditions.", &
                 default="MOM_IC")
  call get_param(param_file, "MOM", "WRITE_GEOM", write_geom, &
                 "If =0, never write the geometry and vertical grid files. "//&
                 "If =1, write the geometry and vertical grid files only for "//&
                 "a new simulation. If =2, always write the geometry and "//&
                 "vertical grid files. Other values are invalid.", default=1)
  if (write_geom<0 .or. write_geom>2) call mom_error(fatal,"MOM: "//&
         "WRITE_GEOM must be equal to 0, 1 or 2.")
  write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. &
     ((dirs%input_filename(1:1)=='n') .and. (len_trim(dirs%input_filename)==1))))
! If the restart file type had been initialized, this could become:
!  write_geom_files = ((write_geom==2) .or. &
!                      ((write_geom==1) .and. is_new_run(restart_CSp)))
 
  ! Check for inconsistent parameter settings.
  if (cs%use_ALE_algorithm .and. bulkmixedlayer) call mom_error(fatal, &
    "MOM: BULKMIXEDLAYER can not currently be used with the ALE algorithm.")
  if (cs%use_ALE_algorithm .and. .not.use_temperature) call mom_error(fatal, &
     "MOM: At this time, USE_EOS should be True when using the ALE algorithm.")
  if (cs%adiabatic .and. use_temperature) call mom_error(warning, &
    "MOM: ADIABATIC and ENABLE_THERMODYNAMICS both defined is usually unwise.")
  if (use_eos .and. .not.use_temperature) call mom_error(fatal, &
    "MOM: ENABLE_THERMODYNAMICS must be defined to use USE_EOS.")
  if (cs%adiabatic .and. bulkmixedlayer) call mom_error(fatal, &
    "MOM: ADIABATIC and BULKMIXEDLAYER can not both be defined.")
  if (bulkmixedlayer .and. .not.use_eos) call mom_error(fatal, &
      "initialize_MOM: A bulk mixed layer can only be used with T & S as "//&
      "state variables. Add USE_EOS = True to MOM_input.")
 
  call get_param(param_file, 'MOM', "ICE_SHELF", use_ice_shelf, default=.false., do_not_log=.true.)
  if (use_ice_shelf) then
     inputdir = "." ;  call get_param(param_file, 'MOM', "INPUTDIR", inputdir)
     inputdir = slasher(inputdir)
     call get_param(param_file, 'MOM', "ICE_THICKNESS_FILE", ice_shelf_file, &
                    "The file from which the ice bathymetry and area are read.", &
                    fail_if_missing=.true.)
     call get_param(param_file, 'MOM', "ICE_AREA_VARNAME", area_varname, &
                    "The name of the area variable in ICE_THICKNESS_FILE.", &
                    fail_if_missing=.true.)
  endif
 
 
  cs%ensemble_ocean=.false.
  call get_param(param_file, "MOM", "ENSEMBLE_OCEAN", cs%ensemble_ocean, &
                 "If False, The model is being run in serial mode as a single realization. "//&
                 "If True, The current model realization is part of a larger ensemble "//&
                 "and at the end of step MOM, we will perform a gather of the ensemble "//&
                 "members for statistical evaluation and/or data assimilation.", default=.false.)
 
  call calltree_waypoint("MOM parameters read (initialize_MOM)")
 
  ! Grid rotation test
  call get_param(param_file, "MOM", "ROTATE_INDEX", cs%rotate_index, &
      "Enable rotation of the horizontal indices.", default=.false., &
      debuggingparam=.true.)
  if (cs%rotate_index) then
    ! TODO: Index rotation currently only works when index rotation does not
    !   change the MPI rank of each domain.  Resolving this will require a
    !   modification to FMS PE assignment.
    !   For now, we only permit single-core runs.
 
    if (num_pes() /= 1) &
      call mom_error(fatal, "Index rotation is only supported on one PE.")
 
    call get_param(param_file, "MOM", "INDEX_TURNS", turns, &
        "Number of counterclockwise quarter-turn index rotations.", &
        default=1, debuggingparam=.true.)
  endif
 
  ! Set up the model domain and grids.
#ifdef SYMMETRIC_MEMORY_
  symmetric = .true.
#else
  symmetric = .false.
#endif
  g_in => cs%G_in
#ifdef STATIC_MEMORY_
  call mom_domains_init(g_in%domain, param_file, symmetric=symmetric, &
            static_memory=.true., nihalo=nihalo_, njhalo=njhalo_, &
            niglobal=niglobal_, njglobal=njglobal_, niproc=niproc_, &
            njproc=njproc_)
#else
  call mom_domains_init(g_in%domain, param_file, symmetric=symmetric, &
                        domain_name="MOM_in")
#endif
 
  ! Copy input grid (G_in) domain to active grid G
  ! Swap axes for quarter and 3-quarter turns
  if (cs%rotate_index) then
    allocate(cs%G)
    call clone_mom_domain(g_in%Domain, cs%G%Domain, turns=turns)
    first_direction = modulo(first_direction + turns, 2)
  else
    cs%G => g_in
  endif
 
  ! TODO: It is unlikey that test_grid_copy and rotate_index would work at the
  !   same time.  It may be possible to enable both but for now we prevent it.
  if (test_grid_copy .and. cs%rotate_index) &
    call mom_error(fatal, "Grid cannot be copied during index rotation.")
 
  if (test_grid_copy) then ; allocate(g)
  else ; g => cs%G ; endif
 
  call calltree_waypoint("domains initialized (initialize_MOM)")
 
  call mom_debugging_init(param_file)
  call diag_mediator_infrastructure_init()
  call mom_io_init(param_file)
 
  ! Create HI and dG on the input index map.
  call hor_index_init(g_in%Domain, hi_in, param_file, &
                      local_indexing=.not.global_indexing)
  call create_dyn_horgrid(dg_in, hi_in, bathymetry_at_vel=bathy_at_vel)
  call clone_mom_domain(g_in%Domain, dg_in%Domain)
 
  ! Allocate initialize time-invariant MOM variables.
  call mom_initialize_fixed(dg_in, us, obc_in, param_file, write_geom_files, &
                            dirs%output_directory)
 
  call calltree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)")
 
  ! Determine HI and dG for the model index map.
  if (cs%rotate_index) then
    allocate(hi)
    call rotate_hor_index(hi_in, turns, hi)
    call create_dyn_horgrid(dg, hi, bathymetry_at_vel=bathy_at_vel)
    call clone_mom_domain(g%Domain, dg%Domain)
    call rotate_dyngrid(dg_in, dg, us, turns)
    if (associated(obc_in)) then
      ! TODO: General OBC index rotations is not yet supported.
      if (modulo(turns, 4) /= 1) &
        call mom_error(fatal, "OBC index rotation of 180 and 270 degrees is " &
          // "not yet unsupported.")
      allocate(cs%OBC)
      call rotate_obc_config(obc_in, dg_in, cs%OBC, dg, turns)
    endif
  else
    hi => hi_in
    dg => dg_in
    cs%OBC => obc_in
  endif
 
  call verticalgridinit( param_file, cs%GV, us )
  gv => cs%GV
 
  ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
  if (cs%debug .or. dg%symmetric) &
    call clone_mom_domain(dg%Domain, dg%Domain_aux, symmetric=.false.)
 
  call calltree_waypoint("grids initialized (initialize_MOM)")
 
  call mom_timing_init(cs)
 
  if (associated(cs%OBC)) call call_obc_register(param_file, cs%update_OBC_CSp, cs%OBC)
 
  call tracer_registry_init(param_file, cs%tracer_Reg)
 
  ! Allocate and initialize space for the primary time-varying MOM variables.
  is   = dg%isc   ; ie   = dg%iec  ; js   = dg%jsc  ; je   = dg%jec ; nz = gv%ke
  isd  = dg%isd   ; ied  = dg%ied  ; jsd  = dg%jsd  ; jed  = dg%jed
  isdb = dg%IsdB  ; iedb = dg%IedB ; jsdb = dg%JsdB ; jedb = dg%JedB
  alloc_(cs%u(isdb:iedb,jsd:jed,nz))   ; cs%u(:,:,:) = 0.0
  alloc_(cs%v(isd:ied,jsdb:jedb,nz))   ; cs%v(:,:,:) = 0.0
  alloc_(cs%h(isd:ied,jsd:jed,nz))     ; cs%h(:,:,:) = gv%Angstrom_H
  alloc_(cs%uh(isdb:iedb,jsd:jed,nz))  ; cs%uh(:,:,:) = 0.0
  alloc_(cs%vh(isd:ied,jsdb:jedb,nz))  ; cs%vh(:,:,:) = 0.0
  if (use_temperature) then
    alloc_(cs%T(isd:ied,jsd:jed,nz))   ; cs%T(:,:,:) = 0.0
    alloc_(cs%S(isd:ied,jsd:jed,nz))   ; cs%S(:,:,:) = 0.0
    cs%tv%T => cs%T ; cs%tv%S => cs%S
    if (cs%tv%T_is_conT) then
      vd_t = var_desc(name="contemp", units="Celsius", longname="Conservative Temperature", &
                      cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", &
                      conversion=us%Q_to_J_kg*cs%tv%C_p)
    else
      vd_t = var_desc(name="temp", units="degC", longname="Potential Temperature", &
                      cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", &
                      conversion=us%Q_to_J_kg*cs%tv%C_p)
    endif
    if (cs%tv%S_is_absS) then
      vd_s = var_desc(name="abssalt",units="g kg-1",longname="Absolute Salinity", &
                      cmor_field_name="so", cmor_longname="Sea Water Salinity", &
                      conversion=0.001)
    else
      vd_s = var_desc(name="salt",units="psu",longname="Salinity", &
                      cmor_field_name="so", cmor_longname="Sea Water Salinity", &
                      conversion=0.001)
    endif
 
    if (advect_ts) then
      s_flux_units = get_tr_flux_units(gv, "psu") ! Could change to "kg m-2 s-1"?
      conv2watt    = gv%H_to_kg_m2 * us%Q_to_J_kg*cs%tv%C_p
      if (gv%Boussinesq) then
        conv2salt = gv%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001?
      else
        conv2salt = gv%H_to_kg_m2
      endif
      call register_tracer(cs%tv%T, cs%tracer_Reg, param_file, dg%HI, gv, &
                           tr_desc=vd_t, registry_diags=.true., flux_nameroot='T', &
                           flux_units='W', flux_longname='Heat', &
                           flux_scale=conv2watt, convergence_units='W m-2', &
                           convergence_scale=conv2watt, cmor_tendprefix="opottemp", diag_form=2)
      call register_tracer(cs%tv%S, cs%tracer_Reg, param_file, dg%HI, gv, &
                           tr_desc=vd_s, registry_diags=.true., flux_nameroot='S', &
                           flux_units=s_flux_units, flux_longname='Salt', &
                           flux_scale=conv2salt, convergence_units='kg m-2 s-1', &
                           convergence_scale=0.001*gv%H_to_kg_m2, cmor_tendprefix="osalt", diag_form=2)
    endif
    ! NOTE: register_temp_salt_segments includes allocation of tracer fields
    !   along segments.  Bit reproducibility requires that MOM_initialize_state
    !   be called on the input index map, so we must setup both OBC and OBC_in.
    !
    ! XXX: This call on OBC_in allocates the tracer fields on the unrotated
    !   grid, but also incorrectly stores a pointer to a tracer_type for the
    !   rotated registry (e.g. segment%tr_reg%Tr(n)%Tr) from CS%tracer_reg.
    !
    !   While incorrect and potentially dangerous, it does not seem that this
    !   pointer is used during initialization, so we leave it for now.
    if (cs%rotate_index .and. associated(obc_in)) &
      call register_temp_salt_segments(gv, obc_in, cs%tracer_Reg, param_file)
    if (associated(cs%OBC)) &
      call register_temp_salt_segments(gv, cs%OBC, cs%tracer_Reg, param_file)
  endif
  if (use_frazil) then
    allocate(cs%tv%frazil(isd:ied,jsd:jed)) ; cs%tv%frazil(:,:) = 0.0
  endif
  if (bound_salinity) then
    allocate(cs%tv%salt_deficit(isd:ied,jsd:jed)) ; cs%tv%salt_deficit(:,:) = 0.0
  endif
 
  if (bulkmixedlayer .or. use_temperature) then
    allocate(cs%Hml(isd:ied,jsd:jed)) ; cs%Hml(:,:) = 0.0
  endif
 
  if (bulkmixedlayer) then
    gv%nkml = nkml ; gv%nk_rho_varies = nkml + nkbl
  else
    gv%nkml = 0 ; gv%nk_rho_varies = 0
  endif
  if (cs%use_ALE_algorithm) then
    call get_param(param_file, "MOM", "NK_RHO_VARIES", gv%nk_rho_varies, default=0) ! Will default to nz later... -AJA
  endif
 
  alloc_(cs%uhtr(isdb:iedb,jsd:jed,nz)) ; cs%uhtr(:,:,:) = 0.0
  alloc_(cs%vhtr(isd:ied,jsdb:jedb,nz)) ; cs%vhtr(:,:,:) = 0.0
  cs%t_dyn_rel_adv = 0.0 ; cs%t_dyn_rel_thermo = 0.0 ; cs%t_dyn_rel_diag = 0.0
 
  if (debug_truncations) then
    allocate(cs%u_prev(isdb:iedb,jsd:jed,nz)) ; cs%u_prev(:,:,:) = 0.0
    allocate(cs%v_prev(isd:ied,jsdb:jedb,nz)) ; cs%v_prev(:,:,:) = 0.0
    mom_internal_state%u_prev => cs%u_prev
    mom_internal_state%v_prev => cs%v_prev
    call safe_alloc_ptr(cs%ADp%du_dt_visc,isdb,iedb,jsd,jed,nz)
    call safe_alloc_ptr(cs%ADp%dv_dt_visc,isd,ied,jsdb,jedb,nz)
    if (.not.cs%adiabatic) then
      call safe_alloc_ptr(cs%ADp%du_dt_dia,isdb,iedb,jsd,jed,nz)
      call safe_alloc_ptr(cs%ADp%dv_dt_dia,isd,ied,jsdb,jedb,nz)
    endif
  endif
 
  mom_internal_state%u => cs%u ; mom_internal_state%v => cs%v
  mom_internal_state%h => cs%h
  mom_internal_state%uh => cs%uh ; mom_internal_state%vh => cs%vh
  if (use_temperature) then
    mom_internal_state%T => cs%T ; mom_internal_state%S => cs%S
  endif
 
  cs%CDp%uh => cs%uh ; cs%CDp%vh => cs%vh
 
  if (cs%interp_p_surf) then
    allocate(cs%p_surf_prev(isd:ied,jsd:jed)) ; cs%p_surf_prev(:,:) = 0.0
  endif
 
  alloc_(cs%ssh_rint(isd:ied,jsd:jed)) ; cs%ssh_rint(:,:) = 0.0
  alloc_(cs%ave_ssh_ibc(isd:ied,jsd:jed)) ; cs%ave_ssh_ibc(:,:) = 0.0
  alloc_(cs%eta_av_bc(isd:ied,jsd:jed)) ; cs%eta_av_bc(:,:) = 0.0
  cs%time_in_cycle = 0.0 ; cs%time_in_thermo_cycle = 0.0
 
  ! Use the Wright equation of state by default, unless otherwise specified
  ! Note: this line and the following block ought to be in a separate
  ! initialization routine for tv.
  if (use_eos) call eos_init(param_file, cs%tv%eqn_of_state, us)
  if (use_temperature) then
    allocate(cs%tv%TempxPmE(isd:ied,jsd:jed)) ; cs%tv%TempxPmE(:,:) = 0.0
    if (use_geothermal) then
      allocate(cs%tv%internal_heat(isd:ied,jsd:jed)) ; cs%tv%internal_heat(:,:) = 0.0
    endif
  endif
  call calltree_waypoint("state variables allocated (initialize_MOM)")
 
  ! Set the fields that are needed for bitwise identical restarting
  ! the time stepping scheme.
  call restart_init(param_file, restart_csp)
  call set_restart_fields(gv, us, param_file, cs, restart_csp)
  if (cs%split) then
    call register_restarts_dyn_split_rk2(dg%HI, gv, param_file, &
             cs%dyn_split_RK2_CSp, restart_csp, cs%uh, cs%vh)
  elseif (cs%use_RK2) then
    call register_restarts_dyn_unsplit_rk2(dg%HI, gv, param_file, &
           cs%dyn_unsplit_RK2_CSp, restart_csp)
  else
    call register_restarts_dyn_unsplit(dg%HI, gv, param_file, &
           cs%dyn_unsplit_CSp, restart_csp)
  endif
 
  ! This subroutine calls user-specified tracer registration routines.
  ! Additional calls can be added to MOM_tracer_flow_control.F90.
  call call_tracer_register(dg%HI, gv, us, param_file, cs%tracer_flow_CSp, &
                            cs%tracer_Reg, restart_csp)
 
  call meke_alloc_register_restart(dg%HI, param_file, cs%MEKE, restart_csp)
  call set_visc_register_restarts(dg%HI, gv, param_file, cs%visc, restart_csp)
  call mixedlayer_restrat_register_restarts(dg%HI, param_file, &
           cs%mixedlayer_restrat_CSp, restart_csp)
 
  if (associated(cs%OBC)) &
    call open_boundary_register_restarts(dg%HI, gv, cs%OBC, cs%tracer_Reg, &
                          param_file, restart_csp, use_temperature)
 
  call calltree_waypoint("restart registration complete (initialize_MOM)")
 
  ! Initialize dynamically evolving fields, perhaps from restart files.
  call cpu_clock_begin(id_clock_mom_init)
  call mom_initialize_coord(gv, us, param_file, write_geom_files, &
                            dirs%output_directory, cs%tv, dg%max_depth)
  call calltree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)")
 
  if (cs%use_ALE_algorithm) then
    call ale_init(param_file, gv, us, dg%max_depth, cs%ALE_CSp)
    call calltree_waypoint("returned from ALE_init() (initialize_MOM)")
  endif
 
  !   Shift from using the temporary dynamic grid type to using the final
  ! (potentially static) ocean-specific grid type.
  !   The next line would be needed if G%Domain had not already been init'd above:
  !     call clone_MOM_domain(dG%Domain, G%Domain)
 
  ! NOTE: If indices are rotated, then G and G_in must both be initialized.
  !   If not rotated, then G_in and G are the same grid.
  if (cs%rotate_index) then
    call mom_grid_init(g, param_file, us, hi, bathymetry_at_vel=bathy_at_vel)
    call copy_dyngrid_to_mom_grid(dg, g, us)
    call destroy_dyn_horgrid(dg)
  endif
  call mom_grid_init(g_in, param_file, us, hi_in, bathymetry_at_vel=bathy_at_vel)
  call copy_dyngrid_to_mom_grid(dg_in, g_in, us)
  call destroy_dyn_horgrid(dg_in)
 
  ! Set a few remaining fields that are specific to the ocean grid type.
  call set_first_direction(g, first_direction)
  ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
  if (cs%debug .or. g%symmetric) then
    call clone_mom_domain(g%Domain, g%Domain_aux, symmetric=.false.)
  else ; g%Domain_aux => g%Domain ; endif
  ! Copy common variables from the vertical grid to the horizontal grid.
  ! Consider removing this later?
  g%ke = gv%ke
 
  if (cs%rotate_index) then
    g_in%ke = gv%ke
 
    allocate(u_in(g_in%IsdB:g_in%IedB, g_in%jsd:g_in%jed, nz))
    allocate(v_in(g_in%isd:g_in%ied, g_in%JsdB:g_in%JedB, nz))
    allocate(h_in(g_in%isd:g_in%ied, g_in%jsd:g_in%jed, nz))
    u_in(:,:,:) = 0.0
    v_in(:,:,:) = 0.0
    h_in(:,:,:) = gv%Angstrom_H
 
    if (use_temperature) then
      allocate(t_in(g_in%isd:g_in%ied, g_in%jsd:g_in%jed, nz))
      allocate(s_in(g_in%isd:g_in%ied, g_in%jsd:g_in%jed, nz))
      t_in(:,:,:) = 0.0
      s_in(:,:,:) = 0.0
 
      cs%tv%T => t_in
      cs%tv%S => s_in
    endif
 
    call mom_initialize_state(u_in, v_in, h_in, cs%tv, time, g_in, gv, us, &
        param_file, dirs, restart_csp, cs%ALE_CSp, cs%tracer_Reg, &
        sponge_in_csp, ale_sponge_in_csp, obc_in, time_in)
 
    if (use_temperature) then
      cs%tv%T => cs%T
      cs%tv%S => cs%S
    endif
 
    call rotate_initial_state(u_in, v_in, h_in, t_in, s_in, use_temperature, &
        turns, cs%u, cs%v, cs%h, cs%T, cs%S)
 
    if (associated(sponge_in_csp)) then
      ! TODO: Implementation and testing of non-ALE spong rotation
      call mom_error(fatal, "Index rotation of non-ALE sponge is not yet implemented.")
    endif
 
    if (associated(ale_sponge_in_csp)) then
      call rotate_ale_sponge(ale_sponge_in_csp, g_in, cs%ALE_sponge_CSp, g, turns, param_file)
      call update_ale_sponge_field(cs%ALE_sponge_CSp, t_in, g, gv, cs%T)
      call update_ale_sponge_field(cs%ALE_sponge_CSp, s_in, g, gv, cs%S)
    endif
 
    if (associated(obc_in)) &
      call rotate_obc_init(obc_in, g, gv, us, param_file, cs%tv, restart_csp, cs%OBC)
 
    deallocate(u_in)
    deallocate(v_in)
    deallocate(h_in)
    if (use_temperature) then
      deallocate(t_in)
      deallocate(s_in)
    endif
  else
    call mom_initialize_state(cs%u, cs%v, cs%h, cs%tv, time, g, gv, us, &
        param_file, dirs, restart_csp, cs%ALE_CSp, cs%tracer_Reg, &
        cs%sponge_CSp, cs%ALE_sponge_CSp, cs%OBC, time_in)
  endif
 
  call cpu_clock_end(id_clock_mom_init)
  call calltree_waypoint("returned from MOM_initialize_state() (initialize_MOM)")
 
! ! Need this after MOM_initialize_state for DOME OBC stuff.
! if (associated(CS%OBC)) &
!   call open_boundary_register_restarts(G%HI, GV, CS%OBC, CS%tracer_Reg, &
!                         param_file, restart_CSp, use_temperature)
 
! call callTree_waypoint("restart registration complete (initialize_MOM)")
 
  ! From this point, there may be pointers being set, so the final grid type
  ! that will persist throughout the run has to be used.
 
  if (test_grid_copy) then
    !  Copy the data from the temporary grid to the dyn_hor_grid to CS%G.
    call create_dyn_horgrid(dg, g%HI)
    call clone_mom_domain(g%Domain, dg%Domain)
 
    call clone_mom_domain(g%Domain, cs%G%Domain)
    call mom_grid_init(cs%G, param_file, us)
 
    call copy_mom_grid_to_dyngrid(g, dg, us)
    call copy_dyngrid_to_mom_grid(dg, cs%G, us)
 
    call destroy_dyn_horgrid(dg)
    call mom_grid_end(g) ; deallocate(g)
 
    g => cs%G
    if (cs%debug .or. cs%G%symmetric) then
      call clone_mom_domain(cs%G%Domain, cs%G%Domain_aux, symmetric=.false.)
    else ; cs%G%Domain_aux => cs%G%Domain ; endif
    g%ke = gv%ke
  endif
 
  ! At this point, all user-modified initialization code has been called.  The
  ! remainder of this subroutine is controlled by the parameters that have
  ! have already been set.
 
  if (ale_remap_init_conds(cs%ALE_CSp) .and. .not. query_initialized(cs%h,"h",restart_csp)) then
    ! This block is controlled by the ALE parameter REMAP_AFTER_INITIALIZATION.
    ! \todo This block exists for legacy reasons and we should phase it out of
    ! all examples. !###
    if (cs%debug) then
      call uvchksum("Pre ALE adjust init cond [uv]", &
                    cs%u, cs%v, g%HI, haloshift=1)
      call hchksum(cs%h,"Pre ALE adjust init cond h", g%HI, haloshift=1, scale=gv%H_to_m)
    endif
    call calltree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)")
    call adjustgridforintegrity(cs%ALE_CSp, g, gv, cs%h )
    call calltree_waypoint("Calling ALE_main() to remap initial conditions (initialize_MOM)")
    if (use_ice_shelf) then
      filename = trim(inputdir)//trim(ice_shelf_file)
      if (.not.file_exists(filename, g%Domain)) call mom_error(fatal, &
        "MOM: Unable to open "//trim(filename))
 
      allocate(area_shelf_h(isd:ied,jsd:jed))
      allocate(frac_shelf_h(isd:ied,jsd:jed))
      call mom_read_data(filename, trim(area_varname), area_shelf_h, g%Domain, scale=us%m_to_L**2)
      ! initialize frac_shelf_h with zeros (open water everywhere)
      frac_shelf_h(:,:) = 0.0
      ! compute fractional ice shelf coverage of h
      do j=jsd,jed ; do i=isd,ied
        if (g%areaT(i,j) > 0.0) &
          frac_shelf_h(i,j) = area_shelf_h(i,j) / g%areaT(i,j)
      enddo ; enddo
      ! pass to the pointer
      shelf_area => frac_shelf_h
      call ale_main(g, gv, us, cs%h, cs%u, cs%v, cs%tv, cs%tracer_Reg, cs%ALE_CSp, &
                    cs%OBC, frac_shelf_h=shelf_area)
    else
      call ale_main( g, gv, us, cs%h, cs%u, cs%v, cs%tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC)
    endif
 
    call cpu_clock_begin(id_clock_pass_init)
    call create_group_pass(tmp_pass_uv_t_s_h, cs%u, cs%v, g%Domain)
    if (use_temperature) then
      call create_group_pass(tmp_pass_uv_t_s_h, cs%tv%T, g%Domain, halo=1)
      call create_group_pass(tmp_pass_uv_t_s_h, cs%tv%S, g%Domain, halo=1)
    endif
    call create_group_pass(tmp_pass_uv_t_s_h, cs%h, g%Domain, halo=1)
    call do_group_pass(tmp_pass_uv_t_s_h, g%Domain)
    call cpu_clock_end(id_clock_pass_init)
 
    if (cs%debug) then
      call uvchksum("Post ALE adjust init cond [uv]", cs%u, cs%v, g%HI, haloshift=1)
      call hchksum(cs%h, "Post ALE adjust init cond h", g%HI, haloshift=1, scale=gv%H_to_m)
    endif
  endif
  if ( cs%use_ALE_algorithm ) call ale_updateverticalgridtype( cs%ALE_CSp, gv )
 
  diag => cs%diag
  ! Initialize the diag mediator.
  call diag_mediator_init(g, gv, us, gv%ke, param_file, diag, doc_file_dir=dirs%output_directory)
  if (present(diag_ptr)) diag_ptr => cs%diag
 
  ! Initialize the diagnostics masks for native arrays.
  ! This step has to be done after call to MOM_initialize_state
  ! and before MOM_diagnostics_init
  call diag_masks_set(g, gv%ke, diag)
 
  ! Set up pointers within diag mediator control structure,
  ! this needs to occur _after_ CS%h etc. have been allocated.
  call diag_set_state_ptrs(cs%h, cs%T, cs%S, cs%tv%eqn_of_state, diag)
 
  ! This call sets up the diagnostic axes. These are needed,
  ! e.g. to generate the target grids below.
  call set_axes_info(g, gv, us, param_file, diag)
 
  ! Whenever thickness/T/S changes let the diag manager know, target grids
  ! for vertical remapping may need to be regenerated.
  ! FIXME: are h, T, S updated at the same time? Review these for T, S updates.
  call diag_update_remap_grids(diag)
 
  ! Setup the diagnostic grid storage types
  call diag_grid_storage_init(cs%diag_pre_sync, g, diag)
  call diag_grid_storage_init(cs%diag_pre_dyn, g, diag)
 
  ! Calculate masks for diagnostics arrays in non-native coordinates
  ! This step has to be done after set_axes_info() because the axes needed
  ! to be configured, and after diag_update_remap_grids() because the grids
  ! must be defined.
  call set_masks_for_axes(g, diag)
 
  ! Diagnose static fields AND associate areas/volumes with axes
  call write_static_fields(g, gv, us, cs%tv, cs%diag)
  call calltree_waypoint("static fields written (initialize_MOM)")
 
  ! Register the volume cell measure (must be one of first diagnostics)
  call register_cell_measure(g, cs%diag, time)
 
  call cpu_clock_begin(id_clock_mom_init)
  if (cs%use_ALE_algorithm) then
    call ale_writecoordinatefile( cs%ALE_CSp, gv, dirs%output_directory )
  endif
  call cpu_clock_end(id_clock_mom_init)
  call calltree_waypoint("ALE initialized (initialize_MOM)")
 
  cs%useMEKE = meke_init(time, g, us, param_file, diag, cs%MEKE_CSp, cs%MEKE, restart_csp)
 
  call varmix_init(time, g, gv, us, param_file, diag, cs%VarMix)
  call set_visc_init(time, g, gv, us, param_file, diag, cs%visc, cs%set_visc_CSp, restart_csp, cs%OBC)
  call thickness_diffuse_init(time, g, gv, us, param_file, diag, cs%CDp, cs%thickness_diffuse_CSp)
 
  if (cs%split) then
    allocate(eta(szi_(g),szj_(g))) ; eta(:,:) = 0.0
    call initialize_dyn_split_rk2(cs%u, cs%v, cs%h, cs%uh, cs%vh, eta, time, &
              g, gv, us, param_file, diag, cs%dyn_split_RK2_CSp, restart_csp, &
              cs%dt, cs%ADp, cs%CDp, mom_internal_state, cs%VarMix, cs%MEKE, &
              cs%thickness_diffuse_CSp,                                      &
              cs%OBC, cs%update_OBC_CSp, cs%ALE_CSp, cs%set_visc_CSp,        &
              cs%visc, dirs, cs%ntrunc, calc_dtbt=calc_dtbt, cont_stencil=cs%cont_stencil)
    if (cs%dtbt_reset_period > 0.0) then
      cs%dtbt_reset_interval = real_to_time(cs%dtbt_reset_period)
      ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval.
      cs%dtbt_reset_time = time_init + cs%dtbt_reset_interval * &
                                 ((time - time_init) / cs%dtbt_reset_interval)
      if ((cs%dtbt_reset_time > time) .and. calc_dtbt) then
        ! Back up dtbt_reset_time one interval to force dtbt to be calculated,
        ! because the restart was not aligned with the interval to recalculate
        ! dtbt, and dtbt was not read from a restart file.
        cs%dtbt_reset_time = cs%dtbt_reset_time - cs%dtbt_reset_interval
      endif
    endif
  elseif (cs%use_RK2) then
    call initialize_dyn_unsplit_rk2(cs%u, cs%v, cs%h, time, g, gv, us,     &
            param_file, diag, cs%dyn_unsplit_RK2_CSp, restart_csp,         &
            cs%ADp, cs%CDp, mom_internal_state, cs%MEKE, cs%OBC,           &
            cs%update_OBC_CSp, cs%ALE_CSp, cs%set_visc_CSp, cs%visc, dirs, &
            cs%ntrunc, cont_stencil=cs%cont_stencil)
  else
    call initialize_dyn_unsplit(cs%u, cs%v, cs%h, time, g, gv, us,         &
            param_file, diag, cs%dyn_unsplit_CSp, restart_csp,             &
            cs%ADp, cs%CDp, mom_internal_state, cs%MEKE, cs%OBC,           &
            cs%update_OBC_CSp, cs%ALE_CSp, cs%set_visc_CSp, cs%visc, dirs, &
            cs%ntrunc, cont_stencil=cs%cont_stencil)
  endif
 
  call calltree_waypoint("dynamics initialized (initialize_MOM)")
 
  cs%mixedlayer_restrat = mixedlayer_restrat_init(time, g, gv, us, param_file, diag, &
                                                  cs%mixedlayer_restrat_CSp, restart_csp)
  if (cs%mixedlayer_restrat) then
    if (.not.(bulkmixedlayer .or. cs%use_ALE_algorithm)) &
      call mom_error(fatal, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.")
    ! When DIABATIC_FIRST=False and using CS%visc%ML in mixedlayer_restrat we need to update after a restart
    if (.not. cs%diabatic_first .and. associated(cs%visc%MLD)) &
      call pass_var(cs%visc%MLD, g%domain, halo=1)
  endif
 
  call mom_diagnostics_init(mom_internal_state, cs%ADp, cs%CDp, time, g, gv, us, &
                            param_file, diag, cs%diagnostics_CSp, cs%tv)
  call diag_copy_diag_to_storage(cs%diag_pre_sync, cs%h, cs%diag)
 
  if (associated(cs%sponge_CSp)) &
    call init_sponge_diags(time, g, gv, us, diag, cs%sponge_CSp)
 
  if (associated(cs%ALE_sponge_CSp)) &
    call init_ale_sponge_diags(time, g, diag, cs%ALE_sponge_CSp)
 
  if (cs%adiabatic) then
    call adiabatic_driver_init(time, g, param_file, diag, cs%diabatic_CSp, &
                               cs%tracer_flow_CSp)
  else
    call diabatic_driver_init(time, g, gv, us, param_file, cs%use_ALE_algorithm, diag, &
                              cs%ADp, cs%CDp, cs%diabatic_CSp, cs%tracer_flow_CSp, &
                              cs%sponge_CSp, cs%ALE_sponge_CSp)
  endif
 
  call tracer_advect_init(time, g, us, param_file, diag, cs%tracer_adv_CSp)
  call tracer_hor_diff_init(time, g, us, param_file, diag, cs%tv%eqn_of_state, cs%diabatic_CSp, &
                            cs%tracer_diff_CSp)
 
  call lock_tracer_registry(cs%tracer_Reg)
  call calltree_waypoint("tracer registry now locked (initialize_MOM)")
 
  ! now register some diagnostics since the tracer registry is now locked
  call register_surface_diags(time, g, us, cs%sfc_IDs, cs%diag, cs%tv)
  call register_diags(time, g, gv, us, cs%IDs, cs%diag)
  call register_transport_diags(time, g, gv, us, cs%transport_IDs, cs%diag)
  call register_tracer_diagnostics(cs%tracer_Reg, cs%h, time, diag, g, gv, us, &
                                   cs%use_ALE_algorithm)
  if (cs%use_ALE_algorithm) then
    call ale_register_diags(time, g, gv, us, diag, cs%ALE_CSp)
  endif
 
  ! This subroutine initializes any tracer packages.
  new_sim = is_new_run(restart_csp)
  call tracer_flow_control_init(.not.new_sim, time, g, gv, us, cs%h, param_file, &
             cs%diag, cs%OBC, cs%tracer_flow_CSp, cs%sponge_CSp, &
             cs%ALE_sponge_CSp, cs%tv)
  if (present(tracer_flow_csp)) tracer_flow_csp => cs%tracer_flow_CSp
 
  ! If running in offline tracer mode, initialize the necessary control structure and
  ! parameters
  if (present(offline_tracer_mode)) offline_tracer_mode=cs%offline_tracer_mode
 
  if (cs%offline_tracer_mode) then
    ! Setup some initial parameterizations and also assign some of the subtypes
    call offline_transport_init(param_file, cs%offline_CSp, cs%diabatic_CSp, g, gv, us)
    call insert_offline_main( cs=cs%offline_CSp, ale_csp=cs%ALE_CSp, diabatic_csp=cs%diabatic_CSp, &
                              diag=cs%diag, obc=cs%OBC, tracer_adv_csp=cs%tracer_adv_CSp,              &
                              tracer_flow_csp=cs%tracer_flow_CSp, tracer_reg=cs%tracer_Reg,            &
                              tv=cs%tv, x_before_y = (mod(first_direction,2)==0), debug=cs%debug )
    call register_diags_offline_transport(time, cs%diag, cs%offline_CSp)
  endif
 
  !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM
  call cpu_clock_begin(id_clock_pass_init)
  dynamics_stencil = min(3, g%Domain%nihalo, g%Domain%njhalo)
  call create_group_pass(pass_uv_t_s_h, cs%u, cs%v, g%Domain, halo=dynamics_stencil)
  if (use_temperature) then
    call create_group_pass(pass_uv_t_s_h, cs%tv%T, g%Domain, halo=dynamics_stencil)
    call create_group_pass(pass_uv_t_s_h, cs%tv%S, g%Domain, halo=dynamics_stencil)
  endif
  call create_group_pass(pass_uv_t_s_h, cs%h, g%Domain, halo=dynamics_stencil)
 
  call do_group_pass(pass_uv_t_s_h, g%Domain)
 
  if (associated(cs%visc%Kv_shear)) &
    call pass_var(cs%visc%Kv_shear, g%Domain, to_all+omit_corners, halo=1)
 
  if (associated(cs%visc%Kv_slow)) &
    call pass_var(cs%visc%Kv_slow, g%Domain, to_all+omit_corners, halo=1)
 
  call cpu_clock_end(id_clock_pass_init)
 
  call register_obsolete_diagnostics(param_file, cs%diag)
 
  if (use_frazil) then
    if (query_initialized(cs%tv%frazil, "frazil", restart_csp)) then
      ! Test whether the dimensional rescaling has changed for heat content.
      if ((us%kg_m3_to_R_restart*us%m_to_Z_restart*us%J_kg_to_Q_restart /= 0.0) .and. &
          ((us%J_kg_to_Q*us%kg_m3_to_R*us%m_to_Z) /= &
           (us%J_kg_to_Q_restart*us%kg_m3_to_R_restart*us%m_to_Z_restart)) ) then
        qrz_rescale = (us%J_kg_to_Q*us%kg_m3_to_R*us%m_to_Z) / &
                      (us%J_kg_to_Q_restart*us%kg_m3_to_R_restart*us%m_to_Z_restart)
        do j=js,je ; do i=is,ie
          cs%tv%frazil(i,j) = qrz_rescale * cs%tv%frazil(i,j)
        enddo ; enddo
      endif
    else
      cs%tv%frazil(:,:) = 0.0
    endif
  endif
 
  if (cs%interp_p_surf) then
    cs%p_surf_prev_set = query_initialized(cs%p_surf_prev,"p_surf_prev",restart_csp)
 
    if (cs%p_surf_prev_set) then
      ! Test whether the dimensional rescaling has changed for pressure.
      if ((us%kg_m3_to_R_restart*us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
          ((us%kg_m3_to_R*(us%m_to_L*us%s_to_T_restart)**2) /= &
           (us%kg_m3_to_R_restart*(us%m_to_L_restart*us%s_to_T)**2)) ) then
        rl2_t2_rescale = (us%kg_m3_to_R*(us%m_to_L*us%s_to_T_restart)**2) / &
                         (us%kg_m3_to_R_restart*(us%m_to_L_restart*us%s_to_T)**2)
        do j=js,je ; do i=is,ie
          cs%p_surf_prev(i,j) = rl2_t2_rescale * cs%p_surf_prev(i,j)
        enddo ; enddo
      endif
 
      call pass_var(cs%p_surf_prev, g%domain)
    endif
  endif
 
  if (use_ice_shelf .and. associated(cs%Hml)) then
    if (query_initialized(cs%Hml, "hML", restart_csp)) then
      ! Test whether the dimensional rescaling has changed for depths.
      if ((us%m_to_Z_restart /= 0.0) .and. (us%m_to_Z /= us%m_to_Z_restart) ) then
        z_rescale = us%m_to_Z / us%m_to_Z_restart
        do j=js,je ; do i=is,ie
          cs%Hml(i,j) = z_rescale * cs%Hml(i,j)
        enddo ; enddo
      endif
    endif
  endif
 
  if (.not.query_initialized(cs%ave_ssh_ibc,"ave_ssh",restart_csp)) then
    if (cs%split) then
      call find_eta(cs%h, cs%tv, g, gv, us, cs%ave_ssh_ibc, eta, eta_to_m=1.0)
    else
      call find_eta(cs%h, cs%tv, g, gv, us, cs%ave_ssh_ibc, eta_to_m=1.0)
    endif
  endif
  if (cs%split) deallocate(eta)
 
  cs%nstep_tot = 0
  if (present(count_calls)) cs%count_calls = count_calls
  call mom_sum_output_init(g_in, us, param_file, dirs%output_directory, &
                           cs%ntrunc, time_init, cs%sum_output_CSp)
 
  ! Flag whether to save initial conditions in finish_MOM_initialization() or not.
  cs%write_IC = save_ic .and. &
                .not.((dirs%input_filename(1:1) == 'r') .and. &
                      (len_trim(dirs%input_filename) == 1))
 
  if (cs%ensemble_ocean) then
    call init_oda(time, g, gv, cs%odaCS)
  endif
 
  !### This could perhaps go here instead of in finish_MOM_initialization?
  ! call fix_restart_scaling(GV)
  ! call fix_restart_unit_scaling(US)
 
  call calltree_leave("initialize_MOM()")
  call cpu_clock_end(id_clock_init)
 
end subroutine initialize_mom
 
!> Finishes initializing MOM and writes out the initial conditions.
subroutine finish_mom_initialization(Time, dirs, CS, restart_CSp)
  type(time_type),          intent(in)    :: time        !< model time, used in this routine
  type(directories),        intent(in)    :: dirs        !< structure with directory paths
  type(mom_control_struct), pointer       :: cs          !< pointer to MOM control structure
  type(mom_restart_cs),     pointer       :: restart_csp !< pointer to the restart control
                                                         !! structure that will be used for MOM.
  ! Local variables
  type(ocean_grid_type),   pointer :: g => null()  ! pointer to a structure containing
                                                   ! metrics and related information
  type(verticalgrid_type), pointer :: gv => null() ! Pointer to the vertical grid structure
  type(unit_scale_type),   pointer :: us => null() ! Pointer to a structure containing
                                                   ! various unit conversion factors
  type(mom_restart_cs),    pointer :: restart_csp_tmp => null()
  real, allocatable :: z_interface(:,:,:) ! Interface heights [m]
  type(vardesc) :: vd
 
  call cpu_clock_begin(id_clock_init)
  call calltree_enter("finish_MOM_initialization()")
 
  ! Pointers for convenience
  g => cs%G ; gv => cs%GV ; us => cs%US
 
  !### Move to initialize_MOM?
  call fix_restart_scaling(gv)
  call fix_restart_unit_scaling(us)
 
  ! Write initial conditions
  if (cs%write_IC) then
    allocate(restart_csp_tmp)
    restart_csp_tmp = restart_csp
    allocate(z_interface(szi_(g),szj_(g),szk_(g)+1))
    call find_eta(cs%h, cs%tv, g, gv, us, z_interface, eta_to_m=1.0)
    call register_restart_field(z_interface, "eta", .true., restart_csp_tmp, &
                                "Interface heights", "meter", z_grid='i')
 
    call save_restart(dirs%output_directory, time, cs%G_in, &
                      restart_csp_tmp, filename=cs%IC_file, gv=gv)
    deallocate(z_interface)
    deallocate(restart_csp_tmp)
  endif
 
  call write_energy(cs%u, cs%v, cs%h, cs%tv, time, 0, g, gv, us, &
                    cs%sum_output_CSp, cs%tracer_flow_CSp)
 
  call calltree_leave("finish_MOM_initialization()")
  call cpu_clock_end(id_clock_init)
 
end subroutine finish_mom_initialization
 
!> Register certain diagnostics
subroutine register_diags(Time, G, GV, US, IDs, diag)
  type(time_type),         intent(in)    :: Time  !< current model time
  type(ocean_grid_type),   intent(in)    :: G     !< ocean grid structure
  type(verticalgrid_type), intent(in)    :: GV    !< ocean vertical grid structure
  type(unit_scale_type),   intent(inout) :: US    !< A dimensional unit scaling type
  type(mom_diag_ids),      intent(inout) :: IDs   !< A structure with the diagnostic IDs.
  type(diag_ctrl),         intent(inout) :: diag  !< regulates diagnostic output
 
  real :: H_convert
  character(len=48) :: thickness_units
 
  thickness_units = get_thickness_units(gv)
  if (gv%Boussinesq) then
    h_convert = gv%H_to_m
  else
    h_convert = gv%H_to_kg_m2
  endif
 
  ! Diagnostics of the rapidly varying dynamic state
  ids%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, time, &
      'Zonal velocity after the dynamics update', 'm s-1', conversion=us%L_T_to_m_s)
  ids%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, time, &
      'Meridional velocity after the dynamics update', 'm s-1', conversion=us%L_T_to_m_s)
  ids%id_h = register_diag_field('ocean_model', 'h_dyn', diag%axesTL, time, &
      'Layer Thickness after the dynamics update', thickness_units, &
      v_extensive=.true., conversion=h_convert)
  ids%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, &
      time, 'Instantaneous Sea Surface Height', 'm')
end subroutine register_diags
 
!> Set up CPU clock IDs for timing various subroutines.
subroutine mom_timing_init(CS)
  type(mom_control_struct), intent(in) :: CS  !< control structure set up by initialize_MOM.
 
 id_clock_ocean    = cpu_clock_id('Ocean', grain=clock_component)
 id_clock_dynamics = cpu_clock_id('Ocean dynamics', grain=clock_subcomponent)
 id_clock_thermo   = cpu_clock_id('Ocean thermodynamics and tracers', grain=clock_subcomponent)
 id_clock_other    = cpu_clock_id('Ocean Other', grain=clock_subcomponent)
 id_clock_tracer   = cpu_clock_id('(Ocean tracer advection)', grain=clock_module_driver)
 if (.not.cs%adiabatic) then
   id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=clock_module_driver)
 else
   id_clock_adiabatic = cpu_clock_id('(Ocean adiabatic driver)', grain=clock_module_driver)
 endif
 
 id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=clock_module)
 id_clock_bbl_visc   = cpu_clock_id('(Ocean set BBL viscosity)', grain=clock_module)
 id_clock_pass       = cpu_clock_id('(Ocean message passing *)', grain=clock_module)
 id_clock_mom_init   = cpu_clock_id('(Ocean MOM_initialize_state)', grain=clock_module)
 id_clock_pass_init  = cpu_clock_id('(Ocean init message passing *)', grain=clock_routine)
 if (cs%thickness_diffuse) &
   id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=clock_module)
!if (CS%mixedlayer_restrat) &
   id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=clock_module)
 id_clock_diagnostics  = cpu_clock_id('(Ocean collective diagnostics)', grain=clock_module)
 id_clock_z_diag       = cpu_clock_id('(Ocean Z-space diagnostics)', grain=clock_module)
 id_clock_ale          = cpu_clock_id('(Ocean ALE)', grain=clock_module)
 if (cs%offline_tracer_mode) then
  id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=clock_subcomponent)
 endif
 
end subroutine mom_timing_init
 
!> Set the fields that are needed for bitwise identical restarting
!! the time stepping scheme.  In addition to those specified here
!! directly, there may be fields related to the forcing or to the
!! barotropic solver that are needed; these are specified in sub-
!! routines that are called from this one.
!!
!! This routine should be altered if there are any changes to the
!! time stepping scheme.  The CHECK_RESTART facility may be used to
!! confirm that all needed restart fields have been included.
subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp)
  type(verticalgrid_type),  intent(inout) :: GV         !< ocean vertical grid structure
  type(unit_scale_type),    intent(inout) :: US         !< A dimensional unit scaling type
  type(param_file_type),    intent(in) :: param_file    !< opened file for parsing to get parameters
  type(mom_control_struct), intent(in) :: CS            !< control structure set up by initialize_MOM
  type(mom_restart_cs),     pointer    :: restart_CSp   !< pointer to the restart control
                                                        !! structure that will be used for MOM.
  ! Local variables
  logical :: use_ice_shelf ! Needed to determine whether to add CS%Hml to restarts
  character(len=48) :: thickness_units, flux_units
  type(vardesc) :: u_desc, v_desc
 
  thickness_units = get_thickness_units(gv)
  flux_units = get_flux_units(gv)
 
  u_desc = var_desc("u", "m s-1", "Zonal velocity", hor_grid='Cu')
  v_desc = var_desc("v", "m s-1", "Meridional velocity", hor_grid='Cv')
 
  if (associated(cs%tv%T)) &
    call register_restart_field(cs%tv%T, "Temp", .true., restart_csp, &
                                "Potential Temperature", "degC")
  if (associated(cs%tv%S)) &
    call register_restart_field(cs%tv%S, "Salt", .true., restart_csp, &
                                "Salinity", "PPT")
 
  call register_restart_field(cs%h, "h", .true., restart_csp, &
                              "Layer Thickness", thickness_units)
 
  call register_restart_pair(cs%u, cs%v, u_desc, v_desc, .true., restart_csp)
 
  if (associated(cs%tv%frazil)) &
    call register_restart_field(cs%tv%frazil, "frazil", .false., restart_csp, &
                                "Frazil heat flux into ocean", "J m-2")
 
  if (cs%interp_p_surf) then
    call register_restart_field(cs%p_surf_prev, "p_surf_prev", .false., restart_csp, &
                                "Previous ocean surface pressure", "Pa")
  endif
 
  call register_restart_field(cs%ave_ssh_ibc, "ave_ssh", .false., restart_csp, &
                              "Time average sea surface height", "meter")
 
  ! hML is needed when using the ice shelf module
  call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., &
                 do_not_log=.true.)
  if (use_ice_shelf .and. associated(cs%Hml)) then
    call register_restart_field(cs%Hml, "hML", .false., restart_csp, &
                                "Mixed layer thickness", "meter")
  endif
 
  ! Register scalar unit conversion factors.
  call register_restart_field(us%m_to_Z_restart, "m_to_Z", .false., restart_csp, &
                              "Height unit conversion factor", "Z meter-1")
  call register_restart_field(gv%m_to_H_restart, "m_to_H", .false., restart_csp, &
                              "Thickness unit conversion factor", "H meter-1")
  call register_restart_field(us%m_to_L_restart, "m_to_L", .false., restart_csp, &
                              "Length unit conversion factor", "L meter-1")
  call register_restart_field(us%s_to_T_restart, "s_to_T", .false., restart_csp, &
                              "Time unit conversion factor", "T second-1")
  call register_restart_field(us%kg_m3_to_R_restart, "kg_m3_to_R", .false., restart_csp, &
                              "Density unit conversion factor", "R m3 kg-1")
  call register_restart_field(us%J_kg_to_Q_restart, "J_kg_to_Q", .false., restart_csp, &
                              "Heat content unit conversion factor.", units="Q kg J-1")
 
end subroutine set_restart_fields
 
!> Apply a correction to the sea surface height to compensate
!! for the atmospheric pressure (the inverse barometer).
subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS)
  type(thermo_var_ptrs),             intent(in)    :: tv  !< A structure pointing to various thermodynamic variables
  type(ocean_grid_type),             intent(in)    :: G   !< ocean grid structure
  type(verticalgrid_type),           intent(in)    :: GV  !< ocean vertical grid structure
  type(unit_scale_type),             intent(in)    :: US  !< A dimensional unit scaling type
  real, dimension(SZI_(G),SZJ_(G)),  intent(inout) :: ssh !< time mean surface height [m]
  real, dimension(:,:),    optional, pointer       :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa]
  logical,                 optional, intent(in)    :: use_EOS !< If true, calculate the density for
                                                       !! the SSH correction using the equation of state.
 
  real :: Rho_conv(SZI_(G))  ! The density used to convert surface pressure to
                      ! a corrected effective SSH [R ~> kg m-3].
  real :: IgR0        ! The SSH conversion factor from R L2 T-2 to m [m T2 R-1 L-2 ~> m Pa-1].
  logical :: calc_rho
  integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
  integer :: i, j, is, ie, js, je
 
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  eosdom(:) = eos_domain(g%HI)
  if (present(p_atm)) then ; if (associated(p_atm)) then
    calc_rho = associated(tv%eqn_of_state)
    if (present(use_eos) .and. calc_rho) calc_rho = use_eos
    ! Correct the output sea surface height for the contribution from the ice pressure.
    do j=js,je
      if (calc_rho) then
        call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), rho_conv, &
                               tv%eqn_of_state, eosdom)
        do i=is,ie
          igr0 = us%Z_to_m / (rho_conv(i) * gv%g_Earth)
          ssh(i,j) = ssh(i,j) + p_atm(i,j) * igr0
        enddo
      else
        do i=is,ie
          ssh(i,j) = ssh(i,j) + p_atm(i,j) * (us%Z_to_m / (gv%Rho0 * gv%g_Earth))
        enddo
      endif
    enddo
  endif ; endif
 
end subroutine adjust_ssh_for_p_atm
 
!> Set the surface (return) properties of the ocean model by
!! setting the appropriate fields in sfc_state.  Unused fields
!! are set to NULL or are unallocated.
subroutine extract_surface_state(CS, sfc_state_in)
  type(mom_control_struct), pointer    :: cs !< Master MOM control structure
  type(surface), target, intent(inout) :: sfc_state_in !< transparent ocean surface state
                                             !! structure shared with the calling routine
                                             !! data in this structure is intent out.
 
  ! Local variables
  real :: hu, hv  ! Thicknesses interpolated to velocity points [H ~> m or kg m-2]
  type(ocean_grid_type),   pointer :: g => null() !< pointer to a structure containing
                                                  !! metrics and related information
  type(ocean_grid_type),   pointer :: g_in => null() !< Input grid metric
  type(verticalgrid_type), pointer :: gv => null() !< structure containing vertical grid info
  type(unit_scale_type),   pointer :: us => null() !< structure containing various unit conversion factors
  type(surface),           pointer :: sfc_state => null()  ! surface state on the model grid
  real, dimension(:,:,:),  pointer :: &
    h => null()    !< h : layer thickness [H ~> m or kg m-2]
  real :: depth(szi_(cs%g))  !< Distance from the surface in depth units [Z ~> m] or [H ~> m or kg m-2]
  real :: depth_ml           !< Depth over which to average to determine mixed
                             !! layer properties [Z ~> m] or [H ~> m or kg m-2]
  real :: dh                 !< Thickness of a layer within the mixed layer [Z ~> m] or [H ~> m or kg m-2]
  real :: mass               !< Mass per unit area of a layer [R Z ~> kg m-2]
  real :: t_freeze           !< freezing temperature [degC]
  real :: i_depth            !< The inverse of depth [Z-1 ~> m-1] or [H-1 ~> m-1 or m2 kg-1]
  real :: missing_depth      !< The portion of depth_ml that can not be found in a column [H ~> m or kg m-2]
  real :: h_rescale          !< A conversion factor from thickness units to the units used in the
                             !! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1]
                             !  After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1.
  real :: delt(szi_(cs%g))   !< Depth integral of T-T_freeze [Z degC ~> m degC]
  logical :: use_temperature !< If true, temp and saln used as state variables.
  integer :: i, j, k, is, ie, js, je, nz, numberoferrors, ig, jg
  integer :: isd, ied, jsd, jed
  integer :: iscb, iecb, jscb, jecb, isdb, iedb, jsdb, jedb
  logical :: localerror
  character(240) :: msg
  integer :: turns    ! Number of quarter turns
 
  call calltree_enter("extract_surface_state(), MOM.F90")
  g => cs%G ; g_in => cs%G_in ; gv => cs%GV ; us => cs%US
  is  = g%isc ; ie  = g%iec ; js  = g%jsc ; je  = g%jec ; nz = gv%ke
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
  iscb = g%iscB ; iecb = g%iecB; jscb = g%jscB ; jecb = g%jecB
  isdb = g%isdB ; iedb = g%iedB; jsdb = g%jsdB ; jedb = g%jedB
  h => cs%h
 
  use_temperature = associated(cs%tv%T)
 
  turns = 0
  if (cs%rotate_index) &
    turns = g%HI%turns
 
  if (.not.sfc_state_in%arrays_allocated) &
    !  Consider using a run-time flag to determine whether to do the vertical
    ! integrals, since the 3-d sums are not negligible in cost.
    call allocate_surface_state(sfc_state_in, g_in, use_temperature, &
        do_integrals=.true., omit_frazil=.not.associated(cs%tv%frazil))
 
  if (cs%rotate_index) then
    allocate(sfc_state)
    call allocate_surface_state(sfc_state, g, use_temperature, &
        do_integrals=.true., omit_frazil=.not.associated(cs%tv%frazil))
  else
    sfc_state => sfc_state_in
  endif
 
  sfc_state%T_is_conT = cs%tv%T_is_conT
  sfc_state%S_is_absS = cs%tv%S_is_absS
 
  do j=js,je ; do i=is,ie
    sfc_state%sea_lev(i,j) = us%m_to_Z*cs%ave_ssh_ibc(i,j)
  enddo ; enddo
 
  if (allocated(sfc_state%frazil) .and. associated(cs%tv%frazil)) then ; do j=js,je ; do i=is,ie
    sfc_state%frazil(i,j) = cs%tv%frazil(i,j)
  enddo ; enddo ; endif
 
  ! copy Hml into sfc_state, so that caps can access it
  if (associated(cs%Hml)) then
    do j=js,je ; do i=is,ie
      sfc_state%Hml(i,j) = cs%Hml(i,j)
    enddo ; enddo
  endif
 
  if (cs%Hmix < 0.0) then  ! A bulk mixed layer is in use, so layer 1 has the properties
    if (use_temperature) then ; do j=js,je ; do i=is,ie
      sfc_state%SST(i,j) = cs%tv%T(i,j,1)
      sfc_state%SSS(i,j) = cs%tv%S(i,j,1)
    enddo ; enddo ; endif
    do j=js,je ; do i=is-1,ie
      sfc_state%u(i,j) = cs%u(i,j,1)
    enddo ; enddo
    do j=js-1,je ; do i=is,ie
      sfc_state%v(i,j) = cs%v(i,j,1)
    enddo ; enddo
 
  else  ! (CS%Hmix >= 0.0)
    h_rescale = 1.0 ; if (cs%answers_2018) h_rescale = gv%H_to_Z
    depth_ml = cs%Hmix
    if (.not.cs%answers_2018) depth_ml = cs%Hmix*gv%Z_to_H
    ! Determine the mean tracer properties of the uppermost depth_ml fluid.
 
    !$OMP parallel do default(shared) private(depth,dh)
    do j=js,je
      do i=is,ie
        depth(i) = 0.0
        if (use_temperature) then
          sfc_state%SST(i,j) = 0.0 ; sfc_state%SSS(i,j) = 0.0
        else
          sfc_state%sfc_density(i,j) = 0.0
        endif
      enddo
 
      do k=1,nz ; do i=is,ie
        if (depth(i) + h(i,j,k)*h_rescale < depth_ml) then
          dh = h(i,j,k)*h_rescale
        elseif (depth(i) < depth_ml) then
          dh = depth_ml - depth(i)
        else
          dh = 0.0
        endif
        if (use_temperature) then
          sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * cs%tv%T(i,j,k)
          sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * cs%tv%S(i,j,k)
        else
          sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) + dh * gv%Rlay(k)
        endif
        depth(i) = depth(i) + dh
      enddo ; enddo
  ! Calculate the average properties of the mixed layer depth.
      do i=is,ie
        if (cs%answers_2018) then
          if (depth(i) < gv%H_subroundoff*h_rescale) &
              depth(i) = gv%H_subroundoff*h_rescale
          if (use_temperature) then
            sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i)
            sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i)
          else
            sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i)
          endif
        else
          if (depth(i) < gv%H_subroundoff*h_rescale) then
            i_depth = 1.0 / (gv%H_subroundoff*h_rescale)
            missing_depth = gv%H_subroundoff*h_rescale - depth(i)
            if (use_temperature) then
              sfc_state%SST(i,j) = (sfc_state%SST(i,j) + missing_depth*cs%tv%T(i,j,1)) * i_depth
              sfc_state%SSS(i,j) = (sfc_state%SSS(i,j) + missing_depth*cs%tv%S(i,j,1)) * i_depth
            else
              sfc_state%sfc_density(i,j) = (sfc_state%sfc_density(i,j) + &
                                            missing_depth*gv%Rlay(1)) * i_depth
            endif
          else
            i_depth = 1.0 / depth(i)
            if (use_temperature) then
              sfc_state%SST(i,j) = sfc_state%SST(i,j) * i_depth
              sfc_state%SSS(i,j) = sfc_state%SSS(i,j) * i_depth
            else
              sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) * i_depth
            endif
          endif
        endif
      enddo
    enddo ! end of j loop
 
!   Determine the mean velocities in the uppermost depth_ml fluid.
    ! NOTE: Velocity loops start on `[ij]s-1` in order to update halo values
    !       required by the speed diagnostic on the non-symmetric grid.
    !       This assumes that u and v halos have already been updated.
    if (cs%Hmix_UV>0.) then
      depth_ml = cs%Hmix_UV
      if (.not.cs%answers_2018) depth_ml = cs%Hmix_UV*gv%Z_to_H
      !$OMP parallel do default(shared) private(depth,dh,hv)
      do j=js-1,ie
        do i=is,ie
          depth(i) = 0.0
          sfc_state%v(i,j) = 0.0
        enddo
        do k=1,nz ; do i=is,ie
          hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * h_rescale
          if (depth(i) + hv < depth_ml) then
            dh = hv
          elseif (depth(i) < depth_ml) then
            dh = depth_ml - depth(i)
          else
            dh = 0.0
          endif
          sfc_state%v(i,j) = sfc_state%v(i,j) + dh * cs%v(i,j,k)
          depth(i) = depth(i) + dh
        enddo ; enddo
        ! Calculate the average properties of the mixed layer depth.
        do i=is,ie
          sfc_state%v(i,j) = sfc_state%v(i,j) / max(depth(i), gv%H_subroundoff*h_rescale)
        enddo
      enddo ! end of j loop
 
      !$OMP parallel do default(shared) private(depth,dh,hu)
      do j=js,je
        do i=is-1,ie
          depth(i) = 0.0
          sfc_state%u(i,j) = 0.0
        enddo
        do k=1,nz ; do i=is-1,ie
          hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * h_rescale
          if (depth(i) + hu < depth_ml) then
            dh = hu
          elseif (depth(i) < depth_ml) then
            dh = depth_ml - depth(i)
          else
            dh = 0.0
          endif
          sfc_state%u(i,j) = sfc_state%u(i,j) + dh * cs%u(i,j,k)
          depth(i) = depth(i) + dh
        enddo ; enddo
        ! Calculate the average properties of the mixed layer depth.
        do i=is-1,ie
          sfc_state%u(i,j) = sfc_state%u(i,j) / max(depth(i), gv%H_subroundoff*h_rescale)
        enddo
      enddo ! end of j loop
    else ! Hmix_UV<=0.
      do j=js,je ; do i=is-1,ie
        sfc_state%u(i,j) = cs%u(i,j,1)
      enddo ; enddo
      do j=js-1,je ; do i=is,ie
        sfc_state%v(i,j) = cs%v(i,j,1)
      enddo ; enddo
    endif
  endif  ! (CS%Hmix >= 0.0)
 
 
  if (allocated(sfc_state%melt_potential)) then
    !$OMP parallel do default(shared) private(depth_ml, dh, T_freeze, depth, delT)
    do j=js,je
      do i=is,ie
        depth(i) = 0.0
        delt(i) = 0.0
      enddo
 
      do k=1,nz ; do i=is,ie
        depth_ml = min(cs%HFrz, cs%visc%MLD(i,j))
        if (depth(i) + h(i,j,k)*gv%H_to_Z < depth_ml) then
          dh = h(i,j,k)*gv%H_to_Z
        elseif (depth(i) < depth_ml) then
          dh = depth_ml - depth(i)
        else
          dh = 0.0
        endif
 
        ! p=0 OK, HFrz ~ 10 to 20m
        call calculate_tfreeze(cs%tv%S(i,j,k), 0.0, t_freeze, cs%tv%eqn_of_state)
        depth(i) = depth(i) + dh
        delt(i) =  delt(i) + dh * (cs%tv%T(i,j,k) - t_freeze)
      enddo ; enddo
 
      do i=is,ie
       ! set melt_potential to zero to avoid passing previous values
       sfc_state%melt_potential(i,j) = 0.0
 
       if (g%mask2dT(i,j)>0.) then
         ! instantaneous melt_potential [Q R Z ~> J m-2]
         sfc_state%melt_potential(i,j) = cs%tv%C_p * gv%Rho0 * delt(i)
       endif
      enddo
    enddo ! end of j loop
  endif   ! melt_potential
 
  if (allocated(sfc_state%salt_deficit) .and. associated(cs%tv%salt_deficit)) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is,ie
      ! Convert from gSalt to kgSalt
      sfc_state%salt_deficit(i,j) = 0.001 * cs%tv%salt_deficit(i,j)
    enddo ; enddo
  endif
  if (allocated(sfc_state%TempxPmE) .and. associated(cs%tv%TempxPmE)) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is,ie
      sfc_state%TempxPmE(i,j) = cs%tv%TempxPmE(i,j)
    enddo ; enddo
  endif
  if (allocated(sfc_state%internal_heat) .and. associated(cs%tv%internal_heat)) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is,ie
      sfc_state%internal_heat(i,j) = cs%tv%internal_heat(i,j)
    enddo ; enddo
  endif
  if (allocated(sfc_state%taux_shelf) .and. associated(cs%visc%taux_shelf)) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is-1,ie
      sfc_state%taux_shelf(i,j) = cs%visc%taux_shelf(i,j)
    enddo ; enddo
  endif
  if (allocated(sfc_state%tauy_shelf) .and. associated(cs%visc%tauy_shelf)) then
    !$OMP parallel do default(shared)
    do j=js-1,je ; do i=is,ie
      sfc_state%tauy_shelf(i,j) = cs%visc%tauy_shelf(i,j)
    enddo ; enddo
  endif
 
  if (allocated(sfc_state%ocean_mass) .and. allocated(sfc_state%ocean_heat) .and. &
      allocated(sfc_state%ocean_salt)) then
    !$OMP parallel do default(shared)
    do j=js,je ; do i=is,ie
      sfc_state%ocean_mass(i,j) = 0.0
      sfc_state%ocean_heat(i,j) = 0.0 ; sfc_state%ocean_salt(i,j) = 0.0
    enddo ; enddo
    !$OMP parallel do default(shared) private(mass)
    do j=js,je ; do k=1,nz; do i=is,ie
      mass = gv%H_to_RZ*h(i,j,k)
      sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + mass
      sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * cs%tv%T(i,j,k)
      sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*cs%tv%S(i,j,k))
    enddo ; enddo ; enddo
  else
    if (allocated(sfc_state%ocean_mass)) then
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is,ie ; sfc_state%ocean_mass(i,j) = 0.0 ; enddo ; enddo
      !$OMP parallel do default(shared)
      do j=js,je ; do k=1,nz ; do i=is,ie
        sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + gv%H_to_RZ*h(i,j,k)
      enddo ; enddo ; enddo
    endif
    if (allocated(sfc_state%ocean_heat)) then
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is,ie ; sfc_state%ocean_heat(i,j) = 0.0 ; enddo ; enddo
      !$OMP parallel do default(shared) private(mass)
      do j=js,je ; do k=1,nz ; do i=is,ie
        mass = gv%H_to_RZ*h(i,j,k)
        sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass*cs%tv%T(i,j,k)
      enddo ; enddo ; enddo
    endif
    if (allocated(sfc_state%ocean_salt)) then
      !$OMP parallel do default(shared)
      do j=js,je ; do i=is,ie ; sfc_state%ocean_salt(i,j) = 0.0 ; enddo ; enddo
      !$OMP parallel do default(shared) private(mass)
      do j=js,je ; do k=1,nz ; do i=is,ie
        mass = gv%H_to_RZ*h(i,j,k)
        sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*cs%tv%S(i,j,k))
      enddo ; enddo ; enddo
    endif
  endif
 
  if (associated(cs%tracer_flow_CSp)) then
    call call_tracer_surface_state(sfc_state, h, g, cs%tracer_flow_CSp)
  endif
 
  if (cs%check_bad_sfc_vals) then
    numberoferrors=0 ! count number of errors
    do j=js,je; do i=is,ie
      if (g%mask2dT(i,j)>0.) then
        localerror = sfc_state%sea_lev(i,j) <= -g%bathyT(i,j) &
                .or. sfc_state%sea_lev(i,j) >=  cs%bad_val_ssh_max  &
                .or. sfc_state%sea_lev(i,j) <= -cs%bad_val_ssh_max  &
                .or. sfc_state%sea_lev(i,j) + g%bathyT(i,j) < cs%bad_val_col_thick
        if (use_temperature) localerror = localerror &
                .or. sfc_state%SSS(i,j)<0.                        &
                .or. sfc_state%SSS(i,j)>=cs%bad_val_sss_max       &
                .or. sfc_state%SST(i,j)< cs%bad_val_sst_min       &
                .or. sfc_state%SST(i,j)>=cs%bad_val_sst_max
        if (localerror) then
          numberoferrors=numberoferrors+1
          if (numberoferrors<9) then ! Only report details for the first few errors
            ig = i + g%HI%idg_offset ! Global i-index
            jg = j + g%HI%jdg_offset ! Global j-index
            if (use_temperature) then
              write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),8(a,es11.4,x))') &
                'Extreme surface sfc_state detected: i=',ig,'j=',jg, &
                'lon=',g%geoLonT(i,j), 'lat=',g%geoLatT(i,j), &
                'x=',g%gridLonT(ig), 'y=',g%gridLatT(jg), &
                'D=',cs%US%Z_to_m*g%bathyT(i,j),  'SSH=',cs%US%Z_to_m*sfc_state%sea_lev(i,j), &
                'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), &
                'U-=',us%L_T_to_m_s*sfc_state%u(i-1,j), 'U+=',us%L_T_to_m_s*sfc_state%u(i,j), &
                'V-=',us%L_T_to_m_s*sfc_state%v(i,j-1), 'V+=',us%L_T_to_m_s*sfc_state%v(i,j)
            else
              write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),6(a,es11.4))') &
                'Extreme surface sfc_state detected: i=',ig,'j=',jg, &
                'lon=',g%geoLonT(i,j), 'lat=',g%geoLatT(i,j), &
                'x=',g%gridLonT(i), 'y=',g%gridLatT(j), &
                'D=',cs%US%Z_to_m*g%bathyT(i,j),  'SSH=',cs%US%Z_to_m*sfc_state%sea_lev(i,j), &
                'U-=',us%L_T_to_m_s*sfc_state%u(i-1,j), 'U+=',us%L_T_to_m_s*sfc_state%u(i,j), &
                'V-=',us%L_T_to_m_s*sfc_state%v(i,j-1), 'V+=',us%L_T_to_m_s*sfc_state%v(i,j)
            endif
            call mom_error(warning, trim(msg), all_print=.true.)
          elseif (numberoferrors==9) then ! Indicate once that there are more errors
            call mom_error(warning, 'There were more unreported extreme events!', all_print=.true.)
          endif ! numberOfErrors
        endif ! localError
      endif ! mask2dT
    enddo ; enddo
    call sum_across_pes(numberoferrors)
    if (numberoferrors>0) then
      write(msg(1:240),'(3(a,i9,x))') 'There were a total of ',numberoferrors, &
          'locations detected with extreme surface values!'
      call mom_error(fatal, trim(msg))
    endif
  endif
 
  if (cs%debug) call mom_surface_chksum("Post extract_sfc", sfc_state, g, us, haloshift=0)
 
  ! Rotate sfc_state back onto the input grid, sfc_state_in
  if (cs%rotate_index) then
    call rotate_surface_state(sfc_state, g, sfc_state_in, g_in, -turns)
    call deallocate_surface_state(sfc_state)
  endif
 
  call calltree_leave("extract_surface_sfc_state()")
end subroutine extract_surface_state
 
!> Rotate initialization fields from input to rotated arrays.
subroutine rotate_initial_state(u_in, v_in, h_in, T_in, S_in, &
    use_temperature, turns, u, v, h, T, S)
  real, dimension(:,:,:), intent(in) :: u_in, v_in, h_in, T_in, S_in
  logical, intent(in) :: use_temperature
  integer, intent(in) :: turns
  real, dimension(:,:,:), intent(out) :: u, v, h, T, S
 
  call rotate_vector(u_in, v_in, turns, u, v)
  call rotate_array(h_in, turns, h)
  if (use_temperature) then
    call rotate_array(t_in, turns, t)
    call rotate_array(s_in, turns, s)
  endif
end subroutine rotate_initial_state
 
!> Return true if all phases of step_MOM are at the same point in time.
function mom_state_is_synchronized(CS, adv_dyn) result(in_synch)
  type(mom_control_struct), pointer :: cs !< MOM control structure
  logical,        optional, intent(in) :: adv_dyn  !< If present and true, only check
                                          !! whether the advection is up-to-date with
                                          !! the dynamics.
  logical :: in_synch !< True if all phases of the update are synchronized.
 
  logical :: adv_only
 
  adv_only = .false. ; if (present(adv_dyn)) adv_only = adv_dyn
 
  if (adv_only) then
    in_synch = (cs%t_dyn_rel_adv == 0.0)
  else
    in_synch = ((cs%t_dyn_rel_adv == 0.0) .and. (cs%t_dyn_rel_thermo == 0.0))
  endif
 
end function mom_state_is_synchronized
 
!> This subroutine offers access to values or pointers to other types from within
!! the MOM_control_struct, allowing the MOM_control_struct to be opaque.
subroutine get_mom_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp)
  type(mom_control_struct),          pointer     :: cs !< MOM control structure
  type(ocean_grid_type),   optional, pointer     :: g    !< structure containing metrics and grid info
  type(verticalgrid_type), optional, pointer     :: gv   !< structure containing vertical grid info
  type(unit_scale_type),   optional, pointer     :: us   !< A dimensional unit scaling type
  real,                    optional, intent(out) :: c_p  !< The heat capacity [J kg degC-1]
  real,                    optional, intent(out) :: c_p_scaled !< The heat capacity in scaled
                                                         !! units [Q degC-1 ~> J kg degC-1]
  logical,                 optional, intent(out) :: use_temp !< True if temperature is a state variable
 
  if (present(g)) g => cs%G_in
  if (present(gv)) gv => cs%GV
  if (present(us)) us => cs%US
  if (present(c_p)) c_p = cs%US%Q_to_J_kg * cs%tv%C_p
  if (present(c_p_scaled)) c_p_scaled = cs%tv%C_p
  if (present(use_temp)) use_temp = associated(cs%tv%T)
end subroutine get_mom_state_elements
 
!> Find the global integrals of various quantities.
subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only)
  type(mom_control_struct), pointer :: cs !< MOM control structure
  real,    optional, intent(out) :: heat  !< The globally integrated integrated ocean heat [J].
  real,    optional, intent(out) :: salt  !< The globally integrated integrated ocean salt [kg].
  real,    optional, intent(out) :: mass  !< The globally integrated integrated ocean mass [kg].
  logical, optional, intent(in)  :: on_pe_only !< If present and true, only sum on the local PE.
 
  if (present(mass)) &
    mass = global_mass_integral(cs%h, cs%G, cs%GV, on_pe_only=on_pe_only)
  if (present(heat)) &
    heat = cs%US%Q_to_J_kg*cs%tv%C_p * global_mass_integral(cs%h, cs%G, cs%GV, cs%tv%T, on_pe_only=on_pe_only)
  if (present(salt)) &
    salt = 1.0e-3 * global_mass_integral(cs%h, cs%G, cs%GV, cs%tv%S, on_pe_only=on_pe_only)
 
end subroutine get_ocean_stocks
 
!> End of ocean model, including memory deallocation
subroutine mom_end(CS)
  type(mom_control_struct), pointer :: cs   !< MOM control structure
 
  if (cs%use_ALE_algorithm) call ale_end(cs%ALE_CSp)
 
  dealloc_(cs%u) ; dealloc_(cs%v) ; dealloc_(cs%h)
  dealloc_(cs%uh) ; dealloc_(cs%vh)
 
  if (associated(cs%tv%T)) then
    dealloc_(cs%T) ; cs%tv%T => null() ; dealloc_(cs%S) ; cs%tv%S => null()
  endif
  if (associated(cs%tv%frazil)) deallocate(cs%tv%frazil)
  if (associated(cs%tv%salt_deficit)) deallocate(cs%tv%salt_deficit)
  if (associated(cs%Hml)) deallocate(cs%Hml)
 
  call tracer_advect_end(cs%tracer_adv_CSp)
  call tracer_hor_diff_end(cs%tracer_diff_CSp)
  call tracer_registry_end(cs%tracer_Reg)
  call tracer_flow_control_end(cs%tracer_flow_CSp)
 
  call diabatic_driver_end(cs%diabatic_CSp)
 
  if (cs%offline_tracer_mode) call offline_transport_end(cs%offline_CSp)
 
  dealloc_(cs%uhtr) ; dealloc_(cs%vhtr)
  if (cs%split) then
    call end_dyn_split_rk2(cs%dyn_split_RK2_CSp)
  elseif (cs%use_RK2) then
    call end_dyn_unsplit_rk2(cs%dyn_unsplit_RK2_CSp)
  else
    call end_dyn_unsplit(cs%dyn_unsplit_CSp)
  endif
  dealloc_(cs%ave_ssh_ibc) ; dealloc_(cs%ssh_rint)
  if (associated(cs%update_OBC_CSp)) call obc_register_end(cs%update_OBC_CSp)
 
  call verticalgridend(cs%GV)
  call unit_scaling_end(cs%US)
  call mom_grid_end(cs%G)
 
  deallocate(cs)
 
end subroutine mom_end
 
!> \namespace mom
!!
!! Modular Ocean Model (MOM) Version 6.0 (MOM6)
!!
!! \authors Alistair Adcroft, Robert Hallberg, and Stephen Griffies
!!
!!  Additional contributions from:
!!    * Whit Anderson
!!    * Brian Arbic
!!    * Will Cooke
!!    * Anand Gnanadesikan
!!    * Matthew Harrison
!!    * Mehmet Ilicak
!!    * Laura Jackson
!!    * Jasmine John
!!    * John Krasting
!!    * Zhi Liang
!!    * Bonnie Samuels
!!    * Harper Simmons
!!    * Laurent White
!!    * Niki Zadeh
!!
!!  MOM ice-shelf code was developed by
!!  * Daniel Goldberg
!!  * Robert Hallberg
!!  * Chris Little
!!  * Olga Sergienko
!!
!!  \section section_overview Overview of MOM
!!
!!  This program (MOM) simulates the ocean by numerically solving
!!  the hydrostatic primitive equations in generalized Lagrangian
!!  vertical coordinates, typically tracking stretched pressure (p*)
!!  surfaces or following isopycnals in the ocean's interior, and
!!  general orthogonal horizontal coordinates. Unlike earlier versions
!!  of MOM, in MOM6 these equations are horizontally discretized on an
!!  Arakawa C-grid.  (It remains to be seen whether a B-grid dynamic
!!  core will be revived in MOM6 at a later date; for now applications
!!  requiring a B-grid discretization should use MOM5.1.)  MOM6 offers
!!  a range of options for the physical parameterizations, from those
!!  most appropriate to highly idealized models for geophysical fluid
!!  dynamics studies to a rich suite of processes appropriate for
!!  realistic ocean simulations.  The thermodynamic options typically
!!  use conservative temperature and preformed salinity as conservative
!!  state variables and a full nonlinear equation of state, but there
!!  are also idealized adiabatic configurations of the model that use
!!  fixed density layers.  Version 6.0 of MOM continues in the long
!!  tradition of a commitment to climate-quality ocean simulations
!!  embodied in previous versions of MOM, even as it draws extensively
!!  on the lessons learned in the development of the Generalized Ocean
!!  Layered Dynamics (GOLD) ocean model, which was also primarily
!!  developed at NOAA/GFDL.  MOM has also benefited tremendously from
!!  the FMS infrastructure, which it utilizes and shares with other
!!  component models developed at NOAA/GFDL.
!!
!!    When run is isopycnal-coordinate mode, the uppermost few layers
!!  are often used to describe a bulk mixed layer, including the
!!  effects of penetrating shortwave radiation.  Either a split-
!!  explicit time stepping scheme or a non-split scheme may be used
!!  for the dynamics, while the time stepping may be split (and use
!!  different numbers of steps to cover the same interval) for the
!!  forcing, the thermodynamics, and for the dynamics.  Most of the
!!  numerics are second order accurate in space.  MOM can run with an
!!  absurdly thin minimum layer thickness. A variety of non-isopycnal
!!  vertical coordinate options are under development, but all exploit
!!  the advantages of a Lagrangian vertical coordinate, as discussed
!!  in detail by Adcroft and Hallberg (Ocean Modelling, 2006).
!!
!!    Details of the numerics and physical parameterizations are
!!  provided in the appropriate source files.  All of the available
!!  options are selected at run-time by parsing the input files,
!!  usually MOM_input and MOM_override, and the options choices are
!!  then documented for each run in MOM_param_docs.
!!
!!    MOM6 integrates the equations forward in time in three distinct
!!  phases.  In one phase, the dynamic equations for the velocities
!!  and layer thicknesses are advanced, capturing the propagation of
!!  external and internal inertia-gravity waves, Rossby waves, and
!!  other strictly adiabatic processes, including lateral stresses,
!!  vertical viscosity and momentum forcing, and interface height
!!  diffusion (commonly called Gent-McWilliams diffusion in depth-
!!  coordinate models).  In the second phase, all tracers are advected
!!  and diffused along the layers.  The third phase applies diabatic
!!  processes, vertical mixing of water properties, and perhaps
!!  vertical remapping to cause the layers to track the desired
!!  vertical coordinate.
!!
!!    The present file (MOM.F90) orchestrates the main time stepping
!!  loops. One time integration option for the dynamics uses a split
!!  explicit time stepping scheme to rapidly step the barotropic
!!  pressure and velocity fields. The barotropic velocities are
!!  averaged over the baroclinic time step before they are used to
!!  advect thickness and determine the baroclinic accelerations.  As
!!  described in Hallberg and Adcroft (2009), a barotropic correction
!!  is applied to the time-mean layer velocities to ensure that the
!!  sum of the layer transports agrees with the time-mean barotropic
!!  transport, thereby ensuring that the estimates of the free surface
!!  from the sum of the layer thicknesses agrees with the final free
!!  surface height as calculated by the barotropic solver.  The
!!  barotropic and baroclinic velocities are kept consistent by
!!  recalculating the barotropic velocities from the baroclinic
!!  transports each time step. This scheme is described in Hallberg,
!!  1997, J. Comp. Phys. 135, 54-65 and in Hallberg and Adcroft, 2009,
!!  Ocean Modelling, 29, 15-26.
!!
!!    The other time integration options use non-split time stepping
!!  schemes based on the 3-step third order Runge-Kutta scheme
!!  described in Matsuno, 1966, J. Met. Soc. Japan, 44, 85-88, or on
!!  a two-step quasi-2nd order Runge-Kutta scheme.  These are much
!!  slower than the split time-stepping scheme, but they are useful
!!  for providing a more robust solution for debugging cases where the
!!  more complicated split time-stepping scheme may be giving suspect
!!  solutions.
!!
!!    There are a range of closure options available.  Horizontal
!!  velocities are subject to a combination of horizontal biharmonic
!!  and Laplacian friction (based on a stress tensor formalism) and a
!!  vertical Fickian viscosity (perhaps using the kinematic viscosity
!!  of water).  The horizontal viscosities may be constant, spatially
!!  varying or may be dynamically calculated using Smagorinsky's
!!  approach.  A diapycnal diffusion of density and thermodynamic
!!  quantities is also allowed, but not required, as is horizontal
!!  diffusion of interface heights (akin to the Gent-McWilliams
!!  closure of geopotential coordinate models).  The diapycnal mixing
!!  may use a fixed diffusivity or it may use the shear Richardson
!!  number dependent closure, like that described in Jackson et al.
!!  (JPO, 2008).  When there is diapycnal diffusion, it applies to
!!  momentum as well. As this is in addition to the vertical viscosity,
!!  the vertical Prandtl always exceeds 1.  A refined bulk-mixed layer
!!  is often used to describe the planetary boundary layer in realistic
!!  ocean simulations.
!!
!!    MOM has a number of noteworthy debugging capabilities.
!!  Excessively large velocities are truncated and MOM will stop
!!  itself after a number of such instances to keep the model from
!!  crashing altogether.  This is useful in diagnosing failures,
!!  or (by accepting some truncations) it may be useful for getting
!!  the model past the adjustment from an ill-balanced initial
!!  condition.  In addition, all of the accelerations in the columns
!!  with excessively large velocities may be directed to a text file.
!!  Parallelization errors may be diagnosed using the DEBUG option,
!!  which causes extensive checksums to be written out along with
!!  comments indicating where in the algorithm the sums originate and
!!  what variable is being summed.  The point where these checksums
!!  differ between runs is usually a good indication of where in the
!!  code the problem lies.  All of the test cases provided with MOM
!!  are routinely tested to ensure that they give bitwise identical
!!  results regardless of the domain decomposition, or whether they
!!  use static or dynamic memory allocation.
!!
!!  \section section_structure Structure of MOM
!!
!!  About 115 other files of source code and 4 header files comprise
!!  the MOM code, although there are several hundred more files that
!!  make up the FMS infrastructure upon which MOM is built.  Each of
!!  the MOM files contains comments documenting what it does, and
!!  most of the file names are fairly self-evident. In addition, all
!!  subroutines and data types are referenced via a module use, only
!!  statement, and the module names are consistent with the file names,
!!  so it is not too hard to find the source file for a subroutine.
!!
!!    The typical MOM directory tree is as follows:
!!
!! \verbatim
!!        ../MOM
!!        |-- config_src
!!        |   |-- coupled_driver
!!        |   |-- dynamic
!!        |   `-- solo_driver
!!        |-- examples
!!        |   |-- CM2G
!!        |   |-- ...
!!        |   `-- torus_advection_test
!!        `-- src
!!            |-- core
!!            |-- diagnostics
!!            |-- equation_of_state
!!            |-- framework
!!            |-- ice_shelf
!!            |-- initialization
!!            |-- parameterizations
!!            |   |-- lateral
!!            |   `-- vertical
!!            |-- tracer
!!            `-- user
!! \endverbatim
!!
!!  Rather than describing each file here, each directory contents
!!  will be described to give a broad overview of the MOM code
!!  structure.
!!
!!    The directories under config_src contain files that are used for
!!  configuring the code, for instance for coupled or ocean-only runs.
!!  Only one or two of these directories are used in compiling any,
!!  particular run.
!!
!!  * config_src/coupled_driver:
!!    The files here are used to couple MOM as a component in a larger
!!    run driven by the FMS coupler.  This includes code that converts
!!    various forcing fields into the code structures and flux and unit
!!    conventions used by MOM, and converts the MOM surface fields
!!    back to the forms used by other FMS components.
!!
!!  * config_src/dynamic:
!!    The only file here is the version of MOM_memory.h that is used
!!    for dynamic memory configurations of MOM.
!!
!!  * config_src/solo_driver:
!!    The files here are include the _main driver that is used when
!!    MOM is configured as an ocean-only model, as well as the files
!!    that specify the surface forcing in this configuration.
!!
!!    The directories under examples provide a large number of working
!!  configurations of MOM, along with reference solutions for several
!!  different compilers on GFDL's latest large computer.  The versions
!!  of MOM_memory.h in these directories need not be used if dynamic
!!  memory allocation is desired, and the answers should be unchanged.
!!
!!    The directories under src contain most of the MOM files.  These
!!  files are used in every configuration using MOM.
!!
!!  * src/core:
!!    The files here constitute the MOM dynamic core.  This directory
!!    also includes files with the types that describe the model's
!!    lateral grid and have defined types that are shared across
!!    various MOM modules to allow for more succinct and flexible
!!    subroutine argument lists.
!!
!!  * src/diagnostics:
!!    The files here calculate various diagnostics that are anciliary
!!    to the model itself.  While most of these diagnostics do not
!!    directly affect the model's solution, there are some, like the
!!    calculation of the deformation radius, that are used in some
!!    of the process parameterizations.
!!
!!  * src/equation_of_state:
!!    These files describe the physical properties of sea-water,
!!    including both the equation of state and when it freezes.
!!
!!  * src/framework:
!!    These files provide infrastructure utilities for MOM.  Many are
!!    simply wrappers for capabilities provided by FMS, although others
!!    provide capabilities (like the file_parser) that are unique to
!!    MOM. When MOM is adapted to use a modeling infrastructure
!!    distinct from FMS, most of the required changes are in this
!!    directory.
!!
!!  * src/initialization:
!!    These are the files that are used to initialize the MOM grid
!!    or provide the initial physical state for MOM.  These files are
!!    not intended to be modified, but provide a means for calling
!!    user-specific initialization code like the examples in src/user.
!!
!!  * src/parameterizations/lateral:
!!    These files implement a number of quasi-lateral (along-layer)
!!    process parameterizations, including lateral viscosities,
!!    parameterizations of eddy effects, and the calculation of tidal
!!    forcing.
!!
!!  * src/parameterizations/vertical:
!!    These files implement a number of vertical mixing or diabatic
!!    processes, including the effects of vertical viscosity and
!!    code to parameterize the planetary boundary layer.  There is a
!!    separate driver that orchestrates this portion of the algorithm,
!!    and there is a diversity of parameterizations to be found here.
!!
!!  * src/tracer:
!!    These files handle the lateral transport and diffusion of
!!    tracers, or are the code to implement various passive tracer
!!    packages.  Additional tracer packages are readily accommodated.
!!
!!  * src/user:
!!    These are either stub routines that a user could use to change
!!    the model's initial conditions or forcing, or are examples that
!!    implement specific test cases.  These files can easily  be hand
!!    edited to create new analytically specified configurations.
!!
!!
!!  Most simulations can be set up by modifying only the files
!!  MOM_input, and possibly one or two of the files in src/user.
!!  In addition, the diag_table (MOM_diag_table) will commonly be
!!  modified to tailor the output to the needs of the question at
!!  hand.  The FMS utility mkmf works with a file called path_names
!!  to build an appropriate makefile, and path_names should be edited
!!  to reflect the actual location of the desired source code.
!!
!!
!!  There are 3 publicly visible subroutines in this file (MOM.F90).
!!  * step_MOM steps MOM over a specified interval of time.
!!  * MOM_initialize calls initialize and does other initialization
!!    that does not warrant user modification.
!!  * extract_surface_state determines the surface (bulk mixed layer
!!    if traditional isoycnal vertical coordinate) properties of the
!!    current model state and packages pointers to these fields into an
!!    exported structure.
!!
!!    The remaining subroutines in this file (src/core/MOM.F90) are:
!!  * find_total_transport determines the barotropic mass transport.
!!  * register_diags registers many diagnostic fields for the dynamic
!!    solver, or of the main model variables.
!!  * MOM_timing_init initializes various CPU time clocks.
!!  * write_static_fields writes out various time-invariant fields.
!!  * set_restart_fields is used to specify those fields that are
!!    written to and read from the restart file.
!!
!!  \section section_heat_budget Diagnosing MOM heat budget
!!
!!  Here are some example heat budgets for the ALE version of MOM6.
!!
!!  \subsection subsection_2d_heat_budget Depth integrated heat budget
!!
!!  Depth integrated heat budget diagnostic for MOM.
!!
!! * OPOTTEMPTEND_2d = T_ADVECTION_XY_2d + OPOTTEMPPMDIFF_2d + HFDS + HFGEOU
!!
!! * T_ADVECTION_XY_2d = horizontal advection
!! * OPOTTEMPPMDIFF_2d = neutral diffusion
!! * HFDS              = net surface boundary heat flux
!! * HFGEOU            = geothermal heat flux
!!
!! * HFDS = net surface boundary heat flux entering the ocean
!!        = rsntds + rlntds + hfls + hfss + heat_pme + hfsifrazil
!!
!! * More heat flux cross-checks
!!   * hfds     = net_heat_coupler + hfsifrazil + heat_pme
!!   * heat_pme = heat_content_surfwater
!!              = heat_content_massin + heat_content_massout
!!              = heat_content_fprec + heat_content_cond + heat_content_vprec
!!               + hfrunoffds + hfevapds + hfrainds
!!
!!  \subsection subsection_3d_heat_budget Depth integrated heat budget
!!
!!  Here is an example 3d heat budget diagnostic for MOM.
!!
!! * OPOTTEMPTEND = T_ADVECTION_XY + TH_TENDENCY_VERT_REMAP + OPOTTEMPDIFF + OPOTTEMPPMDIFF
!!                + BOUNDARY_FORCING_HEAT_TENDENCY + FRAZIL_HEAT_TENDENCY
!!
!! * OPOTTEMPTEND                   = net tendency of heat as diagnosed in MOM.F90
!! * T_ADVECTION_XY                 = heating of a cell from lateral advection
!! * TH_TENDENCY_VERT_REMAP         = heating of a cell from vertical remapping
!! * OPOTTEMPDIFF                   = heating of a cell from diabatic diffusion
!! * OPOTTEMPPMDIFF                 = heating of a cell from neutral diffusion
!! * BOUNDARY_FORCING_HEAT_TENDENCY = heating of cell from boundary fluxes
!! * FRAZIL_HEAT_TENDENCY           = heating of cell from frazil
!!
!! * TH_TENDENCY_VERT_REMAP has zero vertical sum, as it redistributes heat in vertical.
!!
!! * OPOTTEMPDIFF has zero vertical sum, as it redistributes heat in the vertical.
!!
!! * BOUNDARY_FORCING_HEAT_TENDENCY generally has 3d structure, with k > 1 contributions from
!!   penetrative shortwave, and from other fluxes for the case when layers are tiny, in which
!!   case MOM6 partitions tendencies into k > 1 layers.
!!
!! * FRAZIL_HEAT_TENDENCY generally has 3d structure, since MOM6 frazil calculation checks the
!!   full ocean column.
!!
!! * FRAZIL_HEAT_TENDENCY[k=\@sum] = HFSIFRAZIL = column integrated frazil heating.
!!
!! * HFDS = FRAZIL_HEAT_TENDENCY[k=\@sum] + BOUNDARY_FORCING_HEAT_TENDENCY[k=\@sum]
!!
!!  Here is an example 2d heat budget (depth summed) diagnostic for MOM.
!!
!! * OPOTTEMPTEND_2d = T_ADVECTION_XY_2d + OPOTTEMPPMDIFF_2d + HFDS
!!
!!
!!  Here is an example 3d salt budget diagnostic for MOM.
!!
!! * OSALTTEND = S_ADVECTION_XY + SH_TENDENCY_VERT_REMAP + OSALTDIFF + OSALTPMDIFF
!!                + BOUNDARY_FORCING_SALT_TENDENCY
!!
!! * OSALTTEND                      = net tendency of salt as diagnosed in MOM.F90
!! * S_ADVECTION_XY                 = salt convergence to cell from lateral advection
!! * SH_TENDENCY_VERT_REMAP         = salt convergence to cell from vertical remapping
!! * OSALTDIFF                      = salt convergence to cell from diabatic diffusion
!! * OSALTPMDIFF                    = salt convergence to cell from neutral diffusion
!! * BOUNDARY_FORCING_SALT_TENDENCY = salt convergence to cell from boundary fluxes
!!
!! * SH_TENDENCY_VERT_REMAP has zero vertical sum, as it redistributes salt in vertical.
!!
!! * OSALTDIFF has zero vertical sum, as it redistributes salt in the vertical.
!!
!! * BOUNDARY_FORCING_SALT_TENDENCY generally has 3d structure, with k > 1 contributions from
!!   the case when layers are tiny, in which case MOM6 partitions tendencies into k > 1 layers.
!!
!! * SFDSI = BOUNDARY_FORCING_SALT_TENDENCY[k=\@sum]
!!
!!  Here is an example 2d salt budget (depth summed) diagnostic for MOM.
!!
!! * OSALTTEND_2d = S_ADVECTION_XY_2d + OSALTPMDIFF_2d + SFDSI (+ SALT_FLUX_RESTORE)
!!
!!
!!
end module mom