diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 250d554361..e918f642d1 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -17,9 +17,10 @@ module ocean_model_mod ! in the same way as MOM4. ! -use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_state_type, MOM_end -use MOM, only : calculate_surface_state, allocate_surface_state, finish_MOM_initialization -use MOM, only : step_offline +use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization +use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized +use MOM, only : get_ocean_stocks, step_offline use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end @@ -173,6 +174,18 @@ module ocean_model_mod !! and diffusion equation read in from files stored from !! a previous integration of the prognostic model. + logical :: single_step_call !< If true, advance the state of MOM with a single + !! step including both dynamics and thermodynamics. + !! If false, the two phases are advanced with + !! separate calls. The default is true. + ! The following 3 variables are only used here if single_step_call is false. + real :: dt !< (baroclinic) dynamics time step (seconds) + real :: dt_therm !< thermodynamics time step (seconds) + logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time + !! steps can span multiple coupled time steps. + logical :: diabatic_first !< If true, apply diabatic and thermodynamic + !! processes before time stepping the dynamics. + type(directories) :: dirs !< A structure containing several relevant directory paths. type(mech_forcing) :: forces !< A structure with the driving mechanical surface forces type(forcing) :: fluxes !< A structure containing pointers to @@ -190,8 +203,6 @@ module ocean_model_mod !! about the vertical grid. type(MOM_control_struct), pointer :: & MOM_CSp => NULL() !< A pointer to the MOM control structure - type(MOM_state_type), pointer :: & - MSp => NULL() !< A pointer to the MOM_state_type type(ice_shelf_CS), pointer :: & Ice_shelf_CSp => NULL() !< A pointer to the control structure for the !! ice shelf model that couples with MOM6. This @@ -267,16 +278,42 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) if (.not.OS%is_ocean_pe) return OS%Time = Time_in - call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MSp, OS%MOM_CSp, & + call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true.) - OS%grid => OS%MSp%G ; OS%GV => OS%MSp%GV - OS%C_p = OS%MSp%tv%C_p - OS%fluxes%C_p = OS%MSp%tv%C_p - use_temperature = ASSOCIATED(OS%MSp%tv%T) + call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, C_p=OS%C_p, & + use_temp=use_temperature) + OS%fluxes%C_p = OS%C_p ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & + "If true, advance the state of MOM with a single step \n"//& + "including both dynamics and thermodynamics. If false, \n"//& + "the two phases are advanced with separate calls.", default=.true.) + call get_param(param_file, mdl, "DT", OS%dt, & + "The (baroclinic) dynamics time step. The time-step that \n"//& + "is actually used will be an integer fraction of the \n"//& + "forcing time-step.", units="s", fail_if_missing=.true.) + call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & + "The thermodynamic and tracer advection time step. \n"//& + "Ideally DT_THERM should be an integer multiple of DT \n"//& + "and less than the forcing or coupling time-step, unless \n"//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& + "can be an integer multiple of the coupling timestep. By \n"//& + "default DT_THERM is set to DT.", units="s", default=OS%dt) + call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & + "If true, the MOM will take thermodynamic and tracer \n"//& + "timesteps that can be longer than the coupling timestep. \n"//& + "The actual thermodynamic timestep that is used in this \n"//& + "case is the largest integer multiple of the coupling \n"//& + "timestep that is less than or equal to DT_THERM.", default=.false.) + call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & + "If true, apply diabatic and thermodynamic processes, \n"//& + "including buoyancy forcing and mass gain or loss, \n"//& + "before stepping the dynamics forward.", default=.false.) + call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & "An integer whose bits encode which restart files are \n"//& "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& @@ -367,9 +404,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call coupler_type_set_diags(Ocean_sfc%fields, "ocean_sfc", & Ocean_sfc%axes(1:2), Time_in) - call calculate_surface_state(OS%sfc_state, OS%MSp%u, & - OS%MSp%v, OS%MSp%h, OS%MSp%ave_ssh,& - OS%grid, OS%GV, OS%MSp, OS%MOM_CSp) + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) @@ -439,14 +474,25 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! start of a call to step_MOM. integer :: index_bnds(4) ! The computational domain index bounds in the ! ice-ocean boundary type. - real :: weight ! Flux accumulation weight - real :: time_step ! The time step of a call to step_MOM in seconds. + real :: weight ! Flux accumulation weight + real :: dt_coupling ! The coupling time step in seconds. + integer :: nts ! The number of baroclinic dynamics time steps + ! within dt_coupling. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + integer :: n, n_max, n_last_thermo + type(time_type) :: Time2 ! A temporary time. + logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans + ! multiple dynamic timesteps. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") call get_time(Ocean_coupling_time_step, secs, days) - time_step = 86400.0*real(days) + real(secs) + dt_coupling = 86400.0*real(days) + real(secs) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -472,19 +518,19 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & weight = 1.0 if (OS%fluxes%fluxes_used) then - call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%diag) ! Needed to allow diagnostics in convert_IOB + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) ! Needed to allow diagnostics in convert_IOB call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%forces, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif if (OS%icebergs_apply_rigid_boundary) then !This assumes that the iceshelf and ocean are on the same grid. I hope this is true call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%fluxes, OS%use_ice_shelf, & - OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, & - time_step, OS%berg_area_threshold) + OS%density_iceberg, OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, & + dt_coupling, OS%berg_area_threshold) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. @@ -495,21 +541,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #endif ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = time_step + OS%fluxes%dt_buoy_accum = dt_coupling else OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%forces, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif if (OS%icebergs_apply_rigid_boundary) then !This assumes that the iceshelf and ocean are on the same grid. I hope this is true call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf, OS%density_iceberg, & - OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold) + OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) endif - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, OS%grid, weight) + call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types ! are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) @@ -522,7 +568,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MSp, OS%MOM_CSp, OS%fluxes, & + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes, & OS%restart_CSp) endif @@ -530,16 +576,73 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if(OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MSp, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + elseif (OS%single_step_call) then + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MSp, OS%MOM_CSp) + n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) + dt_dyn = dt_coupling / real(n_max) + thermo_does_span_coupling = (OS%thermo_spans_coupling .and. & + (OS%dt_therm > 1.5*dt_coupling)) + + if (thermo_does_span_coupling) then + dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001) + nts = floor(dt_therm/dt_dyn + 0.001) + else + nts = MAX(1,MIN(n_max,floor(OS%dt_therm/dt_dyn + 0.001))) + n_last_thermo = 0 + endif + + Time2 = Time1 ; t_elapsed_seg = 0.0 + do n=1,n_max + if (OS%diabatic_first) then + if (thermo_does_span_coupling) call MOM_error(FATAL, & + "MOM is not yet set up to have restarts that work with "//& + "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") + if (modulo(n-1,nts)==0) then + dtdia = dt_dyn*min(nts,n_max-(n-1)) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + endif + + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + else + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + + step_thermo = .false. + if (thermo_does_span_coupling) then + dtdia = dt_therm + step_thermo = MOM_state_is_synchronized(OS%MOM_CSp, adv_dyn=.true.) + elseif ((modulo(n,nts)==0) .or. (n==n_max)) then + dtdia = dt_dyn*(n - n_last_thermo) + n_last_thermo = n + step_thermo = .true. + endif + + if (step_thermo) then + ! Back up Time2 to the start of the thermodynamic segment. + Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + endif + endif + + t_elapsed_seg = t_elapsed_seg + dt_dyn + Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + enddo endif OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & + call enable_averaging(dt_coupling, OS%Time, OS%diag) + call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) @@ -580,11 +683,11 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: kv_ice ! The viscosity of ice, in m2 s-1. - real, intent(in) :: density_ice ! A typical density of ice, in kg m-3. - real, intent(in) :: latent_heat_fusion ! The latent heat of fusion, in J kg-1. - real, intent(in) :: time_step ! The latent heat of fusion, in J kg-1. - real, intent(in) :: berg_area_threshold !Area threshold for zero'ing fluxes bellow iceberg + real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. + real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. + real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. + real, intent(in) :: time_step !< The coupling time step, in s. + real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg ! Arguments: ! (in) fluxes - A structure of surface fluxes that may be used. ! (in) G - The ocean's grid structure. @@ -675,9 +778,10 @@ subroutine ocean_model_restart(OS, timestamp) type(ocean_state_type), pointer :: OS character(len=*), intent(in), optional :: timestamp - if (OS%MSp%t_dyn_rel_adv > 0.0) call MOM_error(WARNING, "End of MOM_main reached "//& - "with inconsistent dynamics and advective times. Additional restart fields "//& - "that have not been coded yet would be required for reproducibility.") + if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & + call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& + "that have not been coded yet would be required for reproducibility.") if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") @@ -732,7 +836,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag) - call MOM_end(Ocean_state%MSp, Ocean_state%MOM_CSp) + call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) end subroutine ocean_model_end ! NAME="ocean_model_end" @@ -759,9 +863,10 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) ! restart behavior as now in FMS. character(len=200) :: restart_dir - if (OS%MSp%t_dyn_rel_adv > 0.0) call MOM_error(WARNING, "End of MOM_main reached "//& - "with inconsistent dynamics and advective times. Additional restart fields "//& - "that have not been coded yet would be required for reproducibility.") + if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & + call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& + "that have not been coded yet would be required for reproducibility.") if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") @@ -958,9 +1063,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - call calculate_surface_state(OS%sfc_state, OS%MSp%u, & - OS%MSp%v, OS%MSp%h, OS%MSp%ave_ssh,& - OS%grid, OS%GV, OS%MSp, OS%MOM_CSp) + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) @@ -994,6 +1097,8 @@ end subroutine ocean_model_flux_init ! Ocean_stock_pe - returns stocks of heat, water, etc. for conservation checks.! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Ocean_stock_pe - returns the integrated stocks of heat, water, etc. for conservation checks. +!! Because of the way FMS is coded, only the root PE has the integrated amount, +!! while all other PEs get 0. subroutine Ocean_stock_pe(OS, index, value, time_index) use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT,ISTOCK_SALT type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. @@ -1007,49 +1112,29 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) ! (in) value - Sum returned for the conservation quantity of interest. ! (in,opt) time_index - Index for time level to use if this is necessary. - real :: to_heat, to_mass, to_salt, PSU_to_kg ! Conversion constants. - integer :: i, j, k, is, ie, js, je, nz, ind + real :: salt value = 0.0 if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return - is = OS%grid%isc ; ie = OS%grid%iec - js = OS%grid%jsc ; je = OS%grid%jec ; nz = OS%grid%ke - select case (index) - case (ISTOCK_WATER) - ! Return the mass of fresh water in the ocean on this PE in kg. - to_mass = OS%GV%H_to_kg_m2 + case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in kg. if (OS%GV%Boussinesq) then - do k=1,nz ; do j=js,je ; do i=is,ie ; if (OS%grid%mask2dT(i,j) > 0.5) then - value = value + to_mass*(OS%MSp%h(i,j,k) * OS%grid%areaT(i,j)) - endif ; enddo ; enddo ; enddo - else - ! In non-Boussinesq mode, the mass of salt needs to be subtracted. - PSU_to_kg = 1.0e-3 - do k=1,nz ; do j=js,je ; do i=is,ie ; if (OS%grid%mask2dT(i,j) > 0.5) then - value = value + to_mass * ((1.0 - PSU_to_kg*OS%MSp%tv%S(i,j,k))*& - (OS%MSp%h(i,j,k) * OS%grid%areaT(i,j))) - endif ; enddo ; enddo ; enddo + call get_ocean_stocks(OS%MOM_CSp, mass=value, on_PE_only=.true.) + else ! In non-Boussinesq mode, the mass of salt needs to be subtracted. + call get_ocean_stocks(OS%MOM_CSp, mass=value, salt=salt, on_PE_only=.true.) + value = value - salt endif - case (ISTOCK_HEAT) - ! Return the heat content of the ocean on this PE in J. - to_heat = OS%GV%H_to_kg_m2 * OS%C_p - do k=1,nz ; do j=js,je ; do i=is,ie ; if (OS%grid%mask2dT(i,j) > 0.5) then - value = value + (to_heat * OS%MSp%tv%T(i,j,k)) * & - (OS%MSp%h(i,j,k)*OS%grid%areaT(i,j)) - endif ; enddo ; enddo ; enddo - case (ISTOCK_SALT) - ! Return the mass of the salt in the ocean on this PE in kg. - ! The 1000 converts salinity in PSU to salt in kg kg-1. - to_salt = OS%GV%H_to_kg_m2 / 1000.0 - do k=1,nz ; do j=js,je ; do i=is,ie ; if (OS%grid%mask2dT(i,j) > 0.5) then - value = value + (to_salt * OS%MSp%tv%S(i,j,k)) * & - (OS%MSp%h(i,j,k)*OS%grid%areaT(i,j)) - endif ; enddo ; enddo ; enddo + case (ISTOCK_HEAT) ! Return the heat content of the ocean in J. + call get_ocean_stocks(OS%MOM_CSp, heat=value, on_PE_only=.true.) + case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in kg. + call get_ocean_stocks(OS%MOM_CSp, salt=value, on_PE_only=.true.) case default ; value = 0.0 end select + ! If the FMS coupler is changed so that Ocean_stock_PE is only called on + ! ocean PEs, uncomment the following and eliminate the on_PE_only flags above. + ! if (.not.is_root_pe()) value = 0.0 end subroutine Ocean_stock_pe diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 39e477c2eb..d97cb96a40 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -33,9 +33,10 @@ module ocn_comp_mct use MOM_coms, only : reproducing_sum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT -use MOM, only: initialize_MOM, step_MOM, MOM_control_struct, MOM_state_type, MOM_end -use MOM, only: calculate_surface_state, allocate_surface_state +use MOM, only: initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only: extract_surface_state, allocate_surface_state use MOM, only: finish_MOM_initialization, step_offline +use MOM, only: get_MOM_state_elements, MOM_state_is_synchronized use MOM_forcing_type, only: forcing, forcing_diags, register_forcing_type_diags use MOM_forcing_type, only: allocate_forcing_type, deallocate_forcing_type use MOM_forcing_type, only: mech_forcing_diags, forcing_accumulate, forcing_diagnostics @@ -337,7 +338,6 @@ module ocn_comp_mct type(verticalGrid_type), pointer :: GV => NULL() !< A pointer to a vertical grid !! structure containing metrics and related information. type(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(MOM_state_type), pointer :: MSp => NULL() type(surface_forcing_CS), pointer :: forcing_CSp => NULL() type(MOM_restart_CS), pointer :: & restart_CSp => NULL() !< A pointer set to the restart control structure @@ -806,14 +806,13 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i if (.not.OS%is_ocean_pe) return OS%Time = Time_in - call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MSp, OS%MOM_CSp, & + call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & input_restart_file=input_restart_file, diag_ptr=OS%diag, & count_calls=.true.) - OS%grid => OS%MSp%G ; OS%GV => OS%MSp%GV - OS%C_p = OS%MSp%tv%C_p - OS%fluxes%C_p = OS%MSp%tv%C_p - use_temperature = ASSOCIATED(OS%MSp%tv%T) + call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, C_p=OS%fluxes%C_p, & + use_temp=use_temperature) + OS%C_p = OS%fluxes%C_p ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -903,9 +902,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! This call can only occur here if the coupler_bc_type variables have been ! initialized already using the information from gas_fields_ocn. if (present(gas_fields_ocn)) then - call calculate_surface_state(OS%sfc_state, OS%MSp%u, & - OS%MSp%v, OS%MSp%h, OS%MSp%ave_ssh,& - OS%grid, OS%GV, OS%MSp, OS%MOM_CSp) + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) endif @@ -933,9 +930,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - call calculate_surface_state(OS%sfc_state, OS%MSp%u, & - OS%MSp%v, OS%MSp%h, OS%MSp%ave_ssh,& - OS%grid, OS%GV, OS%Msp, OS%MOM_CSp) + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) @@ -1774,7 +1769,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MSp, OS%MOM_CSp, OS%fluxes, & + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes, & OS%restart_CSp) endif @@ -1782,9 +1777,9 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & Master_time = OS%Time ; Time1 = OS%Time if(OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MSp, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MSp, OS%MOM_CSp) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) endif OS%Time = Master_time + Ocean_coupling_time_step @@ -2443,7 +2438,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) ! print time stats call MOM_infra_end - call MOM_end(Ocean_state%MSp, Ocean_state%MOM_CSp) + call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) end subroutine ocean_model_end diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 62a0dc12bf..17fa4167c9 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -29,8 +29,9 @@ program MOM_main use MOM_diag_mediator, only : enable_averaging, disable_averaging, diag_mediator_end use MOM_diag_mediator, only : diag_ctrl, diag_mediator_close_registration use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end - use MOM, only : calculate_surface_state, finish_MOM_initialization - use MOM, only : MOM_state_type, step_offline + use MOM, only : extract_surface_state, finish_MOM_initialization + use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized + use MOM, only : step_offline use MOM_domains, only : MOM_infra_init, MOM_infra_end use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -113,18 +114,23 @@ program MOM_main type(time_type) :: segment_start_time ! The start time of this run segment. type(time_type) :: Time_end ! End time for the segment or experiment. type(time_type) :: restart_time ! The next time to write restart files. - type(time_type) :: Time_step_ocean ! A time_type version of time_step. + type(time_type) :: Time_step_ocean ! A time_type version of dt_forcing. real :: elapsed_time = 0.0 ! Elapsed time in this run in seconds. logical :: elapsed_time_master ! If true, elapsed time is used to set the ! model's master clock (Time). This is needed ! if Time_step_ocean is not an exact - ! representation of time_step. - real :: time_step ! The time step of a call to step_MOM in seconds. + ! representation of dt_forcing. + real :: dt_forcing ! The coupling time step in seconds. real :: dt ! The baroclinic dynamics time step, in seconds. real :: dt_off ! Offline time step in seconds integer :: ntstep ! The number of baroclinic dynamics time steps - ! within time_step. + ! within dt_forcing. + real :: dt_therm + real :: dt_dyn, dtdia, t_elapsed_seg + integer :: n, n_max, nts, n_last_thermo + logical :: diabatic_first, single_step_call + type(time_type) :: Time2 integer :: Restart_control ! An integer that is bit-tested to determine whether ! incremental restart files are saved and whether they @@ -142,7 +148,7 @@ program MOM_main integer :: date(6)=-1 ! Possibly the start date of this run segment. integer :: years=0, months=0, days=0 ! These may determine the segment run integer :: hours=0, minutes=0, seconds=0 ! length, if read from a namelist. - integer :: yr, mon, day, hr, min, sec ! Temp variables for writing the date. + integer :: yr, mon, day, hr, mins, sec ! Temp variables for writing the date. type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. character(len=9) :: month @@ -167,7 +173,6 @@ program MOM_main ! a previous integration of the prognostic model type(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(MOM_state_type), pointer :: MSp => NULL() !> A pointer to the tracer flow control structure. type(tracer_flow_control_CS), pointer :: & tracer_flow_CSp => NULL() !< A pointer to the tracer flow control structure @@ -284,26 +289,24 @@ program MOM_main ! In this case, the segment starts at a time fixed by ocean_solo.res segment_start_time = set_date(date(1),date(2),date(3),date(4),date(5),date(6)) Time = segment_start_time - call initialize_MOM(Time, Start_time, param_file, dirs, MSp, MOM_CSp, restart_CSp, & + call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & segment_start_time, offline_tracer_mode=offline_tracer_mode, & diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp) else ! In this case, the segment starts at a time read from the MOM restart file ! or left as Start_time by MOM_initialize. Time = Start_time - call initialize_MOM(Time, Start_time, param_file, dirs, MSp, MOM_CSp, restart_CSp, & + call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, & tracer_flow_CSp=tracer_flow_CSp) endif - fluxes%C_p = MSp%tv%C_p ! Copy the heat capacity for consistency. + call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, C_p=fluxes%C_p) Master_Time = Time - grid => MSp%G - GV => MSp%GV + call callTree_waypoint("done initialize_MOM") - call calculate_surface_state(sfc_state, MSp%u, MSp%v, MSp%h, & - MSp%ave_ssh, grid, GV, MSp, MOM_CSp) + call extract_surface_state(MOM_CSp, sfc_state) call surface_forcing_init(Time, grid, param_file, diag, & surface_forcing_CSp, tracer_flow_CSp) @@ -324,19 +327,19 @@ program MOM_main ! Read all relevant parameters and write them to the model log. call log_version(param_file, mod_name, version, "") call get_param(param_file, mod_name, "DT", dt, fail_if_missing=.true.) - call get_param(param_file, mod_name, "DT_FORCING", time_step, & + call get_param(param_file, mod_name, "DT_FORCING", dt_forcing, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& "The default value is given by DT.", units="s", default=dt) if (offline_tracer_mode) then - call get_param(param_file, mod_name, "DT_OFFLINE", time_step, & + call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & "Time step for the offline time step") - dt = time_step + dt = dt_forcing endif - ntstep = MAX(1,ceiling(time_step/dt - 0.001)) + ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = set_time(int(floor(time_step+0.5))) - elapsed_time_master = (abs(time_step - time_type_to_real(Time_step_ocean)) > 1.0e-12*time_step) + Time_step_ocean = set_time(int(floor(dt_forcing+0.5))) + elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -365,6 +368,23 @@ program MOM_main Time_end = daymax endif + call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & + "If true, advance the state of MOM with a single step \n"//& + "including both dynamics and thermodynamics. If false \n"//& + "the two phases are advanced with separate calls.", default=.true.) + call get_param(param_file, mod_name, "DT_THERM", dt_therm, & + "The thermodynamic and tracer advection time step. \n"//& + "Ideally DT_THERM should be an integer multiple of DT \n"//& + "and less than the forcing or coupling time-step, unless \n"//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& + "can be an integer multiple of the coupling timestep. By \n"//& + "default DT_THERM is set to DT.", units="s", default=dt) + call get_param(param_file, mod_name, "DIABATIC_FIRST", diabatic_first, & + "If true, apply diabatic and thermodynamic processes, \n"//& + "including buoyancy forcing and mass gain or loss, \n"//& + "before stepping the dynamics forward.", default=.false.) + + if (Time >= Time_end) call MOM_error(FATAL, & "MOM_driver: The run has been started at or after the end time of the run.") @@ -444,29 +464,69 @@ program MOM_main endif if (use_ice_shelf) then - call shelf_calc_flux(sfc_state, forces, fluxes, Time, time_step, ice_shelf_CSp) + call shelf_calc_flux(sfc_state, forces, fluxes, Time, dt_forcing, ice_shelf_CSp) !###IS call add_shelf_flux_forcing(fluxes, ice_shelf_CSp) !###IS ! With a coupled ice/ocean run, use the following call. !###IS call add_shelf_flux_IOB(ice_ocean_bdry_type, ice_shelf_CSp) endif fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = time_step + fluxes%dt_buoy_accum = dt_forcing if (ns==1) then - call finish_MOM_initialization(Time, dirs, MSp, MOM_CSp, fluxes, restart_CSp) + call finish_MOM_initialization(Time, dirs, MOM_CSp, fluxes, restart_CSp) endif - ! This call steps the model over a time time_step. + ! This call steps the model over a time dt_forcing. Time1 = Master_Time ; Time = Master_Time if (offline_tracer_mode) then - call step_offline(forces, fluxes, sfc_state, Time1, time_step, MSp, MOM_CSp) + call step_offline(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp) + elseif (single_step_call) then + call step_MOM(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp) else - call step_MOM(forces, fluxes, sfc_state, Time1, time_step, MSp, MOM_CSp) + n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) + dt_dyn = dt_forcing / real(n_max) + + nts = MAX(1,MIN(n_max,floor(dt_therm/dt_dyn + 0.001))) + n_last_thermo = 0 + + Time2 = Time1 ; t_elapsed_seg = 0.0 + do n=1,n_max + if (diabatic_first) then + if (modulo(n-1,nts)==0) then + dtdia = dt_dyn*min(ntstep,n_max-(n-1)) + call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & + do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) + endif + + call step_MOM(forces, fluxes, sfc_state, Time2, dt_dyn, MOM_CSp, & + do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) + else + call step_MOM(forces, fluxes, sfc_state, Time2, dt_dyn, MOM_CSp, & + do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) + + if ((modulo(n,nts)==0) .or. (n==n_max)) then + dtdia = dt_dyn*(n - n_last_thermo) + ! Back up Time2 to the start of the thermodynamic segment. + if (n > n_last_thermo+1) & + Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & + do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) + n_last_thermo = n + endif + endif + + t_elapsed_seg = t_elapsed_seg + dt_dyn + Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + enddo endif ! Time = Time + Time_step_ocean ! This is here to enable fractional-second time steps. - elapsed_time = elapsed_time + time_step + elapsed_time = elapsed_time + dt_forcing if (elapsed_time > 2e9) then ! This is here to ensure that the conversion from a real to an integer ! can be accurately represented in long runs (longer than ~63 years). @@ -488,8 +548,8 @@ program MOM_main call write_cputime(Time, ns+ntstep-1, nmax, write_CPU_CSp) endif ; endif - call enable_averaging(time_step, Time, diag) - call mech_forcing_diags(forces, fluxes, time_step, grid, diag, & + call enable_averaging(dt_forcing, Time, diag) + call mech_forcing_diags(forces, fluxes, dt_forcing, grid, diag, & surface_forcing_CSp%handles) call disable_averaging(diag) @@ -534,10 +594,11 @@ program MOM_main call cpu_clock_end(mainClock) call cpu_clock_begin(termClock) if (Restart_control>=0) then - if (MSp%t_dyn_rel_adv > 0.0) call MOM_error(WARNING, "End of MOM_main reached "//& - "with inconsistent dynamics and advective times. Additional restart fields "//& + if (.not.MOM_state_is_synchronized(MOM_CSp)) & + call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.fluxes%fluxes_used .and. .not.offline_tracer_mode) call MOM_error(FATAL, & + if (.not.fluxes%fluxes_used .and. .not.offline_tracer_mode) call MOM_error(FATAL, & "End of MOM_main reached with unused buoyancy fluxes. "//& "For conservation, the ocean restart files can only be "//& "created after the buoyancy forcing is applied.") @@ -551,11 +612,11 @@ program MOM_main write(unit, '(i6,8x,a)') calendar_type, & '(Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)' - call get_date(Start_time, yr, mon, day, hr, min, sec) - write(unit, '(6i6,8x,a)') yr, mon, day, hr, min, sec, & + call get_date(Start_time, yr, mon, day, hr, mins, sec) + write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & 'Model start time: year, month, day, hour, minute, second' - call get_date(Time, yr, mon, day, hr, min, sec) - write(unit, '(6i6,8x,a)') yr, mon, day, hr, min, sec, & + call get_date(Time, yr, mon, day, hr, mins, sec) + write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & 'Current model time: year, month, day, hour, minute, second' end if call close_file(unit) @@ -581,7 +642,7 @@ program MOM_main call io_infra_end ; call MOM_infra_end - call MOM_end(MSp, MOM_CSp) + call MOM_end(MOM_CSp) if (use_ice_shelf) call ice_shelf_end(ice_shelf_CSp) end program MOM_main diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 846ad2a387..37bcaea17e 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -119,6 +119,8 @@ module MOM_surface_forcing real :: Rho0 ! Boussinesq reference density (kg/m^3) real :: G_Earth ! gravitational acceleration (m/s^2) real :: Flux_const ! piston velocity for surface restoring (m/s) + real :: Flux_const_T ! piston velocity for surface temperature restoring (m/s) + real :: Flux_const_S ! piston velocity for surface salinity restoring (m/s) real :: latent_heat_fusion ! latent heat of fusion (J/kg) real :: latent_heat_vapor ! latent heat of vaporization (J/kg) real :: tau_x0, tau_y0 ! Constant wind stresses used in the WIND_CONFIG="const" forcing @@ -1037,8 +1039,8 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%heat_added(i,j) = G%mask2dT(i,j) * & - ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) - fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & + ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const_T) + fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const_S) * & (CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) else @@ -1193,8 +1195,8 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%heat_added(i,j) = G%mask2dT(i,j) * & - ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) - fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & + ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const_T) + fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const_S) * & (CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) else @@ -1758,8 +1760,25 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) - ! Convert CS%Flux_const from m day-1 to m s-1. + + if (CS%use_temperature) then + call get_param(param_file, mdl, "FLUXCONST_T", CS%Flux_const_T, & + "The constant that relates the restoring surface temperature\n"//& + "flux to the relative surface anomaly (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + default=CS%Flux_const) + call get_param(param_file, mdl, "FLUXCONST_S", CS%Flux_const_S, & + "The constant that relates the restoring surface salinity\n"//& + "flux to the relative surface anomaly (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + default=CS%Flux_const) + endif + + ! Convert flux constants from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 + CS%Flux_const_T = CS%Flux_const_T / 86400.0 + CS%Flux_const_S = CS%Flux_const_S / 86400.0 + if (trim(CS%buoy_config) == "linear") then call get_param(param_file, mdl, "SST_NORTH", CS%T_north, & "With buoy_config linear, the sea surface temperature \n"//& diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 98a0384993..d068115753 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -109,6 +109,8 @@ module MOM_ALE integer :: id_T_preale = -1 !< diagnostic id for temperatures before ALE. integer :: id_S_preale = -1 !< diagnostic id for salinities before ALE. integer :: id_e_preale = -1 !< diagnostic id for interface heights before ALE. + integer :: id_vert_remap_h = -1 !< diagnostic id for layer thicknesses used for remapping + integer :: id_vert_remap_h_tendency = -1 !< diagnostic id for layer thickness tendency due to ALE end type @@ -296,6 +298,10 @@ subroutine ALE_register_diags(Time, G, GV, diag, CS) CS%id_dzRegrid = register_diag_field('ocean_model','dzRegrid',diag%axesTi,Time, & 'Change in interface height due to ALE regridding', 'm') + cs%id_vert_remap_h = register_diag_field('ocean_model','vert_remap_h',diag%axestl,time, & + 'layer thicknesses after ALE regridding and remapping', 'm', v_extensive = .true.) + cs%id_vert_remap_h_tendency = register_diag_field('ocean_model','vert_remap_h_tendency',diag%axestl,time, & + 'Layer thicknesses tendency due to ALE regridding and remapping', 'm', v_extensive = .true.) end subroutine ALE_register_diags @@ -391,7 +397,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) ! The presence of dt is used for expediency to distinguish whether ALE_main is being called during init ! or in the main loop. Tendency diagnostics in remap_all_state_vars also rely on this logic. if (present(dt)) then - call diag_update_remap_grids(CS%diag, alt_h = h_new) + call diag_update_remap_grids(CS%diag) endif ! Remap all variables from old grid h onto new grid h_new call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, -dzRegrid, & @@ -808,14 +814,12 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap tracer if (ntr>0) then if (show_call_tree) call callTree_waypoint("remapping tracers (remap_all_state_vars)") - !$OMP parallel do default(shared) private(h1,h2,u_column) + !$OMP parallel do default(shared) private(h1,h2,u_column,Tr) do m=1,ntr ! For each tracer Tr => Reg%Tr(m) do j = G%jsc,G%jec do i = G%isc,G%iec - if (G%mask2dT(i,j)>0.) then - ! Build the start and final grids h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) @@ -835,22 +839,18 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, enddo endif endif - ! update tracer concentration Tr%t(i,j,:) = u_column(:) - endif - enddo ! i enddo ! j - ! tendency diagnostics. - if (Tr%id_remap_conc > 0) then - call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag, alt_h = h_new) + if (Tr%id_remap_conc > 0) then + call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) endif if (Tr%id_remap_cont > 0) then - call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag, alt_h = h_new) + call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) endif if (Tr%id_remap_cont_2d > 0) then do j = G%jsc,G%jec @@ -920,6 +920,13 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, enddo endif + if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag) + if (CS_ALE%id_vert_remap_h_tendency > 0) then + do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec + work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS_ALE%id_vert_remap_h_tendency, work_cont, CS_ALE%diag) + endif if (show_call_tree) call callTree_waypoint("v remapped (remap_all_state_vars)") if (show_call_tree) call callTree_leave("remap_all_state_vars()") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0b499e75cf..60ce1d9c99 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1,30 +1,12 @@ -!> This is the main routine for MOM module MOM ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_variables, only : vertvisc_type -use MOM_open_boundary, only : ocean_OBC_type - -! A Structure with pointers to forcing fields to drive MOM; -! all fluxes are positive downward. -use MOM_forcing_type, only : forcing, mech_forcing - -use MOM_variables, only: accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state - -! A structure containing pointers to various fields -! to describe surface state, and will be returned -! to the calling program. -use MOM_variables, only : surface - -! A structure containing pointers to an assortment of -! thermodynamic fields, including potential/Conservative -! temperature, salinity and mixed layer density. -use MOM_variables, only: thermo_var_ptrs ! Infrastructure modules use MOM_debugging, only : MOM_debugging_init, hchksum, uvchksum -use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum +use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum +use MOM_checksum_packages, only : MOM_accel_chksum, MOM_surface_chksum 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 @@ -32,14 +14,14 @@ module MOM use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diag_mediator, only : diag_mediator_init, enable_averaging use MOM_diag_mediator, only : diag_mediator_infrastructure_init -use MOM_diag_mediator, only : diag_register_area_ids -use MOM_diag_mediator, only : register_cell_measure 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_static_field -use MOM_diag_mediator, only : register_scalar_field, get_diag_time_end +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 @@ -51,6 +33,7 @@ module MOM 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_fixed_initialization, only : MOM_initialize_fixed +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 @@ -58,7 +41,7 @@ module MOM use MOM_obsolete_params, only : find_obsolete_params use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_spatial_means, only : global_area_mean, global_area_integral +use MOM_spatial_means, only : global_area_mean, global_area_integral, global_mass_integral use MOM_state_initialization, only : MOM_initialize_state use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -76,11 +59,12 @@ module MOM use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS 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 : diagnostics_CS, surface_diag_IDs +use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics use MOM_diagnostics, only : register_surface_diags, post_surface_diagnostics -use MOM_diag_to_Z, only : calculate_Z_diag_fields, calculate_Z_transport -use MOM_diag_to_Z, only : MOM_diag_to_Z_init, register_Z_tracer, diag_to_Z_CS -use MOM_diag_to_Z, only : MOM_diag_to_Z_end +use MOM_diagnostics, only : write_static_fields +use MOM_diagnostics, only : diagnostics_CS, surface_diag_IDs, transport_diag_IDs +use MOM_diag_to_Z, only : calculate_Z_diag_fields, register_Z_tracer +use MOM_diag_to_Z, only : MOM_diag_to_Z_init, MOM_diag_to_Z_end, diag_to_Z_CS 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 @@ -107,7 +91,8 @@ module MOM use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics -use MOM_open_boundary, only : OBC_registry_type, register_temp_salt_segments +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_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init @@ -122,19 +107,23 @@ module MOM 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 : register_tracer, tracer_registry_init +use MOM_tracer_registry, only : tracer_registry_type, register_tracer, tracer_registry_init use MOM_tracer_registry, only : register_tracer_diagnostics, post_tracer_diagnostics +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 : tracer_registry_type 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_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_vert_friction, only : vertvisc, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units + ! 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 @@ -157,15 +146,9 @@ module MOM integer :: id_ssh_inst = -1 end type MOM_diag_IDs -!> A structure with diagnostic IDs of mass transport related diagnostics -type transport_diag_IDs - ! Diagnostics for tracer horizontal transport - integer :: id_uhtr = -1, id_umo = -1, id_umo_2d = -1 - integer :: id_vhtr = -1, id_vmo = -1, id_vmo_2d = -1 -end type transport_diag_IDs - -!> Structure describing the state of the ocean. -type, public :: MOM_state_type +!> 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 (m or kg/m2 (H)) T, & !< potential temperature (degrees C) @@ -179,88 +162,101 @@ module MOM vh, & !< vh = v * h * dx at v grid points (m3/s or kg/s) vhtr !< accumulated meridional thickness fluxes to advect tracers (m3 or kg) real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - ave_ssh !< time-averaged (ave over baroclinic time steps) sea surface height (meter) - - type(ocean_grid_type) :: G !< structure containing metrics and grid info - type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info - 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 (in seconds), or - !! equivalently the elapsed time since advectively - !! updating the tracers. t_dyn_rel_adv is invariably - !! positive and may span multiple coupling timesteps. -end type MOM_state_type - + ssh_rint, & !< A running time integral of the sea surface height, in s m. + ave_ssh_ibc, & !< time-averaged (over a forcing time step) sea surface height + !! with a correction for the inverse barometer (meter) + eta_av_bc !< free surface height or column mass time averaged over the last + !! baroclinic dynamics time step (m or kg/m2) + real, pointer, dimension(:,:) :: & + Hml => NULL() !< active mixed layer depth, in 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, in s. + + type(ocean_grid_type) :: G !< structure containing metrics and grid info + type(verticalGrid_type), pointer :: & + GV => NULL() !< structure containing vertical grid info + 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 (in seconds), 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 (in seconds). 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 (in seconds). t_dyn_rel_diag + !! is always positive, since the diagnostics must lag. + integer :: ndyn_per_adv = 0 !< Number of calls to dynamics since the last call to advection + !! Must be saved if thermo spans coupling? -!> Control structure for this module -type, public :: MOM_control_struct ; private 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 - 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 continuity equation - !! terms, for derived diagnostics (e.g., energy budgets) - real, pointer, dimension(:,:) :: Hml => NULL() !< active mixed layer depth, in m - real, pointer, dimension(:,:,:) :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics - v_prev => NULL() !< previous value of v stored for diagnostics - 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 :: adiabatic !< If true, then no diapycnal mass fluxes, with no calls + logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. - logical :: use_temperature !< If true, temp and saln used as state variables. - logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level - 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 :: bulkmixedlayer !< If true, a refined bulk mixed layer scheme is used - !! with nkml sublayers and nkbl buffer layer. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - 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 :: debug !< If true, write verbose checksums for debugging purposes. - logical :: debug_truncations !< If true, turn on diagnostics useful for debugging truncations. 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 :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an - !! undocumented run-time flag that is fragile. 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 - logical :: advect_TS !< If false, then no horizontal advection of temperature - !! and salnity is performed + + type(time_type), pointer :: Time !< pointer to ocean clock + real :: rel_time = 0.0 !< relative time (sec) since start of current execution real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. - real :: t_dyn_rel_thermo !< The time of the dynamics relative to diabatic - !! processes and remapping (in seconds). 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 (in seconds). t_dyn_rel_diag - !! is always positive, since the diagnostics must lag. - type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics - type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics - type(time_type), pointer :: Time !< pointer to ocean clock - real :: rel_time = 0.0 !< relative time (sec) since start of current execution + 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 + + ! 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. real :: dtbt_reset_period !< The time interval in seconds between dynamic !! recalculation of the barotropic time step. If !! this is negative, it is never calculated, and !! if it is 0, it is calculated every step. + real :: dtbt_reset_time !< The last time (as indicated by CS%rel_time) when + !! DTBT was last calculated (sec) + + + type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics + type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics + + real, pointer, dimension(:,:,:) :: & + h_pre_dyn => NULL(), & !< The thickness before the transports, in H. + T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. + S_pre_dyn => NULL() !< Salinity before the transports, in psu. + 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, pointer, dimension(:,:,:) :: & + u_prev => NULL(), & !< previous value of u stored for diagnostics + v_prev => NULL() !< previous value of v stored for diagnostics logical :: interp_p_surf !< If true, linearly interpolate surface pressure !! over the coupling time step, using specified value @@ -268,24 +264,30 @@ module MOM 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, pointer, dimension(:,:) :: & + p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM + p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... + p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... - real :: Hmix !< Diagnostic mixed layer thickness (meter) when - !! bulk mixed layer is not used. - real :: Hmix_UV !< Depth scale over which to average surface flow to - !! feedback to the coupler/driver (m). - !! bulk mixed layer is not used. + ! Not needed in CS? real :: missing=-1.0e34 !< missing data value for masked fields - ! Flags needed to reach between start and finish phases of initialization + ! 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. - integer :: nstep_tot = 0 !< The total number of dynamic timesteps taken - !! 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 - integer :: ntrunc !< number u,v truncations since last call to write_energy + 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 (in meter) when + !! bulk mixed layer is not used, or a negative value + !! if a bulk mixed layer is being used. + real :: Hmix_UV !< Depth scale over which to average surface flow to + !! feedback to the coupler/driver (m) when + !! bulk mixed layer is not used, or a negative value + !! if a bulk mixed layer is being used. logical :: check_bad_surface_vals !< If true, scan surface state for ridiculous values. real :: bad_val_ssh_max !< Maximum SSH before triggering bad value message real :: bad_val_sst_max !< Maximum SST before triggering bad value message @@ -293,64 +295,49 @@ module MOM real :: bad_val_sss_max !< Maximum SSS before triggering bad value message real :: bad_val_column_thickness!< Minimum column thickness before triggering bad value message - real, pointer, dimension(:,:) :: & - p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM - p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... - p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... - - type(vardesc) :: & - vd_T, & !< vardesc array describing potential temperature - vd_S !< vardesc array describing salinity - - logical :: tendency_diagnostics = .false. - type(MOM_diag_IDs) :: IDs type(transport_diag_IDs) :: transport_IDs type(surface_diag_IDs) :: sfc_IDs + type(diag_grid_storage) :: diag_pre_sync, diag_pre_dyn + + ! The remainder of this type provides pointers to child module control structures. - ! The remainder provides pointers to child module control structures. + ! These are used for the dynamics updates type(MOM_dyn_unsplit_CS), pointer :: dyn_unsplit_CSp => NULL() type(MOM_dyn_unsplit_RK2_CS), pointer :: dyn_unsplit_RK2_CSp => NULL() type(MOM_dyn_split_RK2_CS), pointer :: dyn_split_RK2_CSp => NULL() + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() + type(mixedlayer_restrat_CS), pointer :: mixedlayer_restrat_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() type(diabatic_CS), pointer :: diabatic_CSp => NULL() - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() - type(mixedlayer_restrat_CS), pointer :: mixedlayer_restrat_CSp => NULL() type(MEKE_CS), pointer :: MEKE_CSp => NULL() type(VarMix_CS), pointer :: VarMix => NULL() + + ! These are used for tracer advection, diffusion, and remapping type(tracer_registry_type), pointer :: tracer_Reg => NULL() type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() type(tracer_hor_diff_CS), pointer :: tracer_diff_CSp => NULL() - type(neutral_diffusion_CS), pointer :: neutral_diffusion_CSp => NULL() type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - type(diagnostics_CS), pointer :: diagnostics_CSp => NULL() - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() + ! This might not be needed outside of initialization? type(update_OBC_CS), pointer :: update_OBC_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() type(sponge_CS), pointer :: sponge_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() type(ALE_CS), pointer :: ALE_CSp => NULL() - type(offline_transport_CS), pointer :: offline_CSp => NULL() - type(sum_output_CS), pointer :: sum_output_CSp => NULL() - ! These are used for group halo updates. - type(group_pass_type) :: pass_tau_ustar_psurf - type(group_pass_type) :: pass_ray - type(group_pass_type) :: pass_bbl_thick_kv_bbl - type(group_pass_type) :: pass_T_S_h - type(group_pass_type) :: pass_T_S - type(group_pass_type) :: pass_uv_T_S_h + type(sum_output_CS), pointer :: sum_output_CSp => NULL() + type(diagnostics_CS), pointer :: diagnostics_CSp => NULL() + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() + type(offline_transport_CS), pointer :: offline_CSp => NULL() end type MOM_control_struct -public initialize_MOM -public finish_MOM_initialization -public step_MOM -public step_offline -public MOM_end -public allocate_surface_state -public calculate_surface_state +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 integer :: id_clock_ocean integer :: id_clock_dynamics @@ -379,21 +366,32 @@ module MOM !! 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, fluxes, sfc_state, Time_start, time_interval, MS, CS) +subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & + do_dynamics, do_thermodynamics, start_cycle, end_cycle, cycle_length) type(mech_forcing), intent(inout) :: 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 covered by this run segment, in s. - type(MOM_state_type), pointer :: MS !< structure describing the MOM state + 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 covered by this run segment, in s. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + 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, in s. ! local type(ocean_grid_type), pointer :: G ! pointer to a structure containing ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() - type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. - integer, save :: nt_debug = 1 ! running number of iterations, for debugging only. + integer :: ntstep ! time steps between tracer updates or diabatic forcing integer :: n_max ! number of steps to take in this call @@ -404,18 +402,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, MS, CS real :: dtth ! time step for thickness diffusion (sec) real :: dtdia ! time step for diabatic processes (sec) real :: dt_therm ! a limited and quantized version of CS%dt_therm (sec) - real :: dtbt_reset_time ! value of CS%rel_time when DTBT was last calculated (sec) - - real :: mass_src_time ! The amount of time for the surface mass source from - ! precipitation-evaporation, rivers, etc., that should - ! be applied to the start of the barotropic solver to - ! avoid generating tsunamis, in s. This is negative - ! if the precipation has already been applied to the - ! layers, and positive if it will be applied later. + real :: dt_therm_here ! a further limited value of dt_therm (sec) 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. + ! properties will apply, for use in diagnostics, or 0 + ! if it is not to be calculated anew (sec). logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -423,181 +415,163 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, MS, CS logical :: do_calc_bbl ! If true, calculate the boundary layer properties. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. - real, dimension(SZI_(MS%G),SZJ_(MS%G)) :: & - eta_av, & ! average sea surface height or column mass over a timestep (meter or kg/m2) - ssh ! sea surface height based on eta_av (meter or kg/m2) + 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). + real :: cycle_time ! The length of the coupled time-stepping cycle, in s. + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & + ssh ! sea surface height, which may be based on eta_av (meter) real, pointer, dimension(:,:,:) :: & u, & ! u : zonal velocity component (m/s) v, & ! v : meridional velocity component (m/s) h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real :: I_wt_ssh - ! Store the layer thicknesses, temperature, and salinity before any changes by the dynamics. - ! This is necessary for remapped mass transport diagnostics - real, dimension(SZI_(MS%G),SZJ_(MS%G),SZK_(MS%G)) :: h_pre_dyn - real, dimension(SZI_(MS%G),SZJ_(MS%G),SZK_(MS%G)) :: T_pre_dyn - real, dimension(SZI_(MS%G),SZJ_(MS%G),SZK_(MS%G)) :: S_pre_dyn - real :: tot_wt_ssh, Itot_wt_ssh - - type(time_type) :: Time_local, end_time_thermo + type(time_type) :: Time_local, end_time_thermo, Time_temp + type(group_pass_type) :: pass_tau_ustar_psurf logical :: showCallTree - ! These are used for group halo passes. - logical :: do_pass_Ray, do_pass_kv_bbl_thick - G => MS%G ; GV => MS%GV ; IDs => CS%IDs + G => CS%G ; GV => CS%GV 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 => MS%u ; v => MS%v ; h => MS%h + u => CS%u ; v => CS%v ; h => CS%h + + 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 = cycle_length 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, MS%uh, MS%vh, G, GV) - call hchksum(MS%h,"MS%h beginning of step_MOM",G%HI, scale=GV%H_to_m) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV) endif showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM(), MOM.F90") - ! First determine the time step that is consistent with this call. - ! It is anticipated that the time step will almost always coincide - ! with dt. In addition, ntstep is determined, subject to the constraint - ! that ntstep cannot exceed n_max. - if (time_interval <= CS%dt) then - n_max = 1 - else - n_max = ceiling(time_interval/CS%dt - 0.001) - endif - - dt = time_interval / real(n_max) - dtdia = 0.0 - thermo_does_span_coupling = (CS%thermo_spans_coupling .and. & - (CS%dt_therm > 1.5*time_interval)) - if (thermo_does_span_coupling) then - ! Set dt_therm to be an integer multiple of the coupling time step. - dt_therm = time_interval * floor(CS%dt_therm / time_interval + 0.001) - ntstep = floor(dt_therm/dt + 0.001) - else - ntstep = MAX(1,MIN(n_max,floor(CS%dt_therm/dt + 0.001))) - dt_therm = dt*ntstep - endif - - if (.not.ASSOCIATED(forces%p_surf)) CS%interp_p_surf = .false. - - !---------- Begin setup for group halo pass - - call cpu_clock_begin(id_clock_pass) - call create_group_pass(CS%pass_tau_ustar_psurf, forces%taux, forces%tauy, G%Domain) - if (ASSOCIATED(forces%ustar)) & - call create_group_pass(CS%pass_tau_ustar_psurf, forces%ustar, G%Domain) - if (ASSOCIATED(forces%p_surf)) & - call create_group_pass(CS%pass_tau_ustar_psurf, forces%p_surf, G%Domain) + ! First determine the time step that is consistent with this call and an + ! integer fraction of time_interval. - do_pass_Ray = .FALSE. ; do_pass_kv_bbl_thick = .FALSE. - if (.not.G%Domain%symmetric) then - if (associated(CS%visc%Ray_u) .and. associated(CS%visc%Ray_v)) then - call create_group_pass(CS%pass_ray, CS%visc%Ray_u, CS%visc%Ray_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_Ray = .TRUE. - endif - if (associated(CS%visc%bbl_thick_u) .and. associated(CS%visc%bbl_thick_v)) then - call create_group_pass(CS%pass_bbl_thick_kv_bbl, CS%visc%bbl_thick_u, & - CS%visc%bbl_thick_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_kv_bbl_thick = .TRUE. - endif - if (associated(CS%visc%kv_bbl_u) .and. associated(CS%visc%kv_bbl_v)) then - call create_group_pass(CS%pass_bbl_thick_kv_bbl, CS%visc%kv_bbl_u, & - CS%visc%kv_bbl_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_kv_bbl_thick = .TRUE. - endif - endif + if (do_dyn) then + n_max = 1 + if (time_interval > CS%dt) n_max = ceiling(time_interval/CS%dt - 0.001) - if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then - if (CS%use_temperature) then - call create_group_pass(CS%pass_T_S_h, MS%tv%T, G%Domain, To_All+Omit_Corners, halo=1) - call create_group_pass(CS%pass_T_S_h, MS%tv%S, G%Domain, To_All+Omit_Corners, halo=1) + 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, 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 - call create_group_pass(CS%pass_T_S_h, h, G%Domain, To_All+Omit_Corners, halo=1) - endif - - if ((CS%adiabatic .OR. CS%diabatic_first) .AND. CS%use_temperature) then - call create_group_pass(CS%pass_T_S, MS%tv%T, G%Domain, To_All+Omit_Corners, halo=1) - call create_group_pass(CS%pass_T_S, MS%tv%S, G%Domain, To_All+Omit_Corners, halo=1) - endif - - !---------- End setup for group halo pass - - if (G%nonblocking_updates) then - call start_group_pass(CS%pass_tau_ustar_psurf, G%Domain) else - call do_group_pass(CS%pass_tau_ustar_psurf, G%Domain) + 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 + thermo_does_span_coupling = .true. ! This is never used in this case? + endif + + if (do_dyn) then + if (.not.ASSOCIATED(forces%p_surf)) CS%interp_p_surf = .false. + + !---------- Initiate group halo pass + 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) endif - call cpu_clock_end(id_clock_pass) - - if (ASSOCIATED(MS%tv%frazil)) MS%tv%frazil(:,:) = 0.0 - if (ASSOCIATED(MS%tv%salt_deficit)) MS%tv%salt_deficit(:,:) = 0.0 - if (ASSOCIATED(MS%tv%TempxPmE)) MS%tv%TempxPmE(:,:) = 0.0 - if (ASSOCIATED(MS%tv%internal_heat)) MS%tv%internal_heat(:,:) = 0.0 CS%rel_time = 0.0 - tot_wt_ssh = 0.0 - do j=js,je ; do i=is,ie ; MS%ave_ssh(i,j) = 0.0 ; ssh(i,j) = CS%missing; enddo ; enddo + if (cycle_start) then + 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 - if (associated(CS%VarMix)) then - call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & - CS%diag) - call calc_resoln_function(h, MS%tv, G, GV, CS%VarMix) - call disable_averaging(CS%diag) + 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_averaging(cycle_time, Time_start+set_time(int(cycle_time)), & + CS%diag) + call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) + call disable_averaging(CS%diag) + endif endif - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_tau_ustar_psurf, G%Domain, clock=id_clock_pass) + 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. + 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 - else - CS%p_surf_end => forces%p_surf endif if (CS%debug) then - call MOM_state_chksum("Before steps ", u, v, h, MS%uh, MS%vh, G, GV) - call MOM_forcing_chksum("Before steps", fluxes, G, haloshift=0) - call MOM_mech_forcing_chksum("Before steps", forces, G, haloshift=0) - call check_redundant("Before steps ", u, v, G) - call check_redundant("Before steps ", forces%taux, forces%tauy, G) + if (cycle_start) & + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV) + if (cycle_start) call check_redundant("Before steps ", u, v, G) + if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, haloshift=0) + if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) endif call cpu_clock_end(id_clock_other) do n=1,n_max - - nt_debug = nt_debug + 1 - - ! Set the universally visible time to the middle of the time step - CS%Time = Time_start + set_time(int(floor(CS%rel_time+0.5*dt+0.5))) - CS%rel_time = CS%rel_time + dt - + CS%rel_time = CS%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 + set_time(int(floor(0.5 + CS%rel_time - 0.5*dt))) ! Set the local time to the end of the time step. Time_local = Time_start + set_time(int(floor(CS%rel_time+0.5))) + if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) !=========================================================================== ! This is the first place where the diabatic processes and remapping could occur. - if (CS%diabatic_first .and. (MS%t_dyn_rel_adv==0.0)) then ! do thermodynamics. + if (CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics. - if (thermo_does_span_coupling) then + 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 @@ -610,271 +584,140 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, MS, CS dtdia = dt*min(ntstep,n_max-(n-1)) endif + ! 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. + if (dtdia > dt) CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + ! 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 + set_time(int(floor(dtdia-dt+0.5))) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(MS, CS, G, GV, u, v, h, MS%tv, fluxes, dtdia, end_time_thermo, .true.) + call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, end_time_thermo, .true.) ! 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)") - endif ! end of block "(CS%diabatic_first .and. (MS%t_dyn_rel_adv==0.0))" - - !=========================================================================== - ! This is the start of the dynamics stepping part of the algorithm. - - call cpu_clock_begin(id_clock_dynamics) - call disable_averaging(CS%diag) - - if ((MS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - if (thermo_does_span_coupling) then - dtth = dt_therm - else - dtth = dt*min(ntstep,n_max-n+1) + if (dtdia > dt) & ! Reset CS%Time to its previous value. + CS%Time = Time_start + set_time(int(floor(0.5 + CS%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 grids for proper diagnostic remapping for transports or advective tendencies + ! If there are more dynamics steps per advective steps (i.e DT_THERM /= DT), this needs to be the + ! stored at the first call + if (CS%ndyn_per_adv == 0 .and. CS%t_dyn_rel_adv == 0.) then + call diag_copy_diag_to_storage(CS%diag_pre_dyn, h, CS%diag) + CS%ndyn_per_adv = CS%ndyn_per_adv + 1 endif - call enable_averaging(dtth,Time_local+set_time(int(floor(dtth-dt+0.5))), CS%diag) - call cpu_clock_begin(id_clock_thick_diff) - if (associated(CS%VarMix)) & - call calc_slope_functions(h, MS%tv, dt, G, GV, CS%VarMix) - call thickness_diffuse(h, MS%uhtr, MS%vhtr, MS%tv, dtth, G, GV, & - 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,cont_stensil)) - 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 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 - ! The bottom boundary layer properties are out-of-date and need to be - ! recalculated. This always occurs at the start of a coupling time - ! step because the externally prescribed stresses may have changed. - do_calc_bbl = ((MS%t_dyn_rel_adv == 0.0) .or. (n==1)) - if (do_calc_bbl) then - ! Calculate the BBL properties and store them inside visc (u,h). - call cpu_clock_begin(id_clock_BBL_visc) - bbl_time_int = max(dt, min(dt_therm - MS%t_dyn_rel_adv, dt*(1+n_max-n)) ) - call enable_averaging(bbl_time_int, & - Time_local+set_time(int(bbl_time_int-dt+0.5)), CS%diag) - call set_viscous_BBL(u, v, h, MS%tv, CS%visc, G, GV, CS%set_visc_CSp) - call disable_averaging(CS%diag) - call cpu_clock_end(id_clock_BBL_visc) - if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") - 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) - if (do_calc_bbl) then - if (G%nonblocking_updates) then - if (do_pass_Ray) & - call start_group_pass(CS%pass_Ray, G%Domain, clock=id_clock_pass) - if (do_pass_kv_bbl_thick) & - call start_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain, clock=id_clock_pass) - ! do_calc_bbl will be set to .false. when the message passing is complete. + ! 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 (do_pass_Ray) & - call do_group_pass(CS%pass_Ray, G%Domain, clock=id_clock_pass) - if (do_pass_kv_bbl_thick) & - call do_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain, clock=id_clock_pass) + if ((CS%t_dyn_rel_adv == 0.0) .or. ((n==1) .and. cycle_start)) & + bbl_time_int = min(dt_therm, cycle_time) endif - 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 - ! The original velocities might be stored for debugging. - 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) = u(I,j,k) - enddo ; enddo ; enddo - 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 - ! Store pre-dynamics state for proper diagnostic remapping if mass transports requested - if (transport_remap_grid_needed(CS%transport_IDs)) then - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_pre_dyn(i,j,k) = h(i,j,k) - if (associated(MS%tv%T)) T_pre_dyn(i,j,k) = MS%tv%T(i,j,k) - if (associated(MS%tv%S)) S_pre_dyn(i,j,k) = MS%tv%S(i,j,k) - enddo ; 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, CS%rel_time, n) - if (G%nonblocking_updates) then ; if (do_calc_bbl) then - if (do_pass_Ray) & - call complete_group_pass(CS%pass_Ray, G%Domain, clock=id_clock_pass) - if (do_pass_kv_bbl_thick) & - call complete_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain, clock=id_clock_pass) - endif ; 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) .and. & - ((n==1) .or. (CS%dtbt_reset_period == 0.0) .or. & - (CS%rel_time >= dtbt_reset_time + 0.999*CS%dtbt_reset_period))) then - calc_dtbt = .true. - dtbt_reset_time = CS%rel_time - endif + !=========================================================================== + ! This is the start of the tracer advection part of the algorithm. - mass_src_time = CS%t_dyn_rel_thermo - call step_MOM_dyn_split_RK2(u, v, h, MS%tv, CS%visc, & - Time_local, dt, forces, CS%p_surf_begin, CS%p_surf_end, & - mass_src_time, dt_therm, MS%uh, MS%vh, MS%uhtr, MS%vhtr, & - eta_av, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE) - 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, MS%tv, CS%visc, Time_local, dt, forces, & - CS%p_surf_begin, CS%p_surf_end, MS%uh, MS%vh, MS%uhtr, MS%vhtr, & - eta_av, G, GV, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) + if (thermo_does_span_coupling .or. .not.do_thermo) then + do_advection = (CS%t_dyn_rel_adv + 0.5*dt > dt_therm) else - call step_MOM_dyn_unsplit(u, v, h, MS%tv, CS%visc, Time_local, dt, forces, & - CS%p_surf_begin, CS%p_surf_end, MS%uh, MS%vh, MS%uhtr, MS%vhtr, & - eta_av, G, GV, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE) + do_advection = ((MOD(n,ntstep) == 0) .or. (n==n_max)) 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, MS%tv, dt, G, GV, CS%VarMix) - call thickness_diffuse(h, MS%uhtr, MS%vhtr, MS%tv, dt, G, GV, & - 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,cont_stensil)) - 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", & - MS%uhtr, MS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_ml_restrat) - call mixedlayer_restrat(h, MS%uhtr, MS%vhtr, MS%tv, forces, dt, CS%visc%MLD, & - CS%VarMix, G, GV, 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,cont_stensil)) - 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", & - MS%uhtr, MS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + if (do_advection) then ! Do advective transport and lateral tracer mixing. + call step_MOM_tracer_dyn(CS, G, GV, h, Time_local) + CS%ndyn_per_adv = 0 + 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 - - ! 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, CS%MEKE_CSp, MS%uhtr, MS%vhtr) - call disable_averaging(CS%diag) - - ! Advance the dynamics time by dt. - MS%t_dyn_rel_adv = MS%t_dyn_rel_adv + dt - CS%t_dyn_rel_thermo = CS%t_dyn_rel_thermo + dt - CS%t_dyn_rel_diag = CS%t_dyn_rel_diag + dt - - call cpu_clock_end(id_clock_dynamics) - - !=========================================================================== - ! This is the start of the tracer advection part of the algorithm. - - if (thermo_does_span_coupling) then - do_advection = (MS%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(MS, CS, G, GV, h, h_pre_dyn, T_pre_dyn, S_pre_dyn, & - MS%tv, Time_local) - endif + endif ! end of (do_dyn) !=========================================================================== ! This is the second place where the diabatic processes and remapping could occur. - if (MS%t_dyn_rel_adv == 0.0) then - if (.not.CS%diabatic_first) then - dtdia = CS%t_dyn_rel_thermo - if (thermo_does_span_coupling .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 - ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(MS, CS, G, GV, u, v, h, MS%tv, fluxes, dtdia, Time_local, .false.) + if (CS%t_dyn_rel_adv == 0.0 .and. do_thermo .and. .not.CS%diabatic_first) then + dtdia = CS%t_dyn_rel_thermo + 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 (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.") - ! Record that the dynamics and diabatic processes are synchronized. + ! 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 - set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + + ! Apply diabatic forcing, do mixing, and regrid. + call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, Time_local, .false.) CS%t_dyn_rel_thermo = 0.0 - endif - call cpu_clock_begin(id_clock_dynamics) + if (dtdia > dt) & ! Reset CS%Time to its previous value. + CS%Time = Time_start + set_time(int(floor(0.5 + CS%rel_time - 0.5*dt))) + endif - ! 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. - tot_wt_ssh = tot_wt_ssh + dt - call find_eta(h, MS%tv, GV%g_Earth, G, GV, ssh, eta_av) - do j=js,je ; do i=is,ie - MS%ave_ssh(i,j) = MS%ave_ssh(i,j) + dt*ssh(i,j) - enddo ; enddo - call cpu_clock_end(id_clock_dynamics) + 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, GV%g_Earth, G, GV, ssh, CS%eta_av_bc) + 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. - call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) - - call enable_averaging(dt, Time_local, CS%diag) - ! These diagnostics are available every time 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) - if (IDs%id_ssh_inst > 0) call post_data(IDs%id_ssh_inst, ssh, CS%diag) - call disable_averaging(CS%diag) - - if (MS%t_dyn_rel_adv == 0.0) then + ! 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_averaging(CS%t_dyn_rel_diag, Time_local, CS%diag) - call calculate_diagnostic_fields(u, v, h, MS%uh, MS%vh, MS%tv, CS%ADp, & - CS%CDp, fluxes, CS%t_dyn_rel_diag, G, GV, CS%diagnostics_CSp) - call post_tracer_diagnostics(CS%Tracer_reg, h, CS%diag, G, GV, CS%t_dyn_rel_diag) + call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, & + CS%CDp, fluxes, CS%t_dyn_rel_diag, CS%diag_pre_sync,& + G, GV, CS%diagnostics_CSp) + call post_tracer_diagnostics(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 @@ -890,49 +733,58 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, MS, CS if (showCallTree) call callTree_waypoint("finished calculate_Z_diag_fields (step_MOM)") endif call cpu_clock_end(id_clock_Z_diag) + call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) endif - call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) - - if (.not.CS%count_calls) CS%nstep_tot = CS%nstep_tot + 1 + 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) CS%nstep_tot = CS%nstep_tot + 1 + if (CS%count_calls .and. cycle_start) CS%nstep_tot = CS%nstep_tot + 1 call cpu_clock_begin(id_clock_other) - Itot_wt_ssh = 1.0/tot_wt_ssh - do j=js,je ; do i=is,ie - MS%ave_ssh(i,j) = MS%ave_ssh(i,j)*Itot_wt_ssh - ssh(i,j) = MS%ave_ssh(i,j) - enddo ; enddo - call adjust_ssh_for_p_atm(MS%tv, G, GV, MS%ave_ssh, forces%p_surf_SSH, CS%calc_rho_for_sea_lev) + 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, 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, CS%ave_ssh_ibc, fluxes%p_surf_SSH, & + CS%calc_rho_for_sea_lev) + endif + endif - if (CS%interp_p_surf) then ; do j=jsd,jed ; do i=isd,ied + 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 (showCallTree) call callTree_waypoint("calling calculate_surface_state (step_MOM)") - call calculate_surface_state(sfc_state, u, v, h, MS%ave_ssh, G, GV, MS, CS) + if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") + call extract_surface_state(CS, sfc_state) ! Do diagnostics that only occur at the end of a complete forcing step. - call cpu_clock_begin(id_clock_diagnostics) - call enable_averaging(dt*n_max, Time_local, CS%diag) - call post_surface_diagnostics(CS%sfc_IDs, G, GV, CS%diag, dt*n_max, sfc_state, MS%tv, ssh, fluxes) - call disable_averaging(CS%diag) - call cpu_clock_end(id_clock_diagnostics) + if (cycle_end) then + call cpu_clock_begin(id_clock_diagnostics) + call enable_averaging(CS%time_in_cycle, Time_local, CS%diag) + call post_surface_diagnostics(CS%sfc_IDs, G, GV, CS%diag, CS%time_in_cycle, & + sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) + call disable_averaging(CS%diag) + call cpu_clock_end(id_clock_diagnostics) + endif ! Accumulate the surface fluxes for assessing conservation - if (fluxes%fluxes_used) & + if (do_thermo .and. fluxes%fluxes_used) & call accumulate_net_input(fluxes, sfc_state, fluxes%dt_buoy_accum, & G, CS%sum_output_CSp) - if (MS%t_dyn_rel_adv==0.0) & - call write_energy(MS%u, MS%v, MS%h, MS%tv, Time_local, & - CS%nstep_tot, G, GV, CS%sum_output_CSp, & - CS%tracer_flow_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, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=set_time(int(floor(time_interval+0.5))) ) call cpu_clock_end(id_clock_other) @@ -942,57 +794,229 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, MS, CS end subroutine step_MOM +subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & + bbl_time_int, CS, Time_local, rel_time, dyn_call) + 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, in Pa. + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface + !! pressure at the end of this dynamic step, + !! intent in, in Pa. + real, intent(in) :: dt !< time interval covered by this call, in s. + real, intent(in) :: dt_thermo !< time interval covered by any updates that may + !! span multiple dynamics steps, in s. + real, intent(in) :: bbl_time_int !< time interval over which updates to the + !! bottom boundary layer properties will apply, + !! in 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 !< Starting time of a segment, as a time type + real, intent(in) :: rel_time !< Relative time since the start of the current + !! time-stepping cycle, in s. + integer, intent(in) :: dyn_call !< A count of the calls to step_MOM_dynamics + !! within this forcing timestep. + ! local + type(ocean_grid_type), pointer :: G ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() + type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. + real, pointer, dimension(:,:,:) :: & + u, & ! u : zonal velocity component (m/s) + v, & ! v : meridional velocity component (m/s) + h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + + 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 ; 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_averaging(dt_thermo,Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) + call cpu_clock_begin(id_clock_thick_diff) + if (associated(CS%VarMix)) & + call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, & + 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,cont_stensil)) + 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_averaging(bbl_time_int, & + Time_local+set_time(int(bbl_time_int-dt+0.5)), 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, & + 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) .and. & + ((dyn_call==1) .or. (CS%dtbt_reset_period == 0.0) .or. & + (rel_time >= CS%dtbt_reset_time + 0.999*CS%dtbt_reset_period))) then + calc_dtbt = .true. + CS%dtbt_reset_time = rel_time + 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, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE) + 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, 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, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE) + 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, CS%VarMix) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, & + 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,cont_stensil)) + 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) + 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, 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,cont_stensil)) + 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) + 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, 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_averaging(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(MS, CS, G, GV, h, h_pre_dyn, T_pre_dyn, S_pre_dyn, & - tv, Time_local) - type(MOM_state_type), intent(inout) :: MS !< structure describing the MOM state +subroutine step_MOM_tracer_dyn(CS, G, GV, 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 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< layer thicknesses after the transports (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_pre_dyn !< The thickness before the transports, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_pre_dyn !< The temperatures before the transports, in deg C. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_pre_dyn !< The salinities before the transports, in psu. - type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(time_type), intent(in) :: Time_local !< The model time at the end !! of the time step. + type(group_pass_type) :: pass_T_S 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", MS%uhtr, MS%vhtr, G%HI, & + call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m) - if (associated(MS%tv%T)) call hchksum(MS%tv%T, "Pre-advection T", G%HI, haloshift=1) - if (associated(MS%tv%S)) call hchksum(MS%tv%S, "Pre-advection S", G%HI, haloshift=1) - if (associated(MS%tv%frazil)) call hchksum(MS%tv%frazil, & + 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) - if (associated(MS%tv%salt_deficit)) call hchksum(MS%tv%salt_deficit, & + if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0) - ! call MOM_thermo_chksum("Pre-advection ", MS%tv, G) + ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G) call cpu_clock_end(id_clock_other) endif call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) - call enable_averaging(MS%t_dyn_rel_adv, Time_local, CS%diag) + call enable_averaging(CS%t_dyn_rel_adv, Time_local, CS%diag) - call advect_tracer(h, MS%uhtr, MS%vhtr, CS%OBC, MS%t_dyn_rel_adv, G, GV, & + call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h, MS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, MS%tv) + call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") 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, MS%uhtr, MS%vhtr, h, CS%transport_IDs, & - CS%diag, MS%t_dyn_rel_adv, CS%diag_to_Z_CSp, h_pre_dyn, T_pre_dyn, S_pre_dyn) + call post_transport_diagnostics(G, GV, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & + CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%diag_to_Z_CSp, 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) @@ -1003,24 +1027,25 @@ subroutine step_MOM_tracer_dyn(MS, CS, G, GV, h, h_pre_dyn, T_pre_dyn, S_pre_dyn ! 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) - MS%uhtr(:,:,:) = 0.0 - MS%vhtr(:,:,:) = 0.0 - MS%t_dyn_rel_adv = 0.0 + 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 (CS%diabatic_first .and. CS%use_temperature) then + if (CS%diabatic_first .and. associated(CS%tv%T)) then ! Temperature and salinity need halo updates because they will be used ! in the dynamics before they are changed again. - call do_group_pass(CS%pass_T_S, G%Domain, clock=id_clock_pass) + 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 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(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_thermo, update_BBL) - type(MOM_state_type), intent(inout) :: MS !< structure describing the MOM state - type(MOM_control_struct), intent(inout) :: CS !< control structure +subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_thermo, update_BBL) + 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 real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1035,10 +1060,12 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t 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. - integer :: i, j, k, is, ie, js, je, nz! , Isq, Ieq, Jsq, Jeq, n logical :: use_ice_shelf ! Needed for selecting the right ALE interface. - logical :: do_pass_kv_bbl_thick 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 :: i, j, k, is, ie, js, je, nz! , Isq, Ieq, Jsq, Jeq, n is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke showCallTree = callTree_showQuery() @@ -1050,28 +1077,13 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t call enable_averaging(dtdia, Time_end_thermo, CS%diag) if (update_BBL) then - if (CS%debug) then - call uvchksum("Pre set_viscous_BBL [uv]", u, v, G%HI, haloshift=1) - call hchksum(h,"Pre set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) - if (associated(MS%tv%T)) call hchksum(MS%tv%T, "Pre set_viscous_BBL T", G%HI, haloshift=1) - if (associated(MS%tv%S)) call hchksum(MS%tv%S, "Pre set_viscous_BBL S", G%HI, haloshift=1) - endif - ! 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, MS%tv, CS%visc, G, GV, CS%set_visc_CSp) + call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) - - if (.not.G%Domain%symmetric) then - if (associated(CS%visc%Ray_u) .and. associated(CS%visc%Ray_v)) & - call do_group_pass(CS%pass_ray, G%Domain, clock=id_clock_pass) - if ((associated(CS%visc%bbl_thick_u) .and. associated(CS%visc%bbl_thick_v)) .or. & - (associated(CS%visc%kv_bbl_u) .and. associated(CS%visc%kv_bbl_v))) & - call do_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain, clock=id_clock_pass) - endif if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") endif @@ -1080,10 +1092,10 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t if (CS%debug) then call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2) call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) - call uvchksum("Pre-diabatic [uv]h", MS%uhtr, MS%vhtr, G%HI, & + call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Pre-diabatic ",u, v, h, MS%uhtr, MS%vhtr, G, GV) - call MOM_thermo_chksum("Pre-diabatic ", MS%tv, G,haloshift=0) + ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) + call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, haloshift=0) endif @@ -1102,12 +1114,17 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t if ( CS%use_ALE_algorithm ) then call enable_averaging(dtdia, Time_end_thermo, CS%diag) ! call pass_vector(u, v, G%Domain) - call do_group_pass(CS%pass_T_S_h, G%Domain) + 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 preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, MS%uh, MS%vh, G, GV) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV) 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) @@ -1124,10 +1141,17 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t call cpu_clock_end(id_clock_ALE) endif ! endif for the block "if ( CS%use_ALE_algorithm )" - call do_group_pass(CS%pass_uv_T_S_h, G%Domain, clock=id_clock_pass) + 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, MS%uh, MS%vh, G, GV) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV) 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) @@ -1144,10 +1168,10 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t if (CS%debug) then call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) - call uvchksum("Post-diabatic [uv]h", MS%uhtr, MS%vhtr, G%HI, & + call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m) ! call MOM_state_chksum("Post-diabatic ", u, v, & - ! h, MS%uhtr, MS%vhtr, G, GV, haloshift=1) + ! 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, & @@ -1165,8 +1189,10 @@ subroutine step_MOM_thermo(MS, CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_t fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) - if (CS%use_temperature) then - call do_group_pass(CS%pass_T_S, G%Domain, clock=id_clock_pass) + 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) @@ -1187,13 +1213,12 @@ end subroutine step_MOM_thermo !! 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, MS, CS) +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_state_type), pointer :: MS !< structure describing the MOM state type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM ! Local pointers @@ -1222,12 +1247,12 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, MS h_end ! 2D Array for diagnostics - real, dimension(SZI_(MS%G),SZJ_(MS%G)) :: eta_pre, eta_end + 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 => MS%G - GV => MS%GV + G => CS%G + GV => CS%GV is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -1267,71 +1292,71 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, MS if(is_root_pe()) print *, "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, & - ! MS%tv%T, MS%tv%S, fluxes, CS%use_ALE_algorithm) + ! 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, MS%h, fluxes, CS%use_ALE_algorithm) + 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, MS%h) + 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, & - MS%h, uhtr, vhtr, converged=adv_converged) + CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport - call offline_redistribute_residual(CS%offline_CSp, MS%h, uhtr, vhtr, adv_converged) + 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(MS%h,G%Domain) - call calc_resoln_function(MS%h, MS%tv, G, GV, CS%VarMix) - call calc_slope_functions(MS%h, MS%tv, REAL(dt_offline), G, GV, CS%VarMix) + call pass_var(CS%h,G%Domain) + call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) endif - call tracer_hordiff(MS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, MS%tv) + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + 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, MS%h, eatr, ebtr) + 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, & - MS%h, uhtr, vhtr, converged=adv_converged) + CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport and perform the remaining advection - call offline_redistribute_residual(CS%offline_CSp, MS%h, uhtr, vhtr, adv_converged) + 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(MS%h,G%Domain) - call calc_resoln_function(MS%h, MS%tv, G, GV, CS%VarMix) - call calc_slope_functions(MS%h, MS%tv, REAL(dt_offline), G, GV, CS%VarMix) + call pass_var(CS%h,G%Domain) + call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) endif - call tracer_hordiff(MS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, MS%tv) + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif if(is_root_pe()) print *, "Last iteration of offline interval" ! Apply freshwater fluxes out of the ocean - call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, MS%h) + 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, MS%h, h_end, uhtr, vhtr) + 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, MS%h, MS%tv, h_end, CS%tracer_Reg, CS%ALE_CSp) + call ALE_offline_tracer_final( G, GV, CS%h, CS%tv, h_end, CS%tracer_Reg, CS%ALE_CSp) call cpu_clock_end(id_clock_ALE) - call pass_var(MS%h, G%Domain) + call pass_var(CS%h, G%Domain) endif else ! NON-ALE MODE...NOT WELL TESTED call MOM_error(WARNING, & @@ -1343,30 +1368,31 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, MS 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, MS%h, fluxes, CS%use_ALE_algorithm) + 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, & - MS%h, eatr, ebtr, uhtr, vhtr) + CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, MS%tv) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif - MS%h = h_end + CS%h = h_end - call pass_var(MS%tv%T, G%Domain) - call pass_var(MS%tv%S, G%Domain) - call pass_var(MS%h, G%Domain) + 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(MS%tv, G, GV, MS%ave_ssh, forces%p_surf_SSH, CS%calc_rho_for_sea_lev) - call calculate_surface_state(sfc_state, MS%u, MS%v, MS%h, MS%ave_ssh, G, GV, MS, CS) + call adjust_ssh_for_p_atm(CS%tv, G, GV, 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(MS%tv%T,G%Domain) - call pass_var(MS%tv%S,G%Domain) - call pass_var(MS%h,G%Domain) + 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. @@ -1375,14 +1401,13 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, MS end subroutine step_offline !> This subroutine initializes MOM. -subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp, & +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 paramater file to parse type(directories), intent(out) :: dirs !< structure with directory paths - type(MOM_state_type), pointer :: MS !< pointer set in this routine to structure describing the MOM state 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 @@ -1422,7 +1447,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp real, dimension(:,:), allocatable, target :: frac_shelf_h ! fraction of total area occupied by ice shelf real, dimension(:,:), pointer :: shelf_area type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() - type(group_pass_type) :: tmp_pass_uv_T_S_h + type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h type(group_pass_type) :: tmp_pass_Kv_turb real :: default_val ! default value for a parameter @@ -1434,15 +1459,26 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp 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 :: 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 :: 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 @@ -1453,6 +1489,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp real :: conv2watt, conv2salt, H_convert 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 @@ -1464,14 +1501,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp endif allocate(CS) - if (associated(MS)) then - call MOM_error(WARNING, "initialize_MOM called with an MOM state structure.") - return - endif - allocate(MS) - if (test_grid_copy) then ; allocate(G) - else ; G => MS%G ; endif + else ; G => CS%G ; endif CS%Time => Time @@ -1518,14 +1549,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp "If true, the in-situ density is used to calculate the\n"//& "effective sea level that is returned to the coupler. If false,\n"//& "the Boussinesq parameter RHO_0 is used.", default=.false.) - call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) call get_param(param_file, "MOM", "USE_EOS", use_EOS, & "If true, density is calculated from temperature and \n"//& "salinity with an equation of state. If USE_EOS is \n"//& "true, ENABLE_THERMODYNAMICS must be true as well.", & - default=CS%use_temperature) + default=use_temperature) call get_param(param_file, "MOM", "DIABATIC_FIRST", CS%diabatic_first, & "If true, apply diabatic and thermodynamic processes, \n"//& "including buoyancy forcing and mass gain or loss, \n"//& @@ -1536,17 +1567,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp "to potential temperature and practical salinity before \n"//& "exchanging them with the coupler and/or reporting T&S diagnostics.\n", & default=.false.) - MS%tv%T_is_conT = use_conT_absS ; MS%tv%S_is_absS = use_conT_absS + 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 \n"//& "true. This assumes that KD = KDML = 0.0 and that \n"//& "there is no buoyancy forcing, but makes the model \n"//& "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\n"//& - "the gravity wave adjustment to h. This is a fragile feature and\n"//& + "If False, skips the dynamics calls that update u & v, as well as \n"//& + "the gravity wave adjustment to h. This is a fragile feature and \n"//& "thus undocumented.", default=.true., do_not_log=.true. ) - call get_param(param_file, "MOM", "ADVECT_TS", CS%advect_TS , & + call get_param(param_file, "MOM", "ADVECT_TS", advect_TS, & "If True, advect temperature and salinity horizontally \n"//& "If False, T/S are registered for advection.\n"//& "This is intended only to be used in offline tracer mode \n"//& @@ -1560,7 +1591,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp "files stored from a previous integration of the prognostic model.\n"//& "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", CS%advect_TS , & + call get_param(param_file, "MOM", "ADVECT_TS", advect_TS, & "If True, advect temperature and salinity horizontally\n"//& "If False, T/S are registered for advection.\n"//& "This is intended only to be used in offline tracer mode."//& @@ -1568,17 +1599,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp default=.false. ) endif endif - call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & + call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm, & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) - call get_param(param_file, "MOM", "BULKMIXEDLAYER", CS%bulkmixedlayer, & + call get_param(param_file, "MOM", "BULKMIXEDLAYER", bulkmixedlayer, & "If true, use a Kraus-Turner-like bulk mixed layer \n"//& "with transitional buffer layers. Layers 1 through \n"//& "NKML+NKBL have variable densities. There must be at \n"//& "least NKML+NKBL+1 layers if BULKMIXEDLAYER is true. \n"//& "BULKMIXEDLAYER can not be used with USE_REGRIDDING. \n"//& "The default is influenced by ENABLE_THERMODYNAMICS.", & - default=CS%use_temperature .and. .not.CS%use_ALE_algorithm) + 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 \n"//& "coefficient of KHTH.", default=.false.) @@ -1596,7 +1627,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp call get_param(param_file, "MOM", "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, "MOM", "DEBUG_TRUNCATIONS", CS%debug_truncations, & + call get_param(param_file, "MOM", "DEBUG_TRUNCATIONS", debug_truncations, & "If true, calculate all diagnostics that are useful for \n"//& "debugging truncations.", default=.false.) @@ -1620,7 +1651,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp "case is the largest integer multiple of the coupling \n"//& "timestep that is less than or equal to DT_THERM.", default=.false.) - if (.not.CS%bulkmixedlayer) then + 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 \n"//& "over which to average to find surface properties like \n"//& @@ -1645,7 +1678,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp if (CS%split) then call get_param(param_file, "MOM", "DTBT", dtbt, default=-0.98) default_val = CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 - CS%dtbt_reset_period = -1.0 + CS%dtbt_reset_period = -1.0 ; CS%dtbt_reset_time = 0.0 call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, & "The period between recalculations of DTBT (if DTBT <= 0). \n"//& "If DTBT_RESET_PERIOD is negative, DTBT is set based \n"//& @@ -1657,33 +1690,33 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp endif ! This is here in case these values are used inappropriately. - CS%use_frazil = .false. ; CS%bound_salinity = .false. ; MS%tv%P_Ref = 2.0e7 - if (CS%use_temperature) then - call get_param(param_file, "MOM", "FRAZIL", CS%use_frazil, & + use_frazil = .false. ; bound_salinity = .false. ; CS%tv%P_Ref = 2.0e7 + if (use_temperature) then + call get_param(param_file, "MOM", "FRAZIL", use_frazil, & "If true, water freezes if it gets too cold, and the \n"//& "the accumulated heat deficit is returned in the \n"//& "surface state. FRAZIL is only used if \n"//& "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", CS%bound_salinity, & + call get_param(param_file, "MOM", "BOUND_SALINITY", bound_salinity, & "If true, limit salinity to being positive. (The sea-ice \n"//& "model may ask for more salt than is available and \n"//& "drive the salinity negative otherwise.)", default=.false.) - call get_param(param_file, "MOM", "C_P", MS%tv%C_p, & + call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & "The heat capacity of sea water, approximated as a \n"//& "constant. This is only used if ENABLE_THERMODYNAMICS is \n"//& "true. The default value is from the TEOS-10 definition \n"//& "of conservative temperature.", units="J kg-1 K-1", & default=3991.86795711963) endif - if (use_EOS) call get_param(param_file, "MOM", "P_REF", MS%tv%P_Ref, & + if (use_EOS) call get_param(param_file, "MOM", "P_REF", CS%tv%P_Ref, & "The pressure that is used for calculating the coordinate \n"//& "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) \n"//& "This is only used if USE_EOS and ENABLE_THERMODYNAMICS \n"//& "are true.", units="Pa", default=2.0e7) - if (CS%bulkmixedlayer) then + if (bulkmixedlayer) then call get_param(param_file, "MOM", "NKML", nkml, & "The number of sublayers within the mixed layer if \n"//& "BULKMIXEDLAYER is true.", units="nondim", default=2) @@ -1709,7 +1742,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp "and odd numbers used for y-first.", default=0) call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", & - CS%check_bad_surface_vals, & + CS%check_bad_surface_vals, & "If true, check the surface state for ridiculous values.", & default=.false.) if (CS%check_bad_surface_vals) then @@ -1755,17 +1788,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! ((write_geom==1) .and. is_new_run(restart_CSp))) ! Check for inconsistent parameter settings. - if (CS%use_ALE_algorithm .and. CS%bulkmixedlayer) call MOM_error(FATAL, & + 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.CS%use_temperature) call MOM_error(FATAL, & + 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. CS%use_temperature) call MOM_error(WARNING, & + 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.CS%use_temperature) call MOM_error(FATAL, & + 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. CS%bulkmixedlayer) call MOM_error(FATAL, & + if (CS%adiabatic .and. bulkmixedlayer) call MOM_error(FATAL, & "MOM: ADIABATIC and BULKMIXEDLAYER can not both be defined.") - if (CS%bulkmixedlayer .and. .not.use_EOS) call MOM_error(FATAL, & + 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.") @@ -1810,8 +1843,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp call create_dyn_horgrid(dG, HI, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G%Domain, dG%Domain) - call verticalGridInit( param_file, MS%GV ) - GV => MS%GV + call verticalGridInit( param_file, CS%GV ) + GV => CS%GV ! dG%g_Earth = GV%g_Earth ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. @@ -1834,37 +1867,37 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp 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_(MS%u(IsdB:IedB,jsd:jed,nz)) ; MS%u(:,:,:) = 0.0 - ALLOC_(MS%v(isd:ied,JsdB:JedB,nz)) ; MS%v(:,:,:) = 0.0 - ALLOC_(MS%h(isd:ied,jsd:jed,nz)) ; MS%h(:,:,:) = GV%Angstrom - ALLOC_(MS%uh(IsdB:IedB,jsd:jed,nz)) ; MS%uh(:,:,:) = 0.0 - ALLOC_(MS%vh(isd:ied,JsdB:JedB,nz)) ; MS%vh(:,:,:) = 0.0 - if (CS%use_temperature) then - ALLOC_(MS%T(isd:ied,jsd:jed,nz)) ; MS%T(:,:,:) = 0.0 - ALLOC_(MS%S(isd:ied,jsd:jed,nz)) ; MS%S(:,:,:) = 0.0 - MS%tv%T => MS%T ; MS%tv%S => MS%S - if (MS%tv%T_is_conT) then - CS%vd_T = var_desc(name="contemp", units="Celsius", longname="Conservative Temperature", & - cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", & - conversion=MS%tv%C_p) + 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 + 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=CS%tv%C_p) else - CS%vd_T = var_desc(name="temp", units="degC", longname="Potential Temperature", & - cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", & - conversion=MS%tv%C_p) + vd_T = var_desc(name="temp", units="degC", longname="Potential Temperature", & + cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", & + conversion=CS%tv%C_p) endif - if (MS%tv%S_is_absS) then - CS%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) + 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 - CS%vd_S = var_desc(name="salt",units="psu",longname="Salinity", & - cmor_field_name="so", cmor_longname="Sea Water Salinity", & - conversion=0.001) + vd_S = var_desc(name="salt",units="psu",longname="Salinity", & + cmor_field_name="so", cmor_longname="Sea Water Salinity", & + conversion=0.001) endif - if(CS%advect_TS) then + 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 * MS%tv%C_p + conv2watt = GV%H_to_kg_m2 * CS%tv%C_p if (GV%Boussinesq) then conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001? H_convert = GV%H_to_m @@ -1872,32 +1905,32 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp conv2salt = GV%H_to_kg_m2 H_convert = GV%H_to_kg_m2 endif - call register_tracer(MS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & - tr_desc=CS%vd_T, registry_diags=.true., flux_nameroot='T', & + 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 m-2', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & - convergence_scale=conv2watt, CMOR_tendname="opottemp", diag_form=2) - call register_tracer(MS%tv%S, CS%tracer_Reg, param_file, dG%HI, GV, & - tr_desc=CS%vd_S, registry_diags=.true., flux_nameroot='S', & + 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_tendname="osalt", diag_form=2) + convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) endif if (associated(CS%OBC)) & - call register_temp_salt_segments(GV, CS%OBC, MS%tv, CS%vd_T, CS%vd_S, param_file) + call register_temp_salt_segments(GV, CS%OBC, CS%tv, vd_T, vd_S, param_file) endif - if (CS%use_frazil) then - allocate(MS%tv%frazil(isd:ied,jsd:jed)) ; MS%tv%frazil(:,:) = 0.0 + if (use_frazil) then + allocate(CS%tv%frazil(isd:ied,jsd:jed)) ; CS%tv%frazil(:,:) = 0.0 endif - if (CS%bound_salinity) then - allocate(MS%tv%salt_deficit(isd:ied,jsd:jed)) ; MS%tv%salt_deficit(:,:)=0.0 + if (bound_salinity) then + allocate(CS%tv%salt_deficit(isd:ied,jsd:jed)) ; CS%tv%salt_deficit(:,:)=0.0 endif - if (CS%bulkmixedlayer .or. CS%use_temperature) then + if (bulkmixedlayer .or. use_temperature) then allocate(CS%Hml(isd:ied,jsd:jed)) ; CS%Hml(:,:) = 0.0 endif - if (CS%bulkmixedlayer) then + if (bulkmixedlayer) then GV%nkml = nkml ; GV%nk_rho_varies = nkml + nkbl else GV%nkml = 0 ; GV%nk_rho_varies = 0 @@ -1906,11 +1939,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp call get_param(param_file, "MOM", "NK_RHO_VARIES", GV%nk_rho_varies, default=0) ! Will default to nz later... -AJA endif - ALLOC_(MS%uhtr(IsdB:IedB,jsd:jed,nz)) ; MS%uhtr(:,:,:) = 0.0 - ALLOC_(MS%vhtr(isd:ied,JsdB:JedB,nz)) ; MS%vhtr(:,:,:) = 0.0 - MS%t_dyn_rel_adv = 0.0 ; CS%t_dyn_rel_thermo = 0.0 ; CS%t_dyn_rel_diag = 0.0 + 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 (CS%debug_truncations) then + 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 call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) @@ -1921,31 +1954,34 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp endif endif - MOM_internal_state%u => MS%u ; MOM_internal_state%v => MS%v - MOM_internal_state%h => MS%h - MOM_internal_state%uh => MS%uh ; MOM_internal_state%vh => MS%vh - if (CS%use_temperature) then - MOM_internal_state%T => MS%T ; MOM_internal_state%S => MS%S + 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 => MS%uh ; CS%CDp%vh => MS%vh + 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_(MS%ave_ssh(isd:ied,jsd:jed)) ; MS%ave_ssh(:,:) = 0.0 + 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 ! 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, MS%tv%eqn_of_state) - if (CS%use_temperature) then - allocate(MS%tv%TempxPmE(isd:ied,jsd:jed)) - MS%tv%TempxPmE(:,:) = 0.0 + if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state) + if (use_temperature) then + allocate(CS%tv%TempxPmE(isd:ied,jsd:jed)) + CS%tv%TempxPmE(:,:) = 0.0 if (use_geothermal) then - allocate(MS%tv%internal_heat(isd:ied,jsd:jed)) - MS%tv%internal_heat(:,:) = 0.0 + 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)") @@ -1953,10 +1989,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! 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, param_file, MS, CS, restart_CSp) + call set_restart_fields(GV, 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, MS%uh, MS%vh) + 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) @@ -1972,7 +2008,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, 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) + 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, restart_CSp) @@ -1982,7 +2019,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! Initialize dynamically evolving fields, perhaps from restart files. call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_coord(GV, param_file, write_geom_files, & - dirs%output_directory, MS%tv, dG%max_depth) + dirs%output_directory, CS%tv, dG%max_depth) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then @@ -2007,7 +2044,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! Consider removing this later? G%ke = GV%ke ; G%g_Earth = GV%g_Earth - call MOM_initialize_state(MS%u, MS%v, MS%h, MS%tv, Time, G, GV, param_file, & + call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%OBC, Time_in) call cpu_clock_end(id_clock_MOM_init) @@ -2017,22 +2054,22 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! 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 MS%G. + ! 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, MS%G%Domain) - call MOM_grid_init(MS%G, param_file) + call clone_MOM_domain(G%Domain, CS%G%Domain) + call MOM_grid_init(CS%G, param_file) call copy_MOM_grid_to_dyngrid(G, dg) - call copy_dyngrid_to_MOM_grid(dg, MS%G) + call copy_dyngrid_to_MOM_grid(dg, CS%G) call destroy_dyn_horgrid(dG) call MOM_grid_end(G) ; deallocate(G) - G => MS%G - if (CS%debug .or. MS%G%symmetric) & - call clone_MOM_domain(MS%G%Domain, MS%G%Domain_aux, symmetric=.false.) + G => CS%G + if (CS%debug .or. CS%G%symmetric) & + call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) G%ke = GV%ke ; G%g_Earth = GV%g_Earth endif @@ -2041,17 +2078,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! 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(MS%h,"h",restart_CSp)) then + 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]", & - MS%u, MS%v, G%HI, haloshift=1) - call hchksum(MS%h,"Pre ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_m) + 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, MS%h ) + 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) @@ -2070,25 +2107,25 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h - call ALE_main(G, GV, MS%h, MS%u, MS%v, MS%tv, CS%tracer_Reg, CS%ALE_CSp, & + call ALE_main(G, GV, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp, & frac_shelf_h = shelf_area) else - call ALE_main( G, GV, MS%h, MS%u, MS%v, MS%tv, CS%tracer_Reg, CS%ALE_CSp ) + call ALE_main( G, GV, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp ) endif call cpu_clock_begin(id_clock_pass_init) - call create_group_pass(tmp_pass_uv_T_S_h, MS%u, MS%v, G%Domain) - if (CS%use_temperature) then - call create_group_pass(tmp_pass_uv_T_S_h, MS%tv%T, G%Domain, halo=1) - call create_group_pass(tmp_pass_uv_T_S_h, MS%tv%S, G%Domain, halo=1) + 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, MS%h, G%Domain, halo=1) + 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]", MS%u, MS%v, G%HI, haloshift=1) - call hchksum(MS%h, "Post ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_m) + 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 ) @@ -2104,8 +2141,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp call diag_masks_set(G, GV%ke, diag) ! Set up pointers within diag mediator control structure, - ! this needs to occur _after_ MS%h etc. have been allocated. - call diag_set_state_ptrs(MS%h, MS%T, MS%S, MS%tv%eqn_of_state, diag) + ! 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. @@ -2116,6 +2153,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! 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 @@ -2123,7 +2164,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp call set_masks_for_axes(G, diag) ! Diagnose static fields AND associate areas/volumes with axes - call write_static_fields(G, GV, MS%tv, CS%diag) + call write_static_fields(G, GV, CS%tv, CS%diag) call callTree_waypoint("static fields written (initialize_MOM)") ! Register the volume cell measure (must be one of first diagnostics) @@ -2139,21 +2180,21 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) call VarMix_init(Time, G, param_file, diag, CS%VarMix) - call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp,CS%OBC) + call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, CS%OBC) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 - call initialize_dyn_split_RK2(MS%u, MS%v, MS%h, MS%uh, MS%vh, eta, Time, & + call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & G, GV, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc) elseif (CS%use_RK2) then - call initialize_dyn_unsplit_RK2(MS%u, MS%v, MS%h, Time, G, GV, & + call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) else - call initialize_dyn_unsplit(MS%u, MS%v, MS%h, Time, G, GV, & + call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, & param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) @@ -2164,7 +2205,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, & CS%mixedlayer_restrat_CSp) if (CS%mixedlayer_restrat) then - if (.not.(CS%bulkmixedlayer .or. CS%use_ALE_algorithm)) & + 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)) & @@ -2172,7 +2213,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp endif call MOM_diagnostics_init(MOM_internal_state, CS%ADp, CS%CDp, Time, G, GV, & - param_file, diag, CS%diagnostics_CSp, MS%tv) + param_file, diag, CS%diagnostics_CSp, CS%tv) + call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) CS%Z_diag_interval = set_time(int((CS%dt_therm) * & max(1,floor(0.01 + Z_diag_int/(CS%dt_therm))))) @@ -2196,17 +2238,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp endif call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) - call tracer_hor_diff_init(Time, G, param_file, diag, MS%tv%eqn_of_state, & - CS%tracer_diff_CSp, CS%neutral_diffusion_CSp) + call tracer_hor_diff_init(Time, G, param_file, diag, CS%tv%eqn_of_state, & + 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, CS%sfc_IDs, CS%diag, CS%missing, MS%tv) - call register_diags(Time, G, GV, CS%IDs, CS%diag, CS%missing) - call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag, CS%missing) - call register_tracer_diagnostics(CS%tracer_Reg, MS%h, Time, diag, G, GV, & + call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) + call register_diags(Time, G, GV, CS%IDs, CS%diag) + call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag) + call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm, CS%diag_to_Z_CSp) if (CS%use_ALE_algorithm) then call ALE_register_diags(Time, G, GV, diag, CS%ALE_CSp) @@ -2214,9 +2257,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp ! This subroutine initializes any tracer packages. new_sim = is_new_run(restart_CSp) - call tracer_flow_control_init(.not.new_sim, Time, G, GV, MS%h, param_file, & + call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, & CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & - CS%ALE_sponge_CSp, CS%diag_to_Z_CSp, MS%tv) + CS%ALE_sponge_CSp, CS%diag_to_Z_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 @@ -2229,21 +2272,21 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp 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=MS%tv, x_before_y = (MOD(first_direction,2)==0), debug=CS%debug ) + 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(CS%pass_uv_T_S_h, MS%u, MS%v, G%Domain, halo=dynamics_stencil) - if (CS%use_temperature) then - call create_group_pass(CS%pass_uv_T_S_h, MS%tv%T, G%Domain, halo=dynamics_stencil) - call create_group_pass(CS%pass_uv_T_S_h, MS%tv%S, G%Domain, halo=dynamics_stencil) + 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(CS%pass_uv_T_S_h, MS%h, G%Domain, halo=dynamics_stencil) + call create_group_pass(pass_uv_T_S_h, CS%h, G%Domain, halo=dynamics_stencil) - call do_group_pass(CS%pass_uv_T_S_h, G%Domain) + call do_group_pass(pass_uv_T_S_h, G%Domain) if (associated(CS%visc%Kv_turb)) & call pass_var(CS%visc%Kv_turb, G%Domain, To_All+Omit_Corners, halo=1) @@ -2252,9 +2295,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp call register_obsolete_diagnostics(param_file, CS%diag) - if (CS%use_frazil) then - if (.not.query_initialized(MS%tv%frazil,"frazil",restart_CSp)) & - MS%tv%frazil(:,:) = 0.0 + if (use_frazil) then + if (.not.query_initialized(CS%tv%frazil,"frazil",restart_CSp)) & + CS%tv%frazil(:,:) = 0.0 endif if (CS%interp_p_surf) then @@ -2264,11 +2307,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp if (CS%p_surf_prev_set) call pass_var(CS%p_surf_prev, G%domain) endif - if (.not.query_initialized(MS%ave_ssh,"ave_ssh",restart_CSp)) then + if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(MS%h, MS%tv, GV%g_Earth, G, GV, MS%ave_ssh, eta) + call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc, eta) else - call find_eta(MS%h, MS%tv, GV%g_Earth, G, GV, MS%ave_ssh) + call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc) endif endif if (CS%split) deallocate(eta) @@ -2289,10 +2332,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, MS, CS, restart_CSp end subroutine initialize_MOM !> This subroutine finishes initializing MOM and writes out the initial conditions. -subroutine finish_MOM_initialization(Time, dirs, MS, CS, fluxes, restart_CSp) +subroutine finish_MOM_initialization(Time, dirs, CS, fluxes, 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_state_type), pointer :: MS !< pointer to structure describing the MOM state type(MOM_control_struct), pointer :: CS !< pointer to MOM control structure type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control @@ -2309,14 +2351,14 @@ subroutine finish_MOM_initialization(Time, dirs, MS, CS, fluxes, restart_CSp) call callTree_enter("finish_MOM_initialization()") ! Pointers for convenience - G => MS%G ; GV => MS%GV + G => CS%G ; GV => CS%GV ! 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(MS%h, MS%tv, GV%g_Earth, G, GV, z_interface) + call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, z_interface) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2326,7 +2368,7 @@ subroutine finish_MOM_initialization(Time, dirs, MS, CS, fluxes, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(MS%u, MS%v, MS%h, MS%tv, Time, 0, G, GV, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") @@ -2335,13 +2377,12 @@ subroutine finish_MOM_initialization(Time, dirs, MS, CS, fluxes, restart_CSp) end subroutine finish_MOM_initialization !> Register certain diagnostics -subroutine register_diags(Time, G, GV, IDs, diag, missing) +subroutine register_diags(Time, G, GV, 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(MOM_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real, intent(in) :: missing !< The value to use to fill in missing data real :: H_convert character(len=48) :: thickness_units @@ -2354,59 +2395,17 @@ subroutine register_diags(Time, G, GV, IDs, diag, missing) endif ! Diagnostics of the rapidly varying dynamic state - IDs%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & - 'Zonal velocity', 'm s-1', cmor_field_name='uo', & - cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') - IDs%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & - 'Meridional velocity', 'm s-1', cmor_field_name='vo', & - cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') - IDs%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & - 'Layer Thickness', 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', missing) + IDs%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, Time, & + 'Zonal velocity after the dynamics update', 'm s-1') + IDs%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, Time, & + 'Meridional velocity after the dynamics update', 'm s-1') + 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 -!> Register certain diagnostics related to transports -subroutine register_transport_diags(Time, G, GV, IDs, diag, missing) - 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(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. - type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real, intent(in) :: missing !< The value to use to fill in missing data - - 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 related to tracer and mass transport - IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & - 'Accumulated zonal thickness fluxes to advect tracers', 'kg', & - y_cell_method='sum', v_extensive=.true., conversion=H_convert) - IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg', & - x_cell_method='sum', v_extensive=.true., conversion=H_convert) - IDs%id_umo = register_diag_field('ocean_model', 'umo', & - diag%axesCuL, Time, 'Ocean Mass X Transport', 'kg s-1', & - standard_name='ocean_mass_x_transport', y_cell_method='sum', v_extensive=.true.) - IDs%id_vmo = register_diag_field('ocean_model', 'vmo', & - diag%axesCvL, Time, 'Ocean Mass Y Transport', 'kg s-1', & - standard_name='ocean_mass_y_transport', x_cell_method='sum', v_extensive=.true.) - IDs%id_umo_2d = register_diag_field('ocean_model', 'umo_2d', & - diag%axesCu1, Time, 'Ocean Mass X Transport Vertical Sum', 'kg s-1', & - standard_name='ocean_mass_x_transport_vertical_sum', y_cell_method='sum') - IDs%id_vmo_2d = register_diag_field('ocean_model', 'vmo_2d', & - diag%axesCv1, Time, 'Ocean Mass Y Transport Vertical Sum', 'kg s-1', & - standard_name='ocean_mass_y_transport_vertical_sum', x_cell_method='sum') - -end subroutine register_transport_diags - !> This subroutine sets up 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. @@ -2437,266 +2436,6 @@ subroutine MOM_timing_init(CS) end subroutine MOM_timing_init -!> This routine posts diagnostics of the transports, including the subgridscale -!! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag, dt_trans, & - diag_to_Z_CSp, h_pre_dyn, T_pre_dyn, S_pre_dyn) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< Accumulated zonal thickness fluxes used - !! to advect tracers (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< Accumulated meridional thickness fluxes - !! used to advect tracers (m3 or kg) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< The updated layer thicknesses, in H - type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. - type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real, intent(in) :: dt_trans !< total time step associated with the transports, in s. - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A control structure for remapping - !! the transports to depth space - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_pre_dyn !< The thickness before the transports, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_pre_dyn !< Temperature before the transports, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_pre_dyn !< Salinity before the transports, in H. - - real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport, in kg s-1 - real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport, in kg s-1 - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)) :: umo ! Diagnostics of layer mass transport, in kg s-1 - real, dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo ! Diagnostics of layer mass transport, in kg s-1 - real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes, in kg m-2 H-1 s-1. - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - - call cpu_clock_begin(id_clock_Z_diag) - call calculate_Z_transport(uhtr, vhtr, h, dt_trans, G, GV, diag_to_Z_CSp) - call cpu_clock_end(id_clock_Z_diag) - - ! Post mass transports, including SGS - ! Build the remap grids using the layer thicknesses from before the dynamics - if (transport_remap_grid_needed(IDs)) & - call diag_update_remap_grids(diag, alt_h = h_pre_dyn, alt_T = T_pre_dyn, alt_S = S_pre_dyn) - - H_to_kg_m2_dt = GV%H_to_kg_m2 / dt_trans - if (IDs%id_umo_2d > 0) then - umo2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=is-1,ie - umo2d(I,j) = umo2d(I,j) + uhtr(I,j,k) * H_to_kg_m2_dt - enddo ; enddo ; enddo - call post_data(IDs%id_umo_2d, umo2d, diag) - endif - if (IDs%id_umo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below - do k=1,nz ; do j=js,je ; do I=is-1,ie - umo(I,j,k) = uhtr(I,j,k) * H_to_kg_m2_dt - enddo ; enddo ; enddo - call post_data(IDs%id_umo, umo, diag, alt_h = h_pre_dyn) - endif - if (IDs%id_vmo_2d > 0) then - vmo2d(:,:) = 0.0 - do k=1,nz ; do J=js-1,je ; do i=is,ie - vmo2d(i,J) = vmo2d(i,J) + vhtr(i,J,k) * H_to_kg_m2_dt - enddo ; enddo ; enddo - call post_data(IDs%id_vmo_2d, vmo2d, diag) - endif - if (IDs%id_vmo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below - do k=1,nz ; do J=js-1,je ; do i=is,ie - vmo(i,J,k) = vhtr(i,J,k) * H_to_kg_m2_dt - enddo ; enddo ; enddo - call post_data(IDs%id_vmo, vmo, diag, alt_h = h_pre_dyn) - endif - - if (IDs%id_uhtr > 0) call post_data(IDs%id_uhtr, uhtr, diag, alt_h = h_pre_dyn) - if (IDs%id_vhtr > 0) call post_data(IDs%id_vhtr, vhtr, diag, alt_h = h_pre_dyn) - -end subroutine post_transport_diagnostics - -!> Indicate whether it is necessary to save and recalculate the grid for finding -!! remapped transports. -function transport_remap_grid_needed(IDs) result(needed) - type(transport_diag_IDs), intent(in) :: IDs !< A structure with transport-related diagnostic IDs - logical :: needed - - needed = .false. - needed = needed .or. (IDs%id_uhtr > 0) .or. (IDs%id_vhtr > 0) - needed = needed .or. (IDs%id_umo > 0) .or. (IDs%id_vmo > 0) -end function transport_remap_grid_needed - - -!> Offers the static fields in the ocean grid type -!! for output via the diag_manager. -subroutine write_static_fields(G, GV, tv, diag) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output - ! Local variables - real :: tmp_h(SZI_(G),SZJ_(G)) - integer :: id, i, j - - id = register_static_field('ocean_model', 'geolat', diag%axesT1, & - 'Latitude of tracer (T) points', 'degrees_north') - if (id > 0) call post_data(id, G%geoLatT, diag, .true.) - - id = register_static_field('ocean_model', 'geolon', diag%axesT1, & - 'Longitude of tracer (T) points', 'degrees_east') - if (id > 0) call post_data(id, G%geoLonT, diag, .true.) - - id = register_static_field('ocean_model', 'geolat_c', diag%axesB1, & - 'Latitude of corner (Bu) points', 'degrees_north', interp_method='none') - if (id > 0) call post_data(id, G%geoLatBu, diag, .true.) - - id = register_static_field('ocean_model', 'geolon_c', diag%axesB1, & - 'Longitude of corner (Bu) points', 'degrees_east', interp_method='none') - if (id > 0) call post_data(id, G%geoLonBu, diag, .true.) - - id = register_static_field('ocean_model', 'geolat_v', diag%axesCv1, & - 'Latitude of meridional velocity (Cv) points', 'degrees_north', interp_method='none') - if (id > 0) call post_data(id, G%geoLatCv, diag, .true.) - - id = register_static_field('ocean_model', 'geolon_v', diag%axesCv1, & - 'Longitude of meridional velocity (Cv) points', 'degrees_east', interp_method='none') - if (id > 0) call post_data(id, G%geoLonCv, diag, .true.) - - id = register_static_field('ocean_model', 'geolat_u', diag%axesCu1, & - 'Latitude of zonal velocity (Cu) points', 'degrees_north', interp_method='none') - if (id > 0) call post_data(id, G%geoLatCu, diag, .true.) - - id = register_static_field('ocean_model', 'geolon_u', diag%axesCu1, & - 'Longitude of zonal velocity (Cu) points', 'degrees_east', interp_method='none') - if (id > 0) call post_data(id, G%geoLonCu, diag, .true.) - - id = register_static_field('ocean_model', 'area_t', diag%axesT1, & - 'Surface area of tracer (T) cells', 'm2', & - cmor_field_name='areacello', cmor_standard_name='cell_area', & - cmor_long_name='Ocean Grid-Cell Area', & - x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaT, diag, .true.) - call diag_register_area_ids(diag, id_area_t=id) - endif - - id = register_static_field('ocean_model', 'area_u', diag%axesCu1, & - 'Surface area of x-direction flow (U) cells', 'm2', & - cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & - cmor_long_name='Ocean Grid-Cell Area', & - x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaCu, diag, .true.) - endif - - id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & - 'Surface area of y-direction flow (V) cells', 'm2', & - cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & - cmor_long_name='Ocean Grid-Cell Area', & - x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaCv, diag, .true.) - endif - - id = register_static_field('ocean_model', 'area_q', diag%axesB1, & - 'Surface area of B-grid flow (Q) cells', 'm2', & - cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & - cmor_long_name='Ocean Grid-Cell Area', & - x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaBu, diag, .true.) - endif - - id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & - 'Depth of the ocean at tracer points', 'm', & - standard_name='sea_floor_depth_below_geoid', & - cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & - cmor_standard_name='sea_floor_depth_below_geoid',& - area=diag%axesT1%id_area, & - x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) - - id = register_static_field('ocean_model', 'wet', diag%axesT1, & - '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) - if (id > 0) call post_data(id, G%mask2dT, diag, .true.) - - id = register_static_field('ocean_model', 'wet_c', diag%axesB1, & - '0 if land, 1 if ocean at corner (Bu) points', 'none', interp_method='none') - if (id > 0) call post_data(id, G%mask2dBu, diag, .true.) - - id = register_static_field('ocean_model', 'wet_u', diag%axesCu1, & - '0 if land, 1 if ocean at zonal velocity (Cu) points', 'none', interp_method='none') - if (id > 0) call post_data(id, G%mask2dCu, diag, .true.) - - id = register_static_field('ocean_model', 'wet_v', diag%axesCv1, & - '0 if land, 1 if ocean at meridional velocity (Cv) points', 'none', interp_method='none') - if (id > 0) call post_data(id, G%mask2dCv, diag, .true.) - - id = register_static_field('ocean_model', 'Coriolis', diag%axesB1, & - 'Coriolis parameter at corner (Bu) points', 's-1', interp_method='none') - if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) - - id = register_static_field('ocean_model', 'dxt', diag%axesT1, & - 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxt, diag, .true.) - - id = register_static_field('ocean_model', 'dyt', diag%axesT1, & - 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyt, diag, .true.) - - id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & - 'Delta(x) at u points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxCu, diag, .true.) - - id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyCu, diag, .true.) - - id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxCv, diag, .true.) - - id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & - 'Delta(y) at v points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyCv, diag, .true.) - - id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & - 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dy_Cu, diag, .true.) - - id = register_static_field('ocean_model', 'dxCvo', diag%axesCv1, & - 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) - - - ! This static diagnostic is from CF 1.8, and is the fraction of a cell - ! covered by ocean, given as a percentage (poorly named). - id = register_static_field('ocean_model', 'area_t_percent', diag%axesT1, & - 'Percentage of cell area covered by ocean', '%', & - cmor_field_name='sftof', cmor_standard_name='SeaAreaFraction', & - cmor_long_name='Sea Area Fraction', & - x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) then - tmp_h(:,:) = 0. - tmp_h(G%isc:G%iec,G%jsc:G%jec) = 100. * G%mask2dT(G%isc:G%iec,G%jsc:G%jec) - call post_data(id, tmp_h, diag, .true.) - endif - - id = register_static_field('ocean_model','Rho_0', diag%axesNull, & - 'mean ocean density used with the Boussinesq approximation', & - 'kg m-3', cmor_field_name='rhozero', & - cmor_standard_name='reference_sea_water_density_for_boussinesq_approximation', & - cmor_long_name='reference sea water density for boussinesq approximation') - if (id > 0) call post_data(id, GV%Rho0, diag, .true.) - - id = register_static_field('ocean_model','C_p', diag%axesNull, & - 'heat capacity of sea water', 'J kg-1 K-1', cmor_field_name='cpocean', & - cmor_standard_name='specific_heat_capacity_of_sea_water', & - cmor_long_name='specific_heat_capacity_of_sea_water') - if (id > 0) call post_data(id, tv%C_p, diag, .true.) - -end subroutine write_static_fields - !> 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 @@ -2706,10 +2445,9 @@ end subroutine write_static_fields !! 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, param_file, MS, CS, restart_CSp) +subroutine set_restart_fields(GV, param_file, CS, restart_CSp) type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< opened file for parsing to get parameters - type(MOM_state_type), intent(in) :: MS !< structure describing the MOM state type(MOM_control_struct), intent(in) :: CS !< control structure set up by inialize_MOM type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control !! structure that will be used for MOM. @@ -2717,41 +2455,41 @@ subroutine set_restart_fields(GV, param_file, MS, CS, restart_CSp) logical :: use_ice_shelf ! Needed to determine whether to add CS%Hml to restarts character(len=48) :: thickness_units, flux_units - call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., do_not_log=.true.) thickness_units = get_thickness_units(GV) flux_units = get_flux_units(GV) - if (CS%use_temperature) then - call register_restart_field(MS%tv%T, "Temp", .true., restart_CSp, & + if (associated(CS%tv%T)) & + call register_restart_field(CS%tv%T, "Temp", .true., restart_CSp, & "Potential Temperature", "degC") - call register_restart_field(MS%tv%S, "Salt", .true., restart_CSp, & + if (associated(CS%tv%S)) & + call register_restart_field(CS%tv%S, "Salt", .true., restart_CSp, & "Salinity", "PPT") - endif - call register_restart_field(MS%h, "h", .true., restart_CSp, & + call register_restart_field(CS%h, "h", .true., restart_CSp, & "Layer Thickness", thickness_units) - call register_restart_field(MS%u, "u", .true., restart_CSp, & + call register_restart_field(CS%u, "u", .true., restart_CSp, & "Zonal velocity", "m s-1", hor_grid='Cu') - call register_restart_field(MS%v, "v", .true., restart_CSp, & + call register_restart_field(CS%v, "v", .true., restart_CSp, & "Meridional velocity", "m s-1", hor_grid='Cv') - if (CS%use_frazil) then - call register_restart_field(MS%tv%frazil, "frazil", .false., 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") - endif 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(MS%ave_ssh, "ave_ssh", .false., restart_CSp, & + 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") @@ -2796,119 +2534,68 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) end subroutine adjust_ssh_for_p_atm -!> This subroutine allocates the fields for the surface (return) properties of -!! the ocean model. Unused fields are unallocated. -subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & - gas_fields_ocn) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. - logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. - logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically integrated fields. - type(coupler_1d_bc_type), & - optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean - !! ocean and surface-ice fields that will participate - !! in the calculation of additional gas or other - !! tracer fluxes, and can be used to spawn related - !! internal variables in the ice model. - - logical :: use_temp, alloc_integ - integer :: is, ie, js, je, isd, ied, jsd, jed - integer :: isdB, iedB, jsdB, jedB - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isdB = G%isdB ; iedB = G%iedB; jsdB = G%jsdB ; jedB = G%jedB - - use_temp = .true. ; if (present(use_temperature)) use_temp = use_temperature - alloc_integ = .true. ; if (present(do_integrals)) alloc_integ = do_integrals - - if (sfc_state%arrays_allocated) return - - if (use_temp) then - allocate(sfc_state%SST(isd:ied,jsd:jed)) ; sfc_state%SST(:,:) = 0.0 - allocate(sfc_state%SSS(isd:ied,jsd:jed)) ; sfc_state%SSS(:,:) = 0.0 - else - allocate(sfc_state%sfc_density(isd:ied,jsd:jed)) ; sfc_state%sfc_density(:,:) = 0.0 - endif - allocate(sfc_state%sea_lev(isd:ied,jsd:jed)) ; sfc_state%sea_lev(:,:) = 0.0 - allocate(sfc_state%Hml(isd:ied,jsd:jed)) ; sfc_state%Hml(:,:) = 0.0 - allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0 - allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0 - - if (alloc_integ) then - ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, - ! and ocean_salt. - allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0 - if (use_temp) then - allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 - allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0 - endif - allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 - endif - - if (present(gas_fields_ocn)) & - call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, & - (/isd,is,ie,ied/), (/jsd,js,je,jed/), as_needed=.true.) - - sfc_state%arrays_allocated = .true. - -end subroutine allocate_surface_state - !> This subroutine sets the surface (return) properties of the ocean -!! model by setting the appropriate fields in state. Unused fields +!! model by setting the appropriate fields in sfc_state. Unused fields !! are set to NULL or are unallocated. -subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(surface), intent(inout) :: sfc_state !< ocean surface state - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< meridional velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh !< time mean surface height (m) - type(MOM_state_type), intent(in) :: MS !< structure describing the MOM state - type(MOM_control_struct), intent(inout) :: CS !< control structure +subroutine extract_surface_state(CS, sfc_state) + type(MOM_control_struct), pointer :: CS !< Master MOM control structure + type(surface), intent(inout) :: sfc_state !< transparent ocean surface state + !! structure shared with the calling routine; + !! data in this structure is intent out. ! local - real :: depth(SZI_(G)) ! distance from the surface (meter) + real :: hu, hv + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() + real, pointer, dimension(:,:,:) :: & + u, & ! u : zonal velocity component (m/s) + v, & ! v : meridional velocity component (m/s) + h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real :: depth(SZI_(CS%G)) ! distance from the surface (meter) real :: depth_ml ! depth over which to average to ! determine mixed layer properties (meter) real :: dh ! thickness of a layer within mixed layer (meter) real :: mass ! mass per unit area of a layer (kg/m2) - real :: hu, hv + logical :: use_temperature ! If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB logical :: localError character(240) :: msg - call callTree_enter("calculate_surface_state(), MOM.F90") - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + call callTree_enter("extract_surface_state(), MOM.F90") + G => CS%G ; GV => CS%GV + 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 + u => CS%u ; v => CS%v ; h => CS%h + + use_temperature = associated(CS%tv%T) if (.not.sfc_state%arrays_allocated) then ! 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, G, CS%use_temperature, do_integrals=.true.) + call allocate_surface_state(sfc_state, G, use_temperature, do_integrals=.true.) endif - sfc_state%frazil => MS%tv%frazil - sfc_state%TempxPmE => MS%tv%TempxPmE - sfc_state%internal_heat => MS%tv%internal_heat - sfc_state%T_is_conT = MS%tv%T_is_conT - sfc_state%S_is_absS = MS%tv%S_is_absS + sfc_state%frazil => CS%tv%frazil + sfc_state%TempxPmE => CS%tv%TempxPmE + sfc_state%internal_heat => CS%tv%internal_heat + sfc_state%T_is_conT = CS%tv%T_is_conT + sfc_state%S_is_absS = CS%tv%S_is_absS if (associated(CS%visc%taux_shelf)) sfc_state%taux_shelf => CS%visc%taux_shelf if (associated(CS%visc%tauy_shelf)) sfc_state%tauy_shelf => CS%visc%tauy_shelf do j=js,je ; do i=is,ie - sfc_state%sea_lev(i,j) = ssh(i,j) + sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) enddo ; enddo - if (CS%bulkmixedlayer) then - if (CS%use_temperature) then ; do j=js,je ; do i=is,ie - sfc_state%SST(i,j) = MS%tv%T(i,j,1) - sfc_state%SSS(i,j) = MS%tv%S(i,j,1) + 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=IscB,IecB sfc_state%u(I,j) = u(I,j,1) @@ -2920,7 +2607,7 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) 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 - else + else ! (CS%Hmix >= 0.0) depth_ml = CS%Hmix ! Determine the mean tracer properties of the uppermost depth_ml fluid. @@ -2928,7 +2615,7 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) do j=js,je do i=is,ie depth(i) = 0.0 - if (CS%use_temperature) then + 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 @@ -2943,9 +2630,9 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) else dh = 0.0 endif - if (CS%use_temperature) then - sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * MS%tv%T(i,j,k) - sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * MS%tv%S(i,j,k) + 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 @@ -2955,7 +2642,7 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) do i=is,ie if (depth(i) < GV%H_subroundoff*GV%H_to_m) & depth(i) = GV%H_subroundoff*GV%H_to_m - if (CS%use_temperature) then + 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 @@ -3027,13 +2714,13 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) sfc_state%v(i,J) = v(i,J,1) enddo ; enddo endif - endif ! end BULKMIXEDLAYER + endif ! (CS%Hmix >= 0.0) - if (allocated(sfc_state%salt_deficit) .and. associated(MS%tv%salt_deficit)) then + 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) = 1000.0 * MS%tv%salt_deficit(i,j) + sfc_state%salt_deficit(i,j) = 1000.0 * CS%tv%salt_deficit(i,j) enddo ; enddo endif @@ -3048,9 +2735,9 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) do j=js,je ; do k=1,nz; do i=is,ie mass = GV%H_to_kg_m2*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*MS%tv%T(i,j,k) + 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*MS%tv%S(i,j,k)) + mass * (1.0e-3*CS%tv%S(i,j,k)) enddo ; enddo ; enddo else if (allocated(sfc_state%ocean_mass)) then @@ -3067,7 +2754,7 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) !$OMP parallel do default(shared) private(mass) do j=js,je ; do k=1,nz ; do i=is,ie mass = GV%H_to_kg_m2*h(i,j,k) - sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass*MS%tv%T(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 @@ -3077,7 +2764,7 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) do j=js,je ; do k=1,nz ; do i=is,ie mass = GV%H_to_kg_m2*h(i,j,k) sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + & - mass * (1.0e-3*MS%tv%S(i,j,k)) + mass * (1.0e-3*CS%tv%S(i,j,k)) enddo ; enddo ; enddo endif endif @@ -3094,7 +2781,7 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) .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_column_thickness - if (CS%use_temperature) localError = localError & + 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 & @@ -3102,28 +2789,21 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) if (localError) then numberOfErrors=numberOfErrors+1 if (numberOfErrors<9) then ! Only report details for the first few errors - if (CS%use_temperature) then + if (use_temperature) then write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & - 'x=',G%geoLonT(i,j),'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), & - 'SSH=',sfc_state%sea_lev(i,j), & - 'SST=',sfc_state%SST(i,j), & - 'SSS=',sfc_state%SSS(i,j), & - 'U-=',sfc_state%u(I-1,j), & - 'U+=',sfc_state%u(I,j), & - 'V-=',sfc_state%v(i,J-1), & - 'V+=',sfc_state%v(i,J) + 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & + 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & + 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & + 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) else write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & - 'x=',G%geoLonT(i,j),'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), & - 'SSH=',sfc_state%sea_lev(i,j), & - 'U-=',sfc_state%u(I-1,j), & - 'U+=',sfc_state%u(I,j), & - 'V-=',sfc_state%v(i,J-1), & - 'V+=',sfc_state%v(i,J) + 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & + 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & + 'V-=',sfc_state%v(i,J-1), 'V+=',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 @@ -3140,27 +2820,79 @@ subroutine calculate_surface_state(sfc_state, u, v, h, ssh, G, GV, MS, CS) endif endif - call callTree_leave("calculate_surface_sfc_state()") -end subroutine calculate_surface_state + if (CS%debug) call MOM_surface_chksum("Post extract_sfc", sfc_state, G) + + call callTree_leave("extract_surface_sfc_state()") +end subroutine extract_surface_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, C_p, 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 + real, optional, intent(out) :: C_p !< The heat capacity + logical, optional, intent(out) :: use_temp !< Indicates whether temperature is a state variable + + if (present(G)) G => CS%G + if (present(GV)) GV => CS%GV + if (present(C_p)) C_p = 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, in J. + real, optional, intent(out) :: salt !< The globally integrated integrated ocean salt, in kg. + real, optional, intent(out) :: mass !< The globally integrated integrated ocean mass, in 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%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 model -subroutine MOM_end(MS, CS) - type(MOM_state_type), pointer :: MS !< structure describing the MOM state +subroutine MOM_end(CS) type(MOM_control_struct), pointer :: CS !< MOM control structure - if (CS%use_ALE_algorithm) then - call ALE_end(CS%ALE_CSp) - endif + if (CS%use_ALE_algorithm) call ALE_end(CS%ALE_CSp) - DEALLOC_(MS%u) ; DEALLOC_(MS%v) ; DEALLOC_(MS%h) - DEALLOC_(MS%uh) ; DEALLOC_(MS%vh) + DEALLOC_(CS%u) ; DEALLOC_(CS%v) ; DEALLOC_(CS%h) + DEALLOC_(CS%uh) ; DEALLOC_(CS%vh) - if (CS%use_temperature) then - DEALLOC_(MS%T) ; MS%tv%T => NULL() ; DEALLOC_(MS%S) ; MS%tv%S => NULL() + if (associated(CS%tv%T)) then + DEALLOC_(CS%T) ; CS%tv%T => NULL() ; DEALLOC_(CS%S) ; CS%tv%S => NULL() endif - if (associated(MS%tv%frazil)) deallocate(MS%tv%frazil) - if (associated(MS%tv%salt_deficit)) deallocate(MS%tv%salt_deficit) + 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) @@ -3168,11 +2900,9 @@ subroutine MOM_end(MS, CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - if (CS%offline_tracer_mode) then - call offline_transport_end(CS%offline_CSp) - endif + if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) - DEALLOC_(MS%uhtr) ; DEALLOC_(MS%vhtr) + 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 @@ -3180,13 +2910,12 @@ subroutine MOM_end(MS, CS) else call end_dyn_unsplit(CS%dyn_unsplit_CSp) endif - DEALLOC_(MS%ave_ssh) + 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(MS%GV) - call MOM_grid_end(MS%G) + call verticalGridEnd(CS%GV) + call MOM_grid_end(CS%G) - deallocate(MS) deallocate(CS) end subroutine MOM_end @@ -3482,7 +3211,7 @@ end subroutine MOM_end !! * step_MOM steps MOM over a specified interval of time. !! * MOM_initialize calls initialize and does other initialization !! that does not warrant user modification. -!! * calculate_surface_state determines the surface (bulk mixed layer +!! * 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. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9890b7ddf6..7d0127b8ff 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -186,8 +186,6 @@ module MOM_barotropic vbtav ! The barotropic meridional velocity averaged over the ! baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - eta_source, & ! The net mass source to be applied within the - ! barotropic solver, in H s-1. eta_cor, & ! The difference between the free surface height from ! the barotropic calculation and the sum of the layer ! thicknesses. This difference is imposed as a forcing @@ -237,10 +235,6 @@ module MOM_barotropic ! give backward Euler. In practice, bebt should be ! of order 0.2 or greater. logical :: split ! If true, use the split time stepping scheme. - real :: eta_source_limit ! The fraction of the initial depth of the ocean - ! that can be added or removed to the bartropic - ! solution within a thermodynamic time step. By - ! default this is 0 (i.e., no correction). Nondim. logical :: bound_BT_corr ! If true, the magnitude of the fake mass source ! in the barotropic equation that drives the two ! estimates of the free surface height toward each @@ -1373,16 +1367,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (((find_uhbt(u_max_cor,BTCL_u(I,j)) + uhbt0(I,j)) - & (find_uhbt(-u_max_cor,BTCL_u(I-1,j)) + uhbt0(I-1,j))) + & ((find_vhbt(v_max_cor,BTCL_v(i,J)) + vhbt0(i,J)) - & - (find_vhbt(-v_max_cor,BTCL_v(i,J-1)) + vhbt0(i,J-1))) ) - & - CS%eta_source(i,j)) + (find_vhbt(-v_max_cor,BTCL_v(i,J-1)) + vhbt0(i,J-1))) )) CS%eta_cor(i,j) = min(CS%eta_cor(i,j), max(0.0, eta_cor_max)) else ! Limit the sink (inward) correction to the amount of mass that is already - ! inside the cell, plus any mass added by eta_source. + ! inside the cell. Htot = eta(i,j) if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) - CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot + dt*CS%eta_source(i,j))) + CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot)) endif endif ; enddo ; enddo else ; do j=js,je ; do i=is,ie @@ -1391,7 +1384,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo ; endif ; endif !$OMP do do j=js,je ; do i=is,ie - eta_src(i,j) = G%mask2dT(i,j) * (Instep * CS%eta_cor(i,j) + dtbt * CS%eta_source(i,j)) + eta_src(i,j) = G%mask2dT(i,j) * (Instep * CS%eta_cor(i,j)) enddo ; enddo !$OMP end parallel @@ -3744,20 +3737,15 @@ end subroutine find_face_areas !! the barotropic solver, along with a corrective fictitious mass source that !! will drive the barotropic estimate of the free surface height toward the !! baroclinic estimate. -subroutine bt_mass_source(h, eta, forces, set_cor, dt_therm, dt_since_therm, & - G, GV, CS) +subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be corrected, in m. - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective !! fluxes (and update the slowly varying part of eta_cor) !! (.true.) or whether to incrementally update the !! corrective fluxes. - real, intent(in) :: dt_therm !< The thermodynamic time step, in s. - real, intent(in) :: dt_since_therm !< The elapsed time since mass forcing was - !! applied, s. type(barotropic_CS), pointer :: CS !< The control structure returned by a previous call !! to barotropic_init. @@ -3792,30 +3780,14 @@ subroutine bt_mass_source(h, eta, forces, set_cor, dt_therm, dt_since_therm, & h_tot(i) = h_tot(i) + h(i,j,k) enddo ; enddo - if (set_cor) then - do i=is,ie ; CS%eta_source(i,j) = 0.0 ; enddo - if (CS%eta_source_limit > 0.0) then - limit_dt = CS%eta_source_limit/dt_therm - if (associated(forces%net_mass_src)) then ; do i=is,ie - CS%eta_source(i,j) = CS%eta_source(i,j) + forces%net_mass_src(i,j) - enddo ; endif - do i=is,ie - CS%eta_source(i,j) = CS%eta_source(i,j)*GV%kg_m2_to_H - if (abs(CS%eta_source(i,j)) > limit_dt * h_tot(i)) then - CS%eta_source(i,j) = SIGN(limit_dt * h_tot(i), CS%eta_source(i,j)) - endif - enddo - endif - endif - if (set_cor) then do i=is,ie - d_eta = eta_h(i) - (eta(i,j) - dt_since_therm*CS%eta_source(i,j)) + d_eta = eta_h(i) - eta(i,j) CS%eta_cor(i,j) = d_eta enddo else do i=is,ie - d_eta = eta_h(i) - (eta(i,j) - dt_since_therm*CS%eta_source(i,j)) + d_eta = eta_h(i) - eta(i,j) CS%eta_cor(i,j) = CS%eta_cor(i,j) + d_eta enddo endif @@ -3966,11 +3938,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "of barotropic time steps between updates to the face \n"//& "areas, or 0 to update only before the barotropic stepping.",& units="nondim", default=1) - call get_param(param_file, mdl, "BT_MASS_SOURCE_LIMIT", CS%eta_source_limit, & - "The fraction of the initial depth of the ocean that can \n"//& - "be added to or removed from the bartropic solution \n"//& - "within a thermodynamic time step. By default this is 0 \n"//& - "for no correction.", units="nondim", default=0.0) call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& "If true, step the barotropic velocity first and project \n"//& "out the velocity tendancy by 1+BEBT when calculating the \n"//& @@ -4149,7 +4116,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & isdw = CS%isdw ; iedw = CS%iedw ; jsdw = CS%jsdw ; jedw = CS%jedw ALLOC_(CS%frhatu(IsdB:IedB,jsd:jed,nz)) ; ALLOC_(CS%frhatv(isd:ied,JsdB:JedB,nz)) - ALLOC_(CS%eta_source(isd:ied,jsd:jed)) ; ALLOC_(CS%eta_cor(isd:ied,jsd:jed)) + ALLOC_(CS%eta_cor(isd:ied,jsd:jed)) if (CS%bound_BT_corr) then ALLOC_(CS%eta_cor_bound(isd:ied,jsd:jed)) ; CS%eta_cor_bound(:,:) = 0.0 endif @@ -4159,7 +4126,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%va_polarity(isdw:iedw,jsdw:jedw)) CS%frhatu(:,:,:) = 0.0 ; CS%frhatv(:,:,:) = 0.0 - CS%eta_source(:,:) = 0.0 ; CS%eta_cor(:,:) = 0.0 + CS%eta_cor(:,:) = 0.0 CS%IDatu(:,:) = 0.0 ; CS%IDatv(:,:) = 0.0 CS%ua_polarity(:,:) = 1.0 ; CS%va_polarity(:,:) = 1.0 @@ -4480,7 +4447,7 @@ subroutine barotropic_end(CS) DEALLOC_(CS%frhatu) ; DEALLOC_(CS%frhatv) DEALLOC_(CS%IDatu) ; DEALLOC_(CS%IDatv) DEALLOC_(CS%ubtav) ; DEALLOC_(CS%vbtav) - DEALLOC_(CS%eta_cor) ; DEALLOC_(CS%eta_source) + DEALLOC_(CS%eta_cor) DEALLOC_(CS%ua_polarity) ; DEALLOC_(CS%va_polarity) if (CS%bound_BT_corr) then DEALLOC_(CS%eta_cor_bound) diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index abcfcc8807..8d94bc12ea 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -14,7 +14,7 @@ module MOM_boundary_update use MOM_open_boundary, only : OBC_registry_type, file_OBC_CS use MOM_open_boundary, only : register_file_OBC, file_OBC_end use MOM_verticalGrid, only : verticalGrid_type -use MOM_tracer_registry, only : add_tracer_OBC_values, tracer_registry_type +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use tidal_bay_initialization, only : tidal_bay_set_OBC_data, register_tidal_bay_OBC use tidal_bay_initialization, only : tidal_bay_OBC_end, tidal_bay_OBC_CS diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 90d7646679..f1f0ed9733 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -9,13 +9,13 @@ module MOM_checksum_packages use MOM_domains, only : sum_across_PEs, min_across_PEs, max_across_PEs use MOM_error_handler, only : MOM_mesg, is_root_pe use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs +use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type implicit none ; private public MOM_state_chksum, MOM_thermo_chksum, MOM_accel_chksum -public MOM_state_stats +public MOM_state_stats, MOM_surface_chksum interface MOM_state_chksum module procedure MOM_state_chksum_5arg @@ -138,6 +138,39 @@ end subroutine MOM_thermo_chksum ! ============================================================================= +subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + type(surface), intent(inout) :: sfc !< transparent ocean surface state + !! structure shared with the calling routine; + !! data in this structure is intent out. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: haloshift + logical, optional, intent(in) :: symmetric +! This subroutine writes out chksums for the model's thermodynamic state +! variables. +! Arguments: mesg - A message that appears on the chksum lines. +! (in) tv - A structure containing pointers to any thermodynamic +! fields that are in use. +! (in) G - The ocean's grid structure. + integer :: hs + logical :: sym + + sym = .false. ; if (present(symmetric)) sym = symmetric + hs = 1 ; if (present(haloshift)) hs = haloshift + + if (allocated(sfc%SST)) call hchksum(sfc%SST, mesg//" SST",G%HI,haloshift=hs) + if (allocated(sfc%SSS)) call hchksum(sfc%SSS, mesg//" SSS",G%HI,haloshift=hs) + if (allocated(sfc%sea_lev)) call hchksum(sfc%sea_lev, mesg//" sea_lev",G%HI,haloshift=hs) + if (allocated(sfc%Hml)) call hchksum(sfc%Hml, mesg//" Hml",G%HI,haloshift=hs) + if (allocated(sfc%u) .and. allocated(sfc%v)) & + call uvchksum(mesg//" SSU", sfc%u, sfc%v, G%HI, haloshift=hs, symmetric=sym) +! if (allocated(sfc%salt_deficit)) call hchksum(sfc%salt_deficit, mesg//" salt deficit",G%HI,haloshift=hs) + if (associated(sfc%frazil)) call hchksum(sfc%frazil, mesg//" frazil",G%HI,haloshift=hs) + +end subroutine MOM_surface_chksum + +! ============================================================================= + subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, & u_accel_bt, v_accel_bt, symmetric) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f24e8d068c..9615c8bab6 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -203,7 +203,7 @@ module MOM_dynamics_split_RK2 !> RK2 splitting for time stepping MOM adiabatic dynamics subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & - dt_since_flux, dt_therm, uh, vh, uhtr, vhtr, eta_av, & + uh, vh, uhtr, vhtr, eta_av, & G, GV, CS, calc_dtbt, VarMix, MEKE) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -217,8 +217,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic time step (Pa) real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic time step (Pa) - real, intent(in) :: dt_since_flux !< elapsed time since fluxes were applied (sec) - real, intent(in) :: dt_therm !< thermodynamic time step (sec) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulatated zonal volume/mass transport since last tracer advection (m3 or kg) @@ -463,8 +461,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! Calculate the relative layer weights for determining barotropic quantities. if (.not.BT_cont_BT_thick) & call btcalc(h, G, GV, CS%barotropic_CSp, OBC=CS%OBC) - call bt_mass_source(h, eta, forces, .true., dt_therm, dt_since_flux, & - G, GV, CS%barotropic_CSp) + call bt_mass_source(h, eta, .true., G, GV, CS%barotropic_CSp) call cpu_clock_end(id_clock_btcalc) if (G%nonblocking_updates) & @@ -603,8 +600,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! hp can be changed if CS%begw /= 0. ! eta_cor = ... (hidden inside CS%barotropic_CSp) call cpu_clock_begin(id_clock_btcalc) - call bt_mass_source(hp, eta_pred, forces, .false., dt_therm, & - dt_since_flux+dt, G, GV, CS%barotropic_CSp) + call bt_mass_source(hp, eta_pred, .false., G, GV, CS%barotropic_CSp) call cpu_clock_end(id_clock_btcalc) if (CS%begw /= 0.0) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1b99905538..aa3bb15dc5 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -45,96 +45,100 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale (m/s) - ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness (m/s) + ustar => NULL(), & !< surface friction velocity scale (m/s) + ustar_gustless => NULL() !< surface friction velocity scale without any + !! any augmentation for gustiness (m/s) - ! surface buoyancy force + ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & - buoy => NULL() !< buoyancy flux (m^2/s^3) + buoy => NULL() !< buoyancy flux (m^2/s^3) ! radiative heat fluxes into the ocean (W/m^2) real, pointer, dimension(:,:) :: & - sw => NULL(), & !< shortwave (W/m^2) - sw_vis_dir => NULL(), & !< visible, direct shortwave (W/m^2) - sw_vis_dif => NULL(), & !< visible, diffuse shortwave (W/m^2) - sw_nir_dir => NULL(), & !< near-IR, direct shortwave (W/m^2) - sw_nir_dif => NULL(), & !< near-IR, diffuse shortwave (W/m^2) - lw => NULL() !< longwave (W/m^2) (typically negative) + sw => NULL(), & !< shortwave (W/m^2) + sw_vis_dir => NULL(), & !< visible, direct shortwave (W/m^2) + sw_vis_dif => NULL(), & !< visible, diffuse shortwave (W/m^2) + sw_nir_dir => NULL(), & !< near-IR, direct shortwave (W/m^2) + sw_nir_dif => NULL(), & !< near-IR, diffuse shortwave (W/m^2) + lw => NULL() !< longwave (W/m^2) (typically negative) ! turbulent heat fluxes into the ocean (W/m^2) real, pointer, dimension(:,:) :: & - latent => NULL(), & !< latent (W/m^2) (typically < 0) - sens => NULL(), & !< sensible (W/m^2) (typically negative) - heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments (W/m^2) + latent => NULL(), & !< latent (W/m^2) (typically < 0) + sens => NULL(), & !< sensible (W/m^2) (typically negative) + heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments (W/m^2) ! components of latent heat fluxes used for diagnostic purposes real, pointer, dimension(:,:) :: & - latent_evap_diag => NULL(), & !< latent (W/m^2) from evaporating liquid water (typically < 0) - latent_fprec_diag => NULL(), & !< latent (W/m^2) from melting fprec (typically < 0) - latent_frunoff_diag => NULL() !< latent (W/m^2) from melting frunoff (calving) (typically < 0) + latent_evap_diag => NULL(), & !< latent (W/m^2) from evaporating liquid water (typically < 0) + latent_fprec_diag => NULL(), & !< latent (W/m^2) from melting fprec (typically < 0) + latent_frunoff_diag => NULL() !< latent (W/m^2) from melting frunoff (calving) (typically < 0) ! water mass fluxes into the ocean ( kg/(m^2 s) ); these fluxes impact the ocean mass real, pointer, dimension(:,:) :: & - evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean ( kg/(m^2 s) ) - lprec => NULL(), & !< precipitating liquid water into the ocean ( kg/(m^2 s) ) - fprec => NULL(), & !< precipitating frozen water into the ocean ( kg/(m^2 s) ) - vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring ( kg/(m^2 s) ) - lrunoff => NULL(), & !< liquid river runoff entering ocean ( kg/(m^2 s) ) - frunoff => NULL(), & !< frozen river runoff (calving) entering ocean ( kg/(m^2 s) ) - seaice_melt => NULL(), & !< seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) - netMassIn => NULL(), & !< Sum of water mass flux out of the ocean ( kg/(m^2 s) ) - netMassOut => NULL(), & !< Net water mass flux into of the ocean ( kg/(m^2 s) ) - netSalt => NULL() !< Net salt entering the ocean + evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean ( kg/(m^2 s) ) + lprec => NULL(), & !< precipitating liquid water into the ocean ( kg/(m^2 s) ) + fprec => NULL(), & !< precipitating frozen water into the ocean ( kg/(m^2 s) ) + vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring ( kg/(m^2 s) ) + lrunoff => NULL(), & !< liquid river runoff entering ocean ( kg/(m^2 s) ) + frunoff => NULL(), & !< frozen river runoff (calving) entering ocean ( kg/(m^2 s) ) + seaice_melt => NULL(), & !< seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) + netMassIn => NULL(), & !< Sum of water mass flux out of the ocean ( kg/(m^2 s) ) + netMassOut => NULL(), & !< Net water mass flux into of the ocean ( kg/(m^2 s) ) + netSalt => NULL() !< Net salt entering the ocean ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & - heat_content_cond => NULL(), & !< heat content associated with condensating water (W/m^2) - heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip (W/m^2) (diagnostic) - heat_content_fprec => NULL(), & !< heat content associated with frozen precip (W/m^2) - heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip (W/m^2) - heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff (W/m^2) - heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff (W/m^2) - heat_content_icemelt => NULL(), & !< heat content associated with liquid sea ice (W/m^2) - heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean (W/m^2) - heat_content_massin => NULL() !< heat content associated with mass entering ocean (W/m^2) + heat_content_cond => NULL(), & !< heat content associated with condensating water (W/m^2) + heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip (W/m^2) (diagnostic) + heat_content_fprec => NULL(), & !< heat content associated with frozen precip (W/m^2) + heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip (W/m^2) + heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff (W/m^2) + heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff (W/m^2) + heat_content_icemelt => NULL(), & !< heat content associated with liquid sea ice (W/m^2) + heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean (W/m^2) + heat_content_massin => NULL() !< heat content associated with mass entering ocean (W/m^2) ! salt mass flux (contributes to ocean mass only if non-Bouss ) real, pointer, dimension(:,:) :: & - salt_flux => NULL(), & !< net salt flux into the ocean ( kg salt/(m^2 s) ) - salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler ( kg salt/(m^2 s) ) - salt_flux_added => NULL() !< additional salt flux from restoring or flux adjustment before adjustment + salt_flux => NULL(), & !< net salt flux into the ocean ( kg salt/(m^2 s) ) + salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler ( kg salt/(m^2 s) ) + salt_flux_added => NULL() !< additional salt flux from restoring or flux adjustment before adjustment !! to net zero ( kg salt/(m^2 s) ) ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: & - p_surf_full => NULL(), & !< Pressure at the top ocean interface (Pa). - !! if there is sea-ice, then p_surf_flux is at ice-ocean interface - p_surf => NULL() !< Pressure at the top ocean interface (Pa) as used - !! to drive the ocean model. If p_surf is limited, - !! p_surf may be smaller than p_surf_full, - !! otherwise they are the same. + p_surf_full => NULL(), & !< Pressure at the top ocean interface (Pa). + !! if there is sea-ice, then p_surf_flux is at ice-ocean interface + p_surf => NULL(), & !< Pressure at the top ocean interface (Pa) as used + !! to drive the ocean model. If p_surf is limited, + !! p_surf may be smaller than p_surf_full, + !! otherwise they are the same. + p_surf_SSH => NULL() !< Pressure at the top ocean interface that is used + !! in corrections to the sea surface height field + !! that is passed back to the calling routines. + !! This may point to p_surf or to p_surf_full. ! tide related inputs real, pointer, dimension(:,:) :: & - TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer (W/m^2) - ustar_tidal => NULL() !< tidal contribution to bottom ustar (m/s) + TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer (W/m^2) + ustar_tidal => NULL() !< tidal contribution to bottom ustar (m/s) ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(),& !< iceberg contribution to top ustar (m/s) - area_berg => NULL(),& !< area of ocean surface covered by icebergs (m2/m2) - mass_berg => NULL() !< mass of icebergs (kg/m2) + ustar_berg => NULL(), & !< iceberg contribution to top ustar (m/s) + area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) + mass_berg => NULL() !< mass of icebergs (kg/m2) ! land ice-shelf related inputs real, pointer, dimension(:,:) :: & - ustar_shelf => NULL(), & !< friction velocity under ice-shelves (m/s) - !! as computed by the ocean at the previous time step. - frac_shelf_h => NULL(), & !! Fractional ice shelf coverage of h-cells, nondimensional - !! cells, nondimensional from 0 to 1. This is only - !! associated if ice shelves are enabled, and are - !! exactly 0 away from shelves or on land. - iceshelf_melt => NULL() !< ice shelf melt rate (positive) or freezing (negative) ( m/year ) + ustar_shelf => NULL(), & !< friction velocity under ice-shelves (m/s) + !! as computed by the ocean at the previous time step. + frac_shelf_h => NULL(), & !! Fractional ice shelf coverage of h-cells, nondimensional + !! cells, nondimensional from 0 to 1. This is only + !! associated if ice shelves are enabled, and are + !! exactly 0 away from shelves or on land. + iceshelf_melt => NULL() !< ice shelf melt rate (positive) or freezing (negative) ( m/year ) ! Scalars set by surface forcing modules real :: vPrecGlobalAdj !< adjustment to restoring vprec to zero out global net ( kg/(m^2 s) ) @@ -1884,6 +1888,12 @@ subroutine copy_common_forcing_fields(forces, fluxes, G) enddo ; enddo endif + if (associated(forces%p_surf_SSH, forces%p_surf_full)) then + fluxes%p_surf_SSH => fluxes%p_surf_full + elseif (associated(forces%p_surf_SSH, forces%p_surf)) then + fluxes%p_surf_SSH => fluxes%p_surf + endif + end subroutine copy_common_forcing_fields diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 23916fad73..10754ff749 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -40,7 +40,7 @@ module MOM_open_boundary public open_boundary_impose_land_mask public radiation_open_bdry_conds public set_tracer_data -public update_obc_segment_data +public update_OBC_segment_data public open_boundary_test_extern_uv public open_boundary_test_extern_h public open_boundary_zero_normal_flow @@ -2407,7 +2407,7 @@ subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(vardesc), intent(in) :: tr_desc !< metadata about the tracer type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values - type(OBC_segment_type), intent(inout) :: segment !< current segment data structure + type(OBC_segment_type), intent(inout) :: segment !< current segment data structure type(vardesc), target, optional :: tr_desc_ptr !< A target that can be used to set a pointer to the !! stored value of tr%tr_desc. This target must be !! an enduring part of the control structure, diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 9adf55fda6..f0f3437f4b 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -8,13 +8,14 @@ module MOM_variables use MOM_grid, only : ocean_grid_type use MOM_EOS, only : EOS_type -use coupler_types_mod, only : coupler_2d_bc_type +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn, coupler_type_destructor implicit none ; private #include -public MOM_thermovar_chksum +public allocate_surface_state, deallocate_surface_state, MOM_thermovar_chksum public ocean_grid_type, alloc_BT_cont_type, dealloc_BT_cont_type type, public :: p3d @@ -269,6 +270,89 @@ module MOM_variables contains + +!> This subroutine allocates the fields for the surface (return) properties of +!! the ocean model. Unused fields are unallocated. +subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & + gas_fields_ocn) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. + logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. + logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically integrated fields. + type(coupler_1d_bc_type), & + optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean + !! ocean and surface-ice fields that will participate + !! in the calculation of additional gas or other + !! tracer fluxes, and can be used to spawn related + !! internal variables in the ice model. + + logical :: use_temp, alloc_integ + integer :: is, ie, js, je, isd, ied, jsd, jed + integer :: isdB, iedB, jsdB, jedB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + isdB = G%isdB ; iedB = G%iedB; jsdB = G%jsdB ; jedB = G%jedB + + use_temp = .true. ; if (present(use_temperature)) use_temp = use_temperature + alloc_integ = .true. ; if (present(do_integrals)) alloc_integ = do_integrals + + if (sfc_state%arrays_allocated) return + + if (use_temp) then + allocate(sfc_state%SST(isd:ied,jsd:jed)) ; sfc_state%SST(:,:) = 0.0 + allocate(sfc_state%SSS(isd:ied,jsd:jed)) ; sfc_state%SSS(:,:) = 0.0 + else + allocate(sfc_state%sfc_density(isd:ied,jsd:jed)) ; sfc_state%sfc_density(:,:) = 0.0 + endif + allocate(sfc_state%sea_lev(isd:ied,jsd:jed)) ; sfc_state%sea_lev(:,:) = 0.0 + allocate(sfc_state%Hml(isd:ied,jsd:jed)) ; sfc_state%Hml(:,:) = 0.0 + allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0 + allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0 + + if (alloc_integ) then + ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, + ! and ocean_salt. + allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0 + if (use_temp) then + allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 + allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0 + endif + allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 + endif + + if (present(gas_fields_ocn)) & + call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, & + (/isd,is,ie,ied/), (/jsd,js,je,jed/), as_needed=.true.) + + sfc_state%arrays_allocated = .true. + +end subroutine allocate_surface_state + +!> This subroutine deallocates the elements of a surface state type. +subroutine deallocate_surface_state(sfc_state) + type(surface), intent(inout) :: sfc_state !< ocean surface state type to be deallocated. + + if (.not.sfc_state%arrays_allocated) return + + if (allocated(sfc_state%SST)) deallocate(sfc_state%SST) + if (allocated(sfc_state%SSS)) deallocate(sfc_state%SSS) + if (allocated(sfc_state%sfc_density)) deallocate(sfc_state%sfc_density) + if (allocated(sfc_state%sea_lev)) deallocate(sfc_state%sea_lev) + if (allocated(sfc_state%Hml)) deallocate(sfc_state%Hml) + if (allocated(sfc_state%u)) deallocate(sfc_state%u) + if (allocated(sfc_state%v)) deallocate(sfc_state%v) + if (allocated(sfc_state%ocean_mass)) deallocate(sfc_state%ocean_mass) + if (allocated(sfc_state%ocean_heat)) deallocate(sfc_state%ocean_heat) + if (allocated(sfc_state%ocean_salt)) deallocate(sfc_state%ocean_salt) + if (allocated(sfc_state%salt_deficit)) deallocate(sfc_state%salt_deficit) + + call coupler_type_destructor(sfc_state%tr_fields) + + sfc_state%arrays_allocated = .false. + +end subroutine deallocate_surface_state + !> alloc_BT_cont_type allocates the arrays contained within a BT_cont_type and !! initializes them to 0. subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e5b1688060..1ea31011cb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -27,8 +27,12 @@ module MOM_diagnostics use MOM_coms, only : reproducing_sum use MOM_diag_mediator, only : post_data, post_data_1d_k, get_diag_time_end use MOM_diag_mediator, only : register_diag_field, register_scalar_field +use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr use MOM_diag_mediator, only : diag_get_volume_cell_measure_dm_id +use MOM_diag_mediator, only : diag_grid_storage +use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids, diag_copy_storage_to_diag +use MOM_diag_to_Z, only : calculate_Z_transport, diag_to_Z_CS use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : To_North, To_East use MOM_EOS, only : calculate_density, int_density_dz @@ -40,9 +44,10 @@ module MOM_diagnostics use MOM_interface_heights, only : find_eta use MOM_spatial_means, only : global_area_mean, global_layer_mean use MOM_spatial_means, only : global_volume_mean, global_area_integral +use MOM_tracer_registry, only : tracer_registry_type, post_tracer_transport_diagnostics use MOM_variables, only : thermo_var_ptrs, ocean_internal_state, p3d use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, surface -use MOM_verticalGrid, only : verticalGrid_type +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speed, wave_speed_CS, wave_speed_init use coupler_types_mod, only : coupler_type_send_data @@ -50,11 +55,11 @@ module MOM_diagnostics #include -public calculate_diagnostic_fields -public register_time_deriv +public calculate_diagnostic_fields, register_time_deriv, write_static_fields public find_eta public MOM_diagnostics_init, MOM_diagnostics_end public register_surface_diags, post_surface_diagnostics +public register_transport_diags, post_transport_diagnostics type, public :: diagnostics_CS ; private real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as @@ -110,6 +115,7 @@ module MOM_diagnostics KE_dia => NULL() ! KE source from diapycnal diffusion ! diagnostic IDs + integer :: id_u = -1, id_v = -1, id_h = -1 integer :: id_e = -1, id_e_D = -1 integer :: id_du_dt = -1, id_dv_dt = -1 integer :: id_col_ht = -1, id_dh_dt = -1 @@ -137,7 +143,7 @@ module MOM_diagnostics integer :: id_pbo = -1 integer :: id_thkcello = -1, id_rhoinsitu = -1 integer :: id_rhopot0 = -1, id_rhopot2 = -1 - + integer :: id_h_pre_sync = -1 type(wave_speed_CS), pointer :: wave_speed_CSp => NULL() ! pointers used in calculation of time derivatives @@ -156,20 +162,12 @@ module MOM_diagnostics !> A structure with diagnostic IDs of the surface and integrated variables type, public :: surface_diag_IDs ; private ! 2-d surface and bottom fields - integer :: id_zos = -1 - integer :: id_zossq = -1 - integer :: id_volo = -1 - integer :: id_ssh = -1 - integer :: id_ssh_ga = -1 - integer :: id_sst = -1 - integer :: id_sst_sq = -1 - integer :: id_sss = -1 - integer :: id_sss_sq = -1 - integer :: id_ssu = -1 - integer :: id_ssv = -1 - integer :: id_speed = -1 - integer :: id_sstcon = -1 - integer :: id_sssabs = -1 + integer :: id_zos = -1, id_zossq = -1 + integer :: id_volo = -1, id_speed = -1 + integer :: id_ssh = -1, id_ssh_ga = -1 + integer :: id_sst = -1, id_sst_sq = -1, id_sstcon = -1 + integer :: id_sss = -1, id_sss_sq = -1, id_sssabs = -1 + integer :: id_ssu = -1, id_ssv = -1 ! heat and salt flux fields integer :: id_fraz = -1 @@ -179,10 +177,20 @@ module MOM_diagnostics end type surface_diag_IDs +!> A structure with diagnostic IDs of mass transport related diagnostics +type, public :: transport_diag_IDs ; private + ! Diagnostics for tracer horizontal transport + integer :: id_uhtr = -1, id_umo = -1, id_umo_2d = -1 + integer :: id_vhtr = -1, id_vmo = -1, id_vmo_2d = -1 + integer :: id_dynamics_h = -1, id_dynamics_h_tendency = -1 + +end type transport_diag_IDs + + contains !> Diagnostics not more naturally calculated elsewhere are computed here. subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & - dt, G, GV, CS, eta_bt) + dt, diag_pre_sync, G, GV, CS, eta_bt) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -210,6 +218,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & real, intent(in) :: dt !< The time difference in s since !! the last call to this !! subroutine. + + type(diag_grid_storage), intent(in) :: diag_pre_sync + !< Target grids from previous + !! timestep type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by !! a previous call to !! diagnostics_init. @@ -250,6 +262,24 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = G%ke ; nkmb = GV%nk_rho_varies + if (dt > 0.0) then + call diag_save_grids(CS%diag) + call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) + + if (CS%id_h_pre_sync > 0) & + call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h = diag_pre_sync%h_state) + + if (CS%id_du_dt>0) call post_data(CS%id_du_dt, CS%du_dt, CS%diag, alt_h = diag_pre_sync%h_state) + + if (CS%id_dv_dt>0) call post_data(CS%id_dv_dt, CS%dv_dt, CS%diag, alt_h = diag_pre_sync%h_state) + + if (CS%id_dh_dt>0) call post_data(CS%id_dh_dt, CS%dh_dt, CS%diag, alt_h = diag_pre_sync%h_state) + + call diag_restore_grids(CS%diag) + + call calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) + endif + ! smg: is the following robust to ALE? It seems a bit opaque. ! If the model is NOT in isopycnal mode then nkmb=0. But we need all the ! following diagnostics to treat all layers as variable density, so we set @@ -263,6 +293,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & call calculate_derivs(dt, G, CS) + if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) + + if (CS%id_v > 0) call post_data(CS%id_v, v, CS%diag) + + if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) + if (ASSOCIATED(CS%e)) then call find_eta(h, tv, GV%g_Earth, G, GV, CS%e, eta_bt) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) @@ -658,16 +694,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & endif endif - if (dt > 0.0) then - if (CS%id_du_dt>0) call post_data(CS%id_du_dt, CS%du_dt, CS%diag) - - if (CS%id_dv_dt>0) call post_data(CS%id_dv_dt, CS%dv_dt, CS%diag) - - if (CS%id_dh_dt>0) call post_data(CS%id_dh_dt, CS%dh_dt, CS%diag) - - call calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) - endif - end subroutine calculate_diagnostic_fields !> This subroutine finds location of R_in in an increasing ordered @@ -1144,7 +1170,8 @@ end subroutine calculate_derivs !> This routine posts diagnostics of various ocean surface and integrated !! quantities at the time the ocean state is reported back to the caller -subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, ssh, fluxes) +subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & + ssh, ssh_ibc) type(surface_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1153,9 +1180,11 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, ssh type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without - !! corrections for ice displacement(m) - type(forcing), intent(in) :: fluxes !< pointers to forcing fields + intent(in) :: ssh !< Time mean surface height without corrections for + !! ice displacement (m) + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: ssh_ibc !< Time mean surface height with corrections for + !! ice displacement and the inverse barometer (m) real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1182,14 +1211,8 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, ssh if (IDs%id_zos > 0 .or. IDs%id_zossq > 0) then zos(:,:) = 0.0 do j=js,je ; do i=is,ie - zos(i,j) = ssh(i,j) + zos(i,j) = ssh_ibc(i,j) enddo ; enddo - if (ASSOCIATED(fluxes%p_surf)) then - do j=js,je ; do i=is,ie - zos(i,j) = zos(i,j) + G%mask2dT(i,j)*fluxes%p_surf(i,j) / & - (GV%Rho0 * GV%g_Earth) - enddo ; enddo - endif zos_area_mean = global_area_mean(zos, G) do j=js,je ; do i=is,ie zos(i,j) = zos(i,j) - G%mask2dT(i,j)*zos_area_mean @@ -1302,6 +1325,91 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, ssh end subroutine post_surface_diagnostics +!> This routine posts diagnostics of the transports, including the subgridscale +!! contributions. +subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, diag_to_Z_CSp, Reg) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: uhtr !< Accumulated zonal thickness fluxes used + !! to advect tracers (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: vhtr !< Accumulated meridional thickness fluxes + !! used to advect tracers (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< The updated layer thicknesses, in H + type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. + type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics + type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output + real, intent(in) :: dt_trans !< total time step associated with the transports, in s. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A control structure for remapping + !! the transports to depth space + type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry + + real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport, in kg s-1 + real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport, in kg s-1 + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)) :: umo ! Diagnostics of layer mass transport, in kg s-1 + real, dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo ! Diagnostics of layer mass transport, in kg s-1 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tend ! Change in layer thickness due to dynamics m s-1 + real :: Idt + real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes, in kg m-2 H-1 s-1. + integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + Idt = 1. / dt_trans + H_to_kg_m2_dt = GV%H_to_kg_m2 * Idt + + call calculate_Z_transport(uhtr, vhtr, h, dt_trans, G, GV, diag_to_Z_CSp) + + call diag_save_grids(diag) + call diag_copy_storage_to_diag(diag, diag_pre_dyn) + + if (IDs%id_umo_2d > 0) then + umo2d(:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=is-1,ie + umo2d(I,j) = umo2d(I,j) + uhtr(I,j,k) * H_to_kg_m2_dt + enddo ; enddo ; enddo + call post_data(IDs%id_umo_2d, umo2d, diag) + endif + if (IDs%id_umo > 0) then + ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + do k=1,nz ; do j=js,je ; do I=is-1,ie + umo(I,j,k) = uhtr(I,j,k) * H_to_kg_m2_dt + enddo ; enddo ; enddo + call post_data(IDs%id_umo, umo, diag, alt_h = diag_pre_dyn%h_state) + endif + if (IDs%id_vmo_2d > 0) then + vmo2d(:,:) = 0.0 + do k=1,nz ; do J=js-1,je ; do i=is,ie + vmo2d(i,J) = vmo2d(i,J) + vhtr(i,J,k) * H_to_kg_m2_dt + enddo ; enddo ; enddo + call post_data(IDs%id_vmo_2d, vmo2d, diag) + endif + if (IDs%id_vmo > 0) then + ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + do k=1,nz ; do J=js-1,je ; do i=is,ie + vmo(i,J,k) = vhtr(i,J,k) * H_to_kg_m2_dt + enddo ; enddo ; enddo + call post_data(IDs%id_vmo, vmo, diag, alt_h = diag_pre_dyn%h_state) + endif + + if (IDs%id_uhtr > 0) call post_data(IDs%id_uhtr, uhtr, diag, alt_h = diag_pre_dyn%h_state) + if (IDs%id_vhtr > 0) call post_data(IDs%id_vhtr, vhtr, diag, alt_h = diag_pre_dyn%h_state) + if (IDs%id_dynamics_h > 0 ) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, alt_h = diag_pre_dyn%h_state) + ! Post the change in thicknesses + if (IDs%id_dynamics_h_tendency > 0) then + h_tend(:,:,:) = 0. + do k=1,nz ; do j=js,je ; do i=is,ie + h_tend(i,j,k) = (h(i,j,k) - diag_pre_dyn%h_state(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(IDs%id_dynamics_h_tendency, h_tend, diag, alt_h = diag_pre_dyn%h_state) + endif + + call post_tracer_transport_diagnostics(G, GV, Reg, diag_pre_dyn%h_state, diag) + + call diag_restore_grids(diag) + +end subroutine post_transport_diagnostics !> This subroutine registers various diagnostics and allocates space for fields !! that other diagnostis depend upon. @@ -1363,7 +1471,6 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS CS%diag => diag use_temperature = ASSOCIATED(tv%T) - ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version) call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_COLUMN_FRACTION", CS%mono_N2_column_fraction, & @@ -1390,6 +1497,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS CS%id_thkcello = register_diag_field('ocean_model', 'thkcello', diag%axesTL, Time, & long_name = 'Cell Thickness', standard_name='cell_thickness', units='m', v_extensive=.true.) + CS%id_h_pre_sync = register_diag_field('ocean_model', 'h_pre_sync', diag%axesTL, Time, & + long_name = 'Cell thickness from the previous timestep', units='m', v_extensive=.true.) ! Note that CS%id_volcello would normally be registered here but because it is a "cell measure" and ! must be registered first. We earlier stored the handle of volcello but need it here for posting @@ -1437,6 +1546,15 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS cmor_long_name='Sea Surface Salinity') endif + CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & + 'Zonal velocity', 'm s-1', cmor_field_name='uo', & + cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') + CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & + 'Meridional velocity', 'm s-1', cmor_field_name='vo', & + cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') + CS%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & + 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) + CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & 'Interface Height Relative to Mean Sea Level', 'm') if (CS%id_e>0) call safe_alloc_ptr(CS%e,isd,ied,jsd,jed,nz+1) @@ -1473,7 +1591,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & - 'Thickness tendency', trim(thickness_units)//" s-1") + 'Thickness tendency', trim(thickness_units)//" s-1", v_extensive = .true.) if ((CS%id_dh_dt>0) .and. .not.ASSOCIATED(CS%dh_dt)) then call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) call register_time_deriv(MIS%h, CS%dh_dt, CS) @@ -1605,12 +1723,11 @@ end subroutine MOM_diagnostics_init !> Register diagnostics of the surface state and integrated quantities -subroutine register_surface_diags(Time, G, IDs, diag, missing, tv) +subroutine register_surface_diags(Time, G, IDs, diag, tv) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real, intent(in) :: missing !< The value to use to fill in missing data type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! Vertically integrated, budget, and surface state diagnostics @@ -1619,46 +1736,46 @@ subroutine register_surface_diags(Time, G, IDs, diag, missing, tv) standard_name='sea_water_volume') IDs%id_zos = register_diag_field('ocean_model', 'zos', diag%axesT1, Time,& standard_name = 'sea_surface_height_above_geoid', & - long_name= 'Sea surface height above geoid', units='m', missing_value=missing) + long_name= 'Sea surface height above geoid', units='m') IDs%id_zossq = register_diag_field('ocean_model', 'zossq', diag%axesT1, Time,& standard_name='square_of_sea_surface_height_above_geoid', & - long_name='Square of sea surface height above geoid', units='m2', missing_value=missing) + long_name='Square of sea surface height above geoid', units='m2') IDs%id_ssh = register_diag_field('ocean_model', 'SSH', diag%axesT1, Time, & - 'Sea Surface Height', 'm', missing) + 'Sea Surface Height', 'm') IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag,& long_name='Area averaged sea surface height', units='m', & standard_name='area_averaged_sea_surface_height') IDs%id_ssu = register_diag_field('ocean_model', 'SSU', diag%axesCu1, Time, & - 'Sea Surface Zonal Velocity', 'm s-1', missing) + 'Sea Surface Zonal Velocity', 'm s-1') IDs%id_ssv = register_diag_field('ocean_model', 'SSV', diag%axesCv1, Time, & - 'Sea Surface Meridional Velocity', 'm s-1', missing) + 'Sea Surface Meridional Velocity', 'm s-1') IDs%id_speed = register_diag_field('ocean_model', 'speed', diag%axesT1, Time, & - 'Sea Surface Speed', 'm s-1', missing) + 'Sea Surface Speed', 'm s-1') if (associated(tv%T)) then IDs%id_sst = register_diag_field('ocean_model', 'SST', diag%axesT1, Time, & - 'Sea Surface Temperature', 'degC', missing, cmor_field_name='tos', & + 'Sea Surface Temperature', 'degC', cmor_field_name='tos', & cmor_long_name='Sea Surface Temperature', & cmor_standard_name='sea_surface_temperature') IDs%id_sst_sq = register_diag_field('ocean_model', 'SST_sq', diag%axesT1, Time, & - 'Sea Surface Temperature Squared', 'degC2', missing, cmor_field_name='tossq', & + 'Sea Surface Temperature Squared', 'degC2', cmor_field_name='tossq', & cmor_long_name='Square of Sea Surface Temperature ', & cmor_standard_name='square_of_sea_surface_temperature') IDs%id_sss = register_diag_field('ocean_model', 'SSS', diag%axesT1, Time, & - 'Sea Surface Salinity', 'psu', missing, cmor_field_name='sos', & + 'Sea Surface Salinity', 'psu', cmor_field_name='sos', & cmor_long_name='Sea Surface Salinity', & cmor_standard_name='sea_surface_salinity') IDs%id_sss_sq = register_diag_field('ocean_model', 'SSS_sq', diag%axesT1, Time, & - 'Sea Surface Salinity Squared', 'psu', missing, cmor_field_name='sossq', & + 'Sea Surface Salinity Squared', 'psu', cmor_field_name='sossq', & cmor_long_name='Square of Sea Surface Salinity ', & cmor_standard_name='square_of_sea_surface_salinity') if (tv%T_is_conT) then IDs%id_sstcon = register_diag_field('ocean_model', 'conSST', diag%axesT1, Time, & - 'Sea Surface Conservative Temperature', 'Celsius', missing) + 'Sea Surface Conservative Temperature', 'Celsius') endif if (tv%S_is_absS) then IDs%id_sssabs = register_diag_field('ocean_model', 'absSSS', diag%axesT1, Time, & - 'Sea Surface Absolute Salinity', 'g kg-1', missing) + 'Sea Surface Absolute Salinity', 'g kg-1') endif if (ASSOCIATED(tv%frazil)) then IDs%id_fraz = register_diag_field('ocean_model', 'frazil', diag%axesT1, Time, & @@ -1677,6 +1794,221 @@ subroutine register_surface_diags(Time, G, IDs, diag, missing, tv) end subroutine register_surface_diags +!> Register certain diagnostics related to transports +subroutine register_transport_diags(Time, G, GV, 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(transport_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 related to tracer and mass transport + IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & + 'Accumulated zonal thickness fluxes to advect tracers', 'kg', & + y_cell_method='sum', v_extensive=.true., conversion=H_convert) + IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg', & + x_cell_method='sum', v_extensive=.true., conversion=H_convert) + IDs%id_umo = register_diag_field('ocean_model', 'umo', & + diag%axesCuL, Time, 'Ocean Mass X Transport', 'kg s-1', & + standard_name='ocean_mass_x_transport', y_cell_method='sum', v_extensive=.true.) + IDs%id_vmo = register_diag_field('ocean_model', 'vmo', & + diag%axesCvL, Time, 'Ocean Mass Y Transport', 'kg s-1', & + standard_name='ocean_mass_y_transport', x_cell_method='sum', v_extensive=.true.) + IDs%id_umo_2d = register_diag_field('ocean_model', 'umo_2d', & + diag%axesCu1, Time, 'Ocean Mass X Transport Vertical Sum', 'kg s-1', & + standard_name='ocean_mass_x_transport_vertical_sum', y_cell_method='sum') + IDs%id_vmo_2d = register_diag_field('ocean_model', 'vmo_2d', & + diag%axesCv1, Time, 'Ocean Mass Y Transport Vertical Sum', 'kg s-1', & + standard_name='ocean_mass_y_transport_vertical_sum', x_cell_method='sum') + IDs%id_dynamics_h = register_diag_field('ocean_model','dynamics_h', & + diag%axesTl, Time, 'Change in layer thicknesses due to horizontal dynamics', & + 'm s-1', v_extensive = .true.) + IDs%id_dynamics_h_tendency = register_diag_field('ocean_model','dynamics_h_tendency', & + diag%axesTl, Time, 'Change in layer thicknesses due to horizontal dynamics', & + 'm s-1', v_extensive = .true.) + +end subroutine register_transport_diags + +!> Offers the static fields in the ocean grid type for output via the diag_manager. +subroutine write_static_fields(G, GV, tv, diag) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output + ! Local variables + real :: tmp_h(SZI_(G),SZJ_(G)) + integer :: id, i, j + + id = register_static_field('ocean_model', 'geolat', diag%axesT1, & + 'Latitude of tracer (T) points', 'degrees_north') + if (id > 0) call post_data(id, G%geoLatT, diag, .true.) + + id = register_static_field('ocean_model', 'geolon', diag%axesT1, & + 'Longitude of tracer (T) points', 'degrees_east') + if (id > 0) call post_data(id, G%geoLonT, diag, .true.) + + id = register_static_field('ocean_model', 'geolat_c', diag%axesB1, & + 'Latitude of corner (Bu) points', 'degrees_north', interp_method='none') + if (id > 0) call post_data(id, G%geoLatBu, diag, .true.) + + id = register_static_field('ocean_model', 'geolon_c', diag%axesB1, & + 'Longitude of corner (Bu) points', 'degrees_east', interp_method='none') + if (id > 0) call post_data(id, G%geoLonBu, diag, .true.) + + id = register_static_field('ocean_model', 'geolat_v', diag%axesCv1, & + 'Latitude of meridional velocity (Cv) points', 'degrees_north', interp_method='none') + if (id > 0) call post_data(id, G%geoLatCv, diag, .true.) + + id = register_static_field('ocean_model', 'geolon_v', diag%axesCv1, & + 'Longitude of meridional velocity (Cv) points', 'degrees_east', interp_method='none') + if (id > 0) call post_data(id, G%geoLonCv, diag, .true.) + + id = register_static_field('ocean_model', 'geolat_u', diag%axesCu1, & + 'Latitude of zonal velocity (Cu) points', 'degrees_north', interp_method='none') + if (id > 0) call post_data(id, G%geoLatCu, diag, .true.) + + id = register_static_field('ocean_model', 'geolon_u', diag%axesCu1, & + 'Longitude of zonal velocity (Cu) points', 'degrees_east', interp_method='none') + if (id > 0) call post_data(id, G%geoLonCu, diag, .true.) + + id = register_static_field('ocean_model', 'area_t', diag%axesT1, & + 'Surface area of tracer (T) cells', 'm2', & + cmor_field_name='areacello', cmor_standard_name='cell_area', & + cmor_long_name='Ocean Grid-Cell Area', & + x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') + if (id > 0) then + call post_data(id, G%areaT, diag, .true.) + call diag_register_area_ids(diag, id_area_t=id) + endif + + id = register_static_field('ocean_model', 'area_u', diag%axesCu1, & + 'Surface area of x-direction flow (U) cells', 'm2', & + cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & + cmor_long_name='Ocean Grid-Cell Area', & + x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') + if (id > 0) then + call post_data(id, G%areaCu, diag, .true.) + endif + + id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & + 'Surface area of y-direction flow (V) cells', 'm2', & + cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & + cmor_long_name='Ocean Grid-Cell Area', & + x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') + if (id > 0) then + call post_data(id, G%areaCv, diag, .true.) + endif + + id = register_static_field('ocean_model', 'area_q', diag%axesB1, & + 'Surface area of B-grid flow (Q) cells', 'm2', & + cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & + cmor_long_name='Ocean Grid-Cell Area', & + x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') + if (id > 0) then + call post_data(id, G%areaBu, diag, .true.) + endif + + id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & + 'Depth of the ocean at tracer points', 'm', & + standard_name='sea_floor_depth_below_geoid', & + cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & + cmor_standard_name='sea_floor_depth_below_geoid',& + area=diag%axesT1%id_area, & + x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') + if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + + id = register_static_field('ocean_model', 'wet', diag%axesT1, & + '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) + if (id > 0) call post_data(id, G%mask2dT, diag, .true.) + + id = register_static_field('ocean_model', 'wet_c', diag%axesB1, & + '0 if land, 1 if ocean at corner (Bu) points', 'none', interp_method='none') + if (id > 0) call post_data(id, G%mask2dBu, diag, .true.) + + id = register_static_field('ocean_model', 'wet_u', diag%axesCu1, & + '0 if land, 1 if ocean at zonal velocity (Cu) points', 'none', interp_method='none') + if (id > 0) call post_data(id, G%mask2dCu, diag, .true.) + + id = register_static_field('ocean_model', 'wet_v', diag%axesCv1, & + '0 if land, 1 if ocean at meridional velocity (Cv) points', 'none', interp_method='none') + if (id > 0) call post_data(id, G%mask2dCv, diag, .true.) + + id = register_static_field('ocean_model', 'Coriolis', diag%axesB1, & + 'Coriolis parameter at corner (Bu) points', 's-1', interp_method='none') + if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) + + id = register_static_field('ocean_model', 'dxt', diag%axesT1, & + 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dxt, diag, .true.) + + id = register_static_field('ocean_model', 'dyt', diag%axesT1, & + 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dyt, diag, .true.) + + id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & + 'Delta(x) at u points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dxCu, diag, .true.) + + id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & + 'Delta(y) at u points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dyCu, diag, .true.) + + id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & + 'Delta(x) at v points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dxCv, diag, .true.) + + id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & + 'Delta(y) at v points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dyCv, diag, .true.) + + id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & + 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dy_Cu, diag, .true.) + + id = register_static_field('ocean_model', 'dxCvo', diag%axesCv1, & + 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') + if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) + + + ! This static diagnostic is from CF 1.8, and is the fraction of a cell + ! covered by ocean, given as a percentage (poorly named). + id = register_static_field('ocean_model', 'area_t_percent', diag%axesT1, & + 'Percentage of cell area covered by ocean', '%', & + cmor_field_name='sftof', cmor_standard_name='SeaAreaFraction', & + cmor_long_name='Sea Area Fraction', & + x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') + if (id > 0) then + tmp_h(:,:) = 0. + tmp_h(G%isc:G%iec,G%jsc:G%jec) = 100. * G%mask2dT(G%isc:G%iec,G%jsc:G%jec) + call post_data(id, tmp_h, diag, .true.) + endif + + id = register_static_field('ocean_model','Rho_0', diag%axesNull, & + 'mean ocean density used with the Boussinesq approximation', & + 'kg m-3', cmor_field_name='rhozero', & + cmor_standard_name='reference_sea_water_density_for_boussinesq_approximation', & + cmor_long_name='reference sea water density for boussinesq approximation') + if (id > 0) call post_data(id, GV%Rho0, diag, .true.) + + id = register_static_field('ocean_model','C_p', diag%axesNull, & + 'heat capacity of sea water', 'J kg-1 K-1', cmor_field_name='cpocean', & + cmor_standard_name='specific_heat_capacity_of_sea_water', & + cmor_long_name='specific_heat_capacity_of_sea_water') + if (id > 0) call post_data(id, tv%C_p, diag, .true.) + +end subroutine write_static_fields + !> This subroutine sets up diagnostics upon which other diagnostics depend. subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) @@ -1745,7 +2077,6 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) end subroutine set_dependent_diagnostics - subroutine MOM_diagnostics_end(CS, ADp) type(diagnostics_CS), pointer :: CS type(accel_diag_ptrs), intent(inout) :: ADp diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index df906c79ab..c548300bb6 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -187,6 +187,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "READJUST_BT_TRANS", .false.) call obsolete_logical(param_file, "RESCALE_BT_FACE_AREAS", .false.) call obsolete_logical(param_file, "APPLY_BT_DRAG", .true.) + call obsolete_real(param_file, "BT_MASS_SOURCE_LIMIT", 0.0) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 9ff9410f49..aff6a36713 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -451,7 +451,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc return ! Do not write this step else ! Determine the next write time before proceeding if (CS%energysave_geometric) then - CS%energysavedays_geometric = CS%energysavedays_geometric*2 if (CS%write_energy_time + CS%energysavedays_geometric >= & CS%geometric_end_time) then CS%write_energy_time = CS%geometric_end_time @@ -459,6 +458,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc else CS%write_energy_time = CS%write_energy_time + CS%energysavedays_geometric endif + CS%energysavedays_geometric = CS%energysavedays_geometric*2 else CS%write_energy_time = CS%write_energy_time + CS%energysavedays endif diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index c8c4deac44..cf2b5adcb3 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -62,6 +62,9 @@ module MOM_diag_mediator public register_cell_measure, diag_associate_volume_cell_measure public diag_get_volume_cell_measure_dm_id public diag_set_state_ptrs, diag_update_remap_grids +public diag_grid_storage_init, diag_grid_storage_end +public diag_copy_diag_to_storage, diag_copy_storage_to_diag +public diag_save_grids, diag_restore_grids interface post_data module procedure post_data_3d, post_data_2d, post_data_0d @@ -104,6 +107,18 @@ module MOM_diag_mediator real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes end type axes_grp +!> Contains an array to store a diagnostic target grid +type, private :: diag_grids_type + real, dimension(:,:,:), allocatable :: h !< Target grid for remapped coordinate +end type diag_grids_type + +!> Stores all the remapping grids and the model's native space thicknesses +type, public :: diag_grid_storage + integer :: num_diag_coords !< Number of target coordinates + real, dimension(:,:,:), allocatable :: h_state !< Layer thicknesses in native space + type(diag_grids_type), dimension(:), allocatable :: diag_grids !< Primarily empty, except h field +end type diag_grid_storage + !> This type is used to represent a diagnostic at the diag_mediator level. !! There can be both 'primary' and 'seconday' diagnostics. The primaries !! reside in the diag_cs%diags array. They have an id which is an index @@ -169,6 +184,8 @@ module MOM_diag_mediator integer :: num_diag_coords !> Control structure for each possible coordinate type(diag_remap_ctrl), dimension(:), allocatable :: diag_remap_cs + type(diag_grid_storage) :: diag_grid_temp !< Stores the remapped diagnostic grid + logical :: diag_grid_overridden = .false. !< True if the diagnostic grids have been overriden !> Axes groups for each possible coordinate (these will all be 3D groups) type(axes_grp), dimension(:), allocatable :: remap_axesZL, remap_axesZi @@ -376,6 +393,8 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) endif enddo + call diag_grid_storage_init(diag_CS%diag_grid_temp, G, diag_CS) + end subroutine set_axes_info !> set_masks_for_axes sets up the 2d and 3d masks for diagnostics using the current grid @@ -2261,6 +2280,11 @@ subroutine diag_update_remap_grids(diag_cs, alt_h, alt_T, alt_S) if (id_clock_diag_grid_updates>0) call cpu_clock_begin(id_clock_diag_grid_updates) + if (diag_cs%diag_grid_overridden) then + call MOM_error(FATAL, "diag_update_remap_grids was called, but current grids in "// & + "diagnostic structure have been overridden") + endif + do i=1, diag_cs%num_diag_coords call diag_remap_update(diag_cs%diag_remap_cs(i), & diag_cs%G, diag_cs%GV, h_diag, T_diag, S_diag, & @@ -2350,6 +2374,7 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) call diag_remap_end(diag_cs%diag_remap_cs(i)) enddo + call diag_grid_storage_end(diag_cs%diag_grid_temp) deallocate(diag_cs%mask3dTL) deallocate(diag_cs%mask3dBL) deallocate(diag_cs%mask3dCuL) @@ -2492,4 +2517,118 @@ subroutine log_available_diag(used, module_name, field_name, cell_methods_string end subroutine log_available_diag +!> Allocates fields necessary to store diagnostic remapping fields +subroutine diag_grid_storage_init(grid_storage, G, diag) + type(diag_grid_storage), intent(inout) :: grid_storage !< Structure containing a snapshot of the target grids + type(ocean_grid_type), intent(in) :: G !< Horizontal grid + type(diag_ctrl), intent(in) :: diag !< Diagnostic control structure used as the contructor + !! template for this routine + + integer :: m, nz + grid_storage%num_diag_coords = diag%num_diag_coords + + ! Don't do anything else if there are no remapped coordinates + if (grid_storage%num_diag_coords < 1) return + + ! Allocate memory for the native space + allocate(grid_storage%h_state(G%isd:G%ied,G%jsd:G%jed, G%ke)) + ! Allocate diagnostic remapping structures + allocate(grid_storage%diag_grids(diag%num_diag_coords)) + ! Loop through and allocate memory for the grid on each target coordinate + do m = 1, diag%num_diag_coords + nz = diag%diag_remap_cs(m)%nz + allocate(grid_storage%diag_grids(m)%h(G%isd:G%ied,G%jsd:G%jed, nz)) + enddo + +end subroutine diag_grid_storage_init + +!> Copy from the main diagnostic arrays to the grid storage as well as the native thicknesses +subroutine diag_copy_diag_to_storage(grid_storage, h_state, diag) + type(diag_grid_storage), intent(inout) :: grid_storage !< Structure containing a snapshot of the target grids + real, dimension(:,:,:), intent(in) :: h_state !< Current model thicknesses + type(diag_ctrl), intent(in) :: diag !< Diagnostic control structure used as the contructor + + integer :: m + + ! Don't do anything else if there are no remapped coordinates + if (grid_storage%num_diag_coords < 1) return + + grid_storage%h_state(:,:,:) = h_state(:,:,:) + do m = 1,grid_storage%num_diag_coords + if (diag%diag_remap_cs(m)%nz > 0) & + grid_storage%diag_grids(m)%h(:,:,:) = diag%diag_remap_cs(m)%h(:,:,:) + enddo + +end subroutine diag_copy_diag_to_storage + +!> Copy from the stored diagnostic arrays to the main diagnostic grids +subroutine diag_copy_storage_to_diag(diag, grid_storage) + type(diag_ctrl), intent(inout) :: diag !< Diagnostic control structure used as the contructor + type(diag_grid_storage), intent(in) :: grid_storage !< Structure containing a snapshot of the target grids + + integer :: m + + ! Don't do anything else if there are no remapped coordinates + if (grid_storage%num_diag_coords < 1) return + + diag%diag_grid_overridden = .true. + do m = 1,grid_storage%num_diag_coords + if (diag%diag_remap_cs(m)%nz > 0) & + diag%diag_remap_cs(m)%h(:,:,:) = grid_storage%diag_grids(m)%h(:,:,:) + enddo + +end subroutine diag_copy_storage_to_diag + +!> Save the current diagnostic grids in the temporary structure within diag +subroutine diag_save_grids(diag) + type(diag_ctrl), intent(inout) :: diag !< Diagnostic control structure used as the contructor + + integer :: m + + ! Don't do anything else if there are no remapped coordinates + if (diag%num_diag_coords < 1) return + + do m = 1,diag%num_diag_coords + if (diag%diag_remap_cs(m)%nz > 0) & + diag%diag_grid_temp%diag_grids(m)%h(:,:,:) = diag%diag_remap_cs(m)%h(:,:,:) + enddo + +end subroutine diag_save_grids + +!> Restore the diagnostic grids from the temporary structure within diag +subroutine diag_restore_grids(diag) + type(diag_ctrl), intent(inout) :: diag !< Diagnostic control structure used as the contructor + + integer :: m + + ! Don't do anything else if there are no remapped coordinates + if (diag%num_diag_coords < 1) return + + diag%diag_grid_overridden = .false. + do m = 1,diag%num_diag_coords + if (diag%diag_remap_cs(m)%nz > 0) & + diag%diag_remap_cs(m)%h(:,:,:) = diag%diag_grid_temp%diag_grids(m)%h(:,:,:) + enddo + +end subroutine diag_restore_grids + +!> Deallocates the fields in the remapping fields container +subroutine diag_grid_storage_end(grid_storage) + type(diag_grid_storage), intent(inout) :: grid_storage !< Structure containing a snapshot of the target grids + ! Local variables + integer :: m, nz + + ! Don't do anything else if there are no remapped coordinates + if (grid_storage%num_diag_coords < 1) return + + ! Deallocate memory for the native space + deallocate(grid_storage%h_state) + ! Loop through and deallocate memory for the grid on each target coordinate + do m = 1, grid_storage%num_diag_coords + deallocate(grid_storage%diag_grids(m)%h) + enddo + ! Deallocate diagnostic remapping structures + deallocate(grid_storage%diag_grids) +end subroutine diag_grid_storage_end + end module MOM_diag_mediator diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 416b53cfb0..1829537bfd 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -17,7 +17,7 @@ module MOM_diag_remap ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms, only : sum_across_PEs -use MOM_error_handler, only : MOM_error, FATAL, assert +use MOM_error_handler, only : MOM_error, FATAL, assert, WARNING use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_file_parser, only : get_param, log_param, param_file_type use MOM_io, only : slasher, mom_read_data @@ -40,6 +40,7 @@ module MOM_diag_remap use diag_axis_mod, only : get_diag_axis_name use diag_manager_mod, only : diag_axis_init +use MOM_debugging, only : check_column_integrals implicit none ; private public diag_remap_ctrl diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index c77ade5506..adf6bac926 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -111,6 +111,10 @@ module MOM_restart ! existence will result in a new run that is not ! initializedfrom restart files. logical :: new_run_set = .false. ! If true, new_run has been determined for this restart_CS. + logical :: checksum_required ! If true, require the restart checksums to match and error out otherwise. + ! Users may want to avoid this comparison if for example the restarts are + ! made from a run with a different mask_table than the current run, + ! in which case the checksums will not match and cause crash. character(len=240) :: restartfile ! The name or name root for MOM restart files. type(field_restart), pointer :: restart_field(:) => NULL() @@ -1047,7 +1051,6 @@ subroutine restore_state(filename, directory, day, G, CS) real :: t1, t2 ! Two times. real, allocatable :: time_vals(:) type(fieldtype), allocatable :: fields(:) - logical,parameter :: checksum_required = .true. logical :: check_exist, is_there_a_checksum integer(kind=8),dimension(1) :: checksum_file integer(kind=8) :: checksum_data @@ -1149,7 +1152,7 @@ subroutine restore_state(filename, directory, day, G, CS) call mpp_get_atts(fields(i),checksum=checksum_file) is_there_a_checksum = .true. endif - if (.NOT. checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming. + if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming. if (ASSOCIATED(CS%var_ptr1d(m)%p)) then ! Read a 1d array, which should be invariant to domain decomposition. @@ -1571,6 +1574,12 @@ subroutine restart_init(param_file, CS, restart_root) call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, & "The maximum number of restart fields that can be used.", & default=100) + call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", CS%checksum_required, & + "If true, require the restart checksums to match and error out otherwise. \n"//& + "Users may want to avoid this comparison if for example the restarts are \n"//& + "made from a run with a different mask_table than the current run, \n"//& + "in which case the checksums will not match and cause crash.",& + default=.true.) allocate(CS%restart_field(CS%max_fields)) allocate(CS%var_ptr0d(CS%max_fields)) diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 15643292d1..e0cfac465c 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -18,7 +18,7 @@ module MOM_spatial_means public :: global_i_mean, global_j_mean public :: global_area_mean, global_layer_mean public :: global_area_integral -public :: global_volume_mean +public :: global_volume_mean, global_mass_integral public :: adjust_area_mean_to_zero contains @@ -86,12 +86,15 @@ function global_layer_mean(var, h, G, GV) end function global_layer_mean +!> Find the global thickness-weighted mean of a variable. function global_volume_mean(var, h, G, GV) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real :: global_volume_mean + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: var !< The variable being averaged + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real :: global_volume_mean !< The thickness-weighted average of var real :: weight_here real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming, sum_weight @@ -111,6 +114,50 @@ function global_volume_mean(var, h, G, GV) end function global_volume_mean +!> Find the global mass-weighted integral of a variable +function global_mass_integral(h, G, GV, var, on_PE_only) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: var !< The variable being integrated + logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only + !! done on the local PE, and it is _not_ order invariant. + real :: global_mass_integral !< The mass-weighted integral of var (or 1) in + !! kg times the units of var + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + logical :: global_sum + integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + tmpForSumming(:,:) = 0.0 + + if (present(var)) then + do k=1,nz ; do j=js,je ; do i=is,ie + tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * & + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + tmpForSumming(i,j) = tmpForSumming(i,j) + & + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + enddo ; enddo ; enddo + endif + global_sum = .true. ; if (present(on_PE_only)) global_sum = .not.on_PE_only + if (global_sum) then + global_mass_integral = reproducing_sum(tmpForSumming) + else + global_mass_integral = 0.0 + do j=js,je ; do i=is,ie + global_mass_integral = global_mass_integral + tmpForSumming(i,j) + enddo ; enddo + endif + +end function global_mass_integral + + subroutine global_i_mean(array, i_mean, G, mask) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6afea77e8f..7bb99a8d24 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -23,7 +23,8 @@ module MOM_state_initialization use MOM_io, only : EAST_FACE, NORTH_FACE , SINGLE_FILE, MULTIPLE use MOM_open_boundary, only : ocean_OBC_type, open_boundary_init use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE -use MOM_open_boundary, only : open_boundary_query, set_tracer_data +use MOM_open_boundary, only : open_boundary_query +use MOM_open_boundary, only : set_tracer_data use MOM_open_boundary, only : open_boundary_test_extern_h use MOM_open_boundary, only : fill_temp_salt_segments !use MOM_open_boundary, only : set_3D_OBC_data @@ -35,7 +36,7 @@ module MOM_state_initialization use MOM_ALE_sponge, only : ALE_sponge_CS use MOM_string_functions, only : uppercase, lowercase use MOM_time_manager, only : time_type, set_time -use MOM_tracer_registry, only : add_tracer_OBC_values, tracer_registry_type +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type use MOM_ALE, only : pressure_gradient_plm diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index bba797523b..0e02cefba2 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -552,13 +552,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, enddo ; enddo ! Divergence gradient - do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) - enddo ; enddo + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + enddo ; enddo - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) - enddo ; enddo + do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 + div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + enddo ; enddo + endif ! Coefficient for modified Leith if (CS%Modified_Leith) then @@ -1038,11 +1040,15 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration (m/s) + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity (m2/s) + real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: get_all ! If true, read and log all parameters, regardless of ! whether they are used, to enable spell-checking of ! valid parameters. character(len=64) :: inputdir, filename + real :: deg2rad ! Converts degrees to radians + real :: slat_fn ! sin(lat)**Kh_pwr_of_sine integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: i, j @@ -1097,6 +1103,15 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "The final viscosity is the largest of this scaled \n"//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & units="m s-1", default=0.0) + call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & + "The amplitude of a latidutinally-dependent background\n"//& + "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & + units = "m2 s-1", default=0.0) + if (Kh_sin_lat>0. .or. get_all) & + call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & + "The power used to raise SIN(LAT) when using a latidutinally-\n"//& + "dependent background viscosity.", & + units = "nondim", default=4.0) call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & "If true, use a Smagorinsky nonlinear eddy viscosity.", & @@ -1239,6 +1254,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) return ! We are not using either Laplacian or Bi-harmonic lateral viscosity endif + deg2rad = atan(1.0) / 45. + ALLOC_(CS%dx2h(isd:ied,jsd:jed)) ; CS%dx2h(:,:) = 0.0 ALLOC_(CS%dy2h(isd:ied,jsd:jed)) ; CS%dy2h(:,:) = 0.0 ALLOC_(CS%dx2q(IsdB:IedB,JsdB:JedB)) ; CS%dx2q(:,:) = 0.0 @@ -1351,32 +1368,56 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. if (CS%bound_Kh .or. CS%bound_Ah) Kh_Limit = 0.3 / (dt*4.0) + + ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + ! Static factors in the Smagorinsky and Leith schemes grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xx(i,j) = Smag_Lap_const * grid_sp_h2 if (CS%Leith_Kh) CS%LAPLAC3_CONST_xx(i,j) = Leith_Lap_const * grid_sp_h3 + ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xx(i,j) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_h2)) + ! Use the larger of the above and values read from a file if (CS%use_Kh_bg_2d) CS%Kh_bg_xx(i,j) = MAX(CS%Kh_bg_2d(i,j), CS%Kh_bg_xx(i,j)) + ! Use the larger of the above and a function of sin(latitude) + if (Kh_sin_lat>0.) then + slat_fn = abs( sin( deg2rad * G%geoLatT(i,j) ) ) ** Kh_pwr_of_sine + CS%Kh_bg_xx(i,j) = MAX(Kh_sin_lat * slat_fn, CS%Kh_bg_xx(i,j)) + endif + if (CS%bound_Kh .and. .not.CS%better_bound_Kh) then + ! Limit the background viscosity to be numerically stable CS%Kh_Max_xx(i,j) = Kh_Limit * grid_sp_h2 CS%Kh_bg_xx(i,j) = MIN(CS%Kh_bg_xx(i,j), CS%Kh_Max_xx(i,j)) endif enddo ; enddo + + ! Calculate and store the background viscosity at q-points do J=js-1,Jeq ; do I=is-1,Ieq + ! Static factors in the Smagorinsky and Leith schemes grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%LAPLAC_CONST_xy(I,J) = Smag_Lap_const * grid_sp_q2 if (CS%Leith_Kh) CS%LAPLAC3_CONST_xy(I,J) = Leith_Lap_const * grid_sp_q3 + ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) + ! Use the larger of the above and values read from a file if (CS%use_Kh_bg_2d) CS%Kh_bg_xy(I,J) = MAX(CS%Kh_bg_2d(i,j), CS%Kh_bg_xy(I,J)) + ! Use the larger of the above and a function of sin(latitude) + if (Kh_sin_lat>0.) then + slat_fn = abs( sin( deg2rad * G%geoLatBu(I,J) ) ) ** Kh_pwr_of_sine + CS%Kh_bg_xy(I,J) = MAX(Kh_sin_lat * slat_fn, CS%Kh_bg_xy(I,J)) + endif + if (CS%bound_Kh .and. .not.CS%better_bound_Kh) then + ! Limit the background viscosity to be numerically stable CS%Kh_Max_xy(I,J) = Kh_Limit * grid_sp_q2 CS%Kh_bg_xy(I,J) = MIN(CS%Kh_bg_xy(I,J), CS%Kh_Max_xy(I,J)) endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 9841d5687b..91b3c343e0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -16,6 +16,9 @@ module MOM_diabatic_driver use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end +use MOM_diag_mediator, only : diag_copy_diag_to_storage, diag_copy_storage_to_diag +use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS @@ -177,8 +180,11 @@ module MOM_diabatic_driver integer :: id_diabatic_diff_salt_tend = -1 integer :: id_diabatic_diff_heat_tend_2d = -1 integer :: id_diabatic_diff_salt_tend_2d = -1 + integer :: id_diabatic_diff_h= -1 logical :: diabatic_diff_tendency_diag = .false. + integer :: id_boundary_forcing_h = -1 + integer :: id_boundary_forcing_h_tendency = -1 integer :: id_boundary_forcing_temp_tend = -1 integer :: id_boundary_forcing_saln_tend = -1 integer :: id_boundary_forcing_heat_tend = -1 @@ -187,6 +193,7 @@ module MOM_diabatic_driver integer :: id_boundary_forcing_salt_tend_2d = -1 logical :: boundary_forcing_tendency_diag = .false. + integer :: id_frazil_h = -1 integer :: id_frazil_temp_tend = -1 integer :: id_frazil_heat_tend = -1 integer :: id_frazil_heat_tend_2d = -1 @@ -218,7 +225,7 @@ module MOM_diabatic_driver type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass - + type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm ! Data arrays for communicating between components real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat (m/s) real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars (m/s) @@ -430,6 +437,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%frazil_tendency_diag) then call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) endif call disable_averaging(CS%diag) endif @@ -452,7 +460,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) 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) @@ -757,21 +764,21 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) endif + ! Save fields before boundary forcing is applied for tendency diagnostics + if(CS%boundary_forcing_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_diag(i,j,k) = h(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + ! Apply forcing when using the ALE algorithm if (CS%useALEalgorithm) then call cpu_clock_begin(id_clock_remap) ! Changes made to following fields: h, tv%T and tv%S. - ! save prior values for diagnostics - if(CS%boundary_forcing_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - h_diag(i,j,k) = h(i,j,k) - temp_diag(i,j,k) = tv%T(i,j,k) - saln_diag(i,j,k) = tv%S(i,j,k) - enddo ; enddo ; enddo - endif - do k=1,nz ; do j=js,je ; do i=is,ie h_prebound(i,j,k) = h(i,j,k) enddo ; enddo ; enddo @@ -837,10 +844,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for CS%use_energetic_PBL ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards if(CS%boundary_forcing_tendency_diag) then - call diag_update_remap_grids(CS%diag) call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) call cpu_clock_end(id_clock_remap) if (CS%debug) then @@ -884,7 +895,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif enddo ; enddo enddo - ! Application of boundary forcing and the checks for negative thickness may have changed layer thicknesses + ! Checks for negative thickness may have changed layer thicknesses call diag_update_remap_grids(CS%diag) if (CS%debug) then @@ -1077,8 +1088,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed + ! In either case, tendencies should be posted on hold if(CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) endif call cpu_clock_end(id_clock_tridiag) @@ -1437,6 +1452,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%frazil_tendency_diag) then call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) endif if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") @@ -1584,7 +1600,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt enddo ; enddo ; enddo if(CS%id_diabatic_diff_temp_tend > 0) then - call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag) + call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h = h) endif ! heat tendency @@ -1593,7 +1609,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) enddo ; enddo ; enddo if(CS%id_diabatic_diff_heat_tend > 0) then - call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag) + call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h = h) endif if(CS%id_diabatic_diff_heat_tend_2d > 0) then do j=js,je ; do i=is,ie @@ -1607,11 +1623,11 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, endif ! salinity tendency - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt - enddo ; enddo ; enddo if(CS%id_diabatic_diff_saln_tend > 0) then - call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag) + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h) endif ! salt tendency @@ -1620,7 +1636,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k) enddo ; enddo ; enddo if(CS%id_diabatic_diff_salt_tend > 0) then - call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag) + call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) endif if(CS%id_diabatic_diff_salt_tend_2d > 0) then do j=js,je ; do i=is,ie @@ -1662,12 +1678,20 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, work_3d(:,:,:) = 0.0 work_2d(:,:) = 0.0 + ! Thickness tendency + if(CS%id_boundary_forcing_h_tendency > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (h(i,j,k) - h_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_h_tendency, work_3d, CS%diag, alt_h = h_old) + endif + ! temperature tendency if(CS%id_boundary_forcing_temp_tend > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag) + call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag, alt_h = h_old) endif ! heat tendency @@ -1676,7 +1700,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) enddo ; enddo ; enddo if(CS%id_boundary_forcing_heat_tend > 0) then - call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag) + call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag, alt_h = h_old) endif if(CS%id_boundary_forcing_heat_tend_2d > 0) then do j=js,je ; do i=is,ie @@ -1689,13 +1713,12 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, endif endif - ! salinity tendency if(CS%id_boundary_forcing_saln_tend > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_saln_tend, work_3d, CS%diag) + call post_data(CS%id_boundary_forcing_saln_tend, work_3d, CS%diag, alt_h = h_old) endif ! salt tendency @@ -1704,7 +1727,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) enddo ; enddo ; enddo if(CS%id_boundary_forcing_salt_tend > 0) then - call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag) + call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) endif if(CS%id_boundary_forcing_salt_tend_2d > 0) then do j=js,je ; do i=is,ie @@ -2137,6 +2160,9 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! diagnostics for tendencies of temp and saln due to diabatic processes; ! available only for ALE algorithm. + ! diagnostics for tendencies of temp and heat due to frazil + CS%id_diabatic_diff_h = register_diag_field('ocean_model', 'diabatic_diff_h', diag%axesTL, Time, & + long_name = 'Cell thickness used during diabatic diffusion', units='m', v_extensive=.true.) if (CS%useALEalgorithm) then CS%id_diabatic_diff_temp_tend = register_diag_field('ocean_model', & 'diabatic_diff_temp_tendency', diag%axesTL, Time, & @@ -2204,8 +2230,19 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%diabatic_diff_tendency_diag = .true. endif - ! diagnostics for tendencies of temp and saln due to boundary forcing; + ! diagnostics for tendencies of thickness temp and saln due to boundary forcing; ! available only for ALE algorithm. + ! diagnostics for tendencies of temp and heat due to frazil + CS%id_boundary_forcing_h = register_diag_field('ocean_model', 'boundary_forcing_h', diag%axesTL, Time, & + long_name = 'Cell thickness after applying boundary forcing', units='m', v_extensive=.true.) + CS%id_boundary_forcing_h_tendency = register_diag_field('ocean_model', & + 'boundary_forcing_h_tendency', diag%axesTL, Time, & + 'Cell thickness tendency due to boundary forcing', 'm s-1', & + v_extensive = .true.) + if (CS%id_boundary_forcing_h_tendency > 0) then + CS%boundary_forcing_tendency_diag = .true. + endif + CS%id_boundary_forcing_temp_tend = register_diag_field('ocean_model',& 'boundary_forcing_temp_tendency', diag%axesTL, Time, & 'Boundary forcing temperature tendency', 'degC s-1') @@ -2254,6 +2291,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif ! diagnostics for tendencies of temp and heat due to frazil + CS%id_frazil_h = register_diag_field('ocean_model', 'frazil_h', diag%axesTL, Time, & + long_name = 'Cell Thickness', standard_name='cell_thickness', units='m', v_extensive=.true.) ! diagnostic for tendency of temp due to frazil CS%id_frazil_temp_tend = register_diag_field('ocean_model',& @@ -2349,6 +2388,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%nsw = 0 if (ASSOCIATED(CS%optics)) CS%nsw = CS%optics%nbands + ! Initialize the diagnostic grid storage + call diag_grid_storage_init(CS%diag_grids_prev, G, diag) end subroutine diabatic_driver_init @@ -2383,6 +2424,8 @@ subroutine diabatic_driver_end(CS) call opacity_end(CS%opacity_CSp, CS%optics) deallocate(CS%optics) endif + + call diag_grid_storage_end(CS%diag_grids_prev) if (associated(CS)) deallocate(CS) end subroutine diabatic_driver_end diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8c12c51b49..394b17dbd2 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -34,7 +34,7 @@ module MOM_set_visc !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_debugging, only : uvchksum +use MOM_debugging, only : uvchksum, hchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type @@ -126,7 +126,7 @@ module MOM_set_visc !! paper of Killworth and Edwards, JPO 1999. It is not necessary to !! calculate the thickness and viscosity every time step; instead !! previous values may be used. -subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS) +subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -142,6 +142,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS) !! related fields. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to vertvisc_init. + logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations + !! of those values in visc that would be + !! calculated with symmetric memory. ! The following subroutine calculates the thickness of the bottom ! boundary layer and the viscosity within that layer. A drag law is ! used, either linearized about an assumed bottom velocity or using @@ -313,6 +316,17 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS) "Module must be initialized before it is used.") if (.not.CS%bottomdraglaw) return + if (present(symmetrize)) then ; if (symmetrize) then + Jsq = js-1 ; Isq = is-1 + endif ; endif + + if (CS%debug) then + call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1) + call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) + if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1) + if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1) + endif + use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS OBC => CS%OBC @@ -324,7 +338,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS) ! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel if ((nkml>0) .and. .not.use_BBL_EOS) then - do i=G%IscB,G%IecB+1 ; p_ref(i) = tv%P_ref ; enddo + do i=Isq,Ieq+1 ; p_ref(i) = tv%P_ref ; enddo !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nkmb call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, & @@ -400,11 +414,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS) !$OMP BBL_visc_frac,h_vel,L0,Vol_0,dV_dL2,dVol,L_max, & !$OMP L_min,Vol_err_min,Vol_err_max,BBL_frac,Cell_width, & !$OMP gam,Rayleigh, Vol_tol, tmp_val_m1_to_p1) - do j=G%JscB,G%JecB ; do m=1,2 + do j=Jsq,Jeq ; do m=1,2 if (m==1) then if (j 0) do_i(i) = .true. @@ -1023,7 +1037,7 @@ end function set_u_at_v !! the thickness of the topmost NKML layers (with a bulk mixed layer) are !! currently used. The thicknesses are given in terms of fractional layers, so !! that this thickness will move as the thickness of the topmost layers change. -subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS) +subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1041,6 +1055,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS) real, intent(in) :: dt !< Time increment in s. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to vertvisc_init. + logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations + !! of those values in visc that would be + !! calculated with symmetric memory. ! The following subroutine calculates the thickness of the surface boundary ! layer for applying an elevated viscosity. A bulk Richardson criterion or @@ -1168,6 +1185,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS) if (.not.(CS%dynamic_viscous_ML .or. associated(forces%frac_shelf_u) .or. & associated(forces%frac_shelf_v)) ) return + if (present(symmetrize)) then ; if (symmetrize) then + Jsq = js-1 ; Isq = is-1 + endif ; endif + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt=sqrt(CS%cdrag) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index fa9a5ac350..0bb4a9bfdb 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -623,8 +623,13 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) enddo ! end of c loop if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then - Idt = 1.0 / dt - if (CS%id_w_sponge > 0) call post_data(CS%id_w_sponge, Idt*GV%H_to_m*w_int(:,:,:), CS%diag) + if (CS%id_w_sponge > 0) then + Idt = 1.0 / dt + do k=1,nz+1 ; do j=js,je ; do i=is,ie + w_int(i,j,K) = w_int(i,j,K) * Idt * GV%H_to_m ! Scale values by clobbering array since it is local + enddo ; enddo ; enddo + call post_data(CS%id_w_sponge, w_int(:,:,:), CS%diag) + endif endif ; endif end subroutine apply_sponge diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index b65b6caefd..d306bb9e79 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -2,25 +2,25 @@ module DOME_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : diag_to_Z_CS -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_hor_index, only : hor_index_type -use MOM_grid, only : ocean_grid_type -use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_to_Z, only : diag_to_Z_CS +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_hor_index, only : hor_index_type +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_tracer_type +use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer +use MOM_restart, only : MOM_restart_CS +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf +use coupler_types_mod, only : coupler_type_set_data, ind_csurf use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux implicit none ; private @@ -140,7 +140,7 @@ end function register_DOME_tracer !> This subroutine initializes the NTR tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp, diag_to_Z_CSp, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure logical, intent(in) :: restart !< .true. if the fields have already @@ -155,6 +155,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & !! for the sponges, if they are in use. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure !! for diagnostics in depth space. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real, allocatable :: temp(:,:,:) @@ -177,6 +178,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & real :: e(SZK_(G)+1), e_top, e_bot, d_tr integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB + type(OBC_segment_type), pointer :: segment if (.not.associated(CS)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -277,22 +279,25 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (associated(OBC)) then call query_vardesc(CS%tr_desc(1), name, caller="initialize_DOME_tracer") if (OBC%specified_v_BCs_exist_globally) then - allocate(OBC_tr1_v(G%isd:G%ied,G%jsd:G%jed,nz)) - do k=1,nz ; do j=G%jsd,G%jed ; do i=G%isd,G%ied - if (k < nz/2) then ; OBC_tr1_v(i,j,k) = 0.0 - else ; OBC_tr1_v(i,j,k) = 1.0 ; endif + segment => OBC%segment(1) + allocate(segment%field(NTR)) + allocate(segment%field(1)%buffer_src(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB,nz)) +! allocate(OBC_tr1_v(G%isd:G%ied,G%jsd:G%jed,nz)) + do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do i=segment%HI%isd,segment%HI%ied + if (k < nz/2) then ; segment%field(1)%buffer_src(i,j,k) = 0.0 + else ; segment%field(1)%buffer_src(i,j,k) = 1.0 ; endif enddo ; enddo ; enddo - call add_tracer_OBC_values(trim(name), CS%tr_Reg, & - 0.0, OBC_in_v=OBC_tr1_v) + call register_segment_tracer(CS%tr_desc(1), param_file, GV, & + OBC%segment(1), OBC_array=.true.) else ! This is not expected in the DOME example. - call add_tracer_OBC_values(trim(name), CS%tr_Reg, 0.0) endif ! All tracers but the first have 0 concentration in their inflows. As this ! is the default value, the following calls are unnecessary. do m=2,NTR call query_vardesc(CS%tr_desc(m), name, caller="initialize_DOME_tracer") - call add_tracer_OBC_values(trim(name), CS%tr_Reg, 0.0) + call register_segment_tracer(CS%tr_desc(m), param_file, GV, & + OBC%segment(1), OBC_scalar=0.0) enddo endif diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 2cfb793802..80c2cc2c3c 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -28,7 +28,6 @@ module ISOMIP_tracer use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface use MOM_open_boundary, only : ocean_OBC_type diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 73090a71c9..454521184e 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -60,7 +60,6 @@ module MOM_OCMIP2_CFC use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_variables, only : surface @@ -412,10 +411,7 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & CS%CFC12_IC_val, G, CS) if (associated(OBC)) then - ! By default, all tracers have 0 concentration in their inflows. This may - ! make the following calls are unnecessary. - ! call add_tracer_OBC_values(trim(CS%CFC11_desc%name), CS%tr_Reg, 0.0) - ! call add_tracer_OBC_values(trim(CS%CFC12_desc%name), CS%tr_Reg, 0.0) + ! Steal from updated DOME in the fullness of time. endif end subroutine initialize_OCMIP2_CFC diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4a7526aedc..36e73b9ee2 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -38,7 +38,6 @@ module MOM_generic_tracer use MOM_time_manager, only : time_type, get_time, set_time use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_registry, only : register_tracer, tracer_registry_type - use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_Z_init, only : tracer_Z_init use MOM_tracer_initialization_from_Z, only : MOM_initialize_tracer_from_Z use MOM_variables, only : surface, thermo_var_ptrs diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 2d583d2d9c..0a11de9c1e 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -295,26 +295,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB !! structure for diagnostics in depth space. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables -! This subroutine calls all registered tracer initialization -! subroutines. -! Arguments: restart - 1 if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m (Boussinesq) or kg m-2 (non-Boussinesq). -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in) CS - The control structure returned by a previous call to -! call_tracer_register. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) ALE_sponge_CSp - A pointer to the control structure for the ALE sponges, if they are -! in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. if (.not. associated(CS)) call MOM_error(FATAL, "tracer_flow_control_init: "// & "Module must be initialized via call_tracer_register before it is used.") @@ -324,7 +305,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB sponge_CSp, diag_to_Z_CSp) if (CS%use_DOME_tracer) & call initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS%DOME_tracer_CSp, & - sponge_CSp, diag_to_Z_CSp) + sponge_CSp, diag_to_Z_CSp, param_file) if (CS%use_ISOMIP_tracer) & call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & ALE_sponge_CSp, diag_to_Z_CSp) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index e75fffc38b..056ed8fc96 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -1324,14 +1324,13 @@ end subroutine tracer_epipycnal_ML_diff !> Initialize lateral tracer diffusion module -subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS, CSnd) +subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS type(param_file_type), intent(in) :: param_file !< parameter file type(tracer_hor_diff_CS), pointer :: CS !< horz diffusion control structure - type(neutral_diffusion_CS), pointer :: CSnd !< pointer to neutral diffusion CS ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1392,7 +1391,6 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS, CSnd) endif CS%use_neutral_diffusion = neutral_diffusion_init(Time, G, param_file, diag, EOS, CS%neutral_diffusion_CSp) - CSnd => CS%neutral_diffusion_CSp if (CS%use_neutral_diffusion .and. CS%Diffuse_ML_interior) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "USE_NEUTRAL_DIFFUSION and DIFFUSE_ML_TO_INTERIOR are mutually exclusive!") diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 0a9c66897d..effbc6d1fe 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -10,6 +10,8 @@ module MOM_tracer_registry use MOM_coms, only : reproducing_sum use MOM_debugging, only : hchksum use MOM_diag_mediator, only : diag_ctrl, register_diag_field, post_data, safe_alloc_ptr +use MOM_diag_mediator, only : diag_grid_storage +use MOM_diag_mediator, only : diag_copy_storage_to_diag, diag_save_grids, diag_restore_grids use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -27,20 +29,19 @@ module MOM_tracer_registry public register_tracer public MOM_tracer_chksum, MOM_tracer_chkinv -public register_tracer_diagnostics, post_tracer_diagnostics +public register_tracer_diagnostics, post_tracer_diagnostics, post_tracer_transport_diagnostics public preALE_tracer_diagnostics, postALE_tracer_diagnostics -public add_tracer_OBC_values public tracer_registry_init, lock_tracer_registry, tracer_registry_end !> The tracer type type, public :: tracer_type real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array - real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows - real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain - !! specified in OBCs through u-face of cell - real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain - !! specified in OBCs through v-face of cell +! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows +! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain +! !! specified in OBCs through u-face of cell +! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain +! !! specified in OBCs through v-face of cell real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux @@ -88,7 +89,7 @@ module MOM_tracer_registry character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer. real :: conv_scale = 1.0 !< A scaling factor used to convert the flux !! convergence of this tracer to its desired units. - character(len=48) :: cmor_tendname = "" !< The CMOR variable name for tendencies of this + character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this !! tracer, required because CMOR does not follow any !! discernable pattern for these names. integer :: ind_tr_squared = -1 @@ -117,7 +118,7 @@ module MOM_tracer_registry logical :: locked = .false. !< New tracers may be registered if locked=.false. !! When locked=.true., no more tracers can be registered, !! at which point common diagnostics can be set up - !! for the registered tracers. + !! for the registered tracers end type tracer_registry_type contains @@ -128,7 +129,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, & ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & flux_nameroot, flux_longname, flux_units, flux_scale, & - convergence_units, convergence_scale, cmor_tendname, diag_form, & + convergence_units, convergence_scale, cmor_tendprefix, diag_form, & restart_CS, mandatory) type(hor_index_type), intent(in) :: HI !< horizontal index type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -174,7 +175,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of this tracer. real, optional, intent(in) :: convergence_scale !< A scaling factor used to convert the flux !! convergence of this tracer to its desired units. - character(len=*), optional, intent(in) :: cmor_tendname !< The CMOR name for the layer-integrated tendencies of this tracer. + character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated tendencies of this tracer. integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the character !! string template to use in labeling diagnostics type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure; @@ -247,8 +248,8 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit Tr%conv_units = "" if (present(convergence_units)) Tr%conv_units = convergence_units - Tr%cmor_tendname = "" - if (present(cmor_tendname)) Tr%cmor_tendname = cmor_tendname + Tr%cmor_tendprefix = "" + if (present(cmor_tendprefix)) Tr%cmor_tendprefix = cmor_tendprefix Tr%conv_scale = 1.0 if (present(convergence_scale)) then @@ -268,11 +269,11 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit if (present(ad_y)) then ; if (associated(ad_y)) Tr%ad_y => ad_y ; endif if (present(df_x)) then ; if (associated(df_x)) Tr%df_x => df_x ; endif if (present(df_y)) then ; if (associated(df_y)) Tr%df_y => df_y ; endif - if (present(OBC_inflow)) Tr%OBC_inflow_conc = OBC_inflow - if (present(OBC_in_u)) then ; if (associated(OBC_in_u)) & - Tr%OBC_in_u => OBC_in_u ; endif - if (present(OBC_in_v)) then ; if (associated(OBC_in_v)) & - Tr%OBC_in_v => OBC_in_v ; endif +! if (present(OBC_inflow)) Tr%OBC_inflow_conc = OBC_inflow +! if (present(OBC_in_u)) then ; if (associated(OBC_in_u)) & +! Tr%OBC_in_u => OBC_in_u ; endif +! if (present(OBC_in_v)) then ; if (associated(OBC_in_v)) & +! Tr%OBC_in_v => OBC_in_v ; endif if (present(ad_2d_x)) then ; if (associated(ad_2d_x)) Tr%ad2d_x => ad_2d_x ; endif if (present(ad_2d_y)) then ; if (associated(ad_2d_y)) Tr%ad2d_y => ad_2d_y ; endif if (present(df_2d_x)) then ; if (associated(df_2d_x)) Tr%df2d_x => df_2d_x ; endif @@ -302,40 +303,6 @@ subroutine lock_tracer_registry(Reg) end subroutine lock_tracer_registry - -!> This subroutine adds open boundary condition concentrations for a tracer that -!! has previously been registered by a call to register_tracer. -subroutine add_tracer_OBC_values(name, Reg, OBC_inflow, OBC_in_u, OBC_in_v) - character(len=*), intent(in) :: name !< tracer name for which the diagnostic points - type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry - real, intent(in), optional :: OBC_inflow !< tracer value for all inflows via the OBC - !! for which OBC_in_u or OBC_in_v are - !! not specified (same units as tracer CONC) - real, pointer, dimension(:,:,:), optional :: OBC_in_u !< tracer at inflows through u-face of tracer cells - !! (same units as tracer CONC) - real, pointer, dimension(:,:,:), optional :: OBC_in_v !< tracer at inflows through v-face of tracer cells - !! (same units as tracer CONC) - - integer :: m - - if (.not. associated(Reg)) call MOM_error(FATAL, "add_tracer_OBC_values :"//& - "register_tracer must be called before add_tracer_OBC_values") - - do m=1,Reg%ntr ; if (Reg%Tr(m)%name == trim(name)) exit ; enddo - - if (m <= Reg%ntr) then - if (present(OBC_inflow)) Reg%Tr(m)%OBC_inflow_conc = OBC_inflow - if (present(OBC_in_u)) then ; if (associated(OBC_in_u)) & - Reg%Tr(m)%OBC_in_u => OBC_in_u ; endif - if (present(OBC_in_v)) then ; if (associated(OBC_in_v)) & - Reg%Tr(m)%OBC_in_v => OBC_in_v ; endif - else - call MOM_error(FATAL, "MOM_tracer: register_tracer must be called for "//& - trim(name)//" before add_tracer_OBC_values is called for it.") - endif - -end subroutine add_tracer_OBC_values - !> register_tracer_diagnostics does a set of register_diag_field calls for any previously !! registered in a tracer registry with a value of registry_diags set to .true. subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_to_Z_CSp) @@ -500,7 +467,7 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_ ' content due to parameterized mesoscale diffusion' Tr%id_dfxy_cont = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_cont_tendency', & diag%axesTL, Time, "Lateral or neutral diffusion tracer concentration tendency for "//trim(shortnm), & - conv_units, conversion = Tr%conv_scale, cmor_field_name = trim(Tr%cmor_tendname)//'pmdiff', & + conv_units, conversion = Tr%conv_scale, cmor_field_name = trim(Tr%cmor_tendprefix)//'pmdiff', & cmor_long_name = trim(cmor_var_lname), cmor_standard_name = trim(cmor_long_std(cmor_var_lname)), & x_cell_method = 'sum', y_cell_method = 'sum', v_extensive = .true.) @@ -509,7 +476,7 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_ Tr%id_dfxy_cont_2d = register_diag_field("ocean_model", trim(shortnm)//'_dfxy_cont_tendency_2d', & diag%axesT1, Time, "Depth integrated lateral or neutral diffusion tracer "//& "concentration tendency for "//trim(shortnm), conv_units, & - conversion=Tr%conv_scale, cmor_field_name=trim(Tr%cmor_tendname)//'pmdiff_2d', & + conversion=Tr%conv_scale, cmor_field_name=trim(Tr%cmor_tendprefix)//'pmdiff_2d', & cmor_long_name=trim(cmor_var_lname), cmor_standard_name=trim(cmor_long_std(cmor_var_lname)), & x_cell_method='sum', y_cell_method='sum') endif @@ -518,7 +485,7 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_ trim(units)//' s-1') var_lname = "Net time tendency for "//lowercase(flux_longname) - if (len_trim(Tr%cmor_tendname) == 0) then + if (len_trim(Tr%cmor_tendprefix) == 0) then Tr%id_trxh_tendency = register_diag_field('ocean_model', trim(shortnm)//'h_tendency', & diag%axesTL, Time, var_lname, conv_units, v_extensive=.true.) Tr%id_trxh_tendency_2d = register_diag_field('ocean_model', trim(shortnm)//'h_tendency_2d', & @@ -528,13 +495,13 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, use_ALE, diag_ trim(flux_longname)//" Content" Tr%id_trxh_tendency = register_diag_field('ocean_model', trim(shortnm)//'h_tendency', & diag%axesTL, Time, var_lname, conv_units, & - cmor_field_name=trim(Tr%cmor_tendname)//"tend", & + cmor_field_name=trim(Tr%cmor_tendprefix)//"tend", & cmor_standard_name=cmor_long_std(cmor_var_lname), cmor_long_name=cmor_var_lname, & v_extensive=.true., conversion=Tr%conv_scale) cmor_var_lname = trim(cmor_var_lname)//" Vertical Sum" Tr%id_trxh_tendency_2d = register_diag_field('ocean_model', trim(shortnm)//'h_tendency_2d', & diag%axesT1, Time, "Vertical sum of "//trim(lowercase(var_lname)), conv_units, & - cmor_field_name=trim(Tr%cmor_tendname)//"tend_2d", & + cmor_field_name=trim(Tr%cmor_tendprefix)//"tend_2d", & cmor_standard_name=cmor_long_std(cmor_var_lname), cmor_long_name=cmor_var_lname, & conversion=Tr%conv_scale) endif @@ -644,13 +611,14 @@ end subroutine postALE_tracer_diagnostics !> post_tracer_diagnostics does post_data calls for any diagnostics that are !! being handled via the tracer registry. -subroutine post_tracer_diagnostics(Reg, h, diag, G, GV, dt) +subroutine post_tracer_diagnostics(Reg, h, diag_prev, diag, G, GV, dt) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses - type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output + type(diag_grid_storage), intent(in) :: diag_prev !< Contains diagnostic grids from previous timestep + type(diag_ctrl), intent(inout) :: diag !< structure to regulate diagnostic output real, intent(in) :: dt !< total time step for tracer updates real :: work3d(SZI_(G),SZJ_(G),SZK_(GV)) @@ -662,39 +630,25 @@ subroutine post_tracer_diagnostics(Reg, h, diag, G, GV, dt) Idt = 0.; if (dt/=0.) Idt = 1.0 / dt ! The "if" is in case the diagnostic is called for a zero length interval + ! Tendency diagnostics need to be posted on the grid from the last call to this routine + call diag_save_grids(diag) + call diag_copy_storage_to_diag(diag, diag_prev) do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then Tr => Reg%Tr(m) - if (Tr%id_tr > 0) call post_data(Tr%id_tr, Tr%t, diag) - if (Tr%id_adx > 0) call post_data(Tr%id_adx, Tr%ad_x, diag) - if (Tr%id_ady > 0) call post_data(Tr%id_ady, Tr%ad_y, diag) - if (Tr%id_dfx > 0) call post_data(Tr%id_dfx, Tr%df_x, diag) - if (Tr%id_dfy > 0) call post_data(Tr%id_dfy, Tr%df_y, diag) - if (Tr%id_adx_2d > 0) call post_data(Tr%id_adx_2d, Tr%ad2d_x, diag) - if (Tr%id_ady_2d > 0) call post_data(Tr%id_ady_2d, Tr%ad2d_y, diag) - if (Tr%id_dfx_2d > 0) call post_data(Tr%id_dfx_2d, Tr%df2d_x, diag) - if (Tr%id_dfy_2d > 0) call post_data(Tr%id_dfy_2d, Tr%df2d_y, diag) - if (Tr%id_adv_xy > 0) call post_data(Tr%id_adv_xy, Tr%advection_xy, diag) - if (Tr%id_adv_xy_2d > 0) then - work2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - work2d(i,j) = work2d(i,j) + Tr%advection_xy(i,j,k) - enddo ; enddo ; enddo - call post_data(Tr%id_adv_xy_2d, work2d, diag) - endif if (Tr%id_tendency > 0) then work3d(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie work3d(i,j,k) = (Tr%t(i,j,k) - Tr%t_prev(i,j,k))*Idt tr%t_prev(i,j,k) = Tr%t(i,j,k) enddo ; enddo ; enddo - call post_data(Tr%id_tendency, work3d, diag) + call post_data(Tr%id_tendency, work3d, diag, alt_h = diag_prev%h_state) endif if ((Tr%id_trxh_tendency > 0) .or. (Tr%id_trxh_tendency_2d > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie work3d(i,j,k) = (Tr%t(i,j,k)*h(i,j,k) - Tr%Trxh_prev(i,j,k)) * Idt Tr%Trxh_prev(i,j,k) = Tr%t(i,j,k) * h(i,j,k) enddo ; enddo ; enddo - if (Tr%id_trxh_tendency > 0) call post_data(Tr%id_trxh_tendency, work3d, diag) + if (Tr%id_trxh_tendency > 0) call post_data(Tr%id_trxh_tendency, work3d, diag, alt_h = diag_prev%h_state) if (Tr%id_trxh_tendency_2d > 0) then work2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie @@ -704,9 +658,48 @@ subroutine post_tracer_diagnostics(Reg, h, diag, G, GV, dt) endif endif endif ; enddo + call diag_restore_grids(diag) end subroutine post_tracer_diagnostics +!> Post the advective and diffusive tendencies +subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_diag !< Layer thicknesses on which to post fields + type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output + + integer :: i, j, k, is, ie, js, je, nz, m + real :: work2d(SZI_(G),SZJ_(G)) + type(tracer_type), pointer :: Tr=>NULL() + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then + Tr => Reg%Tr(m) + if (Tr%id_tr > 0) call post_data(Tr%id_tr, Tr%t, diag) + if (Tr%id_adx > 0) call post_data(Tr%id_adx, Tr%ad_x, diag, alt_h = h_diag) + if (Tr%id_ady > 0) call post_data(Tr%id_ady, Tr%ad_y, diag, alt_h = h_diag) + if (Tr%id_dfx > 0) call post_data(Tr%id_dfx, Tr%df_x, diag, alt_h = h_diag) + if (Tr%id_dfy > 0) call post_data(Tr%id_dfy, Tr%df_y, diag, alt_h = h_diag) + if (Tr%id_adx_2d > 0) call post_data(Tr%id_adx_2d, Tr%ad2d_x, diag) + if (Tr%id_ady_2d > 0) call post_data(Tr%id_ady_2d, Tr%ad2d_y, diag) + if (Tr%id_dfx_2d > 0) call post_data(Tr%id_dfx_2d, Tr%df2d_x, diag) + if (Tr%id_dfy_2d > 0) call post_data(Tr%id_dfy_2d, Tr%df2d_y, diag) + if (Tr%id_adv_xy > 0) call post_data(Tr%id_adv_xy, Tr%advection_xy, diag, alt_h = h_diag) + if (Tr%id_adv_xy_2d > 0) then + work2d(:,:) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + work2d(i,j) = work2d(i,j) + Tr%advection_xy(i,j,k) + enddo ; enddo ; enddo + call post_data(Tr%id_adv_xy_2d, work2d, diag) + endif + endif ; enddo + +end subroutine post_tracer_transport_diagnostics + !> This subroutine writes out chksums for tracers. subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) character(len=*), intent(in) :: mesg !< message that appears on the chksum lines diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 6a1cb576b3..39e6e668e3 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -49,7 +49,6 @@ module advection_test_tracer use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 00f3d90d90..03cf06fdfa 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -16,7 +16,6 @@ module boundary_impulse_tracer use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_variables, only : surface @@ -220,11 +219,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, enddo ! Tracer loop if (associated(OBC)) then - ! All tracers but the first have 0 concentration in their inflows. As this - ! is the default value, the following calls are unnecessary. - ! do m=1,CS%ntr - ! call add_tracer_OBC_values(trim(CS%tr_desc(m)%name), CS%tr_Reg, 0.0) - ! enddo + ! Steal from updated DOME in the fullness of time. endif end subroutine initialize_boundary_impulse_tracer diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a8ca61c762..dcd2b6fecb 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -15,7 +15,6 @@ module regional_dyes use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_variables, only : surface diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index f299ba95cb..d9ca3ff9f1 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -14,7 +14,6 @@ module dyed_obc_tracer use MOM_restart, only : MOM_restart_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 51cc79f0a7..4f08dd7db1 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -50,7 +50,6 @@ module ideal_age_example use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_variables, only : surface @@ -327,11 +326,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & enddo ! Tracer loop if (associated(OBC)) then - ! All tracers but the first have 0 concentration in their inflows. As this - ! is the default value, the following calls are unnecessary. - ! do m=1,CS%ntr - ! call add_tracer_OBC_values(trim(CS%tr_desc(m)%name), CS%tr_Reg, 0.0) - ! enddo + ! Steal from updated DOME in the fullness of time. endif end subroutine initialize_ideal_age_tracer diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 9240db9524..e7071f9431 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -50,7 +50,6 @@ module oil_tracer use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_variables, only : surface @@ -345,11 +344,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & enddo ! Tracer loop if (associated(OBC)) then - ! All tracers but the first have 0 concentration in their inflows. As this - ! is the default value, the following calls are unnecessary. - ! do m=1,CS%ntr - ! call add_tracer_OBC_values(trim(CS%tr_desc(m)%name), CS%tr_Reg, 0.0) - ! enddo + ! Put something here... endif end subroutine initialize_oil_tracer diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index ee57789297..479de3d059 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -50,7 +50,6 @@ module pseudo_salt_tracer use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_variables, only : surface @@ -206,9 +205,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, endif if (associated(OBC)) then - ! All tracers but the first have 0 concentration in their inflows. As this - ! is the default value, the following calls are unnecessary. - ! call add_tracer_OBC_values(trim(CS%tr_desc%name), CS%tr_Reg, 0.0) + ! Steal from updated DOME in the fullness of time. endif CS%id_psd = register_diag_field("ocean_model", "pseudo_salt_diff", CS%diag%axesTL, & diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 7c5e8e26b4..b5d31ef5fe 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -46,7 +46,6 @@ module USER_tracer_example use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_OBC_values use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type @@ -289,17 +288,15 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (k < nz/2) then ; OBC_tr1_v(i,j,k) = 0.0 else ; OBC_tr1_v(i,j,k) = 1.0 ; endif enddo ; enddo ; enddo - call add_tracer_OBC_values(trim(name), CS%tr_Reg, & - 0.0, OBC_in_v=OBC_tr1_v) + ! Steal from updated DOME in the fullness of time. else - ! This is not expected in the DOME example. - call add_tracer_OBC_values(trim(name), CS%tr_Reg, 0.0) + ! Steal from updated DOME in the fullness of time. endif ! All tracers but the first have 0 concentration in their inflows. As this ! is the default value, the following calls are unnecessary. do m=2,lntr call query_vardesc(CS%tr_desc(m), name, caller="USER_initialize_tracer") - call add_tracer_OBC_values(trim(name), CS%tr_Reg, 0.0) + ! Steal from updated DOME in the fullness of time. enddo endif diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 35e9d68388..1217394edc 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -30,7 +30,7 @@ module BFB_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 99c5f3de5c..a46f95bd38 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -10,7 +10,7 @@ module DOME_initialization use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -318,7 +318,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) ! these variables are used. The following code is just a naive example. if (associated(tv%S)) then ! In this example, all S inflows have values of 35 psu. - call add_tracer_OBC_values("S", tr_Reg, OBC_inflow=35.0) +! call add_tracer_OBC_values("S", tr_Reg, OBC_inflow=35.0) +! call register_segment_tracer(CS%tr_desc(m), param_file, GV, & +! segment, OBC_scalar=35.0) endif if (associated(tv%T)) then ! In this example, the T values are set to be consistent with the layer @@ -341,9 +343,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied OBC_T_v(i,J,k) = T0(k) enddo ; enddo ; enddo - call add_tracer_OBC_values("T", tr_Reg, OBC_in_v=OBC_T_v) -! call register_segment_tracer(tr_desc(m), param_file, segment%HI, GV, & -! segment%Reg, m, OBC_scalar=1.0) +! call add_tracer_OBC_values("T", tr_Reg, OBC_in_v=OBC_T_v) +! call register_segment_tracer(CS%tr_desc(m), param_file, GV, & +! segment, OBC_array=.true.) endif end subroutine DOME_set_OBC_data diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index f6b3e0f9a8..ccf89c720e 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -12,7 +12,7 @@ module dyed_channel_initialization use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_open_boundary, only : OBC_registry_type, register_OBC use MOM_time_manager, only : time_type, set_time, time_type_to_real -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index b608395a3f..293b4095d9 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -10,7 +10,7 @@ module dyed_obcs_initialization use MOM_io, only : vardesc, var_desc use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 46fb3d5a40..24905ead1d 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -267,6 +267,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file S(i,j,k) = S_surf + S_range * (2.0 / 3.0) * (xi1**3 - xi0**3) / (xi1 - xi0) T(i,j,k) = T_surf + T_range * (2.0 / 3.0) * (xi1**3 - xi0**3) / (xi1 - xi0) case ('exponential') + r = 0.8 ! small values give sharp profiles S(i,j,k) = S_surf + S_range * (exp(xi1/r)-exp(xi0/r)) / (xi1 - xi0) T(i,j,k) = T_surf + T_range * (exp(xi1/r)-exp(xi0/r)) / (xi1 - xi0) case default diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 5e394089af..049bf6f6c6 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -14,7 +14,7 @@ module user_initialization use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N use MOM_open_boundary, only : OBC_DIRECTION_S use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type