From 0add693a8970bf206fa6879915b56c3170ae33da Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Tue, 5 May 2020 09:41:38 -0500 Subject: [PATCH 01/83] additions for stochastic physics and ePBL perts --- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 2 + src/core/MOM.F90 | 39 +++++++++--- src/core/MOM_forcing_type.F90 | 19 ++++-- src/diagnostics/MOM_diagnostics.F90 | 22 +++++-- src/framework/MOM_domains.F90 | 59 ++++--------------- .../vertical/MOM_energetic_PBL.F90 | 2 +- 6 files changed, 79 insertions(+), 64 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index c704214930..10add0f8d0 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -315,6 +315,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call safe_alloc_ptr(fluxes%p_surf ,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + print*,'allocate fluxes%t_rp' + call safe_alloc_ptr(fluxes%t_rp,isd,ied,jsd,jed) if (CS%use_limited_P_SSH) then fluxes%p_surf_SSH => fluxes%p_surf else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c36c0545e1..ae535dcbeb 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -30,6 +30,7 @@ module MOM use MOM_domains, only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : start_group_pass, complete_group_pass, Omit_Corners +use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -154,8 +155,7 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline -use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf -use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end +use stochastic_physics, only : init_stochastic_physics_ocn,run_stochastic_physics_ocn implicit none ; private @@ -248,6 +248,8 @@ module MOM 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 :: do_stochy = .false. + !< If true, call stochastic physics pattern generator type(time_type), pointer :: Time !< pointer to the ocean clock real :: dt !< (baroclinic) dynamics time step [T ~> s] @@ -826,6 +828,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif + print*,'calling run_stochastic_physics_ocn',CS%do_stochy + if (CS%do_stochy) call run_stochastic_physics_ocn(forces%t_rp) call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & @@ -978,7 +982,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%time_in_thermo_cycle > 0.0) then call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & - sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc) + sfc_state, CS%tv, ssh, fluxes%t_rp, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1811,10 +1815,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt ! A conversion factor from temperature fluxes to heat - ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] - real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] - real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors + integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean + integer :: num_procs +! model + integer :: me ! my pe + integer :: master ! root pe + real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -2490,6 +2496,25 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif + ! Shift from using the temporary dynamic grid type to using the final + ! (potentially static) ocean-specific grid type. + ! The next line would be needed if G%Domain had not already been init'd above: + ! call clone_MOM_domain(dG%Domain, G%Domain) + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) + call copy_dyngrid_to_MOM_grid(dG, G, US) + call destroy_dyn_horgrid(dG) + + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist) + me=PE_here() + master=root_PE() + + !call init_stochastic_physics_ocn(CS%dt_therm,G,me,master,pelist,CS%do_stochy) + print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) + call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,CS%do_stochy) + print*,'back from init_stochastic_physics_ocn',CS%do_stochy + ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then call set_first_direction(G, modulo(first_direction + turns, 2)) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 3248c09fa4..e11b6a39ce 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -145,6 +145,8 @@ module MOM_forcing_type !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. + real, pointer, dimension(:,:) :: t_rp => NULL() + !< random pattern at t-points logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -248,10 +250,10 @@ module MOM_forcing_type !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled, !! and is exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: & - rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at - !! u-points [L4 Z-1 T-1 ~> m3 s-1] - rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at - !! v-points [L4 Z-1 T-1 ~> m3 s-1] + rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points [m3 s-1] + rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points [m3 s-1] + real, pointer, dimension(:,:) :: t_rp => NULL() + !< random pattern at t-points real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -2126,6 +2128,12 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres + if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then + do j=js,je ; do i=is,ie + fluxes%t_rp(i,j) = forces%t_rp(i,j) + enddo ; enddo + endif + if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie fluxes%ustar(i,j) = forces%ustar(i,j) @@ -3088,6 +3096,7 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) call myAlloc(forces%net_mass_src,isd,ied,jsd,jed, press) + call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) call myAlloc(forces%rigidity_ice_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%rigidity_ice_v,isd,ied,JsdB,JedB, shelf) @@ -3252,6 +3261,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) + if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) @@ -3280,6 +3290,7 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%ustar)) deallocate(forces%ustar) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) + if (associated(forces%t_rp)) deallocate(forces%t_rp) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8d667503d7..fca2ed869f 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -139,7 +139,9 @@ module MOM_diagnostics integer :: id_salt_deficit = -1 integer :: id_Heat_PmE = -1 integer :: id_intern_heat = -1 - !>@} +! stochastic pattern + integer :: id_t_rp = -1 + !!@} end type surface_diag_IDs @@ -1277,7 +1279,7 @@ end subroutine post_surface_dyn_diags !> 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_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv, & - ssh, ssh_ibc) + ssh, t_rp, 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 @@ -1286,8 +1288,10 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. 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 [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: t_rp!< random pattern for stochastic proceeses real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] @@ -1414,6 +1418,11 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv call post_data(IDs%id_sss_sq, work_2d, diag, mask=G%mask2dT) endif + if (IDs%id_t_rp > 0) then + !call post_data(IDs%id_t_rp, t_rp, diag, mask=G%mask2dT) + call post_data(IDs%id_t_rp, t_rp, diag) + endif + call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag)) end subroutine post_surface_thermo_diags @@ -1901,8 +1910,9 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& - 'Heat flux into ocean from geothermal or other internal sources', & - 'W m-2', conversion=US%QRZ_T_to_W_m2) + 'Heat flux into ocean from geothermal or other internal sources', 'W m-2') + IDs%id_t_rp = register_diag_field('ocean_model', 'random_pattern', diag%axesT1, Time, & + 'random pattern for stochastics', 'None') end subroutine register_surface_diags diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 0cdcc455fc..acbc1ccaea 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,56 +3,23 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coms_infra, only : MOM_infra_init, MOM_infra_end -use MOM_coms_infra, only : PE_here, root_PE, num_PEs, broadcast -use MOM_coms_infra, only : sum_across_PEs, min_across_PEs, max_across_PEs -use MOM_domain_infra, only : MOM_domain_type, domain2D, domain1D, group_pass_type -use MOM_domain_infra, only : create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain -use MOM_domain_infra, only : get_domain_extent, get_domain_components, same_domain -use MOM_domain_infra, only : compute_block_extent, get_global_shape -use MOM_domain_infra, only : pass_var, pass_vector, fill_symmetric_edges, global_field_sum -use MOM_domain_infra, only : pass_var_start, pass_var_complete -use MOM_domain_infra, only : pass_vector_start, pass_vector_complete -use MOM_domain_infra, only : create_group_pass, do_group_pass -use MOM_domain_infra, only : start_group_pass, complete_group_pass -use MOM_domain_infra, only : rescale_comp_data, global_field, redistribute_array, broadcast_domain -use MOM_domain_infra, only : MOM_thread_affinity_set, set_MOM_thread_affinity -use MOM_domain_infra, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM -use MOM_domain_infra, only : CORNER, CENTER, NORTH_FACE, EAST_FACE -use MOM_domain_infra, only : To_East, To_West, To_North, To_South, To_All, Omit_Corners -use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_io_infra, only : file_exists +use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Get_PElist +use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs +use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end +use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL, is_root_pe +use MOM_file_parser, only : get_param, log_param, log_version +use MOM_file_parser, only : param_file_type use MOM_string_functions, only : slasher implicit none ; private -public :: MOM_infra_init, MOM_infra_end -! Domain types and creation and destruction routines -public :: MOM_domain_type, domain2D, domain1D -public :: MOM_domains_init, create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain -public :: MOM_thread_affinity_set, set_MOM_thread_affinity -! Domain query routines -public :: get_domain_extent, get_domain_components, get_global_shape, same_domain -public :: PE_here, root_PE, num_PEs -! Blocks are not actively used in MOM6, so this routine could be deprecated. -public :: compute_block_extent -! Single call communication routines -public :: pass_var, pass_vector, fill_symmetric_edges, broadcast -! Non-blocking communication routines -public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete -! Multi-variable group communication routines and type -public :: create_group_pass, do_group_pass, group_pass_type, start_group_pass, complete_group_pass -! Global reduction routines -public :: sum_across_PEs, min_across_PEs, max_across_PEs -public :: global_field, redistribute_array, broadcast_domain -! Simple index-convention-invariant array manipulation routine -public :: rescale_comp_data -!> These encoding constants are used to indicate the staggering of scalars and vectors -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR -!> These encoding constants are used to indicate the discretization position of a variable -public :: CORNER, CENTER, NORTH_FACE, EAST_FACE -!> These encoding constants indicate communication patterns. In practice they can be added. +public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 +public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs, Get_PElist +public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast +public :: pass_vector_start, pass_vector_complete +public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners ! These are no longer used by MOM6 because the reproducing sum works so well, but they are ! still referenced by some of the non-GFDL couplers. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 99dd38135d..c9ae6e43ed 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -401,7 +401,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - u_star = fluxes%ustar(i,j) + u_star = fluxes%ustar(i,j)*(fluxes%t_rp(i,j)) u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then From a534541c52b5b319c6f07df4b01992b3f4c96bc7 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 2 Dec 2020 15:35:05 +0000 Subject: [PATCH 02/83] cleanup of code and enhancement of ePBL perts --- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 2 - src/core/MOM.F90 | 28 +-- src/core/MOM_forcing_type.F90 | 43 +++-- src/diagnostics/MOM_diagnostics.F90 | 16 +- .../vertical/MOM_diabatic_driver.F90 | 174 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 62 ++++--- 6 files changed, 172 insertions(+), 153 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 10add0f8d0..c704214930 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -315,8 +315,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call safe_alloc_ptr(fluxes%p_surf ,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - print*,'allocate fluxes%t_rp' - call safe_alloc_ptr(fluxes%t_rp,isd,ied,jsd,jed) if (CS%use_limited_P_SSH) then fluxes%p_surf_SSH => fluxes%p_surf else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ae535dcbeb..1a5b27a462 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -155,7 +155,7 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline -use stochastic_physics, only : init_stochastic_physics_ocn,run_stochastic_physics_ocn +use stochastic_physics, only : init_stochastic_physics_ocn implicit none ; private @@ -828,9 +828,6 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif - print*,'calling run_stochastic_physics_ocn',CS%do_stochy - if (CS%do_stochy) call run_stochastic_physics_ocn(forces%t_rp) - call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & Time_local, Waves=Waves) @@ -982,7 +979,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%time_in_thermo_cycle > 0.0) then call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & - sfc_state, CS%tv, ssh, fluxes%t_rp, CS%ave_ssh_ibc) + sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc) + !sfc_state_diag, CS%tv, ssh,fluxes%t_rp,fluxes%sppt_wts, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1809,6 +1807,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: calc_dtbt ! Indicates whether the dynamically adjusted barotropic ! time step needs to be updated before it is used. logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. + logical :: do_epbl,do_sppt integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the ! calculation. @@ -1816,7 +1815,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean - integer :: num_procs + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs,iret ! model integer :: me ! my pe integer :: master ! root pe @@ -2506,14 +2506,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & num_procs=num_PEs() allocate(pelist(num_procs)) - call Get_PElist(pelist) + call Get_PElist(pelist,commID = mom_comm) me=PE_here() master=root_PE() - !call init_stochastic_physics_ocn(CS%dt_therm,G,me,master,pelist,CS%do_stochy) - print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) - call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,CS%do_stochy) - print*,'back from init_stochastic_physics_ocn',CS%do_stochy + !print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) + do_epbl=.false. + do_sppt=.false. + call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) + if (do_sppt .eq. .true.) CS%do_stochy=.true. + if (do_epbl .eq. .true.) CS%do_stochy=.true. + !print*,'back from init_stochastic_physics_ocn',CS%do_stochy ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then @@ -2969,6 +2972,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! call fix_restart_scaling(GV) ! call fix_restart_unit_scaling(US) + CS%diabatic_CSp%do_epbl=do_epbl + CS%diabatic_CSp%do_sppt=do_sppt + call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e11b6a39ce..c363d72f09 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -145,8 +145,10 @@ module MOM_forcing_type !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. - real, pointer, dimension(:,:) :: t_rp => NULL() - !< random pattern at t-points +! real, pointer, dimension(:,:) :: t_rp => NULL() +! !< random pattern at t-points +! real, pointer, dimension(:,:) :: sppt_wts => NULL() +! !< random pattern at t-points logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -250,10 +252,14 @@ module MOM_forcing_type !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled, !! and is exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: & - rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points [m3 s-1] - rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points [m3 s-1] - real, pointer, dimension(:,:) :: t_rp => NULL() - !< random pattern at t-points + rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at + !! u-points [L4 Z-1 T-1 ~> m3 s-1] + rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at + !! v-points [L4 Z-1 T-1 ~> m3 s-1] +! real, pointer, dimension(:,:) :: t_rp => NULL() +! !< random pattern at t-points +! real, pointer, dimension(:,:) :: sppt_wts => NULL() +! !< random pattern at t-points real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -2128,11 +2134,17 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres - if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then - do j=js,je ; do i=is,ie - fluxes%t_rp(i,j) = forces%t_rp(i,j) - enddo ; enddo - endif +! if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then +! do j=js,je ; do i=is,ie +! fluxes%t_rp(i,j) = forces%t_rp(i,j) +! enddo ; enddo +! endif +! +! if (associated(forces%sppt_wts) .and. associated(fluxes%sppt_wts)) then +! do j=js,je ; do i=is,ie +! fluxes%sppt_wts(i,j) = forces%sppt_wts(i,j) +! enddo ; enddo +! endif if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie @@ -3096,7 +3108,8 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) call myAlloc(forces%net_mass_src,isd,ied,jsd,jed, press) - call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) +! call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) +! call myAlloc(forces%sppt_wts,isd,ied,jsd,jed, press) call myAlloc(forces%rigidity_ice_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%rigidity_ice_v,isd,ied,JsdB,JedB, shelf) @@ -3261,7 +3274,8 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) - if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) +! if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) +! if (associated(fluxes%sppt_wts)) deallocate(fluxes%sppt_wts) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) @@ -3290,7 +3304,8 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%ustar)) deallocate(forces%ustar) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) - if (associated(forces%t_rp)) deallocate(forces%t_rp) +! if (associated(forces%t_rp)) deallocate(forces%t_rp) +! if (associated(forces%sppt_wts)) deallocate(forces%sppt_wts) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index fca2ed869f..b60093dce5 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -139,8 +139,6 @@ module MOM_diagnostics integer :: id_salt_deficit = -1 integer :: id_Heat_PmE = -1 integer :: id_intern_heat = -1 -! stochastic pattern - integer :: id_t_rp = -1 !!@} end type surface_diag_IDs @@ -1279,7 +1277,7 @@ end subroutine post_surface_dyn_diags !> 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_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv, & - ssh, t_rp, ssh_ibc) + 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 @@ -1290,8 +1288,6 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv 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] - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: t_rp!< random pattern for stochastic proceeses real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] @@ -1418,11 +1414,6 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv call post_data(IDs%id_sss_sq, work_2d, diag, mask=G%mask2dT) endif - if (IDs%id_t_rp > 0) then - !call post_data(IDs%id_t_rp, t_rp, diag, mask=G%mask2dT) - call post_data(IDs%id_t_rp, t_rp, diag) - endif - call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag)) end subroutine post_surface_thermo_diags @@ -1910,9 +1901,8 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& - 'Heat flux into ocean from geothermal or other internal sources', 'W m-2') - IDs%id_t_rp = register_diag_field('ocean_model', 'random_pattern', diag%axesT1, Time, & - 'random pattern for stochastics', 'None') + 'Heat flux into ocean from geothermal or other internal sources', & + 'W m-2', conversion=US%QRZ_T_to_W_m2) end subroutine register_surface_diags diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 5eaca3c275..c44ebba5b3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -69,7 +69,8 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS -use MOM_stochastics, only : stochastic_CS +use stochastic_physics, only : run_stochastic_physics_ocn + implicit none ; private @@ -175,20 +176,15 @@ module MOM_diabatic_driver real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diag handle for mode-1 speed - integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds - integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic - integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 - integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 - integer :: id_Tdif = -1, id_Sdif = -1, id_Tadv = -1, id_Sadv = -1 - ! These are handles to diagnostics related to the mixed layer properties. - integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_MLD_EN1 = -1, id_MLD_EN2 = -1, id_MLD_EN3 = -1, id_subMLN2 = -1 - - ! These are handles to diatgnostics that are only available in non-ALE layered mode. - integer :: id_wd = -1 - integer :: id_dudt_dia = -1, id_dvdt_dia = -1 - integer :: id_hf_dudt_dia_2d = -1, id_hf_dvdt_dia_2d = -1 + integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) + integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) + integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic + integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_ea_s = -1, id_eb_s = -1 + integer :: id_ea_t = -1, id_eb_t = -1 + integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 + integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 + integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 + integer :: id_subMLN2 = -1, id_brine_lay = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -220,6 +216,10 @@ module MOM_diabatic_driver logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics + logical,public :: do_epbl = .false. !< If true pertrub u_start in ePBL calculation + logical,public :: do_sppt = .false. !< If true perturb all physics tendenceies in MOM_diabatic_driver + real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil + real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module @@ -303,31 +303,36 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics - real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics - real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics + real, dimension(SZI_(G),SZJ_(G)) :: sppt_wts + real, dimension(SZI_(G),SZJ_(G),2) :: t_rp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT - real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT + real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT if (G%ke == 1) return - ! save copy of the date for SPPT if active - if (stoch_CS%do_sppt) then - allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - h_in(:,:,:)=h(:,:,:) - t_in(:,:,:)=tv%T(:,:,:) - s_in(:,:,:)=tv%S(:,:,:) - - if (stoch_CS%id_sppt_wts > 0) then - call post_data(stoch_CS%id_sppt_wts, stoch_CS%sppt_wts, CS%diag) - endif + ! save copy of the date for SPPT + if (CS%do_sppt) then + h_in=h + t_in=tv%T + s_in=tv%S + endif + call run_stochastic_physics_ocn(t_rp,sppt_wts) + !print*,'in diabatic',CS%do_sppt,size(t_in,1),size(t_in,2),size(t_in,3),size(sppt_wts,1),size(sppt_wts,2) + !print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) + if (CS%id_t_rp1 > 0) then + call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) + endif + if (CS%id_t_rp2 > 0) then + call post_data(CS%id_t_rp2, t_rp(:,:,2), CS%diag) + endif + if (CS%id_sppt_wts > 0) then + call post_data(CS%id_sppt_wts, sppt_wts, CS%diag) endif - if (GV%ke == 1) return - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -411,11 +416,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) + call diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -481,55 +486,53 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) - if (stoch_CS%do_sppt) then - ! perturb diabatic tendecies + if (CS%do_sppt) then do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*stoch_CS%sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stoch_CS%sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stoch_CS%sppt_wts(i,j) + h_tend = (h(i,j,k)-h_in(i,j,k))*sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*sppt_wts(i,j) h_pert=h_tend+h_in(i,j,k) t_pert=t_tend+t_in(i,j,k) s_pert=s_tend+s_in(i,j,k) if (h_pert > GV%Angstrom_H) then - h(i,j,k) = h_pert + h(i,j,k)=h_pert else - h(i,j,k) = GV%Angstrom_H + h(i,j,k)=GV%Angstrom_H endif - tv%T(i,j,k) = t_pert + tv%T(i,j,k)=t_pert if (s_pert > 0.0) then - tv%S(i,j,k) = s_pert + tv%S(i,j,k)=s_pert endif enddo enddo enddo - deallocate(h_in) - deallocate(t_in) - deallocate(s_in) endif end subroutine diabatic +end subroutine diabatic + !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, - !! BBL properties and related fields - type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum + real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -837,8 +840,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -1100,22 +1103,22 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, - !! BBL properties and related fields - type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum + real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1374,8 +1377,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -3138,11 +3141,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_dvdt_dia_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - if ((CS%id_dudt_dia > 0) .or. (CS%id_hf_dudt_dia_2d > 0)) & - call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) - if ((CS%id_dvdt_dia > 0) .or. (CS%id_hf_dvdt_dia_2d > 0)) & - call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) - endif + CS%id_dudt_dia = register_diag_field('ocean_model', 'dudt_dia', diag%axesCuL, Time, & + 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_dvdt_dia = register_diag_field('ocean_model', 'dvdt_dia', diag%axesCvL, Time, & + 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & + 'random pattern1 for stochastics', 'None') + CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & + 'random pattern2 for stochastics', 'None') + CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', diag%axesT1, Time, & + 'random pattern for sppt', 'None') if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index c9ae6e43ed..ffa942b03a 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -165,6 +165,7 @@ module MOM_energetic_PBL !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. + logical :: do_epbl type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -244,8 +245,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, Waves ) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, US, CS, & + dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & + dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -277,8 +279,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 T-1 ~> m2 s-1]. - type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct + !! [Z2 s-1 ~> m2 s-1]. + type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous + !! call to mixedlayer_init. + real, dimension(SZI_(G),SZJ_(G),2), & + intent(in) :: t_rp !< random pattern to perturb wind real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -401,7 +406,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - u_star = fluxes%ustar(i,j)*(fluxes%t_rp(i,j)) + !print*,'PJP EPBL',minval(t_rp),maxval(t_rp) + u_star = fluxes%ustar(i,j)!*t_rp(i,j) u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then @@ -423,16 +429,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - if (stoch_CS%pert_epbl) then ! stochastics are active - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, Waves, G, i, j, & - epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j)) - else - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, Waves, G, i, j) - endif + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + + ! applly stochastic perturbation to TKE generation ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -500,7 +501,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - Waves, G, i, j, epbl1_wt, epbl2_wt) + t_rp1,t_rp2, dt_diag, Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -537,12 +538,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, optional, intent(in) :: epbl1_wt !< random number to perturb KE generation - real, optional, intent(in) :: epbl2_wt !< random number to perturb KE dissipation - integer, intent(in) :: i !< The i-index to work on (used for Waves) - integer, intent(in) :: j !< The i-index to work on (used for Waves) + real, intent(in) :: t_rp1 !< random value to perturb TKE production + real, intent(in) :: t_rp2 !< random value to perturb TKE production + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [T ~> s]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS for Langmuir turbulence + type(ocean_grid_type), & + optional, intent(inout) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) + integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) ! This subroutine determines the diffusivities in a single column from the integrated energetics ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes @@ -831,8 +836,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif - ! stochastically pertrub mech_TKE in the UFS - if (present(epbl1_wt)) mech_TKE=mech_TKE*epbl1_wt + ! stochastically pertrub mech_TKE + mech_TKE=mech_TKE*t_rp1 if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -914,12 +919,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs exp_kh = 1.0 if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) - else - mech_TKE = mech_TKE * exp_kh - endif + !eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag + eCD%dTKE_mech_decay = exp_kh + mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From a0e5b56afaeb70957d91f3ce2795ed40fda3542d Mon Sep 17 00:00:00 2001 From: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Date: Wed, 2 Dec 2020 09:03:36 -0700 Subject: [PATCH 03/83] Update MOM_diabatic_driver.F90 remove conflict with dev/emc --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c44ebba5b3..95ec33e91a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -184,7 +184,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_brine_lay = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 From c48a46ae01cf094c919ca8aae9971a0feea09c4d Mon Sep 17 00:00:00 2001 From: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Date: Wed, 2 Dec 2020 09:05:28 -0700 Subject: [PATCH 04/83] Update MOM_diabatic_driver.F90 further resolve conflict --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 95ec33e91a..14856b4415 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -184,7 +184,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 + integer :: id_subMLN2 = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 From 5f6973b4d77d3829fd51e75d333d153dd69c7ca1 Mon Sep 17 00:00:00 2001 From: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Date: Wed, 2 Dec 2020 09:06:52 -0700 Subject: [PATCH 05/83] Update MOM_diabatic_driver.F90 put id_sppt_wts, etc back. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 14856b4415..95ec33e91a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -184,7 +184,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 From 36ce2d10807e8b43d3a1588e712d74f9cf42dd75 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 14 Dec 2020 15:47:16 +0000 Subject: [PATCH 06/83] add stochy_restart writing to mom_cap --- config_src/drivers/nuopc_cap/mom_cap.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 174a659f12..0434103b5a 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,6 +97,7 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM +use get_stochy_pattern_mod, only: write_stoch_restart_ocn !$use omp_lib , only : omp_set_num_threads @@ -1749,9 +1750,17 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname, & - stoch_restartname=stoch_restartname) + call ocean_model_restart(ocean_state, restartname=restartname) + ! write stochastic physics restart file if active + if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then + write(restartname,'(A)')"ocn_stoch.res.nc") + else + write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & + "oc_stoch.res.", year, month, day, hour, minute, seconds,".nc" + endif + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) + call write_stoch_restart_ocn('RESTART/'//trim(timestamp)//'.ocn_stoch.res.nc') endif if (is_root_pe()) then From becb4420e0eaa6d32511ba7efdedd96d2450632b Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 22 Dec 2020 18:40:13 +0000 Subject: [PATCH 07/83] additions for stochy restarts --- config_src/drivers/nuopc_cap/mom_cap.F90 | 11 ++++++++--- config_src/drivers/solo_driver/MOM_driver.F90 | 16 ++++++++++++++++ src/core/MOM.F90 | 14 +++++++------- .../vertical/MOM_diabatic_driver.F90 | 16 +++++++++++++--- .../vertical/MOM_energetic_PBL.F90 | 19 ++++++++++--------- 5 files changed, 54 insertions(+), 22 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 0434103b5a..b298270d17 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,7 +97,9 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM +#ifdef UFS use get_stochy_pattern_mod, only: write_stoch_restart_ocn +#endif !$use omp_lib , only : omp_set_num_threads @@ -1753,14 +1755,17 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, restartname=restartname) ! write stochastic physics restart file if active +#ifdef UFS if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then - write(restartname,'(A)')"ocn_stoch.res.nc") + write(restartname,'(A)')"ocn_stoch.res.nc" else write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & - "oc_stoch.res.", year, month, day, hour, minute, seconds,".nc" + "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - call write_stoch_restart_ocn('RESTART/'//trim(timestamp)//'.ocn_stoch.res.nc') + if (is_root_pe()) print*,'calling write_stoch_restart_ocn ',trim(restartname) + call write_stoch_restart_ocn('RESTART/'//trim(restartname)) +#endif endif if (is_root_pe()) then diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 1b88f1ce36..eb6f64710d 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -69,6 +69,22 @@ program MOM_main use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS + use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_size + use ensemble_manager_mod, only : ensemble_pelist_setup + use mpp_mod, only : set_current_pelist => mpp_set_current_pelist + use time_interp_external_mod, only : time_interp_external_init + use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get + + use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS + use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart +! , add_shelf_flux_forcing, add_shelf_flux_IOB + + use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init + use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves +#ifdef UFS + use get_stochy_pattern_mod, only: write_stoch_restart_ocn +#endif + implicit none #include diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1a5b27a462..e864b9f481 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -155,7 +155,9 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline +#ifdef UFS use stochastic_physics, only : init_stochastic_physics_ocn +#endif implicit none ; private @@ -248,8 +250,6 @@ module MOM 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 :: do_stochy = .false. - !< If true, call stochastic physics pattern generator type(time_type), pointer :: Time !< pointer to the ocean clock real :: dt !< (baroclinic) dynamics time step [T ~> s] @@ -2504,6 +2504,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) + do_epbl=.false. + do_sppt=.false. +#ifdef UFS num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) @@ -2511,12 +2514,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & master=root_PE() !print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) - do_epbl=.false. - do_sppt=.false. + if (master) print*,'about to call init_stochastic_physics' call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) - if (do_sppt .eq. .true.) CS%do_stochy=.true. - if (do_epbl .eq. .true.) CS%do_stochy=.true. - !print*,'back from init_stochastic_physics_ocn',CS%do_stochy +#endif ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 95ec33e91a..bef2e1c584 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -69,7 +69,9 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS +#ifdef UFS use stochastic_physics, only : run_stochastic_physics_ocn +#endif implicit none ; private @@ -305,23 +307,28 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G)) :: sppt_wts real, dimension(SZI_(G),SZJ_(G),2) :: t_rp +#ifdef UFS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT +#endif if (G%ke == 1) return +#ifdef UFS ! save copy of the date for SPPT if (CS%do_sppt) then h_in=h t_in=tv%T s_in=tv%S endif + print*,'calling run_stochastic_physics' call run_stochastic_physics_ocn(t_rp,sppt_wts) !print*,'in diabatic',CS%do_sppt,size(t_in,1),size(t_in,2),size(t_in,3),size(sppt_wts,1),size(sppt_wts,2) - !print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) + print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) + print*,'in diabatic',CS%do_sppt,minval(t_rp),maxval(t_rp) if (CS%id_t_rp1 > 0) then call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) endif @@ -331,6 +338,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_sppt_wts > 0) then call post_data(CS%id_sppt_wts, sppt_wts, CS%diag) endif +#endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -486,6 +494,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) +#ifdef UFS if (CS%do_sppt) then do k=1,nz do j=js,je @@ -509,6 +518,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo enddo endif +#endif end subroutine diabatic @@ -840,7 +850,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, d endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -1377,7 +1387,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index ffa942b03a..4f7fff1a05 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -245,7 +245,7 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, US, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -284,6 +284,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G),2), & intent(in) :: t_rp !< random pattern to perturb wind + logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -406,8 +407,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - !print*,'PJP EPBL',minval(t_rp),maxval(t_rp) - u_star = fluxes%ustar(i,j)!*t_rp(i,j) + u_star = fluxes%ustar(i,j) u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then @@ -431,7 +431,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), stoch_epbl, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) ! applly stochastic perturbation to TKE generation @@ -501,7 +501,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - t_rp1,t_rp2, dt_diag, Waves, G, i, j) + t_rp1,t_rp2, stoch_epbl, dt_diag, Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -539,7 +539,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. real, intent(in) :: t_rp1 !< random value to perturb TKE production - real, intent(in) :: t_rp2 !< random value to perturb TKE production + real, intent(in) :: t_rp2 !< random value to perturb TKE dissipation + logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two calls to mixedlayer [T ~> s]. type(wave_parameters_CS), & @@ -836,8 +837,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif - ! stochastically pertrub mech_TKE - mech_TKE=mech_TKE*t_rp1 + ! stochastically pertrub mech_TKE in the UFS + if (stoch_epbl) mech_TKE=mech_TKE*t_rp1 if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -921,7 +922,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & !eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag eCD%dTKE_mech_decay = exp_kh - mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + if (stoch_epbl) mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 0c48bfc6a4aff73da944a7eecf6e1e7d57db20cd Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 23 Dec 2020 21:46:27 +0000 Subject: [PATCH 08/83] clean up debug statements --- config_src/drivers/nuopc_cap/mom_cap.F90 | 1 - config_src/drivers/solo_driver/MOM_driver.F90 | 3 --- src/core/MOM.F90 | 2 -- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ---- 4 files changed, 10 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index b298270d17..8778df067a 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -1763,7 +1763,6 @@ subroutine ModelAdvance(gcomp, rc) "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - if (is_root_pe()) print*,'calling write_stoch_restart_ocn ',trim(restartname) call write_stoch_restart_ocn('RESTART/'//trim(restartname)) #endif endif diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index eb6f64710d..5bfe0bb8a2 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -81,9 +81,6 @@ program MOM_main use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves -#ifdef UFS - use get_stochy_pattern_mod, only: write_stoch_restart_ocn -#endif implicit none diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e864b9f481..058c285133 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2513,8 +2513,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & me=PE_here() master=root_PE() - !print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) - if (master) print*,'about to call init_stochastic_physics' call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) #endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index bef2e1c584..01ae5811af 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -324,11 +324,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & t_in=tv%T s_in=tv%S endif - print*,'calling run_stochastic_physics' call run_stochastic_physics_ocn(t_rp,sppt_wts) - !print*,'in diabatic',CS%do_sppt,size(t_in,1),size(t_in,2),size(t_in,3),size(sppt_wts,1),size(sppt_wts,2) - print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) - print*,'in diabatic',CS%do_sppt,minval(t_rp),maxval(t_rp) if (CS%id_t_rp1 > 0) then call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) endif From 49111ff9fef60d180f33272e19acf32da4e800ed Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 6 Jan 2021 15:35:18 +0000 Subject: [PATCH 09/83] clean up code --- src/core/MOM.F90 | 7 +++-- src/core/MOM_forcing_type.F90 | 26 ------------------- src/diagnostics/MOM_diagnostics.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 6 ++--- 4 files changed, 6 insertions(+), 35 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 058c285133..0c5a1a9788 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -980,7 +980,6 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc) - !sfc_state_diag, CS%tv, ssh,fluxes%t_rp,fluxes%sppt_wts, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1815,9 +1814,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean - integer :: mom_comm ! list of pes for this instance of the ocean - integer :: num_procs,iret -! model + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs ! number of processors to pass to stochastic physics + integer :: iret ! return code from stochastic physics integer :: me ! my pe integer :: master ! root pe real :: conv2watt, conv2salt diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index c363d72f09..3248c09fa4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -145,10 +145,6 @@ module MOM_forcing_type !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. -! real, pointer, dimension(:,:) :: t_rp => NULL() -! !< random pattern at t-points -! real, pointer, dimension(:,:) :: sppt_wts => NULL() -! !< random pattern at t-points logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -256,10 +252,6 @@ module MOM_forcing_type !! u-points [L4 Z-1 T-1 ~> m3 s-1] rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at !! v-points [L4 Z-1 T-1 ~> m3 s-1] -! real, pointer, dimension(:,:) :: t_rp => NULL() -! !< random pattern at t-points -! real, pointer, dimension(:,:) :: sppt_wts => NULL() -! !< random pattern at t-points real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -2134,18 +2126,6 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres -! if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then -! do j=js,je ; do i=is,ie -! fluxes%t_rp(i,j) = forces%t_rp(i,j) -! enddo ; enddo -! endif -! -! if (associated(forces%sppt_wts) .and. associated(fluxes%sppt_wts)) then -! do j=js,je ; do i=is,ie -! fluxes%sppt_wts(i,j) = forces%sppt_wts(i,j) -! enddo ; enddo -! endif - if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie fluxes%ustar(i,j) = forces%ustar(i,j) @@ -3108,8 +3088,6 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) call myAlloc(forces%net_mass_src,isd,ied,jsd,jed, press) -! call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) -! call myAlloc(forces%sppt_wts,isd,ied,jsd,jed, press) call myAlloc(forces%rigidity_ice_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%rigidity_ice_v,isd,ied,JsdB,JedB, shelf) @@ -3274,8 +3252,6 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) -! if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) -! if (associated(fluxes%sppt_wts)) deallocate(fluxes%sppt_wts) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) @@ -3304,8 +3280,6 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%ustar)) deallocate(forces%ustar) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) -! if (associated(forces%t_rp)) deallocate(forces%t_rp) -! if (associated(forces%sppt_wts)) deallocate(forces%sppt_wts) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b60093dce5..e0b0d4469b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -139,7 +139,7 @@ module MOM_diagnostics integer :: id_salt_deficit = -1 integer :: id_Heat_PmE = -1 integer :: id_intern_heat = -1 - !!@} + !>@} end type surface_diag_IDs diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 4f7fff1a05..85dc52dd0e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -433,8 +433,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), stoch_epbl, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) - ! applly stochastic perturbation to TKE generation - ! Copy the diffusivities to a 2-d array. do K=1,nz+1 Kd_2d(i,K) = Kd(K) @@ -920,8 +918,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs exp_kh = 1.0 if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - !eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - eCD%dTKE_mech_decay = exp_kh + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag + mech_TKE = mech_TKE * exp_kh if (stoch_epbl) mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) ! Accumulate any convectively released potential energy to contribute From 15dde3622ae82a7c95ba6f62e34fbad976bfb7c9 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Thu, 7 Jan 2021 15:42:13 +0000 Subject: [PATCH 10/83] fix non stochastic ePBL calculation --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 85dc52dd0e..1cf089d5ed 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -919,8 +919,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - mech_TKE = mech_TKE * exp_kh - if (stoch_epbl) mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + if (stoch_epbl) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + else + mech_TKE = mech_TKE * exp_kh + endif ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 58f1fe98fc397abc4b6418b592b91575ae50a351 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 29 Jan 2021 19:40:10 +0000 Subject: [PATCH 11/83] re-write of stochastic code to remove CPP directives --- .../drivers/FMS_cap/ocean_model_MOM.F90 | 15 +-- .../drivers/mct_cap/mom_ocean_model_mct.F90 | 15 +-- config_src/drivers/nuopc_cap/mom_cap.F90 | 4 - .../nuopc_cap/mom_ocean_model_nuopc.F90 | 62 ++++++++----- config_src/drivers/solo_driver/MOM_driver.F90 | 14 +-- src/core/MOM.F90 | 48 +++------- src/core/MOM_variables.F90 | 7 ++ .../vertical/MOM_diabatic_driver.F90 | 93 +++++++------------ .../vertical/MOM_energetic_PBL.F90 | 79 ++++++++-------- 9 files changed, 158 insertions(+), 179 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 97fb869ad4..6292c32469 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -50,7 +50,7 @@ module ocean_model_mod use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -186,6 +186,7 @@ module ocean_model_mod !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. + type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -576,12 +577,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -603,16 +604,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda "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, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -629,7 +630,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. Time1 = Time1 - real_to_time(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index 3bd0e1e28d..4a4f6eee05 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -47,7 +47,7 @@ module MOM_ocean_model_mct use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -187,6 +187,7 @@ module MOM_ocean_model_mct !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. + type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -586,12 +587,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) @@ -615,16 +616,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -641,7 +642,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 8778df067a..3de56c0511 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,9 +97,7 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM -#ifdef UFS use get_stochy_pattern_mod, only: write_stoch_restart_ocn -#endif !$use omp_lib , only : omp_set_num_threads @@ -1755,7 +1753,6 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, restartname=restartname) ! write stochastic physics restart file if active -#ifdef UFS if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then write(restartname,'(A)')"ocn_stoch.res.nc" else @@ -1764,7 +1761,6 @@ subroutine ModelAdvance(gcomp, rc) endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) call write_stoch_restart_ocn('RESTART/'//trim(restartname)) -#endif endif if (is_root_pe()) then diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 448f23140e..290e6b30df 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -43,7 +43,7 @@ module MOM_ocean_model_nuopc use time_interp_external_mod,only : time_interp_external_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -62,8 +62,8 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use get_stochy_pattern_mod, only : write_stoch_restart_ocn -use iso_fortran_env, only : int64 +use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs +use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -194,6 +194,7 @@ module MOM_ocean_model_nuopc !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. + type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -255,9 +256,14 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! The actual depth over which melt potential is computed will !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot !< If true, allocate melt_potential array - logical :: use_CFC !< If true, allocated arrays for surface CFCs. - + logical :: use_melt_pot!< If true, allocate melt_potential array +! stochastic physics + integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs ! number of processors to pass to stochastic physics + integer :: iret ! return code from stochastic physics + integer :: me ! my pe + integer :: master ! root pe ! This include declares and sets the variable "version". #include "version_variable.h" @@ -429,19 +435,21 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif - call extract_surface_state(OS%MOM_CSp, OS%sfc_state) -! get number of processors and PE list for stocasthci physics initialization - call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & - "If true, then stochastically perturb the thermodynamic "//& - "tendencies of T,S, and h. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) - call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & - "If true, then stochastically perturb the kinetic energy "//& - "production and dissipation terms. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) + me=PE_here() + master=root_PE() + + call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& + OS%stochastics%pert_epbl,OS%stochastics%do_sppt,master,mom_comm,iret) + print*,'after init_stochastic_physics_ocn',OS%stochastics%pert_epbl,OS%stochastics%do_sppt + if (OS%stochastics%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%stochastics%pert_epbl) then + allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + endif call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -613,17 +621,23 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time +! update stochastic physics patterns before running next time-step + print*,'before call to stoch',OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl + if (OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl ) then + call run_stochastic_physics_ocn(OS%stochastics%sppt_wts,OS%stochastics%t_rp1,OS%stochastics%t_rp2) + endif + if (OS%offline_tracer_mode) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -646,16 +660,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -672,7 +686,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 5bfe0bb8a2..ee5e92e0f4 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -62,7 +62,7 @@ program MOM_main use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type - use MOM_variables, only : surface + use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only : Update_Surface_Waves @@ -91,6 +91,8 @@ program MOM_main ! A structure containing pointers to the thermodynamic forcing fields ! at the ocean surface. type(forcing) :: fluxes + type(stochastic_pattern) :: stochastics !< A structure containing pointers to + ! A structure containing pointers to the ocean surface state fields. type(surface) :: sfc_state @@ -487,7 +489,7 @@ program MOM_main if (offline_tracer_mode) then 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, Waves=Waves_CSP) + call step_MOM(forces, fluxes, sfc_state, stochastics, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) else n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) dt_dyn = dt_forcing / real(n_max) @@ -500,16 +502,16 @@ program MOM_main 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, & + call step_MOM(forces, fluxes, sfc_state, stochastics, 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, & + call step_MOM(forces, fluxes, sfc_state, stochastics, 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, & + call step_MOM(forces, fluxes, sfc_state, stochastics, Time2, dt_dyn, MOM_CSp, & do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) @@ -518,7 +520,7 @@ program MOM_main ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & Time2 = Time2 - real_to_time(dtdia - dt_dyn) - call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, stochastics, 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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0c5a1a9788..50e58b8a63 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -30,7 +30,6 @@ module MOM use MOM_domains, only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : start_group_pass, complete_group_pass, Omit_Corners -use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -133,7 +132,7 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_variables, only : rotate_surface_state +use MOM_variables, only : rotate_surface_state,stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units @@ -155,9 +154,6 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline -#ifdef UFS -use stochastic_physics, only : init_stochastic_physics_ocn -#endif implicit none ; private @@ -455,13 +451,14 @@ 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_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, & +subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & end_cycle, cycle_length, reset_therm) type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields type(surface), target, intent(inout) :: sfc_state !< surface ocean state + type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM @@ -770,8 +767,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS endif ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - end_time_thermo, .true., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & + dtdia, end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. @@ -871,8 +868,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS CS%Time = CS%Time - real_to_time(0.5*US%T_to_s*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - Time_local, .false., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & + dtdia, Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then @@ -1304,8 +1301,8 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. -subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & - Time_end_thermo, update_BBL, Waves) +subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, stochastics, & + dtdia, Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure @@ -1318,6 +1315,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s] type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. @@ -1393,8 +1391,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS, CS%OBC, Waves) + call diabatic(u, v, h, tv, CS%Hml, fluxes, stochastics, CS%visc, CS%ADp, CS%CDp, dtdia, & + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1806,19 +1804,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: calc_dtbt ! Indicates whether the dynamically adjusted barotropic ! time step needs to be updated before it is used. logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. - logical :: do_epbl,do_sppt integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the ! calculation. integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean - integer :: mom_comm ! list of pes for this instance of the ocean - integer :: num_procs ! number of processors to pass to stochastic physics - integer :: iret ! return code from stochastic physics - integer :: me ! my pe - integer :: master ! root pe real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units @@ -2503,18 +2494,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) - do_epbl=.false. - do_sppt=.false. -#ifdef UFS - num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) - me=PE_here() - master=root_PE() - - call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) -#endif - ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then call set_first_direction(G, modulo(first_direction + turns, 2)) @@ -2969,9 +2948,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! call fix_restart_scaling(GV) ! call fix_restart_unit_scaling(US) - CS%diabatic_CSp%do_epbl=do_epbl - CS%diabatic_CSp%do_sppt=do_sppt - call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a9bf6c3dcf..4020721075 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -276,6 +276,13 @@ module MOM_variables !> Container for information about the summed layer transports !! and how they will vary as the barotropic velocity is changed. +type, public :: stochastic_pattern + logical :: do_sppt = .false. + logical :: pert_epbl = .false. + real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT + real, allocatable :: t_rp1(:,:) !< Random pattern for K.E. generation + real, allocatable :: t_rp2(:,:) !< Random pattern for K.E. dissipation +end type stochastic_pattern type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east [H L ~> m2 or kg m-1]. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 01ae5811af..df4dd4c453 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -65,13 +65,10 @@ module MOM_diabatic_driver use MOM_tracer_diabatic, only : tracer_vertdiff, tracer_vertdiff_Eulerian use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs -use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d +use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS -#ifdef UFS -use stochastic_physics, only : run_stochastic_physics_ocn -#endif implicit none ; private @@ -218,8 +215,6 @@ module MOM_diabatic_driver logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics - logical,public :: do_epbl = .false. !< If true pertrub u_start in ePBL calculation - logical,public :: do_sppt = .false. !< If true perturb all physics tendenceies in MOM_diabatic_driver real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil @@ -270,21 +265,21 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, OBC, Waves) - 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_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields +subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, OBC, WAVES) + 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, - !! BBL properties and related fields - type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum + type(stochastic_pattern), intent(in) :: stochastics !< random patterns + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -305,36 +300,24 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G)) :: sppt_wts - real, dimension(SZI_(G),SZJ_(G),2) :: t_rp -#ifdef UFS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT -#endif if (G%ke == 1) return -#ifdef UFS ! save copy of the date for SPPT - if (CS%do_sppt) then - h_in=h - t_in=tv%T - s_in=tv%S - endif - call run_stochastic_physics_ocn(t_rp,sppt_wts) - if (CS%id_t_rp1 > 0) then - call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) - endif - if (CS%id_t_rp2 > 0) then - call post_data(CS%id_t_rp2, t_rp(:,:,2), CS%diag) - endif - if (CS%id_sppt_wts > 0) then - call post_data(CS%id_sppt_wts, sppt_wts, CS%diag) + if (stochastics%do_sppt) then + h_in=h + t_in=tv%T + s_in=tv%S + + if (CS%id_sppt_wts > 0) then + call post_data(CS%id_sppt_wts, stochastics%sppt_wts, CS%diag) + endif endif -#endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -420,10 +403,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + call diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & @@ -490,14 +473,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) -#ifdef UFS - if (CS%do_sppt) then + if (stochastics%do_sppt) then do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*sppt_wts(i,j) + h_tend = (h(i,j,k)-h_in(i,j,k))*stochastics%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stochastics%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stochastics%sppt_wts(i,j) h_pert=h_tend+h_in(i,j,k) t_pert=t_tend+t_in(i,j,k) s_pert=s_tend+s_in(i,j,k) @@ -514,7 +496,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo enddo endif -#endif end subroutine diabatic @@ -523,7 +504,7 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -533,10 +514,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, d real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] - type(forcing), intent(inout) :: fluxes !< points to forcing fields + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + type(stochastic_pattern), intent(in) :: stochastics !< points to forcing fields !! unused fields have NULL ptrs - real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived @@ -846,7 +827,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, d endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -1109,7 +1090,7 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1122,7 +1103,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern + type(stochastic_pattern), intent(in) :: stochastics !< random patterns type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived @@ -1383,7 +1364,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -3151,12 +3132,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_dvdt_dia = register_diag_field('ocean_model', 'dvdt_dia', diag%axesCvL, Time, & 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & - 'random pattern1 for stochastics', 'None') - CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & - 'random pattern2 for stochastics', 'None') CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', diag%axesT1, Time, & - 'random pattern for sppt', 'None') + 'random pattern for sppt', 'None') if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1cf089d5ed..a0b9ee0b51 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -14,7 +14,7 @@ module MOM_energetic_PBL use MOM_grid, only : ocean_grid_type use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs +use MOM_variables, only : thermo_var_ptrs, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number use MOM_stochastics, only : stochastic_CS @@ -165,7 +165,6 @@ module MOM_energetic_PBL !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. - logical :: do_epbl type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -198,6 +197,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 + integer :: id_t_rp1=-1,id_t_rp2=-1 !>@} end type energetic_PBL_CS @@ -245,7 +245,7 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_int, G, GV, US, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -276,15 +276,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. + type(stochastic_pattern), intent(in) :: stochastics !< A structure containing array to any unsued fields + !! are not allocated real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. - real, dimension(SZI_(G),SZJ_(G),2), & - intent(in) :: t_rp !< random pattern to perturb wind - logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -429,9 +428,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), stoch_epbl, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, stochastics, & + B_flux, absf, u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, & + GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -470,26 +469,30 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ enddo ! j-loop - if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) - if (stoch_CS%pert_epbl) then - if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) - if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) + if (write_diags) then + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + ! only write random patterns if running with stochastic physics, otherwise the + ! array is unallocated and will give an error + if (stochastics%pert_epbl) then + if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) + if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) + endif endif end subroutine energetic_PBL @@ -497,9 +500,9 @@ end subroutine energetic_PBL !> This subroutine determines the diffusivities from the integrated energetics !! mixed layer model for a single column of water. -subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & +subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - t_rp1,t_rp2, stoch_epbl, dt_diag, Waves, G, i, j) + dt_diag, Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -518,6 +521,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the !! forcing that has been applied to each layer !! [R Z3 T-2 ~> J m-2]. + type(stochastic_pattern), intent(in) :: stochastics !< stochastic patterns and logic controls real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1 ~> s-1]. real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. @@ -536,9 +540,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - real, intent(in) :: t_rp1 !< random value to perturb TKE production - real, intent(in) :: t_rp2 !< random value to perturb TKE dissipation - logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two calls to mixedlayer [T ~> s]. type(wave_parameters_CS), & @@ -836,7 +837,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (stoch_epbl) mech_TKE=mech_TKE*t_rp1 + if (stochastics%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -919,8 +920,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (stoch_epbl) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + if (stochastics%pert_epbl) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) else mech_TKE = mech_TKE * exp_kh endif @@ -2326,6 +2327,10 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') + CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & + 'random pattern1 for stochastics', 'None') + CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & + 'random pattern2 for stochastics', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From 9e7029ca85aa7bd5f34decc170be7d5e824ad40f Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 29 Jan 2021 20:49:07 +0000 Subject: [PATCH 12/83] clean up MOM_domains --- src/framework/MOM_domains.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index acbc1ccaea..ce4c1a9d6e 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,6 +3,8 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_array_transform, only : rotate_array use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Get_PElist use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end From 0bf4ff0a109c6e98507d6364d02b0179f229b49b Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 2 Feb 2021 00:05:24 +0000 Subject: [PATCH 13/83] make stochastics optional --- .../drivers/FMS_cap/ocean_model_MOM.F90 | 17 ++- .../drivers/mct_cap/mom_ocean_model_mct.F90 | 15 ++- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 80 ++++++++----- config_src/drivers/solo_driver/MOM_driver.F90 | 13 +-- src/core/MOM.F90 | 25 ++-- src/core/MOM_variables.F90 | 2 - .../vertical/MOM_diabatic_driver.F90 | 110 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 56 ++++++--- 8 files changed, 181 insertions(+), 137 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 6292c32469..e0c512250b 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -50,7 +50,7 @@ module ocean_model_mod use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, stochastic_pattern +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -186,7 +186,6 @@ module ocean_model_mod !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -562,7 +561,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. @@ -577,12 +576,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -604,16 +603,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda "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, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -630,7 +629,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. Time1 = Time1 - real_to_time(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index 4a4f6eee05..3bd0e1e28d 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -47,7 +47,7 @@ module MOM_ocean_model_mct use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, stochastic_pattern +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -187,7 +187,6 @@ module MOM_ocean_model_mct !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -587,12 +586,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) @@ -616,16 +615,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -642,7 +641,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 290e6b30df..3ac6ef542d 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -177,10 +177,8 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical :: do_sppt !< If true, stochastically perturb the diabatic and - !! write restarts - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and - !! genration termsand write restarts + logical :: do_sppt !< If true, allocate array for SPPT + logical :: pert_epbl !< If true, allocate arrays for energetic PBL perturbations real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -435,20 +433,38 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif - num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) - me=PE_here() - master=root_PE() - - call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& - OS%stochastics%pert_epbl,OS%stochastics%do_sppt,master,mom_comm,iret) - print*,'after init_stochastic_physics_ocn',OS%stochastics%pert_epbl,OS%stochastics%do_sppt +! get number of processors and PE list for stocasthci physics initialization + call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & + "If true, then stochastically perturb the thermodynamic "//& + "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & + "If true, then stochastically perturb the kinetic energy "//& + "production and dissipation terms. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + if (OS%do_sppt .OR. OS%pert_epbl) then + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) + me=PE_here() + master=root_PE() + + call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& + OS%pert_epbl,OS%do_sppt,master,mom_comm,iret) + if (iret/=0) then + write(6,*) 'call to init_stochastic_physics_ocn failed' + call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & + "not activated in stochastic_physics namelist ") + return + endif - if (OS%stochastics%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - if (OS%stochastics%pert_epbl) then - allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%pert_epbl) then + allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + endif endif call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -622,8 +638,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time ! update stochastic physics patterns before running next time-step - print*,'before call to stoch',OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl - if (OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl ) then + if (OS%do_sppt .OR. OS%pert_epbl ) then call run_stochastic_physics_ocn(OS%stochastics%sppt_wts,OS%stochastics%t_rp1,OS%stochastics%t_rp2) endif @@ -631,13 +646,14 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & - reset_therm=Ocn_fluxes_used) + reset_therm=Ocn_fluxes_used, stochastics=OS%stochastics) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves, & + stochastics=OS%stochastics) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -660,18 +676,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & + stochastics=OS%stochastics) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & + stochastics=OS%stochastics) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & + stochastics=OS%stochastics) step_thermo = .false. if (thermo_does_span_coupling) then @@ -686,9 +705,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & + stochastics=OS%stochastics) endif endif diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index ee5e92e0f4..afb1901e0a 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -62,7 +62,7 @@ program MOM_main use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type - use MOM_variables, only : surface, stochastic_pattern + use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only : Update_Surface_Waves @@ -91,7 +91,6 @@ program MOM_main ! A structure containing pointers to the thermodynamic forcing fields ! at the ocean surface. type(forcing) :: fluxes - type(stochastic_pattern) :: stochastics !< A structure containing pointers to ! A structure containing pointers to the ocean surface state fields. type(surface) :: sfc_state @@ -489,7 +488,7 @@ program MOM_main if (offline_tracer_mode) then call step_offline(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp) elseif (single_step_call) then - call step_MOM(forces, fluxes, sfc_state, stochastics, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) + call step_MOM(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) else n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) dt_dyn = dt_forcing / real(n_max) @@ -502,16 +501,16 @@ program MOM_main 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, stochastics, Time2, dtdia, MOM_CSp, & + 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, stochastics, Time2, dt_dyn, MOM_CSp, & + 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, stochastics, Time2, dt_dyn, MOM_CSp, & + 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) @@ -520,7 +519,7 @@ program MOM_main ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & Time2 = Time2 - real_to_time(dtdia - dt_dyn) - call step_MOM(forces, fluxes, sfc_state, stochastics, Time2, dtdia, MOM_CSp, & + 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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 50e58b8a63..374d1be208 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -451,14 +451,13 @@ 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_in, fluxes_in, sfc_state, stochastics, Time_start, time_int_in, CS, & +subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & - end_cycle, cycle_length, reset_therm) + end_cycle, cycle_length, reset_therm, stochastics) type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields type(surface), target, intent(inout) :: sfc_state !< surface ocean state - type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM @@ -479,6 +478,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, ti logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patternss for stochastics ! local variables type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing @@ -767,8 +767,9 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, ti endif ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & - dtdia, end_time_thermo, .true., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & + end_time_thermo, .true., Waves=Waves, & + stochastics=stochastics) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. @@ -868,8 +869,9 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, ti CS%Time = CS%Time - real_to_time(0.5*US%T_to_s*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & - dtdia, Time_local, .false., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & + Time_local, .false., Waves=Waves, & + stochastics=stochastics) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then @@ -1301,8 +1303,8 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. -subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, stochastics, & - dtdia, Time_end_thermo, update_BBL, Waves) +subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & + Time_end_thermo, update_BBL, Waves, stochastics) 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 @@ -1391,8 +1393,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, stochastics, & call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, stochastics, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves, & + stochastics=stochastics) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4020721075..4d5c83f3bd 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -277,8 +277,6 @@ module MOM_variables !> Container for information about the summed layer transports !! and how they will vary as the barotropic velocity is changed. type, public :: stochastic_pattern - logical :: do_sppt = .false. - logical :: pert_epbl = .false. real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT real, allocatable :: t_rp1(:,:) !< Random pattern for K.E. generation real, allocatable :: t_rp2(:,:) !< Random pattern for K.E. dissipation diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index df4dd4c453..f5bd2225a3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -142,12 +142,12 @@ module MOM_diabatic_driver integer :: NKBL !< The number of buffer layers (if bulk_mixed_layer) logical :: massless_match_targets !< If true (the default), keep the T & S !! consistent with the target values. - logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless layers at the - !! bottom into the interior as though a diffusivity of - !! Kd_min_tr (see below) were operating. - logical :: mix_boundary_tracer_ALE !< If true, in ALE mode mix the passive tracers in massless - !! layers at the bottom into the interior as though a - !! diffusivity of Kd_min_tr (see below) were operating. + logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless + !! layers at the bottom into the interior as though + !! a diffusivity of Kd_min_tr (see below) were + !! operating. + logical :: do_sppt !< If true, stochastically perturb the diabatic + !! tendencies with a number between 0 and 2 real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at @@ -183,7 +183,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1 = -1, id_t_rp2 = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -265,8 +265,8 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, WAVES) +subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, OBC, WAVES, stochastics) 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] @@ -277,19 +277,18 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(stochastic_pattern), intent(in) :: stochastics !< random patterns type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(diabatic_CS), pointer :: CS !< module control structure - type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -300,16 +299,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickenss before thermodynamics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in ! temperature before thermodynamics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT - real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT + real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT if (G%ke == 1) return ! save copy of the date for SPPT - if (stochastics%do_sppt) then + if (CS%do_sppt) then h_in=h t_in=tv%T s_in=tv%S @@ -403,11 +402,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves,stochastics=stochastics) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves, stochastics=stochastics) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -473,7 +472,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) - if (stochastics%do_sppt) then + if (CS%do_sppt) then do k=1,nz do j=js,je do i=is,ie @@ -504,8 +503,8 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES, stochastics) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -516,18 +515,17 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields - type(stochastic_pattern), intent(in) :: stochastics !< points to forcing fields - !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and + !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -827,8 +825,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + waves=waves, stochastics=stochastics) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -1090,8 +1089,8 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves, stochastics) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1103,17 +1102,17 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, d real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(stochastic_pattern), intent(in) :: stochastics !< random patterns type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and + !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1364,8 +1363,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, d endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + waves=waves, stochastics=stochastics) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -3088,9 +3088,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "mass loss is passed down through the column.", & units="nondim", default=0.8) - if (CS%use_energetic_PBL .and. .not.CS%useALEalgorithm) & - call MOM_error(FATAL, "diabatic_driver_init: "//& - "ENERGETICS_SFC_PBL = True is only coded to work when USE_REGRIDDING = True.") + call get_param(param_file, mdl, "DO_SPPT", CS%do_sppt, & + "If true, then stochastically perturb the thermodynamic "//& + "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) ! Register all available diagnostics for this module. thickness_units = get_thickness_units(GV) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index a0b9ee0b51..4ef7239791 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -58,6 +58,7 @@ module MOM_energetic_PBL !! self-consistent mixed layer depth. Otherwise use the false position !! after a maximum and minimum bound have been evaluated and the !! returned value from the previous guess or bisection before this. + logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms integer :: max_MLD_its !< The maximum number of iterations that can be used to find a !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. @@ -245,9 +246,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, G, GV, US, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves ) + dT_expected, dS_expected, Waves, stochastics ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -276,8 +277,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. - type(stochastic_pattern), intent(in) :: stochastics !< A structure containing array to any unsued fields - !! are not allocated real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces @@ -286,8 +285,26 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. - type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence - type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [T ~> s]. + logical, optional, intent(in) :: last_call !< If true, this is the last call to + !! mixedlayer in the current time step, so + !! diagnostics will be written. The default + !! is .true. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(out) :: dT_expected !< The values of temperature change that + !! should be expected when the returned + !! diffusivities are applied [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(out) :: dS_expected !< The values of salinity change that + !! should be expected when the returned + !! diffusivities are applied [ppt]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS + type(stochastic_pattern), optional, & + intent(in) :: stochastics !< A structure containing array to stochastic + !! patterns. Any unsued fields + !! are not allocated ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -428,9 +445,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, stochastics, & + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, & B_flux, absf, u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, & - GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + stochastics=stochastics,i=i, j=j) ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -489,7 +507,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error - if (stochastics%pert_epbl) then + if (CS%pert_epbl) then if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) endif @@ -500,9 +518,9 @@ end subroutine energetic_PBL !> This subroutine determines the diffusivities from the integrated energetics !! mixed layer model for a single column of water. -subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics, B_flux, absf, & +subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, i, j) + dt_diag, Waves, G, stochastics, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -521,7 +539,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the !! forcing that has been applied to each layer !! [R Z3 T-2 ~> J m-2]. - type(stochastic_pattern), intent(in) :: stochastics !< stochastic patterns and logic controls real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1 ~> s-1]. real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. @@ -546,6 +563,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics optional, pointer :: Waves !< Wave CS for Langmuir turbulence type(ocean_grid_type), & optional, intent(inout) :: G !< The ocean's grid structure. + type(stochastic_pattern), & + optional, intent(in) :: stochastics !< stochastic patterns and logic controls integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) @@ -837,7 +856,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (stochastics%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) + if (CS%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -920,7 +939,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (stochastics%pert_epbl) then ! perturb the TKE destruction + if (CS%pert_epbl) then ! perturb the TKE destruction mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) else mech_TKE = mech_TKE * exp_kh @@ -2153,6 +2172,11 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "This is only used if USE_MLD_ITERATION is True.", & units="nondim", default=2.0) + call get_param(param_file, mdl, "PERT_EPBL", CS%pert_epbl, & + "If true, then stochastically perturb the kinetic energy "//& + "production and dissipation terms. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) !/ Turbulent velocity scale in mixing coefficient call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & "Selects the method for translating TKE into turbulent velocities. "//& @@ -2328,9 +2352,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & - 'random pattern1 for stochastics', 'None') + 'random pattern for KE generation', 'None') CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & - 'random pattern2 for stochastics', 'None') + 'random pattern for KE dissipation', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From e80d5f57ee97f290dbcf98b4d4ee894c389b2523 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 2 Feb 2021 00:13:24 +0000 Subject: [PATCH 14/83] correct coupled_driver/ocean_model_MOM.F90 and other cleanup --- config_src/drivers/FMS_cap/ocean_model_MOM.F90 | 2 +- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ++-- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index e0c512250b..97fb869ad4 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -561,7 +561,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f5bd2225a3..6ea57f56eb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -299,7 +299,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickenss before thermodynamics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickness before thermodynamics real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in ! temperature before thermodynamics real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT @@ -403,7 +403,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves,stochastics=stochastics) + G, GV, US, CS, Waves, stochastics=stochastics) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves, stochastics=stochastics) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 4ef7239791..7ad3aea276 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -445,9 +445,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, & - B_flux, absf, u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, & - GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & stochastics=stochastics,i=i, j=j) ! Copy the diffusivities to a 2-d array. From 08dc1a44b8c5d442ea19df9f402604f4f34c4ff6 Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Tue, 2 Feb 2021 09:45:46 -0600 Subject: [PATCH 15/83] clean up of code for MOM6 coding standards --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 8 +++--- src/core/MOM.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 27 ++++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 10 +++---- 4 files changed, 24 insertions(+), 23 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 3ac6ef542d..c20b0a08ef 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -460,10 +460,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i return endif - if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) if (OS%pert_epbl) then - allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) endif endif call close_param_file(param_file) @@ -639,7 +639,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! update stochastic physics patterns before running next time-step if (OS%do_sppt .OR. OS%pert_epbl ) then - call run_stochastic_physics_ocn(OS%stochastics%sppt_wts,OS%stochastics%t_rp1,OS%stochastics%t_rp2) + call run_stochastic_physics_ocn(OS%stochastics%sppt_wts, OS%stochastics%t_rp1, OS%stochastics%t_rp2) endif if (OS%offline_tracer_mode) then diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 374d1be208..3edc7b6b9c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -132,7 +132,7 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_variables, only : rotate_surface_state,stochastic_pattern +use MOM_variables, only : rotate_surface_state, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6ea57f56eb..9faf8616b8 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -309,9 +309,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! save copy of the date for SPPT if (CS%do_sppt) then - h_in=h - t_in=tv%T - s_in=tv%S + h_in(:,:,:)=h(:,:,:) + t_in(:,:,:)=tv%T(:,:,:) + s_in(:,:,:)=tv%S(:,:,:) if (CS%id_sppt_wts > 0) then call post_data(CS%id_sppt_wts, stochastics%sppt_wts, CS%diag) @@ -473,23 +473,24 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) if (CS%do_sppt) then + ! perturb diabatic tendecies do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*stochastics%sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stochastics%sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stochastics%sppt_wts(i,j) - h_pert=h_tend+h_in(i,j,k) - t_pert=t_tend+t_in(i,j,k) - s_pert=s_tend+s_in(i,j,k) + h_tend = (h(i,j,k) - h_in(i,j,k)) * stochastics%sppt_wts(i,j) + t_tend = (tv%T(i,j,k) - t_in(i,j,k)) * stochastics%sppt_wts(i,j) + s_tend = (tv%S(i,j,k) - s_in(i,j,k)) * stochastics%sppt_wts(i,j) + h_pert = h_tend + h_in(i,j,k) + t_pert = t_tend + t_in(i,j,k) + s_pert = s_tend + s_in(i,j,k) if (h_pert > GV%Angstrom_H) then - h(i,j,k)=h_pert + h(i,j,k) = h_pert else - h(i,j,k)=GV%Angstrom_H + h(i,j,k) = GV%Angstrom_H endif - tv%T(i,j,k)=t_pert + tv%T(i,j,k) = t_pert if (s_pert > 0.0) then - tv%S(i,j,k)=s_pert + tv%S(i,j,k) = s_pert endif enddo enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7ad3aea276..1655cdab4c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -198,7 +198,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 - integer :: id_t_rp1=-1,id_t_rp2=-1 + integer :: id_t_rp1=-1, id_t_rp2=-1 !>@} end type energetic_PBL_CS @@ -508,8 +508,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error if (CS%pert_epbl) then - if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) - if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) + if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) + if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) endif endif end subroutine energetic_PBL @@ -856,7 +856,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (CS%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) + if (CS%pert_epbl) mech_TKE = mech_TKE * stochastics%t_rp1(i,j) if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -939,7 +939,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (CS%pert_epbl) then ! perturb the TKE destruction + if (CS%pert_epbl) then ! perturb the TKE dissipation mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) else mech_TKE = mech_TKE * exp_kh From c7531a75f4a7cb1e552666089fe9daf0a2a8235e Mon Sep 17 00:00:00 2001 From: pjpegion Date: Thu, 4 Feb 2021 16:59:22 +0000 Subject: [PATCH 16/83] remove stochastics container --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 37 ++++++------- src/core/MOM.F90 | 15 ++---- src/core/MOM_forcing_type.F90 | 4 ++ src/core/MOM_variables.F90 | 5 -- src/framework/MOM_domains.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 52 +++++++++---------- .../vertical/MOM_energetic_PBL.F90 | 45 ++++++++-------- 7 files changed, 73 insertions(+), 87 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index c20b0a08ef..ea64808f26 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -43,7 +43,7 @@ module MOM_ocean_model_nuopc use time_interp_external_mod,only : time_interp_external_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, stochastic_pattern +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -51,7 +51,7 @@ module MOM_ocean_model_nuopc use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain,mpp_get_pelist use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain use fms_mod, only : stdout use mpp_mod, only : mpp_chksum @@ -62,7 +62,7 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs +use MOM_domains, only : root_PE,PE_here,num_PEs use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -192,7 +192,6 @@ module MOM_ocean_model_nuopc !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -256,7 +255,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot!< If true, allocate melt_potential array ! stochastic physics - integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean integer :: mom_comm ! list of pes for this instance of the ocean integer :: num_procs ! number of processors to pass to stochastic physics integer :: iret ! return code from stochastic physics @@ -446,8 +444,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i default=.false.) if (OS%do_sppt .OR. OS%pert_epbl) then num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) + call mpp_get_pelist(Ocean_sfc%domain, mom_comm) me=PE_here() master=root_PE() @@ -460,10 +457,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i return endif - if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) + if (OS%do_sppt) allocate(OS%fluxes%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) if (OS%pert_epbl) then - allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) - allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) + allocate(OS%fluxes%epbl1_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%fluxes%epbl2_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) endif endif call close_param_file(param_file) @@ -639,7 +636,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! update stochastic physics patterns before running next time-step if (OS%do_sppt .OR. OS%pert_epbl ) then - call run_stochastic_physics_ocn(OS%stochastics%sppt_wts, OS%stochastics%t_rp1, OS%stochastics%t_rp2) + call run_stochastic_physics_ocn(OS%fluxes%sppt_wts,OS%fluxes%epbl1_wts,OS%fluxes%epbl2_wts) endif if (OS%offline_tracer_mode) then @@ -648,12 +645,11 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! The call sequence is being orchestrated from outside of update_ocean_model. call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & - reset_therm=Ocn_fluxes_used, stochastics=OS%stochastics) + reset_therm=Ocn_fluxes_used) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves, & - stochastics=OS%stochastics) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -678,19 +674,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & dtdia = dt_dyn*min(nts,n_max-(n-1)) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & - stochastics=OS%stochastics) + 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, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & - stochastics=OS%stochastics) + 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, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & - stochastics=OS%stochastics) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -707,8 +700,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & - stochastics=OS%stochastics) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + endif endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3edc7b6b9c..440ddce0be 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -453,7 +453,7 @@ module MOM !! occur inside of diabatic. subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & - end_cycle, cycle_length, reset_therm, stochastics) + end_cycle, cycle_length, reset_therm) type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields @@ -478,7 +478,6 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patternss for stochastics ! local variables type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing @@ -768,8 +767,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - end_time_thermo, .true., Waves=Waves, & - stochastics=stochastics) + end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. @@ -870,8 +868,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - Time_local, .false., Waves=Waves, & - stochastics=stochastics) + Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then @@ -1304,7 +1301,7 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & - Time_end_thermo, update_BBL, Waves, stochastics) + Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure @@ -1317,7 +1314,6 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s] type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. @@ -1394,8 +1390,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves, & - stochastics=stochastics) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 3248c09fa4..ab782df7b8 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -170,6 +170,10 @@ module MOM_forcing_type !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) !! or freezing (negative) [R Z T-1 ~> kg m-2 s-1] + ! stochastic patterns + real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT + real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation + real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation ! Scalars set by surface forcing modules real :: vPrecGlobalAdj = 0. !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4d5c83f3bd..a9bf6c3dcf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -276,11 +276,6 @@ module MOM_variables !> Container for information about the summed layer transports !! and how they will vary as the barotropic velocity is changed. -type, public :: stochastic_pattern - real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - real, allocatable :: t_rp1(:,:) !< Random pattern for K.E. generation - real, allocatable :: t_rp2(:,:) !< Random pattern for K.E. dissipation -end type stochastic_pattern type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east [H L ~> m2 or kg m-1]. diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index ce4c1a9d6e..1bb38bc0aa 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -17,7 +17,7 @@ module MOM_domains public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, PE_here, root_PE, num_PEs, Get_PElist +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast public :: pass_vector_start, pass_vector_complete public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 9faf8616b8..312462b45b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -65,7 +65,7 @@ module MOM_diabatic_driver use MOM_tracer_diabatic, only : tracer_vertdiff, tracer_vertdiff_Eulerian use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs -use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d, stochastic_pattern +use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS @@ -183,7 +183,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1 = -1, id_t_rp2 = -1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -266,7 +266,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, WAVES, stochastics) + G, GV, US, CS, OBC, WAVES) 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] @@ -288,7 +288,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(diabatic_CS), pointer :: CS !< module control structure type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -299,9 +298,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickness before thermodynamics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in ! temperature before thermodynamics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in ! salinity before thermodynamics + real, allocatable(:,:,:) :: h_in ! thickness before thermodynamics + real, allocatable(:,:,:) :: t_in ! temperature before thermodynamics + real, allocatable(:,:,:) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT @@ -309,12 +308,15 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! save copy of the date for SPPT if (CS%do_sppt) then - h_in(:,:,:)=h(:,:,:) - t_in(:,:,:)=tv%T(:,:,:) - s_in(:,:,:)=tv%S(:,:,:) + allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + h_in(:,:) = h(:,:) + t_in(:,:) = tv%T(:,:) + s_in(:,:) = tv%S(:,:) if (CS%id_sppt_wts > 0) then - call post_data(CS%id_sppt_wts, stochastics%sppt_wts, CS%diag) + call post_data(CS%id_sppt_wts, fluxes%sppt_wts, CS%diag) endif endif @@ -403,10 +405,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves, stochastics=stochastics) + G, GV, US, CS, Waves) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves, stochastics=stochastics) + G, GV, US, CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -477,12 +479,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k) - h_in(i,j,k)) * stochastics%sppt_wts(i,j) - t_tend = (tv%T(i,j,k) - t_in(i,j,k)) * stochastics%sppt_wts(i,j) - s_tend = (tv%S(i,j,k) - s_in(i,j,k)) * stochastics%sppt_wts(i,j) - h_pert = h_tend + h_in(i,j,k) - t_pert = t_tend + t_in(i,j,k) - s_pert = s_tend + s_in(i,j,k) + h_tend = (h(i,j,k)-h_in(i,j,k))*fluxes%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*fluxes%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*fluxes%sppt_wts(i,j) + h_pert=h_tend+h_in(i,j,k) + t_pert=t_tend+t_in(i,j,k) + s_pert=s_tend+s_in(i,j,k) if (h_pert > GV%Angstrom_H) then h(i,j,k) = h_pert else @@ -505,7 +507,7 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES, stochastics) + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -525,8 +527,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and - !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -828,7 +828,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves, stochastics=stochastics) + waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -1091,7 +1091,7 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves, stochastics) + G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1112,8 +1112,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and - !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1366,7 +1364,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves, stochastics=stochastics) + waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1655cdab4c..8a708e4861 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -14,7 +14,7 @@ module MOM_energetic_PBL use MOM_grid, only : ocean_grid_type use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, stochastic_pattern +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number use MOM_stochastics, only : stochastic_CS @@ -198,7 +198,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 - integer :: id_t_rp1=-1, id_t_rp2=-1 + integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 !>@} end type energetic_PBL_CS @@ -248,7 +248,7 @@ module MOM_energetic_PBL !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves, stochastics ) + dT_expected, dS_expected, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -301,10 +301,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! diffusivities are applied [ppt]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS - type(stochastic_pattern), optional, & - intent(in) :: stochastics !< A structure containing array to stochastic - !! patterns. Any unsued fields - !! are not allocated ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -444,11 +440,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - stochastics=stochastics,i=i, j=j) + if (CS%pert_epbl) then ! stochastics are active + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + epbl1_wt=epbl1_wts(i,j),epbl2_wt=epbl2_wts(i,j),i=i, j=j) + else + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + endif ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -508,8 +509,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error if (CS%pert_epbl) then - if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) - if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) + if (CS%id_epbl1_wts > 0) call post_data(CS%id_epbl1_wts, stochastics%epbl1_wts, CS%diag) + if (CS%id_epbl2_wts > 0) call post_data(CS%id_epbl2_wts, stochastics%epbl2_wts, CS%diag) endif endif end subroutine energetic_PBL @@ -520,7 +521,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, stochastics, i, j) + dt_diag, Waves, G, epbl1_wt, epbl2_wt, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -563,8 +564,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs optional, pointer :: Waves !< Wave CS for Langmuir turbulence type(ocean_grid_type), & optional, intent(inout) :: G !< The ocean's grid structure. - type(stochastic_pattern), & - optional, intent(in) :: stochastics !< stochastic patterns and logic controls + real, optional, intent(in) :: epbl1_wt ! random number to perturb KE generation + real, optional, intent(in) :: epbl2_wt ! random number to perturb KE dissipation integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) @@ -856,7 +857,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (CS%pert_epbl) mech_TKE = mech_TKE * stochastics%t_rp1(i,j) + if (CS%pert_epbl) mech_TKE=mech_TKE*epbl1_wt if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -939,8 +940,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (CS%pert_epbl) then ! perturb the TKE dissipation - mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) + if (CS%pert_epbl) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) else mech_TKE = mech_TKE * exp_kh endif @@ -2351,9 +2352,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') - CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & + CS%id_epbl1_wts = register_diag_field('ocean_model', 'epbl1_wts', diag%axesT1, Time, & 'random pattern for KE generation', 'None') - CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & + CS%id_epbl2_wts = register_diag_field('ocean_model', 'epbl2_wts', diag%axesT1, Time, & 'random pattern for KE dissipation', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & From 4c931094f26b92ed107a43526765f74d48c3d404 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 5 Feb 2021 20:18:31 +0000 Subject: [PATCH 17/83] revert MOM_domains.F90 --- src/framework/MOM_domains.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 1bb38bc0aa..2b30a4d629 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,9 +3,8 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. - use MOM_array_transform, only : rotate_array -use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Get_PElist +use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL, is_root_pe From ea36db2385ff9d15d070d06812255feecf8d5742 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 5 Feb 2021 20:50:56 +0000 Subject: [PATCH 18/83] clean up of mom_ocean_model_nuopc.F90 --- config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index ea64808f26..9e43638751 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -51,7 +51,7 @@ module MOM_ocean_model_nuopc use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain,mpp_get_pelist +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain use fms_mod, only : stdout use mpp_mod, only : mpp_chksum @@ -444,7 +444,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i default=.false.) if (OS%do_sppt .OR. OS%pert_epbl) then num_procs=num_PEs() - call mpp_get_pelist(Ocean_sfc%domain, mom_comm) + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) me=PE_here() master=root_PE() @@ -701,7 +702,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) - endif endif From e2431bc81bdeb2af2929782c220e7019ff167892 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 5 Feb 2021 20:54:05 +0000 Subject: [PATCH 19/83] remove PE_here from mom_ocean_model_nuopc.F90 --- config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 9e43638751..1ef5b07c06 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -62,7 +62,8 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use MOM_domains, only : root_PE,PE_here,num_PEs +use MOM_domains, only : root_PE,num_PEs +use MOM_coms, only : Get_PElist use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -446,7 +447,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) - me=PE_here() master=root_PE() call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& From a67bc78a291e1184528896564b1bc103999d2b01 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 26 Feb 2021 17:43:50 +0000 Subject: [PATCH 20/83] remove debug statements --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 8a708e4861..7cf8d48ae0 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -945,6 +945,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = mech_TKE * exp_kh endif + !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 493717a353382cfa1c6136165323921407421ee6 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 15:09:50 +0000 Subject: [PATCH 21/83] stochastic physics re-write --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 38 +---- src/core/MOM.F90 | 25 +-- src/core/MOM_forcing_type.F90 | 4 - .../stochastic/MOM_stochastics.F90 | 50 +++--- .../stochastic/MOM_stochastics_stub.F90 | 64 ++++++++ .../vertical/MOM_diabatic_driver.F90 | 155 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 34 ++-- 7 files changed, 204 insertions(+), 166 deletions(-) create mode 100644 src/parameterizations/stochastic/MOM_stochastics_stub.F90 diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 1ef5b07c06..9ffe4cd794 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -64,7 +64,6 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : forcing_save_restart use MOM_domains, only : root_PE,num_PEs use MOM_coms, only : Get_PElist -use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -178,8 +177,8 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical :: do_sppt !< If true, allocate array for SPPT - logical :: pert_epbl !< If true, allocate arrays for energetic PBL perturbations + logical,public :: do_sppt !< If true, write stochastic physics restarts + logical,public :: pert_epbl !< If true, write stochastic physics restarts real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -255,12 +254,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot!< If true, allocate melt_potential array -! stochastic physics - integer :: mom_comm ! list of pes for this instance of the ocean - integer :: num_procs ! number of processors to pass to stochastic physics - integer :: iret ! return code from stochastic physics - integer :: me ! my pe - integer :: master ! root pe ! This include declares and sets the variable "version". #include "version_variable.h" @@ -432,7 +425,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif -! get number of processors and PE list for stocasthci physics initialization + ! check to see if stochastic physics is active call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & "If true, then stochastically perturb the thermodynamic "//& "tendemcies of T,S, amd h. Amplitude and correlations are "//& @@ -443,27 +436,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "production and dissipation terms. Amplitude and correlations are "//& "controlled by the nam_stoch namelist in the UFS model only.", & default=.false.) - if (OS%do_sppt .OR. OS%pert_epbl) then - num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) - master=root_PE() - - call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& - OS%pert_epbl,OS%do_sppt,master,mom_comm,iret) - if (iret/=0) then - write(6,*) 'call to init_stochastic_physics_ocn failed' - call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & - "not activated in stochastic_physics namelist ") - return - endif - if (OS%do_sppt) allocate(OS%fluxes%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - if (OS%pert_epbl) then - allocate(OS%fluxes%epbl1_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - allocate(OS%fluxes%epbl2_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - endif - endif call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -635,11 +608,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time -! update stochastic physics patterns before running next time-step - if (OS%do_sppt .OR. OS%pert_epbl ) then - call run_stochastic_physics_ocn(OS%fluxes%sppt_wts,OS%fluxes%epbl1_wts,OS%fluxes%epbl2_wts) - endif - if (OS%offline_tracer_mode) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 440ddce0be..71009d225d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -402,16 +402,6 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors - type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) & - :: por_face_areaU !< fractional open area of U-faces [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) & - :: por_face_areaV !< fractional open area of V-faces [nondim] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) & - :: por_layer_widthU !< fractional open width of U-faces [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) & - :: por_layer_widthV !< fractional open width of V-faces [nondim] - type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure end type MOM_control_struct @@ -672,7 +662,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call disable_averaging(CS%diag) endif endif - ! advance the random pattern if stochastic physics is active + if (CS%stoch_CS%do_sppt .OR. CS%stoch_CS%pert_epbl) call update_stochastics(CS%stoch_CS) if (do_dyn) then @@ -824,6 +814,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif + call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & Time_local, Waves=Waves) @@ -1390,7 +1381,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS,OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -2498,6 +2489,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else call set_first_direction(G, modulo(first_direction, 2)) endif + call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) + call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) + call destroy_dyn_horgrid(dG_in) + + if (.not. CS%rotate_index) & + G => G_in + ! initialize stochastic physics + !call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) + ! Set a few remaining fields that are specific to the ocean grid type. + call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index ab782df7b8..3248c09fa4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -170,10 +170,6 @@ module MOM_forcing_type !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) !! or freezing (negative) [R Z T-1 ~> kg m-2 s-1] - ! stochastic patterns - real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation - real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation ! Scalars set by surface forcing modules real :: vPrecGlobalAdj = 0. !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 index 21a22a222e..5bcf158f7e 100644 --- a/src/parameterizations/stochastic/MOM_stochastics.F90 +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -4,10 +4,13 @@ module MOM_stochastics ! This file is part of MOM6. See LICENSE.md for the license. ! This is the top level module for the MOM6 ocean model. It contains routines -! for initialization, update, and writing restart of stochastic physics. This +! for initialization, termination and update of ocean model state. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! +! This code is a stop-gap wrapper of the MOM6 code to enable it to be called +! in the same way as MOM4. + use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type @@ -26,13 +29,11 @@ module MOM_stochastics public stochastics_init, update_stochastics -!> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms - integer :: id_sppt_wts = -1 !< Diagnostic id for SPPT - integer :: id_epbl1_wts=-1 !< Diagnostic id for epbl generation perturbation - integer :: id_epbl2_wts=-1 !< Diagnostic id for epbl dissipation perturbation + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 + integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT !! tendencies with a number between 0 and 2 @@ -42,14 +43,22 @@ module MOM_stochastics type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type stochastic_CS +!> This type is used for communication with other components via the FMS coupler. +!! The element names and types can be changed only with great deliberation, hence +!! the persistnce of things like the cutsy element name "avg_kount". contains -!! This subroutine initializes the stochastics physics control structure. +!> ocean_model_init initializes the ocean model, including registering fields +!! for restarts and reading restart files if appropriate. +!! +!! This subroutine initializes both the ocean state and the ocean surface type. +!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! been used in a previous call to cean_type. subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] - type(ocean_grid_type), intent(in) :: grid !< horizontal grid information - type(verticalGrid_type), intent(in) :: GV !< vertical grid structure - type(stochastic_CS), pointer, intent(inout):: CS !< stochastic control structure + type(ocean_grid_type), intent(in) :: grid ! horizontal grid information + type(verticalGrid_type), intent(in) :: GV ! vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output type(time_type), target :: Time !< model time @@ -59,7 +68,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) integer :: num_procs ! number of processors to pass to stochastic physics integer :: iret ! return code from stochastic physics integer :: me ! my pe - integer :: pe_zero ! root pe + integer :: master ! root pe integer :: nx ! number of x-points including halo integer :: ny ! number of x-points including halo @@ -95,13 +104,15 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) - pe_zero=root_PE() - nx = grid%ied - grid%isd + 1 - ny = grid%jed - grid%jsd + 1 + master=root_PE() + nx=grid%ied-grid%isd+1 + ny=grid%jed-grid%jsd+1 call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & - CS%pert_epbl,CS%do_sppt,pe_zero,mom_comm,iret) + CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) if (iret/=0) then - call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") + write(6,*) 'call to init_stochastic_physics_ocn failed' + call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & + "not activated in stochastic_physics namelist ") return endif @@ -122,7 +133,6 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) write(*,'(/12x,a/)') '=== COMPLETED MOM STOCHASTIC INITIALIZATION =====' call callTree_leave("ocean_model_init(") - return end subroutine stochastics_init !> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the @@ -135,9 +145,9 @@ subroutine update_stochastics(CS) call callTree_enter("update_stochastics(), MOM_stochastics.F90") ! update stochastic physics patterns before running next time-step - call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + print*,'in update_stoch',minval(CS%sppt_wts),maxval(CS%sppt_wts),minval(CS%epbl1_wts),maxval(CS%epbl1_wts) - return end subroutine update_stochastics end module MOM_stochastics diff --git a/src/parameterizations/stochastic/MOM_stochastics_stub.F90 b/src/parameterizations/stochastic/MOM_stochastics_stub.F90 new file mode 100644 index 0000000000..f03f5283d3 --- /dev/null +++ b/src/parameterizations/stochastic/MOM_stochastics_stub.F90 @@ -0,0 +1,64 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. +module MOM_stochastics + +! This file is part of MOM6. See LICENSE.md for the license. + +! This is the top level module for the MOM6 ocean model. It contains routines +! for initialization, termination and update of ocean model state. This +! particular version wraps all of the calls for MOM6 in the calls that had +! been used for MOM4. +! +! This code is a stop-gap wrapper of the MOM6 code to enable it to be called +! in the same way as MOM4. + +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use MOM_domains, only : root_PE,num_PEs +use MOM_coms, only : Get_PElist + +#include + +implicit none ; private + +public stochastics_init, update_stochastics + +type, public:: stochastic_CS + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 + integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 + ! stochastic patterns + real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT + !! tendencies with a number between 0 and 2 + real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation + real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation + type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output + type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) +end type stochastic_CS + +contains + +subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) + real, intent(in) :: dt !< time step [T ~> s] + type(ocean_grid_type), intent(in) :: grid ! horizontal grid information + type(verticalGrid_type), intent(in) :: GV ! vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output + type(time_type), target :: Time !< model time + return +end subroutine stochastics_init + +subroutine update_stochastics(CS) + type(stochastic_CS), intent(inout) :: CS !< diabatic control structure + return +end subroutine update_stochastics + +end module MOM_stochastics + diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 312462b45b..ffbbd2c7d1 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -69,6 +69,7 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS +use MOM_stochastics, only : stochastic_CS implicit none ; private @@ -142,12 +143,12 @@ module MOM_diabatic_driver integer :: NKBL !< The number of buffer layers (if bulk_mixed_layer) logical :: massless_match_targets !< If true (the default), keep the T & S !! consistent with the target values. - logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless - !! layers at the bottom into the interior as though - !! a diffusivity of Kd_min_tr (see below) were - !! operating. - logical :: do_sppt !< If true, stochastically perturb the diabatic - !! tendencies with a number between 0 and 2 + logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless layers at the + !! bottom into the interior as though a diffusivity of + !! Kd_min_tr (see below) were operating. + logical :: mix_boundary_tracer_ALE !< If true, in ALE mode mix the passive tracers in massless + !! layers at the bottom into the interior as though a + !! diffusivity of Kd_min_tr (see below) were operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at @@ -175,15 +176,20 @@ module MOM_diabatic_driver real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) - integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) - integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic - integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_ea_s = -1, id_eb_s = -1 - integer :: id_ea_t = -1, id_eb_t = -1 - integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 - integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 - integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1 + integer :: id_cg1 = -1 ! diag handle for mode-1 speed + integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds + integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic + integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 + integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 + integer :: id_Tdif = -1, id_Sdif = -1, id_Tadv = -1, id_Sadv = -1 + ! These are handles to diagnostics related to the mixed layer properties. + integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 + integer :: id_MLD_EN1 = -1, id_MLD_EN2 = -1, id_MLD_EN3 = -1, id_subMLN2 = -1 + + ! These are handles to diatgnostics that are only available in non-ALE layered mode. + integer :: id_wd = -1 + integer :: id_dudt_dia = -1, id_dvdt_dia = -1 + integer :: id_hf_dudt_dia_2d = -1, id_hf_dvdt_dia_2d = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -266,13 +272,13 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, WAVES) - 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + G, GV, US, CS, stoch_CS, OBC, Waves) + 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_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -281,13 +287,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(diabatic_CS), pointer :: CS !< module control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -307,16 +314,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (G%ke == 1) return ! save copy of the date for SPPT - if (CS%do_sppt) then + if (stoch_CS%do_sppt) then allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - h_in(:,:) = h(:,:) - t_in(:,:) = tv%T(:,:) - s_in(:,:) = tv%S(:,:) + h_in(:,:,:)=h(:,:,:) + t_in(:,:,:)=tv%T(:,:,:) + s_in(:,:,:)=tv%S(:,:,:) - if (CS%id_sppt_wts > 0) then - call post_data(CS%id_sppt_wts, fluxes%sppt_wts, CS%diag) + if (stoch_CS%id_sppt_wts > 0) then + call post_data(stoch_CS%id_sppt_wts, stoch_CS%sppt_wts, CS%diag) endif endif @@ -405,10 +412,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -474,14 +481,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) - if (CS%do_sppt) then + if (stoch_CS%do_sppt) then ! perturb diabatic tendecies do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*fluxes%sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*fluxes%sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*fluxes%sppt_wts(i,j) + h_tend = (h(i,j,k)-h_in(i,j,k))*stoch_CS%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stoch_CS%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stoch_CS%sppt_wts(i,j) h_pert=h_tend+h_in(i,j,k) t_pert=t_tend+t_in(i,j,k) s_pert=s_tend+s_in(i,j,k) @@ -507,14 +514,14 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + G, GV, US, CS, stoch_CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -522,11 +529,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -827,7 +835,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & waves=waves) if (associated(Hml)) then @@ -1091,14 +1099,14 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + G, GV, US, CS, stoch_CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -1107,11 +1115,12 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1363,7 +1372,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & waves=waves) if (associated(Hml)) then @@ -3087,11 +3096,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "mass loss is passed down through the column.", & units="nondim", default=0.8) - call get_param(param_file, mdl, "DO_SPPT", CS%do_sppt, & - "If true, then stochastically perturb the thermodynamic "//& - "tendemcies of T,S, amd h. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) + if (CS%use_energetic_PBL .and. .not.CS%useALEalgorithm) & + call MOM_error(FATAL, "diabatic_driver_init: "//& + "ENERGETICS_SFC_PBL = True is only coded to work when USE_REGRIDDING = True.") ! Register all available diagnostics for this module. thickness_units = get_thickness_units(GV) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7cf8d48ae0..36e92c2850 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -58,7 +58,6 @@ module MOM_energetic_PBL !! self-consistent mixed layer depth. Otherwise use the false position !! after a maximum and minimum bound have been evaluated and the !! returned value from the previous guess or bisection before this. - logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms integer :: max_MLD_its !< The maximum number of iterations that can be used to find a !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. @@ -198,7 +197,6 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 - integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 !>@} end type energetic_PBL_CS @@ -246,9 +244,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & + stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, & + last_call, dT_expected, dS_expected, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -301,6 +299,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! diffusivities are applied [ppt]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS + type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous + ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -440,11 +440,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - if (CS%pert_epbl) then ! stochastics are active + if (stoch_CS%pert_epbl) then ! stochastics are active call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - epbl1_wt=epbl1_wts(i,j),epbl2_wt=epbl2_wts(i,j),i=i, j=j) + epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j), & + i=i, j=j) else call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & @@ -508,9 +509,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error - if (CS%pert_epbl) then - if (CS%id_epbl1_wts > 0) call post_data(CS%id_epbl1_wts, stochastics%epbl1_wts, CS%diag) - if (CS%id_epbl2_wts > 0) call post_data(CS%id_epbl2_wts, stochastics%epbl2_wts, CS%diag) + if (stoch_CS%pert_epbl) then + if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) + if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) endif endif end subroutine energetic_PBL @@ -857,7 +858,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (CS%pert_epbl) mech_TKE=mech_TKE*epbl1_wt + if (present(epbl1_wt)) mech_TKE=mech_TKE*epbl1_wt if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -940,7 +941,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (CS%pert_epbl) then ! perturb the TKE destruction + if (present(epbl2_wt)) then ! perturb the TKE destruction mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) else mech_TKE = mech_TKE * exp_kh @@ -2174,11 +2175,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "This is only used if USE_MLD_ITERATION is True.", & units="nondim", default=2.0) - call get_param(param_file, mdl, "PERT_EPBL", CS%pert_epbl, & - "If true, then stochastically perturb the kinetic energy "//& - "production and dissipation terms. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) !/ Turbulent velocity scale in mixing coefficient call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & "Selects the method for translating TKE into turbulent velocities. "//& @@ -2353,10 +2349,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') - CS%id_epbl1_wts = register_diag_field('ocean_model', 'epbl1_wts', diag%axesT1, Time, & - 'random pattern for KE generation', 'None') - CS%id_epbl2_wts = register_diag_field('ocean_model', 'epbl2_wts', diag%axesT1, Time, & - 'random pattern for KE dissipation', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From cf1d29628395dab0f94676b9ed853f5166287e56 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 17:35:27 +0000 Subject: [PATCH 22/83] move stochastics to external directory --- .../external/OCEAN_stochastic_phyiscs}/MOM_stochastics.F90 | 0 .../external/OCEAN_stochastic_phyiscs}/MOM_stochastics_stub.F90 | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {src/parameterizations/stochastic => config_src/external/OCEAN_stochastic_phyiscs}/MOM_stochastics.F90 (100%) rename {src/parameterizations/stochastic => config_src/external/OCEAN_stochastic_phyiscs}/MOM_stochastics_stub.F90 (100%) diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 similarity index 100% rename from src/parameterizations/stochastic/MOM_stochastics.F90 rename to config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 diff --git a/src/parameterizations/stochastic/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 similarity index 100% rename from src/parameterizations/stochastic/MOM_stochastics_stub.F90 rename to config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 From e91c96609e93e9f34515baa4957272bb4ccafddc Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 18:14:44 +0000 Subject: [PATCH 23/83] doxygen cleanup --- .../external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 | 5 +++-- .../OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 | 7 +++++-- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 1 - 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index 5bcf158f7e..03b33dc2b3 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -29,6 +29,7 @@ module MOM_stochastics public stochastics_init, update_stochastics +!> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS logical :: do_sppt !< If true, stochastically perturb the diabatic logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms @@ -105,8 +106,8 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) master=root_PE() - nx=grid%ied-grid%isd+1 - ny=grid%jed-grid%jsd+1 + nx = grid%ied - grid%isd + 1 + ny = grid%jed - grid%jsd + 1 call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) if (iret/=0) then diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 index f03f5283d3..89a6d43c4f 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 @@ -28,11 +28,14 @@ module MOM_stochastics public stochastics_init, update_stochastics +!> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms + !>@{ Diagnostic IDs integer :: id_sppt_wts = -1 integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 + !>@} ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT !! tendencies with a number between 0 and 2 diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 36e92c2850..9ecba8a7b8 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -301,7 +301,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS optional, pointer :: Waves !< Wave CS type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous - ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes ! have already been applied. All calculations are done implicitly, and there From a5d90655d884fbbc3a3dda67368479935cb11341 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 21:41:16 +0000 Subject: [PATCH 24/83] add write_stoch_restart_ocn to MOM_stochastics --- config_src/drivers/nuopc_cap/mom_cap.F90 | 18 +++++++++++------- .../MOM_stochastics.F90 | 18 +++++++++++++++--- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 3de56c0511..25de32d526 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,8 +97,8 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM -use get_stochy_pattern_mod, only: write_stoch_restart_ocn +use MOM_stochastics, only : write_mom_restart_stoch !$use omp_lib , only : omp_set_num_threads implicit none; private @@ -1752,12 +1752,16 @@ subroutine ModelAdvance(gcomp, rc) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - ! write stochastic physics restart file if active - if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then - write(restartname,'(A)')"ocn_stoch.res.nc" - else - write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & - "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" + if (ocean_state%do_sppt .OR. ocean_state%pert_epbl) then + if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then + write(restartname,'(A)')"ocn_stoch.res.nc" + else + write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & + "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" + endif + call ESMF_LogWrite("MOM_cap: Writing stoch restart : "//trim(restartname), & + ESMF_LOGMSG_INFO) + call write_mom_restart_stoch('RESTART/'//trim(restartname)) endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) call write_stoch_restart_ocn('RESTART/'//trim(restartname)) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index 03b33dc2b3..ab33a17c29 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -22,12 +22,13 @@ module MOM_stochastics use MOM_domains, only : root_PE,num_PEs use MOM_coms, only : Get_PElist use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn +use get_stochy_pattern_mod, only: write_stoch_restart_ocn #include implicit none ; private -public stochastics_init, update_stochastics +public stochastics_init, update_stochastics, write_mom_restart_stoch !> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS @@ -146,10 +147,21 @@ subroutine update_stochastics(CS) call callTree_enter("update_stochastics(), MOM_stochastics.F90") ! update stochastic physics patterns before running next time-step - call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) - print*,'in update_stoch',minval(CS%sppt_wts),maxval(CS%sppt_wts),minval(CS%epbl1_wts),maxval(CS%epbl1_wts) + call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + return end subroutine update_stochastics +!< wrapper to write ocean stochastic restarts +subroutine write_mom_restart_stoch(filename) + character(len=*) :: filename + + call callTree_enter("write_mom_restart_stoch(), MOM_stochastics.F90") + + call write_stoch_restart_ocn(filename) + + return +end subroutine write_mom_restart_stoch + end module MOM_stochastics From 78b8d79193c61166f07b2a92e4a87005109201e6 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 27 Jul 2021 17:08:13 +0000 Subject: [PATCH 25/83] add logic to remove incrments from restart if outside IAU window --- src/ocean_data_assim/MOM_oda_incupd.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index ab3621296f..269b584006 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -554,6 +554,16 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) if (CS%ncount >= CS%nstep_incupd) then if (is_root_pe()) call MOM_error(NOTE,"ended updating fields with increments. ") return + if (CS%ncount == CS%nstep_incupd) then + call register_restart_field_as_obsolete("oda_incupd_ncount", "none", CS) + call register_restart_field_as_obsolete("T_inc", "none", CS) + call register_restart_field_as_obsolete("S_inc", "none", CS) + call register_restart_field_as_obsolete("h_obs", "none", CS) + if (CS%uv_inc) then + call register_restart_field_as_obsolete("u_inc", "none", CS) + call register_restart_field_as_obsolete("v_inc", "none", CS) + endif + endif endif !ncount>CS%nstep_incupd ! update counter From 15e4029400c3bbe21cb89e1accced65ea09c771a Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 28 Jul 2021 17:35:21 +0000 Subject: [PATCH 26/83] revert logic wrt increments --- src/ocean_data_assim/MOM_oda_incupd.F90 | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 269b584006..8b93582e4b 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -416,7 +416,7 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) enddo endif enddo; enddo - + ! remap u to h_obs to get increment if (CS%uv_inc) then call pass_var(h, G%Domain) @@ -554,16 +554,6 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) if (CS%ncount >= CS%nstep_incupd) then if (is_root_pe()) call MOM_error(NOTE,"ended updating fields with increments. ") return - if (CS%ncount == CS%nstep_incupd) then - call register_restart_field_as_obsolete("oda_incupd_ncount", "none", CS) - call register_restart_field_as_obsolete("T_inc", "none", CS) - call register_restart_field_as_obsolete("S_inc", "none", CS) - call register_restart_field_as_obsolete("h_obs", "none", CS) - if (CS%uv_inc) then - call register_restart_field_as_obsolete("u_inc", "none", CS) - call register_restart_field_as_obsolete("v_inc", "none", CS) - endif - endif endif !ncount>CS%nstep_incupd ! update counter From 59e733f3e44611d7fefbd6f2fc74e8f70060c105 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 28 Jul 2021 19:40:29 +0000 Subject: [PATCH 27/83] add comments --- .../MOM_stochastics.F90 | 16 +++------------- .../MOM_stochastics_stub.F90 | 17 +++++++++-------- src/core/MOM.F90 | 4 +--- .../vertical/MOM_diabatic_driver.F90 | 2 +- 4 files changed, 14 insertions(+), 25 deletions(-) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index ab33a17c29..427b3c754b 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -4,13 +4,10 @@ module MOM_stochastics ! This file is part of MOM6. See LICENSE.md for the license. ! This is the top level module for the MOM6 ocean model. It contains routines -! for initialization, termination and update of ocean model state. This +! for initialization, update, and writing restart of stochastic physics. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! -! This code is a stop-gap wrapper of the MOM6 code to enable it to be called -! in the same way as MOM4. - use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type @@ -45,17 +42,9 @@ module MOM_stochastics type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type stochastic_CS -!> This type is used for communication with other components via the FMS coupler. -!! The element names and types can be changed only with great deliberation, hence -!! the persistnce of things like the cutsy element name "avg_kount". contains -!> ocean_model_init initializes the ocean model, including registering fields -!! for restarts and reading restart files if appropriate. -!! -!! This subroutine initializes both the ocean state and the ocean surface type. -!! Because of the way that indicies and domains are handled, Ocean_sfc must have -!! been used in a previous call to cean_type. +!! This subroutine initializes the stochastics physics control structure. subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] type(ocean_grid_type), intent(in) :: grid ! horizontal grid information @@ -135,6 +124,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) write(*,'(/12x,a/)') '=== COMPLETED MOM STOCHASTIC INITIALIZATION =====' call callTree_leave("ocean_model_init(") + return end subroutine stochastics_init !> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 index 89a6d43c4f..349d56c0c7 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 @@ -3,13 +3,11 @@ module MOM_stochastics ! This file is part of MOM6. See LICENSE.md for the license. -! This is the top level module for the MOM6 ocean model. It contains routines -! for initialization, termination and update of ocean model state. This -! particular version wraps all of the calls for MOM6 in the calls that had -! been used for MOM4. -! -! This code is a stop-gap wrapper of the MOM6 code to enable it to be called -! in the same way as MOM4. +! This is the top level module for the MOM6 ocean model. It contains +! placeholder for initialization, update, and writing restarts of ocean stochastic physics. +! The actualy stochastic physics is available at +! https://github.com/ufs-community/ufs-weather-model +! use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type use MOM_grid, only : ocean_grid_type @@ -62,6 +60,9 @@ subroutine update_stochastics(CS) type(stochastic_CS), intent(inout) :: CS !< diabatic control structure return end subroutine update_stochastics - +subroutine write_mom_restart_stoch(filename) + character(len=*) :: filename + return +end subroutine write_mom_restart_stoch end module MOM_stochastics diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 71009d225d..b331c64174 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -662,7 +662,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call disable_averaging(CS%diag) endif endif - + ! advance the random pattern if stochastic physics is active if (CS%stoch_CS%do_sppt .OR. CS%stoch_CS%pert_epbl) call update_stochastics(CS%stoch_CS) if (do_dyn) then @@ -2495,8 +2495,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not. CS%rotate_index) & G => G_in - ! initialize stochastic physics - !call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ffbbd2c7d1..044071dc38 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -313,7 +313,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (G%ke == 1) return - ! save copy of the date for SPPT + ! save copy of the date for SPPT if active if (stoch_CS%do_sppt) then allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) From 9221b5d50180c365a951d7672e94ad39533c9dd8 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Mon, 16 Aug 2021 08:53:19 -0400 Subject: [PATCH 28/83] update to gfdl 20210806 (#74) * remove white space and fix comment * Update MOM_oda_incupd.F90 remove unused index bounds, and fix sum_h2 loop. Co-authored-by: pjpegion Co-authored-by: Marshall Ward --- src/ocean_data_assim/MOM_oda_incupd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 8b93582e4b..ab3621296f 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -416,7 +416,7 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) enddo endif enddo; enddo - + ! remap u to h_obs to get increment if (CS%uv_inc) then call pass_var(h, G%Domain) From 348a81b630502e17f0566edde8f37d457548f9a4 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 21 Sep 2021 18:54:31 -0800 Subject: [PATCH 29/83] Several little things, one is making sponge less verbose. - Pointing to OBC wiki file from the lateral parameterizations doc. - Using the MOM6 verbosity to control the time_interp verbosity. - Making the check for negative water depths more informative. --- src/framework/MOM_horizontal_regridding.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index de511688a9..1204fc21b1 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -740,7 +740,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t if (.not.spongeDataOngrid) then if (is_root_pe()) & - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd @@ -840,6 +840,14 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) + ! now fill in missing values using "ICE-nine" algorithm. + tr_outf(:,:) = tr_out(:,:) + if (k==1) tr_prev(:,:) = tr_outf(:,:) + good2(:,:) = good(:,:) + fill2(:,:) = fill(:,:) + + call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) + ! if (debug) then ! call hchksum(tr_outf, 'field from fill_miss_2d ', G%HI) ! endif @@ -856,7 +864,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd else - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) do k=1,kd do j=js,je do i=is,ie @@ -867,6 +875,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo enddo endif + end subroutine horiz_interp_and_extrap_tracer_fms_id !> Create a 2d-mesh of grid coordinates from 1-d arrays. From c3ff425ce1bf31b7f4a98b389872ef91c6707f4b Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 28 Sep 2021 18:47:57 +0000 Subject: [PATCH 30/83] return a more accurate error message in MOM_stochasics --- .../external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index 427b3c754b..e6b0c80280 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -101,9 +101,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) if (iret/=0) then - write(6,*) 'call to init_stochastic_physics_ocn failed' - call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & - "not activated in stochastic_physics namelist ") + call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") return endif From b7b4141a606c164f6d6d9c29710bd19c705a39ae Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 4 Oct 2021 10:57:33 -0800 Subject: [PATCH 31/83] Working on boundary layer docs. --- src/framework/MOM_horizontal_regridding.F90 | 4 +- src/parameterizations/vertical/_EPBL.dox | 184 +------------------- 2 files changed, 5 insertions(+), 183 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 1204fc21b1..e5e651407e 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -740,7 +740,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t if (.not.spongeDataOngrid) then if (is_root_pe()) & - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd @@ -864,7 +864,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd else - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) do k=1,kd do j=js,je do i=is,ie diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox index d531c9ad9a..6134de31e0 100644 --- a/src/parameterizations/vertical/_EPBL.dox +++ b/src/parameterizations/vertical/_EPBL.dox @@ -57,7 +57,7 @@ Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes \f] The parameters needed to close the system of equations are then reduced to the turbulent -mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$. +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$$. We start with an equation for the turbulent kinetic energy (TKE): @@ -67,188 +67,10 @@ We start with an equation for the turbulent kinetic energy (TKE): {\partial z} + \overline{w^\prime b^\prime} - \epsilon \f] + Terms in this equation represent TKE storage (LHS), TKE flux convergence, shear production, buoyancy production, and dissipation. -\section section_WMBL Well-mixed Boundary Layers (WMBL) - -Assuming steady state and other parameterizations, integrating vertically -over the surface boundary layer, \cite reichl2018 obtains the form: - -\f[ - \frac{1}{2} H_{bl} w_e \Delta b = m_\ast u_\ast^3 - n_\ast \frac{H_{bl}}{2} - B(H_{bl}) , -\f] - -with the following variables: - - - -
Symbols used in integrated TKE equation
Symbol Meaning -
\f$H_{bl}\f$ boundary layer thickness -
\f$w_e\f$ entrainment velocity -
\f$\Delta b\f$ change in buoyancy at base of mixed layer -
\f$m_\ast\f$ sum of mechanical coefficients -
\f$u_\ast\f$ friction velocity (\f$u_\ast = (|\tau| / \rho_0)^{1/2}\f$) -
\f$\tau\f$ wind stress -
\f$n_\ast\f$ convective proportionality coefficient -
1 for stabilizing surface buoyancy flux, less otherwise -
\f$B(H_{bl})\f$ surface buoyancy flux -
- -\section section_ePBL Energetics-based Planetary Boundary Layer - -Once again, the goal is to formulate a surface mixing scheme to find the -turbulent eddy diffusivity (and viscosity) in a way that is suitable for use -in a global climate model, using long timesteps and large grid spacing. -After evaluating a well-mixed boundary layer (WMBL), the shear mixing of -\cite jackson2008 (JHL, \ref subsection_kappa_shear), as well as a more complete -boundary layer scheme, it was decided to combine a number of these ideas -into a new scheme: - -\f[ - K(z) = F_x(K_{ePBL}(z), K_{JHL}(z), K_n(z)) -\f] - -where \f$F_x\f$ is some unknown function of a new \f$K_{ePBL}\f$, -\f$K_{JHL}\f$, the diffusivity due to shear as determined by -\cite jackson2008, and \f$K_n\f$, the diffusivity from other ideas. -We start by specifying the form of \f$K_{ePBL}\f$ as being: - -\f[ - K_{ePBL}(z) = C_K w_t l , -\f] - -where \f$w_t\f$ is a turbulent velocity scale, \f$C_K\f$ is a coefficient, and -\f$l\f$ is a length scale. - -\subsection subsection_lengthscale Turbulent length scale - -We propose a form for the length scale as follows: - -\f[ - l = (z_0 + |z|) \times \max \left[ \frac{l_b}{H_{bl}} , \left( - \frac{H_{bl} - |z|}{H_{bl}} \right)^\gamma \, \right] , -\f] - -where we have the following variables: - - - -
Symbols used in ePBL length scale
Symbol Meaning -
\f$H_{bl}\f$ boundary layer thickness -
\f$z_0\f$ roughness length -
\f$\gamma\f$ coefficient, 2 is as in KPP, \cite large1994 -
\f$l_b\f$ bottom length scale -
- -\subsection subsection_velocityscale Turbulent velocity scale - -We do not predict the TKE prognostically and therefore approximate the vertical TKE -profile to estimate \f$w_t\f$. An estimate for the mechanical contribution to the velocity -scale follows the standard two-equation approach. In one and two-equation second-order -\f$K\f$ parameterizations the boundary condition for the TKE is typically employed as a -flux boundary condition. - -\f[ - K \left. \frac{\partial k}{\partial z} \right|_{z=0} = c_\mu^0 u_\ast^3 . -\f] - -The profile of \f$k\f$ decays in the vertical from \f$k \propto (c_\mu^0)^{2/3} -u_\ast^2\f$ toward the base of the OSBL. Here we assume a similar relationship to estimate -the mechanical contribution to the TKE profile. The value of \f$w_t\f$ due to mechanical -sources, \f$v_\ast\f$, is estimate as \f$v_\ast (z=0) \propto (c_\mu^0)^{1/3} u_\ast\f$ at -the surface. Since we only parameterize OSBL turbulent mixing due to surface forcing, the -value of the velocity scale is assumed to decay moving away from the surface. For -simplicity we employ a linear decay in depth: - -\f[ - v_\ast (z) = (c_\mu^0)^{1/3} u_\ast \left( 1 - a \cdot \min \left[ 1, - \frac{|z|}{H_{bl}} \right] \right) , -\f] - -where \f$1 > a > 0\f$ has the effect of making \f$v_\ast(z=H_{bl}) > 0\f$. -Making the constant coefficient \f$a\f$ close to one has the effect of reducing the mixing -rate near the base of the boundary layer, thus producing a more diffuse entrainment -region. Making \f$a\f$ close to zero has the effect of increasing the mixing at the base -of the boundary layer, producing a more 'step-like' entrainment region. - -An estimate for the buoyancy contribution is found utilizing the convective velocity -scale: - -\f[ - w_\ast (z) = C_{w_\ast} \left( \int_z^0 \overline{w^\prime b^\prime} dz \right)^{1/3} , -\f] - -where \f$C_{w_\ast}\f$ is a non-dimensional empirical coefficient. Convection in one and -two-equation closure causes a TKE profile that peaks below the surface. The quantity -\f$\overline{w^\prime b^\prime}\f$ is solved for in ePBL as \f$KN^2\f$. - -These choices for the convective and mechanical components of the velocity scale in the -OSBL are then added together to get an estimate for the total turbulent velocity scale: - -\f[ - w_t (z) = w_\ast (z) + v_\ast (z) . -\f] - -The value of \f$a\f$ is arbitrarily chosen to be 0.95 here. - -\subsection subsection_ePBL_summary Summarizing the ePBL implementation - -The ePBL mixing coefficient is found by multiplying a velocity scale -(\ref subsection_velocityscale) by a length scale (\ref subsection_lengthscale). The -precise value of the coefficient \f$C_K\f$ used does not significantly alter the -prescribed potential energy change constraint. A reasonable value is \f$C_K \approx 0.55\f$ to -be consistent with other approaches (e.g. \cite umlauf2005). - -The boundary layer thickness (\f$H_{bl}\f$) within ePBL is based on -the depth where the energy requirement for turbulent mixing of density -exceeds the available energy (\ref section_WMBL). \f$H_{bl}\f$ is -determined by the energetic constraint imposed using the value of -\f$m_\ast\f$ and \f$n_\ast\f$. An iterative solver is required because -\f$m_\ast\f$ and the mixing length are dependent on \f$H_{bl}\f$. - -We use a constant value for convectively driven TKE of \f$n_\ast = 0.066\f$. The -parameterizations for \f$m_\ast\f$ are formulated specifically for the regimes where -\f$K_{JHL}\f$ is sensitive to model numerics \f$(|f| \Delta t \approx -1)\f$ (\cite reichl2018). - -\subsection subsection_ePBL_JHL Combining ePBL and JHL mixing coefficients - -We now address the combination of the ePBL mixing coefficient and the JHL mixing -coefficient. The function \f$F_x\f$ above cannot be the linear sum of \f$K_{ePBL}\f$ and -\f$K_{JHL}\f$. One reason this sum is not valid is because the JHL mixing coefficient is -determined by resolved current shear, including that driven by the surface wind. The -wind-driven current is also included in the ePBL mixing coefficient formulation. An -alternative approach is therefore needed to avoid double counting. - -\f$K_{ePBL}\f$ is not used at the equator as scalings are only investigated when \f$|f| > -0\f$. The solution we employ is to use the maximum mixing coefficient of the two -contributions, - -\f[ - K (z) = \max (K_{ePBL} (z), K_{JHL} (z)), -\f] - -where \f$m_\ast\f$ (and hence \f$K_{ePBL}\f$) is constrained to be small as \f$|f| -\rightarrow 0\f$. This form uses the JHL mixing coefficient when the ePBL coefficient is -small. - -This approach is reasonable when the wind-driven mixing dominates, since both JHL and ePBL -give a similar solution when deployed optimally. One weakness of this approach is the -tropical region, where the shear-driven ePBL \f$m_\ast\f$ coefficient is not formulated. -The JHL parameterization is skillful to simulate this mixing, but does not include the -contribution of convection. The convective portion of \f$K_{ePBL}\f$ should be combined -with \f$K_{JHL}\f$ in the equatorial region when shear and convection occur together. -Future research is warranted. - -Finally, one should note that the mixing coefficient here (\f$K\f$) is used for both -diffusivity and viscosity, implying a turbulent Prandtl number of 1.0. - -\subsection subsection_Langmuir Langmuir circulation - -While only briefly alluded to in \cite reichl2018, the MOM6 code implementing ePBL does -support the option to add a Langmuir parameterization. There are in fact two options, both -adjusting \f$m_\ast\f$. +Following the lead of \cite jackson2008 (\ref subsection_kappa_shear). */ From 71908c8fd30b08a6ffb43ba655ed6c4e6cc1e70f Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Oct 2021 13:46:54 -0800 Subject: [PATCH 32/83] Done with EPBL docs? --- docs/conf.py | 2 +- src/parameterizations/vertical/_EPBL.dox | 184 ++++++++++++++++++++++- 2 files changed, 182 insertions(+), 4 deletions(-) diff --git a/docs/conf.py b/docs/conf.py index 4407d88356..5d84b3c37a 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2022, MOM6 developers' +copyright = u'2017-2021, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox index 6134de31e0..d531c9ad9a 100644 --- a/src/parameterizations/vertical/_EPBL.dox +++ b/src/parameterizations/vertical/_EPBL.dox @@ -57,7 +57,7 @@ Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes \f] The parameters needed to close the system of equations are then reduced to the turbulent -mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$$. +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$. We start with an equation for the turbulent kinetic energy (TKE): @@ -67,10 +67,188 @@ We start with an equation for the turbulent kinetic energy (TKE): {\partial z} + \overline{w^\prime b^\prime} - \epsilon \f] - Terms in this equation represent TKE storage (LHS), TKE flux convergence, shear production, buoyancy production, and dissipation. -Following the lead of \cite jackson2008 (\ref subsection_kappa_shear). +\section section_WMBL Well-mixed Boundary Layers (WMBL) + +Assuming steady state and other parameterizations, integrating vertically +over the surface boundary layer, \cite reichl2018 obtains the form: + +\f[ + \frac{1}{2} H_{bl} w_e \Delta b = m_\ast u_\ast^3 - n_\ast \frac{H_{bl}}{2} + B(H_{bl}) , +\f] + +with the following variables: + + + +
Symbols used in integrated TKE equation
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$w_e\f$ entrainment velocity +
\f$\Delta b\f$ change in buoyancy at base of mixed layer +
\f$m_\ast\f$ sum of mechanical coefficients +
\f$u_\ast\f$ friction velocity (\f$u_\ast = (|\tau| / \rho_0)^{1/2}\f$) +
\f$\tau\f$ wind stress +
\f$n_\ast\f$ convective proportionality coefficient +
1 for stabilizing surface buoyancy flux, less otherwise +
\f$B(H_{bl})\f$ surface buoyancy flux +
+ +\section section_ePBL Energetics-based Planetary Boundary Layer + +Once again, the goal is to formulate a surface mixing scheme to find the +turbulent eddy diffusivity (and viscosity) in a way that is suitable for use +in a global climate model, using long timesteps and large grid spacing. +After evaluating a well-mixed boundary layer (WMBL), the shear mixing of +\cite jackson2008 (JHL, \ref subsection_kappa_shear), as well as a more complete +boundary layer scheme, it was decided to combine a number of these ideas +into a new scheme: + +\f[ + K(z) = F_x(K_{ePBL}(z), K_{JHL}(z), K_n(z)) +\f] + +where \f$F_x\f$ is some unknown function of a new \f$K_{ePBL}\f$, +\f$K_{JHL}\f$, the diffusivity due to shear as determined by +\cite jackson2008, and \f$K_n\f$, the diffusivity from other ideas. +We start by specifying the form of \f$K_{ePBL}\f$ as being: + +\f[ + K_{ePBL}(z) = C_K w_t l , +\f] + +where \f$w_t\f$ is a turbulent velocity scale, \f$C_K\f$ is a coefficient, and +\f$l\f$ is a length scale. + +\subsection subsection_lengthscale Turbulent length scale + +We propose a form for the length scale as follows: + +\f[ + l = (z_0 + |z|) \times \max \left[ \frac{l_b}{H_{bl}} , \left( + \frac{H_{bl} - |z|}{H_{bl}} \right)^\gamma \, \right] , +\f] + +where we have the following variables: + + + +
Symbols used in ePBL length scale
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$z_0\f$ roughness length +
\f$\gamma\f$ coefficient, 2 is as in KPP, \cite large1994 +
\f$l_b\f$ bottom length scale +
+ +\subsection subsection_velocityscale Turbulent velocity scale + +We do not predict the TKE prognostically and therefore approximate the vertical TKE +profile to estimate \f$w_t\f$. An estimate for the mechanical contribution to the velocity +scale follows the standard two-equation approach. In one and two-equation second-order +\f$K\f$ parameterizations the boundary condition for the TKE is typically employed as a +flux boundary condition. + +\f[ + K \left. \frac{\partial k}{\partial z} \right|_{z=0} = c_\mu^0 u_\ast^3 . +\f] + +The profile of \f$k\f$ decays in the vertical from \f$k \propto (c_\mu^0)^{2/3} +u_\ast^2\f$ toward the base of the OSBL. Here we assume a similar relationship to estimate +the mechanical contribution to the TKE profile. The value of \f$w_t\f$ due to mechanical +sources, \f$v_\ast\f$, is estimate as \f$v_\ast (z=0) \propto (c_\mu^0)^{1/3} u_\ast\f$ at +the surface. Since we only parameterize OSBL turbulent mixing due to surface forcing, the +value of the velocity scale is assumed to decay moving away from the surface. For +simplicity we employ a linear decay in depth: + +\f[ + v_\ast (z) = (c_\mu^0)^{1/3} u_\ast \left( 1 - a \cdot \min \left[ 1, + \frac{|z|}{H_{bl}} \right] \right) , +\f] + +where \f$1 > a > 0\f$ has the effect of making \f$v_\ast(z=H_{bl}) > 0\f$. +Making the constant coefficient \f$a\f$ close to one has the effect of reducing the mixing +rate near the base of the boundary layer, thus producing a more diffuse entrainment +region. Making \f$a\f$ close to zero has the effect of increasing the mixing at the base +of the boundary layer, producing a more 'step-like' entrainment region. + +An estimate for the buoyancy contribution is found utilizing the convective velocity +scale: + +\f[ + w_\ast (z) = C_{w_\ast} \left( \int_z^0 \overline{w^\prime b^\prime} dz \right)^{1/3} , +\f] + +where \f$C_{w_\ast}\f$ is a non-dimensional empirical coefficient. Convection in one and +two-equation closure causes a TKE profile that peaks below the surface. The quantity +\f$\overline{w^\prime b^\prime}\f$ is solved for in ePBL as \f$KN^2\f$. + +These choices for the convective and mechanical components of the velocity scale in the +OSBL are then added together to get an estimate for the total turbulent velocity scale: + +\f[ + w_t (z) = w_\ast (z) + v_\ast (z) . +\f] + +The value of \f$a\f$ is arbitrarily chosen to be 0.95 here. + +\subsection subsection_ePBL_summary Summarizing the ePBL implementation + +The ePBL mixing coefficient is found by multiplying a velocity scale +(\ref subsection_velocityscale) by a length scale (\ref subsection_lengthscale). The +precise value of the coefficient \f$C_K\f$ used does not significantly alter the +prescribed potential energy change constraint. A reasonable value is \f$C_K \approx 0.55\f$ to +be consistent with other approaches (e.g. \cite umlauf2005). + +The boundary layer thickness (\f$H_{bl}\f$) within ePBL is based on +the depth where the energy requirement for turbulent mixing of density +exceeds the available energy (\ref section_WMBL). \f$H_{bl}\f$ is +determined by the energetic constraint imposed using the value of +\f$m_\ast\f$ and \f$n_\ast\f$. An iterative solver is required because +\f$m_\ast\f$ and the mixing length are dependent on \f$H_{bl}\f$. + +We use a constant value for convectively driven TKE of \f$n_\ast = 0.066\f$. The +parameterizations for \f$m_\ast\f$ are formulated specifically for the regimes where +\f$K_{JHL}\f$ is sensitive to model numerics \f$(|f| \Delta t \approx +1)\f$ (\cite reichl2018). + +\subsection subsection_ePBL_JHL Combining ePBL and JHL mixing coefficients + +We now address the combination of the ePBL mixing coefficient and the JHL mixing +coefficient. The function \f$F_x\f$ above cannot be the linear sum of \f$K_{ePBL}\f$ and +\f$K_{JHL}\f$. One reason this sum is not valid is because the JHL mixing coefficient is +determined by resolved current shear, including that driven by the surface wind. The +wind-driven current is also included in the ePBL mixing coefficient formulation. An +alternative approach is therefore needed to avoid double counting. + +\f$K_{ePBL}\f$ is not used at the equator as scalings are only investigated when \f$|f| > +0\f$. The solution we employ is to use the maximum mixing coefficient of the two +contributions, + +\f[ + K (z) = \max (K_{ePBL} (z), K_{JHL} (z)), +\f] + +where \f$m_\ast\f$ (and hence \f$K_{ePBL}\f$) is constrained to be small as \f$|f| +\rightarrow 0\f$. This form uses the JHL mixing coefficient when the ePBL coefficient is +small. + +This approach is reasonable when the wind-driven mixing dominates, since both JHL and ePBL +give a similar solution when deployed optimally. One weakness of this approach is the +tropical region, where the shear-driven ePBL \f$m_\ast\f$ coefficient is not formulated. +The JHL parameterization is skillful to simulate this mixing, but does not include the +contribution of convection. The convective portion of \f$K_{ePBL}\f$ should be combined +with \f$K_{JHL}\f$ in the equatorial region when shear and convection occur together. +Future research is warranted. + +Finally, one should note that the mixing coefficient here (\f$K\f$) is used for both +diffusivity and viscosity, implying a turbulent Prandtl number of 1.0. + +\subsection subsection_Langmuir Langmuir circulation + +While only briefly alluded to in \cite reichl2018, the MOM6 code implementing ePBL does +support the option to add a Langmuir parameterization. There are in fact two options, both +adjusting \f$m_\ast\f$. */ From 3dbf2f58dc29898492f1a9b72e80d1454685f1b1 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Oct 2021 14:53:52 -0800 Subject: [PATCH 33/83] Undoing some patches from others --- src/core/MOM_barotropic.F90 | 32 +++------------------ src/framework/MOM_horizontal_regridding.F90 | 9 ------ 2 files changed, 4 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 3cb1ebf399..cf001fc1d0 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -225,10 +225,7 @@ module MOM_barotropic !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. - logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the - !! barotropic solver has the wrong sign, replicating a long-standing - !! bug. - real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim]. + real :: G_extra !< A nondimensional factor by which gtot is enhanced. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are !! given by the parameters defined below: @@ -1057,11 +1054,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - if (CS%tidal_sal_bug) then - dgeo_de = 1.0 + det_de + CS%G_extra - else - dgeo_de = (1.0 - det_de) + CS%G_extra - endif + dgeo_de = 1.0 + det_de + CS%G_extra else dgeo_de = 1.0 + CS%G_extra endif @@ -2804,11 +2797,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) det_de = 0.0 if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - if (CS%tidal_sal_bug) then - dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) - else - dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de) - endif + dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) if (present(pbce)) then do j=js,je ; do i=is,ie gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0 @@ -4299,12 +4288,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. - real :: det_de ! The partial derivative due to self-attraction and loading of the reference - ! geopotential with the sea surface height when tides are enabled. - ! This is typically ~0.09 or less. - real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points - ! that acts on the barotropic flow [Z T-1 ~> m s-1]. - + real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity @@ -4458,14 +4442,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) - det_de = 0.0 - if (CS%tides .and. associated(CS%tides_CSp)) & - call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, & - "If true, the tidal self-attraction and loading anomaly in the barotropic "//& - "solver has the wrong sign, replicating a long-standing bug with a scalar "//& - "self-attraction and loading term or the SAL term from a previous simulation.", & - default=.true., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index e5e651407e..de511688a9 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -840,14 +840,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) - ! now fill in missing values using "ICE-nine" algorithm. - tr_outf(:,:) = tr_out(:,:) - if (k==1) tr_prev(:,:) = tr_outf(:,:) - good2(:,:) = good(:,:) - fill2(:,:) = fill(:,:) - - call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) - ! if (debug) then ! call hchksum(tr_outf, 'field from fill_miss_2d ', G%HI) ! endif @@ -875,7 +867,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo enddo endif - end subroutine horiz_interp_and_extrap_tracer_fms_id !> Create a 2d-mesh of grid coordinates from 1-d arrays. From 45d6151916f0d3d064bab5aefe15513bc4b2ebcb Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 12 Oct 2021 11:01:28 -0800 Subject: [PATCH 34/83] Adding in that SAL commit again. --- src/core/MOM_barotropic.F90 | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cf001fc1d0..9ee023c546 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -225,6 +225,9 @@ module MOM_barotropic !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. + logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the + !! barotropic solver has the wrong sign, replicating a long-standing + !! bug. real :: G_extra !< A nondimensional factor by which gtot is enhanced. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are @@ -1054,7 +1057,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + det_de + CS%G_extra + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + det_de + CS%G_extra + else + dgeo_de = (1.0 - det_de) + CS%G_extra + endif else dgeo_de = 1.0 + CS%G_extra endif @@ -2797,7 +2804,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) det_de = 0.0 if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + else + dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de) + endif if (present(pbce)) then do j=js,je ; do i=is,ie gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0 @@ -4288,6 +4299,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. + real :: det_de ! The partial derivative due to self-attraction and loading of the reference + ! geopotential with the sea surface height when tides are enabled. + ! This is typically ~0.09 or less. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -4442,6 +4456,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) + det_de = 0.0 + if (CS%tides .and. associated(CS%tides_CSp)) & + call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) + call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, & + "If true, the tidal self-attraction and loading anomaly in the barotropic "//& + "solver has the wrong sign, replicating a long-standing bug with a scalar "//& + "self-attraction and loading term or the SAL term from a previous simulation.", & + default=.true., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& From 65cccb7a04d17b2f9a1af89240ef9ab287d947cb Mon Sep 17 00:00:00 2001 From: jiandewang Date: Thu, 28 Oct 2021 15:47:25 -0400 Subject: [PATCH 35/83] correction on type in directory name --- .../MOM_stochastics.F90 | 0 .../MOM_stochastics_stub.F90 | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename config_src/external/{OCEAN_stochastic_phyiscs => OCEAN_stochastic_physics}/MOM_stochastics.F90 (100%) rename config_src/external/{OCEAN_stochastic_phyiscs => OCEAN_stochastic_physics}/MOM_stochastics_stub.F90 (100%) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 similarity index 100% rename from config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 rename to config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 similarity index 100% rename from config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 rename to config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 From ebb643af955320dbfc581da4377cb3290a0215e8 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 28 Jan 2022 11:24:39 -0900 Subject: [PATCH 36/83] Oops, more cleanup. --- config_src/drivers/nuopc_cap/mom_cap.F90 | 17 +-- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 19 ++-- config_src/drivers/solo_driver/MOM_driver.F90 | 14 --- .../MOM_stochastics_stub.F90 | 68 ------------ docs/conf.py | 2 +- src/core/MOM.F90 | 37 ++++--- src/core/MOM_barotropic.F90 | 6 +- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/framework/MOM_domains.F90 | 60 ++++++++--- .../stochastic}/MOM_stochastics.F90 | 35 +++--- .../vertical/MOM_diabatic_driver.F90 | 63 +++++------ .../vertical/MOM_energetic_PBL.F90 | 102 +++++++----------- 12 files changed, 167 insertions(+), 260 deletions(-) delete mode 100644 config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 rename {config_src/external/OCEAN_stochastic_physics => src/parameterizations/stochastic}/MOM_stochastics.F90 (86%) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 25de32d526..174a659f12 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -98,7 +98,6 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM -use MOM_stochastics, only : write_mom_restart_stoch !$use omp_lib , only : omp_set_num_threads implicit none; private @@ -1750,21 +1749,9 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) + call ocean_model_restart(ocean_state, restartname=restartname, & + stoch_restartname=stoch_restartname) - if (ocean_state%do_sppt .OR. ocean_state%pert_epbl) then - if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then - write(restartname,'(A)')"ocn_stoch.res.nc" - else - write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & - "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" - endif - call ESMF_LogWrite("MOM_cap: Writing stoch restart : "//trim(restartname), & - ESMF_LOGMSG_INFO) - call write_mom_restart_stoch('RESTART/'//trim(restartname)) - endif - call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - call write_stoch_restart_ocn('RESTART/'//trim(restartname)) endif if (is_root_pe()) then diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 9ffe4cd794..448f23140e 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -62,8 +62,8 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use MOM_domains, only : root_PE,num_PEs -use MOM_coms, only : Get_PElist +use get_stochy_pattern_mod, only : write_stoch_restart_ocn +use iso_fortran_env, only : int64 #include @@ -177,8 +177,10 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical,public :: do_sppt !< If true, write stochastic physics restarts - logical,public :: pert_epbl !< If true, write stochastic physics restarts + logical :: do_sppt !< If true, stochastically perturb the diabatic and + !! write restarts + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and + !! genration termsand write restarts real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -253,7 +255,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! The actual depth over which melt potential is computed will !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot!< If true, allocate melt_potential array + logical :: use_melt_pot !< If true, allocate melt_potential array + logical :: use_CFC !< If true, allocated arrays for surface CFCs. + ! This include declares and sets the variable "version". #include "version_variable.h" @@ -425,10 +429,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif - ! check to see if stochastic physics is active + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) +! get number of processors and PE list for stocasthci physics initialization call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & "If true, then stochastically perturb the thermodynamic "//& - "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "tendencies of T,S, and h. Amplitude and correlations are "//& "controlled by the nam_stoch namelist in the UFS model only.", & default=.false.) call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index afb1901e0a..1b88f1ce36 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -69,19 +69,6 @@ program MOM_main use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_size - use ensemble_manager_mod, only : ensemble_pelist_setup - use mpp_mod, only : set_current_pelist => mpp_set_current_pelist - use time_interp_external_mod, only : time_interp_external_init - use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get - - use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS - use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart -! , add_shelf_flux_forcing, add_shelf_flux_IOB - - use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init - use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves - implicit none #include @@ -91,7 +78,6 @@ program MOM_main ! A structure containing pointers to the thermodynamic forcing fields ! at the ocean surface. type(forcing) :: fluxes - ! A structure containing pointers to the ocean surface state fields. type(surface) :: sfc_state diff --git a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 deleted file mode 100644 index 349d56c0c7..0000000000 --- a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 +++ /dev/null @@ -1,68 +0,0 @@ -!> Top-level module for the MOM6 ocean model in coupled mode. -module MOM_stochastics - -! This file is part of MOM6. See LICENSE.md for the license. - -! This is the top level module for the MOM6 ocean model. It contains -! placeholder for initialization, update, and writing restarts of ocean stochastic physics. -! The actualy stochastic physics is available at -! https://github.com/ufs-community/ufs-weather-model -! - -use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use MOM_domains, only : root_PE,num_PEs -use MOM_coms, only : Get_PElist - -#include - -implicit none ; private - -public stochastics_init, update_stochastics - -!> This control structure holds parameters for the MOM_stochastics module -type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms - !>@{ Diagnostic IDs - integer :: id_sppt_wts = -1 - integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 - !>@} - ! stochastic patterns - real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - !! tendencies with a number between 0 and 2 - real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation - real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation - type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output - type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) -end type stochastic_CS - -contains - -subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) - real, intent(in) :: dt !< time step [T ~> s] - type(ocean_grid_type), intent(in) :: grid ! horizontal grid information - type(verticalGrid_type), intent(in) :: GV ! vertical grid structure - type(stochastic_CS), pointer, intent(inout):: CS - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output - type(time_type), target :: Time !< model time - return -end subroutine stochastics_init - -subroutine update_stochastics(CS) - type(stochastic_CS), intent(inout) :: CS !< diabatic control structure - return -end subroutine update_stochastics -subroutine write_mom_restart_stoch(filename) - character(len=*) :: filename - return -end subroutine write_mom_restart_stoch -end module MOM_stochastics - diff --git a/docs/conf.py b/docs/conf.py index 5d84b3c37a..4407d88356 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2021, MOM6 developers' +copyright = u'2017-2022, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b331c64174..c36c0545e1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -132,7 +132,7 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_variables, only : rotate_surface_state, stochastic_pattern +use MOM_variables, only : rotate_surface_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units @@ -154,6 +154,8 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline +use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf +use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end implicit none ; private @@ -402,6 +404,16 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors + type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) & + :: por_face_areaU !< fractional open area of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) & + :: por_face_areaV !< fractional open area of V-faces [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) & + :: por_layer_widthU !< fractional open width of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) & + :: por_layer_widthV !< fractional open width of V-faces [nondim] + type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure end type MOM_control_struct @@ -1381,7 +1393,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS,OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS, CS%OBC, Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1799,7 +1811,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt + real :: conv2watt ! A conversion factor from temperature fluxes to heat + ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] + real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] + real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -2475,28 +2490,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif - ! Shift from using the temporary dynamic grid type to using the final - ! (potentially static) ocean-specific grid type. - ! The next line would be needed if G%Domain had not already been init'd above: - ! call clone_MOM_domain(dG%Domain, G%Domain) - call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G, US) - call destroy_dyn_horgrid(dG) - ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then call set_first_direction(G, modulo(first_direction + turns, 2)) else call set_first_direction(G, modulo(first_direction, 2)) endif - call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) - call destroy_dyn_horgrid(dG_in) - - if (.not. CS%rotate_index) & - G => G_in - ! Set a few remaining fields that are specific to the ocean grid type. - call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9ee023c546..3cb1ebf399 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -228,7 +228,7 @@ module MOM_barotropic logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the !! barotropic solver has the wrong sign, replicating a long-standing !! bug. - real :: G_extra !< A nondimensional factor by which gtot is enhanced. + real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim]. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are !! given by the parameters defined below: @@ -4302,7 +4302,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real :: det_de ! The partial derivative due to self-attraction and loading of the reference ! geopotential with the sea surface height when tides are enabled. ! This is typically ~0.09 or less. - real, allocatable, dimension(:,:) :: lin_drag_h + real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points + ! that acts on the barotropic flow [Z T-1 ~> m s-1]. + type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e0b0d4469b..8d667503d7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1286,8 +1286,8 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. 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] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 2b30a4d629..0cdcc455fc 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,24 +3,56 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_array_transform, only : rotate_array -use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end -use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs -use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end -use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL, is_root_pe -use MOM_file_parser, only : get_param, log_param, log_version -use MOM_file_parser, only : param_file_type +use MOM_coms_infra, only : MOM_infra_init, MOM_infra_end +use MOM_coms_infra, only : PE_here, root_PE, num_PEs, broadcast +use MOM_coms_infra, only : sum_across_PEs, min_across_PEs, max_across_PEs +use MOM_domain_infra, only : MOM_domain_type, domain2D, domain1D, group_pass_type +use MOM_domain_infra, only : create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain +use MOM_domain_infra, only : get_domain_extent, get_domain_components, same_domain +use MOM_domain_infra, only : compute_block_extent, get_global_shape +use MOM_domain_infra, only : pass_var, pass_vector, fill_symmetric_edges, global_field_sum +use MOM_domain_infra, only : pass_var_start, pass_var_complete +use MOM_domain_infra, only : pass_vector_start, pass_vector_complete +use MOM_domain_infra, only : create_group_pass, do_group_pass +use MOM_domain_infra, only : start_group_pass, complete_group_pass +use MOM_domain_infra, only : rescale_comp_data, global_field, redistribute_array, broadcast_domain +use MOM_domain_infra, only : MOM_thread_affinity_set, set_MOM_thread_affinity +use MOM_domain_infra, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM +use MOM_domain_infra, only : CORNER, CENTER, NORTH_FACE, EAST_FACE +use MOM_domain_infra, only : To_East, To_West, To_North, To_South, To_All, Omit_Corners +use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_io_infra, only : file_exists use MOM_string_functions, only : slasher implicit none ; private -public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 -public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, PE_here, root_PE, num_PEs -public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast -public :: pass_vector_start, pass_vector_complete -public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER +public :: MOM_infra_init, MOM_infra_end +! Domain types and creation and destruction routines +public :: MOM_domain_type, domain2D, domain1D +public :: MOM_domains_init, create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain +public :: MOM_thread_affinity_set, set_MOM_thread_affinity +! Domain query routines +public :: get_domain_extent, get_domain_components, get_global_shape, same_domain +public :: PE_here, root_PE, num_PEs +! Blocks are not actively used in MOM6, so this routine could be deprecated. +public :: compute_block_extent +! Single call communication routines +public :: pass_var, pass_vector, fill_symmetric_edges, broadcast +! Non-blocking communication routines +public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete +! Multi-variable group communication routines and type +public :: create_group_pass, do_group_pass, group_pass_type, start_group_pass, complete_group_pass +! Global reduction routines +public :: sum_across_PEs, min_across_PEs, max_across_PEs +public :: global_field, redistribute_array, broadcast_domain +! Simple index-convention-invariant array manipulation routine +public :: rescale_comp_data +!> These encoding constants are used to indicate the staggering of scalars and vectors +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR +!> These encoding constants are used to indicate the discretization position of a variable +public :: CORNER, CENTER, NORTH_FACE, EAST_FACE +!> These encoding constants indicate communication patterns. In practice they can be added. public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners ! These are no longer used by MOM6 because the reproducing sum works so well, but they are ! still referenced by some of the non-GFDL couplers. diff --git a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 similarity index 86% rename from config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 rename to src/parameterizations/stochastic/MOM_stochastics.F90 index e6b0c80280..21a22a222e 100644 --- a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -19,20 +19,20 @@ module MOM_stochastics use MOM_domains, only : root_PE,num_PEs use MOM_coms, only : Get_PElist use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn -use get_stochy_pattern_mod, only: write_stoch_restart_ocn #include implicit none ; private -public stochastics_init, update_stochastics, write_mom_restart_stoch +public stochastics_init, update_stochastics !> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms - integer :: id_sppt_wts = -1 - integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 !< Diagnostic id for SPPT + integer :: id_epbl1_wts=-1 !< Diagnostic id for epbl generation perturbation + integer :: id_epbl2_wts=-1 !< Diagnostic id for epbl dissipation perturbation ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT !! tendencies with a number between 0 and 2 @@ -47,9 +47,9 @@ module MOM_stochastics !! This subroutine initializes the stochastics physics control structure. subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] - type(ocean_grid_type), intent(in) :: grid ! horizontal grid information - type(verticalGrid_type), intent(in) :: GV ! vertical grid structure - type(stochastic_CS), pointer, intent(inout):: CS + type(ocean_grid_type), intent(in) :: grid !< horizontal grid information + type(verticalGrid_type), intent(in) :: GV !< vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS !< stochastic control structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output type(time_type), target :: Time !< model time @@ -59,7 +59,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) integer :: num_procs ! number of processors to pass to stochastic physics integer :: iret ! return code from stochastic physics integer :: me ! my pe - integer :: master ! root pe + integer :: pe_zero ! root pe integer :: nx ! number of x-points including halo integer :: ny ! number of x-points including halo @@ -95,11 +95,11 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) - master=root_PE() + pe_zero=root_PE() nx = grid%ied - grid%isd + 1 ny = grid%jed - grid%jsd + 1 call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & - CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) + CS%pert_epbl,CS%do_sppt,pe_zero,mom_comm,iret) if (iret/=0) then call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") return @@ -140,16 +140,5 @@ subroutine update_stochastics(CS) return end subroutine update_stochastics -!< wrapper to write ocean stochastic restarts -subroutine write_mom_restart_stoch(filename) - character(len=*) :: filename - - call callTree_enter("write_mom_restart_stoch(), MOM_stochastics.F90") - - call write_stoch_restart_ocn(filename) - - return -end subroutine write_mom_restart_stoch - end module MOM_stochastics diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 044071dc38..5eaca3c275 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -71,7 +71,6 @@ module MOM_diabatic_driver use MOM_wave_interface, only : wave_parameters_CS use MOM_stochastics, only : stochastic_CS - implicit none ; private #include @@ -221,8 +220,6 @@ module MOM_diabatic_driver logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics - real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil - real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module @@ -283,8 +280,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -293,8 +291,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -305,9 +303,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, allocatable(:,:,:) :: h_in ! thickness before thermodynamics - real, allocatable(:,:,:) :: t_in ! temperature before thermodynamics - real, allocatable(:,:,:) :: s_in ! salinity before thermodynamics + real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics + real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics + real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT @@ -327,7 +325,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (GV%ke == 1) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -504,12 +504,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo enddo enddo + deallocate(h_in) + deallocate(t_in) + deallocate(s_in) endif end subroutine diabatic -end subroutine diabatic - !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. @@ -523,10 +524,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] - type(forcing), intent(inout) :: fluxes !< points to forcing fields - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -534,7 +537,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -835,8 +838,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves) + CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -1111,8 +1113,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1120,7 +1123,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1372,8 +1375,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves) + CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) @@ -3136,12 +3138,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_dvdt_dia_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - CS%id_dudt_dia = register_diag_field('ocean_model', 'dudt_dia', diag%axesCuL, Time, & - 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_dvdt_dia = register_diag_field('ocean_model', 'dvdt_dia', diag%axesCvL, Time, & - 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', diag%axesT1, Time, & - 'random pattern for sppt', 'None') + if ((CS%id_dudt_dia > 0) .or. (CS%id_hf_dudt_dia_2d > 0)) & + call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) + if ((CS%id_dvdt_dia > 0) .or. (CS%id_hf_dvdt_dia_2d > 0)) & + call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) + endif if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 9ecba8a7b8..99dd38135d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -244,9 +244,8 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, & - last_call, dT_expected, dS_expected, Waves) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & + stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -278,27 +277,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 s-1 ~> m2 s-1]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to mixedlayer_init. + !! [Z2 T-1 ~> m2 s-1]. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - logical, optional, intent(in) :: last_call !< If true, this is the last call to - !! mixedlayer in the current time step, so - !! diagnostics will be written. The default - !! is .true. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dT_expected !< The values of temperature change that - !! should be expected when the returned - !! diffusivities are applied [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dS_expected !< The values of salinity change that - !! should be expected when the returned - !! diffusivities are applied [ppt]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous ! This subroutine determines the diffusivities from the integrated energetics @@ -439,16 +422,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) + if (stoch_CS%pert_epbl) then ! stochastics are active call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j), & - i=i, j=j) + US, CS, eCD, Waves, G, i, j, & + epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j)) else call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + US, CS, eCD, Waves, G, i, j) endif ! Copy the diffusivities to a 2-d array. @@ -488,30 +471,26 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo ! j-loop - if (write_diags) then - if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) - ! only write random patterns if running with stochastic physics, otherwise the - ! array is unallocated and will give an error - if (stoch_CS%pert_epbl) then - if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) - if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) - endif + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + if (stoch_CS%pert_epbl) then + if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) + if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) endif end subroutine energetic_PBL @@ -521,7 +500,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, epbl1_wt, epbl2_wt, i, j) + Waves, G, i, j, epbl1_wt, epbl2_wt) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -558,16 +537,12 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS for Langmuir turbulence - type(ocean_grid_type), & - optional, intent(inout) :: G !< The ocean's grid structure. - real, optional, intent(in) :: epbl1_wt ! random number to perturb KE generation - real, optional, intent(in) :: epbl2_wt ! random number to perturb KE dissipation - integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) - integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + real, optional, intent(in) :: epbl1_wt !< random number to perturb KE generation + real, optional, intent(in) :: epbl2_wt !< random number to perturb KE dissipation + integer, intent(in) :: i !< The i-index to work on (used for Waves) + integer, intent(in) :: j !< The i-index to work on (used for Waves) ! This subroutine determines the diffusivities in a single column from the integrated energetics ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes @@ -941,11 +916,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) else - mech_TKE = mech_TKE * exp_kh + mech_TKE = mech_TKE * exp_kh endif - !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From e853f839bed28ad8a8c86f94e5d7669bcda6a419 Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Tue, 5 May 2020 09:41:38 -0500 Subject: [PATCH 37/83] additions for stochastic physics and ePBL perts --- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 2 + src/core/MOM.F90 | 39 +++++++++--- src/core/MOM_forcing_type.F90 | 19 ++++-- src/diagnostics/MOM_diagnostics.F90 | 22 +++++-- src/framework/MOM_domains.F90 | 59 ++++--------------- .../vertical/MOM_energetic_PBL.F90 | 2 +- 6 files changed, 79 insertions(+), 64 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index c704214930..10add0f8d0 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -315,6 +315,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call safe_alloc_ptr(fluxes%p_surf ,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + print*,'allocate fluxes%t_rp' + call safe_alloc_ptr(fluxes%t_rp,isd,ied,jsd,jed) if (CS%use_limited_P_SSH) then fluxes%p_surf_SSH => fluxes%p_surf else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f3d8869320..f3ce4f3b11 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -30,6 +30,7 @@ module MOM use MOM_domains, only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : start_group_pass, complete_group_pass, Omit_Corners +use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -155,8 +156,7 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline -use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf -use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end +use stochastic_physics, only : init_stochastic_physics_ocn,run_stochastic_physics_ocn implicit none ; private @@ -249,6 +249,8 @@ module MOM 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 :: do_stochy = .false. + !< If true, call stochastic physics pattern generator type(time_type), pointer :: Time !< pointer to the ocean clock real :: dt !< (baroclinic) dynamics time step [T ~> s] @@ -827,6 +829,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif + print*,'calling run_stochastic_physics_ocn',CS%do_stochy + if (CS%do_stochy) call run_stochastic_physics_ocn(forces%t_rp) call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & @@ -979,7 +983,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%time_in_thermo_cycle > 0.0) then call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & - sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc) + sfc_state, CS%tv, ssh, fluxes%t_rp, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1812,10 +1816,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt ! A conversion factor from temperature fluxes to heat - ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] - real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] - real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors + integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean + integer :: num_procs +! model + integer :: me ! my pe + integer :: master ! root pe + real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -2492,6 +2498,25 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif + ! Shift from using the temporary dynamic grid type to using the final + ! (potentially static) ocean-specific grid type. + ! The next line would be needed if G%Domain had not already been init'd above: + ! call clone_MOM_domain(dG%Domain, G%Domain) + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) + call copy_dyngrid_to_MOM_grid(dG, G, US) + call destroy_dyn_horgrid(dG) + + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist) + me=PE_here() + master=root_PE() + + !call init_stochastic_physics_ocn(CS%dt_therm,G,me,master,pelist,CS%do_stochy) + print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) + call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,CS%do_stochy) + print*,'back from init_stochastic_physics_ocn',CS%do_stochy + ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then call set_first_direction(G, modulo(first_direction + turns, 2)) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index bdf4823f81..8bbcb9854d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -145,6 +145,8 @@ module MOM_forcing_type !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. + real, pointer, dimension(:,:) :: t_rp => NULL() + !< random pattern at t-points logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -250,10 +252,10 @@ module MOM_forcing_type !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled, !! and is exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: & - rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at - !! u-points [L4 Z-1 T-1 ~> m3 s-1] - rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at - !! v-points [L4 Z-1 T-1 ~> m3 s-1] + rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points [m3 s-1] + rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points [m3 s-1] + real, pointer, dimension(:,:) :: t_rp => NULL() + !< random pattern at t-points real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -2135,6 +2137,12 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres + if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then + do j=js,je ; do i=is,ie + fluxes%t_rp(i,j) = forces%t_rp(i,j) + enddo ; enddo + endif + if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie fluxes%ustar(i,j) = forces%ustar(i,j) @@ -3109,6 +3117,7 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) call myAlloc(forces%net_mass_src,isd,ied,jsd,jed, press) + call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) call myAlloc(forces%rigidity_ice_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%rigidity_ice_v,isd,ied,JsdB,JedB, shelf) @@ -3273,6 +3282,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) + if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) @@ -3303,6 +3313,7 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%ustar)) deallocate(forces%ustar) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) + if (associated(forces%t_rp)) deallocate(forces%t_rp) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ef71d9286c..ddb925af28 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -139,7 +139,9 @@ module MOM_diagnostics integer :: id_salt_deficit = -1 integer :: id_Heat_PmE = -1 integer :: id_intern_heat = -1 - !>@} +! stochastic pattern + integer :: id_t_rp = -1 + !!@} end type surface_diag_IDs @@ -1277,7 +1279,7 @@ end subroutine post_surface_dyn_diags !> 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_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv, & - ssh, ssh_ibc) + ssh, t_rp, 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 @@ -1286,8 +1288,10 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. 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 [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: t_rp!< random pattern for stochastic proceeses real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] @@ -1409,6 +1413,11 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv call post_data(IDs%id_sss_sq, work_2d, diag, mask=G%mask2dT) endif + if (IDs%id_t_rp > 0) then + !call post_data(IDs%id_t_rp, t_rp, diag, mask=G%mask2dT) + call post_data(IDs%id_t_rp, t_rp, diag) + endif + call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag)) end subroutine post_surface_thermo_diags @@ -1896,8 +1905,9 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& - 'Heat flux into ocean from geothermal or other internal sources', & - 'W m-2', conversion=US%QRZ_T_to_W_m2) + 'Heat flux into ocean from geothermal or other internal sources', 'W m-2') + IDs%id_t_rp = register_diag_field('ocean_model', 'random_pattern', diag%axesT1, Time, & + 'random pattern for stochastics', 'None') end subroutine register_surface_diags diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index dc6c0a8996..b647c56534 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,56 +3,23 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coms_infra, only : MOM_infra_init, MOM_infra_end -use MOM_coms_infra, only : PE_here, root_PE, num_PEs, broadcast -use MOM_coms_infra, only : sum_across_PEs, min_across_PEs, max_across_PEs -use MOM_domain_infra, only : MOM_domain_type, domain2D, domain1D, group_pass_type -use MOM_domain_infra, only : create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain -use MOM_domain_infra, only : get_domain_extent, get_domain_components, same_domain -use MOM_domain_infra, only : compute_block_extent, get_global_shape -use MOM_domain_infra, only : pass_var, pass_vector, fill_symmetric_edges, global_field_sum -use MOM_domain_infra, only : pass_var_start, pass_var_complete -use MOM_domain_infra, only : pass_vector_start, pass_vector_complete -use MOM_domain_infra, only : create_group_pass, do_group_pass -use MOM_domain_infra, only : start_group_pass, complete_group_pass -use MOM_domain_infra, only : rescale_comp_data, global_field, redistribute_array, broadcast_domain -use MOM_domain_infra, only : MOM_thread_affinity_set, set_MOM_thread_affinity -use MOM_domain_infra, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM -use MOM_domain_infra, only : CORNER, CENTER, NORTH_FACE, EAST_FACE -use MOM_domain_infra, only : To_East, To_West, To_North, To_South, To_All, Omit_Corners -use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_io_infra, only : file_exists +use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Get_PElist +use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs +use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end +use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL, is_root_pe +use MOM_file_parser, only : get_param, log_param, log_version +use MOM_file_parser, only : param_file_type use MOM_string_functions, only : slasher implicit none ; private -public :: MOM_infra_init, MOM_infra_end -! Domain types and creation and destruction routines -public :: MOM_domain_type, domain2D, domain1D -public :: MOM_domains_init, create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain -public :: MOM_thread_affinity_set, set_MOM_thread_affinity -! Domain query routines -public :: get_domain_extent, get_domain_components, get_global_shape, same_domain -public :: PE_here, root_PE, num_PEs -! Blocks are not actively used in MOM6, so this routine could be deprecated. -public :: compute_block_extent -! Single call communication routines -public :: pass_var, pass_vector, fill_symmetric_edges, broadcast -! Non-blocking communication routines -public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete -! Multi-variable group communication routines and type -public :: create_group_pass, do_group_pass, group_pass_type, start_group_pass, complete_group_pass -! Global reduction routines -public :: sum_across_PEs, min_across_PEs, max_across_PEs -public :: global_field, redistribute_array, broadcast_domain -! Simple index-convention-invariant array manipulation routine -public :: rescale_comp_data -!> These encoding constants are used to indicate the staggering of scalars and vectors -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR -!> These encoding constants are used to indicate the discretization position of a variable -public :: CORNER, CENTER, NORTH_FACE, EAST_FACE -!> These encoding constants indicate communication patterns. In practice they can be added. +public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 +public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs, Get_PElist +public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast +public :: pass_vector_start, pass_vector_complete +public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners ! These are no longer used by MOM6 because the reproducing sum works so well, but they are ! still referenced by some of the non-GFDL couplers. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 99dd38135d..c9ae6e43ed 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -401,7 +401,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - u_star = fluxes%ustar(i,j) + u_star = fluxes%ustar(i,j)*(fluxes%t_rp(i,j)) u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then From 45acf37f19176c583b364b1caf069d819f91e3b1 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 2 Dec 2020 15:35:05 +0000 Subject: [PATCH 38/83] cleanup of code and enhancement of ePBL perts --- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 2 - src/core/MOM.F90 | 28 +-- src/core/MOM_forcing_type.F90 | 43 +++-- src/diagnostics/MOM_diagnostics.F90 | 16 +- .../vertical/MOM_diabatic_driver.F90 | 174 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 62 ++++--- 6 files changed, 172 insertions(+), 153 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 10add0f8d0..c704214930 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -315,8 +315,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call safe_alloc_ptr(fluxes%p_surf ,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - print*,'allocate fluxes%t_rp' - call safe_alloc_ptr(fluxes%t_rp,isd,ied,jsd,jed) if (CS%use_limited_P_SSH) then fluxes%p_surf_SSH => fluxes%p_surf else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f3ce4f3b11..b421955863 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -156,7 +156,7 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline -use stochastic_physics, only : init_stochastic_physics_ocn,run_stochastic_physics_ocn +use stochastic_physics, only : init_stochastic_physics_ocn implicit none ; private @@ -829,9 +829,6 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif - print*,'calling run_stochastic_physics_ocn',CS%do_stochy - if (CS%do_stochy) call run_stochastic_physics_ocn(forces%t_rp) - call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & Time_local, Waves=Waves) @@ -983,7 +980,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%time_in_thermo_cycle > 0.0) then call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & - sfc_state, CS%tv, ssh, fluxes%t_rp, CS%ave_ssh_ibc) + sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc) + !sfc_state_diag, CS%tv, ssh,fluxes%t_rp,fluxes%sppt_wts, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1810,6 +1808,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: calc_dtbt ! Indicates whether the dynamically adjusted barotropic ! time step needs to be updated before it is used. logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. + logical :: do_epbl,do_sppt integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the ! calculation. @@ -1817,7 +1816,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean - integer :: num_procs + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs,iret ! model integer :: me ! my pe integer :: master ! root pe @@ -2508,14 +2508,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & num_procs=num_PEs() allocate(pelist(num_procs)) - call Get_PElist(pelist) + call Get_PElist(pelist,commID = mom_comm) me=PE_here() master=root_PE() - !call init_stochastic_physics_ocn(CS%dt_therm,G,me,master,pelist,CS%do_stochy) - print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) - call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,CS%do_stochy) - print*,'back from init_stochastic_physics_ocn',CS%do_stochy + !print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) + do_epbl=.false. + do_sppt=.false. + call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) + if (do_sppt .eq. .true.) CS%do_stochy=.true. + if (do_epbl .eq. .true.) CS%do_stochy=.true. + !print*,'back from init_stochastic_physics_ocn',CS%do_stochy ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then @@ -2968,6 +2971,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! call fix_restart_scaling(GV) ! call fix_restart_unit_scaling(US) + CS%diabatic_CSp%do_epbl=do_epbl + CS%diabatic_CSp%do_sppt=do_sppt + call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 8bbcb9854d..3351a6eee1 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -145,8 +145,10 @@ module MOM_forcing_type !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. - real, pointer, dimension(:,:) :: t_rp => NULL() - !< random pattern at t-points +! real, pointer, dimension(:,:) :: t_rp => NULL() +! !< random pattern at t-points +! real, pointer, dimension(:,:) :: sppt_wts => NULL() +! !< random pattern at t-points logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -252,10 +254,14 @@ module MOM_forcing_type !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled, !! and is exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: & - rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points [m3 s-1] - rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points [m3 s-1] - real, pointer, dimension(:,:) :: t_rp => NULL() - !< random pattern at t-points + rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at + !! u-points [L4 Z-1 T-1 ~> m3 s-1] + rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at + !! v-points [L4 Z-1 T-1 ~> m3 s-1] +! real, pointer, dimension(:,:) :: t_rp => NULL() +! !< random pattern at t-points +! real, pointer, dimension(:,:) :: sppt_wts => NULL() +! !< random pattern at t-points real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -2137,11 +2143,17 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres - if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then - do j=js,je ; do i=is,ie - fluxes%t_rp(i,j) = forces%t_rp(i,j) - enddo ; enddo - endif +! if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then +! do j=js,je ; do i=is,ie +! fluxes%t_rp(i,j) = forces%t_rp(i,j) +! enddo ; enddo +! endif +! +! if (associated(forces%sppt_wts) .and. associated(fluxes%sppt_wts)) then +! do j=js,je ; do i=is,ie +! fluxes%sppt_wts(i,j) = forces%sppt_wts(i,j) +! enddo ; enddo +! endif if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie @@ -3117,7 +3129,8 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) call myAlloc(forces%net_mass_src,isd,ied,jsd,jed, press) - call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) +! call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) +! call myAlloc(forces%sppt_wts,isd,ied,jsd,jed, press) call myAlloc(forces%rigidity_ice_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%rigidity_ice_v,isd,ied,JsdB,JedB, shelf) @@ -3282,7 +3295,8 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) - if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) +! if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) +! if (associated(fluxes%sppt_wts)) deallocate(fluxes%sppt_wts) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) @@ -3313,7 +3327,8 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%ustar)) deallocate(forces%ustar) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) - if (associated(forces%t_rp)) deallocate(forces%t_rp) +! if (associated(forces%t_rp)) deallocate(forces%t_rp) +! if (associated(forces%sppt_wts)) deallocate(forces%sppt_wts) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ddb925af28..221b5b7ebf 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -139,8 +139,6 @@ module MOM_diagnostics integer :: id_salt_deficit = -1 integer :: id_Heat_PmE = -1 integer :: id_intern_heat = -1 -! stochastic pattern - integer :: id_t_rp = -1 !!@} end type surface_diag_IDs @@ -1279,7 +1277,7 @@ end subroutine post_surface_dyn_diags !> 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_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv, & - ssh, t_rp, ssh_ibc) + 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 @@ -1290,8 +1288,6 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv 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] - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: t_rp!< random pattern for stochastic proceeses real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] @@ -1413,11 +1409,6 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv call post_data(IDs%id_sss_sq, work_2d, diag, mask=G%mask2dT) endif - if (IDs%id_t_rp > 0) then - !call post_data(IDs%id_t_rp, t_rp, diag, mask=G%mask2dT) - call post_data(IDs%id_t_rp, t_rp, diag) - endif - call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag)) end subroutine post_surface_thermo_diags @@ -1905,9 +1896,8 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& - 'Heat flux into ocean from geothermal or other internal sources', 'W m-2') - IDs%id_t_rp = register_diag_field('ocean_model', 'random_pattern', diag%axesT1, Time, & - 'random pattern for stochastics', 'None') + 'Heat flux into ocean from geothermal or other internal sources', & + 'W m-2', conversion=US%QRZ_T_to_W_m2) end subroutine register_surface_diags diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 7b180f1d65..1e7611de19 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -69,7 +69,8 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS -use MOM_stochastics, only : stochastic_CS +use stochastic_physics, only : run_stochastic_physics_ocn + implicit none ; private @@ -175,20 +176,15 @@ module MOM_diabatic_driver real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diag handle for mode-1 speed - integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds - integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic - integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 - integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 - integer :: id_Tdif = -1, id_Sdif = -1, id_Tadv = -1, id_Sadv = -1 - ! These are handles to diagnostics related to the mixed layer properties. - integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_MLD_EN1 = -1, id_MLD_EN2 = -1, id_MLD_EN3 = -1, id_subMLN2 = -1 - - ! These are handles to diatgnostics that are only available in non-ALE layered mode. - integer :: id_wd = -1 - integer :: id_dudt_dia = -1, id_dvdt_dia = -1 - integer :: id_hf_dudt_dia_2d = -1, id_hf_dvdt_dia_2d = -1 + integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) + integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) + integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic + integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_ea_s = -1, id_eb_s = -1 + integer :: id_ea_t = -1, id_eb_t = -1 + integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 + integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 + integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 + integer :: id_subMLN2 = -1, id_brine_lay = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -220,6 +216,10 @@ module MOM_diabatic_driver logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics + logical,public :: do_epbl = .false. !< If true pertrub u_start in ePBL calculation + logical,public :: do_sppt = .false. !< If true perturb all physics tendenceies in MOM_diabatic_driver + real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil + real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module @@ -303,31 +303,36 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics - real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics - real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics + real, dimension(SZI_(G),SZJ_(G)) :: sppt_wts + real, dimension(SZI_(G),SZJ_(G),2) :: t_rp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT - real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT + real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT if (G%ke == 1) return - ! save copy of the date for SPPT if active - if (stoch_CS%do_sppt) then - allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - h_in(:,:,:)=h(:,:,:) - t_in(:,:,:)=tv%T(:,:,:) - s_in(:,:,:)=tv%S(:,:,:) - - if (stoch_CS%id_sppt_wts > 0) then - call post_data(stoch_CS%id_sppt_wts, stoch_CS%sppt_wts, CS%diag) - endif + ! save copy of the date for SPPT + if (CS%do_sppt) then + h_in=h + t_in=tv%T + s_in=tv%S + endif + call run_stochastic_physics_ocn(t_rp,sppt_wts) + !print*,'in diabatic',CS%do_sppt,size(t_in,1),size(t_in,2),size(t_in,3),size(sppt_wts,1),size(sppt_wts,2) + !print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) + if (CS%id_t_rp1 > 0) then + call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) + endif + if (CS%id_t_rp2 > 0) then + call post_data(CS%id_t_rp2, t_rp(:,:,2), CS%diag) + endif + if (CS%id_sppt_wts > 0) then + call post_data(CS%id_sppt_wts, sppt_wts, CS%diag) endif - if (GV%ke == 1) return - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -411,11 +416,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) + call diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -481,55 +486,53 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) - if (stoch_CS%do_sppt) then - ! perturb diabatic tendecies + if (CS%do_sppt) then do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*stoch_CS%sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stoch_CS%sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stoch_CS%sppt_wts(i,j) + h_tend = (h(i,j,k)-h_in(i,j,k))*sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*sppt_wts(i,j) h_pert=h_tend+h_in(i,j,k) t_pert=t_tend+t_in(i,j,k) s_pert=s_tend+s_in(i,j,k) if (h_pert > GV%Angstrom_H) then - h(i,j,k) = h_pert + h(i,j,k)=h_pert else - h(i,j,k) = GV%Angstrom_H + h(i,j,k)=GV%Angstrom_H endif - tv%T(i,j,k) = t_pert + tv%T(i,j,k)=t_pert if (s_pert > 0.0) then - tv%S(i,j,k) = s_pert + tv%S(i,j,k)=s_pert endif enddo enddo enddo - deallocate(h_in) - deallocate(t_in) - deallocate(s_in) endif end subroutine diabatic +end subroutine diabatic + !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, - !! BBL properties and related fields - type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum + real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -837,8 +840,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -1100,22 +1103,22 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, - !! BBL properties and related fields - type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum + real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1374,8 +1377,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -3137,11 +3140,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_dvdt_dia_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - if ((CS%id_dudt_dia > 0) .or. (CS%id_hf_dudt_dia_2d > 0)) & - call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) - if ((CS%id_dvdt_dia > 0) .or. (CS%id_hf_dvdt_dia_2d > 0)) & - call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) - endif + CS%id_dudt_dia = register_diag_field('ocean_model', 'dudt_dia', diag%axesCuL, Time, & + 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_dvdt_dia = register_diag_field('ocean_model', 'dvdt_dia', diag%axesCvL, Time, & + 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & + 'random pattern1 for stochastics', 'None') + CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & + 'random pattern2 for stochastics', 'None') + CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', diag%axesT1, Time, & + 'random pattern for sppt', 'None') if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index c9ae6e43ed..ffa942b03a 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -165,6 +165,7 @@ module MOM_energetic_PBL !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. + logical :: do_epbl type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -244,8 +245,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, Waves ) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, US, CS, & + dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & + dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -277,8 +279,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 T-1 ~> m2 s-1]. - type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct + !! [Z2 s-1 ~> m2 s-1]. + type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous + !! call to mixedlayer_init. + real, dimension(SZI_(G),SZJ_(G),2), & + intent(in) :: t_rp !< random pattern to perturb wind real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -401,7 +406,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - u_star = fluxes%ustar(i,j)*(fluxes%t_rp(i,j)) + !print*,'PJP EPBL',minval(t_rp),maxval(t_rp) + u_star = fluxes%ustar(i,j)!*t_rp(i,j) u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then @@ -423,16 +429,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - if (stoch_CS%pert_epbl) then ! stochastics are active - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, Waves, G, i, j, & - epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j)) - else - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, Waves, G, i, j) - endif + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + + ! applly stochastic perturbation to TKE generation ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -500,7 +501,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - Waves, G, i, j, epbl1_wt, epbl2_wt) + t_rp1,t_rp2, dt_diag, Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -537,12 +538,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, optional, intent(in) :: epbl1_wt !< random number to perturb KE generation - real, optional, intent(in) :: epbl2_wt !< random number to perturb KE dissipation - integer, intent(in) :: i !< The i-index to work on (used for Waves) - integer, intent(in) :: j !< The i-index to work on (used for Waves) + real, intent(in) :: t_rp1 !< random value to perturb TKE production + real, intent(in) :: t_rp2 !< random value to perturb TKE production + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [T ~> s]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS for Langmuir turbulence + type(ocean_grid_type), & + optional, intent(inout) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) + integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) ! This subroutine determines the diffusivities in a single column from the integrated energetics ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes @@ -831,8 +836,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif - ! stochastically pertrub mech_TKE in the UFS - if (present(epbl1_wt)) mech_TKE=mech_TKE*epbl1_wt + ! stochastically pertrub mech_TKE + mech_TKE=mech_TKE*t_rp1 if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -914,12 +919,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs exp_kh = 1.0 if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) - else - mech_TKE = mech_TKE * exp_kh - endif + !eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag + eCD%dTKE_mech_decay = exp_kh + mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From b6ac287b6f6e134a700e65bbad146d65b42553a8 Mon Sep 17 00:00:00 2001 From: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Date: Wed, 2 Dec 2020 09:03:36 -0700 Subject: [PATCH 39/83] Update MOM_diabatic_driver.F90 remove conflict with dev/emc --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 1e7611de19..a9d3a63b15 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -184,7 +184,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_brine_lay = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 From 2f5d83d3c0f9fc3c3c2e8c12bf292e2624604548 Mon Sep 17 00:00:00 2001 From: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Date: Wed, 2 Dec 2020 09:05:28 -0700 Subject: [PATCH 40/83] Update MOM_diabatic_driver.F90 further resolve conflict --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a9d3a63b15..654ad8615d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -184,7 +184,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 + integer :: id_subMLN2 = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 From cefdb81edbeca418d33930bc9a9e630e52e4cff3 Mon Sep 17 00:00:00 2001 From: Phil Pegion <38869668+pjpegion@users.noreply.github.com> Date: Wed, 2 Dec 2020 09:06:52 -0700 Subject: [PATCH 41/83] Update MOM_diabatic_driver.F90 put id_sppt_wts, etc back. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 654ad8615d..a9d3a63b15 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -184,7 +184,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 From 6ff36ec6d6527b96a4623bb03b812e9724b5fed4 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 14 Dec 2020 15:47:16 +0000 Subject: [PATCH 42/83] add stochy_restart writing to mom_cap --- config_src/drivers/nuopc_cap/mom_cap.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 174a659f12..0434103b5a 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,6 +97,7 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM +use get_stochy_pattern_mod, only: write_stoch_restart_ocn !$use omp_lib , only : omp_set_num_threads @@ -1749,9 +1750,17 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname, & - stoch_restartname=stoch_restartname) + call ocean_model_restart(ocean_state, restartname=restartname) + ! write stochastic physics restart file if active + if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then + write(restartname,'(A)')"ocn_stoch.res.nc") + else + write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & + "oc_stoch.res.", year, month, day, hour, minute, seconds,".nc" + endif + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) + call write_stoch_restart_ocn('RESTART/'//trim(timestamp)//'.ocn_stoch.res.nc') endif if (is_root_pe()) then From 095c36ca4125fca7e98cb11f740292701e8761fa Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 22 Dec 2020 18:40:13 +0000 Subject: [PATCH 43/83] additions for stochy restarts --- config_src/drivers/nuopc_cap/mom_cap.F90 | 11 ++++++++--- config_src/drivers/solo_driver/MOM_driver.F90 | 16 ++++++++++++++++ src/core/MOM.F90 | 14 +++++++------- .../vertical/MOM_diabatic_driver.F90 | 16 +++++++++++++--- .../vertical/MOM_energetic_PBL.F90 | 19 ++++++++++--------- 5 files changed, 54 insertions(+), 22 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 0434103b5a..b298270d17 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,7 +97,9 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM +#ifdef UFS use get_stochy_pattern_mod, only: write_stoch_restart_ocn +#endif !$use omp_lib , only : omp_set_num_threads @@ -1753,14 +1755,17 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, restartname=restartname) ! write stochastic physics restart file if active +#ifdef UFS if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then - write(restartname,'(A)')"ocn_stoch.res.nc") + write(restartname,'(A)')"ocn_stoch.res.nc" else write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & - "oc_stoch.res.", year, month, day, hour, minute, seconds,".nc" + "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - call write_stoch_restart_ocn('RESTART/'//trim(timestamp)//'.ocn_stoch.res.nc') + if (is_root_pe()) print*,'calling write_stoch_restart_ocn ',trim(restartname) + call write_stoch_restart_ocn('RESTART/'//trim(restartname)) +#endif endif if (is_root_pe()) then diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index c2cd0a248c..c706ed70b4 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -71,6 +71,22 @@ program MOM_main use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS + use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_size + use ensemble_manager_mod, only : ensemble_pelist_setup + use mpp_mod, only : set_current_pelist => mpp_set_current_pelist + use time_interp_external_mod, only : time_interp_external_init + use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get + + use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS + use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart +! , add_shelf_flux_forcing, add_shelf_flux_IOB + + use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init + use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves +#ifdef UFS + use get_stochy_pattern_mod, only: write_stoch_restart_ocn +#endif + implicit none #include diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b421955863..f9cd435177 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -156,7 +156,9 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline +#ifdef UFS use stochastic_physics, only : init_stochastic_physics_ocn +#endif implicit none ; private @@ -249,8 +251,6 @@ module MOM 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 :: do_stochy = .false. - !< If true, call stochastic physics pattern generator type(time_type), pointer :: Time !< pointer to the ocean clock real :: dt !< (baroclinic) dynamics time step [T ~> s] @@ -2506,6 +2506,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) + do_epbl=.false. + do_sppt=.false. +#ifdef UFS num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) @@ -2513,12 +2516,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & master=root_PE() !print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) - do_epbl=.false. - do_sppt=.false. + if (master) print*,'about to call init_stochastic_physics' call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) - if (do_sppt .eq. .true.) CS%do_stochy=.true. - if (do_epbl .eq. .true.) CS%do_stochy=.true. - !print*,'back from init_stochastic_physics_ocn',CS%do_stochy +#endif ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a9d3a63b15..ffe5f3151a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -69,7 +69,9 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS +#ifdef UFS use stochastic_physics, only : run_stochastic_physics_ocn +#endif implicit none ; private @@ -305,23 +307,28 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G)) :: sppt_wts real, dimension(SZI_(G),SZJ_(G),2) :: t_rp +#ifdef UFS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT +#endif if (G%ke == 1) return +#ifdef UFS ! save copy of the date for SPPT if (CS%do_sppt) then h_in=h t_in=tv%T s_in=tv%S endif + print*,'calling run_stochastic_physics' call run_stochastic_physics_ocn(t_rp,sppt_wts) !print*,'in diabatic',CS%do_sppt,size(t_in,1),size(t_in,2),size(t_in,3),size(sppt_wts,1),size(sppt_wts,2) - !print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) + print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) + print*,'in diabatic',CS%do_sppt,minval(t_rp),maxval(t_rp) if (CS%id_t_rp1 > 0) then call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) endif @@ -331,6 +338,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_sppt_wts > 0) then call post_data(CS%id_sppt_wts, sppt_wts, CS%diag) endif +#endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -486,6 +494,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) +#ifdef UFS if (CS%do_sppt) then do k=1,nz do j=js,je @@ -509,6 +518,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo enddo endif +#endif end subroutine diabatic @@ -840,7 +850,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, d endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -1377,7 +1387,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index ffa942b03a..4f7fff1a05 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -245,7 +245,7 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, US, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -284,6 +284,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G),2), & intent(in) :: t_rp !< random pattern to perturb wind + logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -406,8 +407,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - !print*,'PJP EPBL',minval(t_rp),maxval(t_rp) - u_star = fluxes%ustar(i,j)!*t_rp(i,j) + u_star = fluxes%ustar(i,j) u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then @@ -431,7 +431,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, dt, Kd_int, G, GV, call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), stoch_epbl, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) ! applly stochastic perturbation to TKE generation @@ -501,7 +501,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - t_rp1,t_rp2, dt_diag, Waves, G, i, j) + t_rp1,t_rp2, stoch_epbl, dt_diag, Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -539,7 +539,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. real, intent(in) :: t_rp1 !< random value to perturb TKE production - real, intent(in) :: t_rp2 !< random value to perturb TKE production + real, intent(in) :: t_rp2 !< random value to perturb TKE dissipation + logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two calls to mixedlayer [T ~> s]. type(wave_parameters_CS), & @@ -836,8 +837,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif - ! stochastically pertrub mech_TKE - mech_TKE=mech_TKE*t_rp1 + ! stochastically pertrub mech_TKE in the UFS + if (stoch_epbl) mech_TKE=mech_TKE*t_rp1 if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -921,7 +922,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & !eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag eCD%dTKE_mech_decay = exp_kh - mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + if (stoch_epbl) mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 878543d22fee46dd353e8f64ee85f84389824eac Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 23 Dec 2020 21:46:27 +0000 Subject: [PATCH 44/83] clean up debug statements --- config_src/drivers/nuopc_cap/mom_cap.F90 | 1 - config_src/drivers/solo_driver/MOM_driver.F90 | 3 --- src/core/MOM.F90 | 2 -- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ---- 4 files changed, 10 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index b298270d17..8778df067a 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -1763,7 +1763,6 @@ subroutine ModelAdvance(gcomp, rc) "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - if (is_root_pe()) print*,'calling write_stoch_restart_ocn ',trim(restartname) call write_stoch_restart_ocn('RESTART/'//trim(restartname)) #endif endif diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index c706ed70b4..c35caa9d38 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -83,9 +83,6 @@ program MOM_main use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves -#ifdef UFS - use get_stochy_pattern_mod, only: write_stoch_restart_ocn -#endif implicit none diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f9cd435177..dc6a5a7f1e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2515,8 +2515,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & me=PE_here() master=root_PE() - !print*,'callling init_stochastic_physics_ocn',maxval(G%geoLatT) - if (master) print*,'about to call init_stochastic_physics' call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) #endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ffe5f3151a..856dd30f4e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -324,11 +324,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & t_in=tv%T s_in=tv%S endif - print*,'calling run_stochastic_physics' call run_stochastic_physics_ocn(t_rp,sppt_wts) - !print*,'in diabatic',CS%do_sppt,size(t_in,1),size(t_in,2),size(t_in,3),size(sppt_wts,1),size(sppt_wts,2) - print*,'in diabatic',CS%do_sppt,minval(sppt_wts),maxval(sppt_wts) - print*,'in diabatic',CS%do_sppt,minval(t_rp),maxval(t_rp) if (CS%id_t_rp1 > 0) then call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) endif From 583c6ae1e9ee6856ce9768cbee4e6d8827c53e63 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 6 Jan 2021 15:35:18 +0000 Subject: [PATCH 45/83] clean up code --- src/core/MOM.F90 | 7 +++-- src/core/MOM_forcing_type.F90 | 26 ------------------- src/diagnostics/MOM_diagnostics.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 6 ++--- 4 files changed, 6 insertions(+), 35 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index dc6a5a7f1e..bab2cf5a4a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -981,7 +981,6 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call enable_averages(CS%time_in_thermo_cycle, Time_local, CS%diag) call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & sfc_state_diag, CS%tv, ssh, CS%ave_ssh_ibc) - !sfc_state_diag, CS%tv, ssh,fluxes%t_rp,fluxes%sppt_wts, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1816,9 +1815,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean - integer :: mom_comm ! list of pes for this instance of the ocean - integer :: num_procs,iret -! model + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs ! number of processors to pass to stochastic physics + integer :: iret ! return code from stochastic physics integer :: me ! my pe integer :: master ! root pe real :: conv2watt, conv2salt diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 3351a6eee1..bdf4823f81 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -145,10 +145,6 @@ module MOM_forcing_type !< Pressure at the top ocean interface [R L2 T-2 ~> Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. -! real, pointer, dimension(:,:) :: t_rp => NULL() -! !< random pattern at t-points -! real, pointer, dimension(:,:) :: sppt_wts => NULL() -! !< random pattern at t-points logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -258,10 +254,6 @@ module MOM_forcing_type !! u-points [L4 Z-1 T-1 ~> m3 s-1] rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at !! v-points [L4 Z-1 T-1 ~> m3 s-1] -! real, pointer, dimension(:,:) :: t_rp => NULL() -! !< random pattern at t-points -! real, pointer, dimension(:,:) :: sppt_wts => NULL() -! !< random pattern at t-points real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -2143,18 +2135,6 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres -! if (associated(forces%t_rp) .and. associated(fluxes%t_rp)) then -! do j=js,je ; do i=is,ie -! fluxes%t_rp(i,j) = forces%t_rp(i,j) -! enddo ; enddo -! endif -! -! if (associated(forces%sppt_wts) .and. associated(fluxes%sppt_wts)) then -! do j=js,je ; do i=is,ie -! fluxes%sppt_wts(i,j) = forces%sppt_wts(i,j) -! enddo ; enddo -! endif - if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie fluxes%ustar(i,j) = forces%ustar(i,j) @@ -3129,8 +3109,6 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) call myAlloc(forces%net_mass_src,isd,ied,jsd,jed, press) -! call myAlloc(forces%t_rp,isd,ied,jsd,jed, press) -! call myAlloc(forces%sppt_wts,isd,ied,jsd,jed, press) call myAlloc(forces%rigidity_ice_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%rigidity_ice_v,isd,ied,JsdB,JedB, shelf) @@ -3295,8 +3273,6 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%netMassIn)) deallocate(fluxes%netMassIn) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) -! if (associated(fluxes%t_rp)) deallocate(fluxes%t_rp) -! if (associated(fluxes%sppt_wts)) deallocate(fluxes%sppt_wts) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal) if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal) @@ -3327,8 +3303,6 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%ustar)) deallocate(forces%ustar) if (associated(forces%p_surf)) deallocate(forces%p_surf) if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) -! if (associated(forces%t_rp)) deallocate(forces%t_rp) -! if (associated(forces%sppt_wts)) deallocate(forces%sppt_wts) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 221b5b7ebf..27164c2c75 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -139,7 +139,7 @@ module MOM_diagnostics integer :: id_salt_deficit = -1 integer :: id_Heat_PmE = -1 integer :: id_intern_heat = -1 - !!@} + !>@} end type surface_diag_IDs diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 4f7fff1a05..85dc52dd0e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -433,8 +433,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), stoch_epbl, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) - ! applly stochastic perturbation to TKE generation - ! Copy the diffusivities to a 2-d array. do K=1,nz+1 Kd_2d(i,K) = Kd(K) @@ -920,8 +918,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs exp_kh = 1.0 if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - !eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - eCD%dTKE_mech_decay = exp_kh + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag + mech_TKE = mech_TKE * exp_kh if (stoch_epbl) mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) ! Accumulate any convectively released potential energy to contribute From 48354da37c5e7601089f317947e7ba17a8299c32 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Thu, 7 Jan 2021 15:42:13 +0000 Subject: [PATCH 46/83] fix non stochastic ePBL calculation --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 85dc52dd0e..1cf089d5ed 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -919,8 +919,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - mech_TKE = mech_TKE * exp_kh - if (stoch_epbl) mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + if (stoch_epbl) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + else + mech_TKE = mech_TKE * exp_kh + endif ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 390fee8d0cc1364bed2b9cc8ae9a6d9f7ea06799 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 29 Jan 2021 19:40:10 +0000 Subject: [PATCH 47/83] re-write of stochastic code to remove CPP directives --- .../drivers/FMS_cap/ocean_model_MOM.F90 | 15 +-- .../drivers/mct_cap/mom_ocean_model_mct.F90 | 15 +-- config_src/drivers/nuopc_cap/mom_cap.F90 | 4 - .../nuopc_cap/mom_ocean_model_nuopc.F90 | 62 ++++++++----- config_src/drivers/solo_driver/MOM_driver.F90 | 14 +-- src/core/MOM.F90 | 48 +++------- src/core/MOM_variables.F90 | 7 ++ .../vertical/MOM_diabatic_driver.F90 | 93 +++++++------------ .../vertical/MOM_energetic_PBL.F90 | 79 ++++++++-------- 9 files changed, 158 insertions(+), 179 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 97fb869ad4..6292c32469 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -50,7 +50,7 @@ module ocean_model_mod use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -186,6 +186,7 @@ module ocean_model_mod !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. + type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -576,12 +577,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -603,16 +604,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda "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, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -629,7 +630,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. Time1 = Time1 - real_to_time(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index 3bd0e1e28d..4a4f6eee05 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -47,7 +47,7 @@ module MOM_ocean_model_mct use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -187,6 +187,7 @@ module MOM_ocean_model_mct !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. + type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -586,12 +587,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) @@ -615,16 +616,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -641,7 +642,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 8778df067a..3de56c0511 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,9 +97,7 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM -#ifdef UFS use get_stochy_pattern_mod, only: write_stoch_restart_ocn -#endif !$use omp_lib , only : omp_set_num_threads @@ -1755,7 +1753,6 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, restartname=restartname) ! write stochastic physics restart file if active -#ifdef UFS if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then write(restartname,'(A)')"ocn_stoch.res.nc" else @@ -1764,7 +1761,6 @@ subroutine ModelAdvance(gcomp, rc) endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) call write_stoch_restart_ocn('RESTART/'//trim(restartname)) -#endif endif if (is_root_pe()) then diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 448f23140e..290e6b30df 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -43,7 +43,7 @@ module MOM_ocean_model_nuopc use time_interp_external_mod,only : time_interp_external_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -62,8 +62,8 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use get_stochy_pattern_mod, only : write_stoch_restart_ocn -use iso_fortran_env, only : int64 +use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs +use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -194,6 +194,7 @@ module MOM_ocean_model_nuopc !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. + type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -255,9 +256,14 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! The actual depth over which melt potential is computed will !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot !< If true, allocate melt_potential array - logical :: use_CFC !< If true, allocated arrays for surface CFCs. - + logical :: use_melt_pot!< If true, allocate melt_potential array +! stochastic physics + integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs ! number of processors to pass to stochastic physics + integer :: iret ! return code from stochastic physics + integer :: me ! my pe + integer :: master ! root pe ! This include declares and sets the variable "version". #include "version_variable.h" @@ -429,19 +435,21 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif - call extract_surface_state(OS%MOM_CSp, OS%sfc_state) -! get number of processors and PE list for stocasthci physics initialization - call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & - "If true, then stochastically perturb the thermodynamic "//& - "tendencies of T,S, and h. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) - call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & - "If true, then stochastically perturb the kinetic energy "//& - "production and dissipation terms. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) + me=PE_here() + master=root_PE() + + call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& + OS%stochastics%pert_epbl,OS%stochastics%do_sppt,master,mom_comm,iret) + print*,'after init_stochastic_physics_ocn',OS%stochastics%pert_epbl,OS%stochastics%do_sppt + if (OS%stochastics%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%stochastics%pert_epbl) then + allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + endif call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -613,17 +621,23 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time +! update stochastic physics patterns before running next time-step + print*,'before call to stoch',OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl + if (OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl ) then + call run_stochastic_physics_ocn(OS%stochastics%sppt_wts,OS%stochastics%t_rp1,OS%stochastics%t_rp2) + endif + if (OS%offline_tracer_mode) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -646,16 +660,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -672,7 +686,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index c35caa9d38..0db4033c8d 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -64,7 +64,7 @@ program MOM_main use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type - use MOM_variables, only : surface + use MOM_variables, only : surface, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only : Update_Surface_Waves @@ -93,6 +93,8 @@ program MOM_main ! A structure containing pointers to the thermodynamic forcing fields ! at the ocean surface. type(forcing) :: fluxes + type(stochastic_pattern) :: stochastics !< A structure containing pointers to + ! A structure containing pointers to the ocean surface state fields. type(surface) :: sfc_state @@ -493,7 +495,7 @@ program MOM_main if (offline_tracer_mode) then 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, Waves=Waves_CSP) + call step_MOM(forces, fluxes, sfc_state, stochastics, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) else n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) dt_dyn = dt_forcing / real(n_max) @@ -506,16 +508,16 @@ program MOM_main 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, & + call step_MOM(forces, fluxes, sfc_state, stochastics, 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, & + call step_MOM(forces, fluxes, sfc_state, stochastics, 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, & + call step_MOM(forces, fluxes, sfc_state, stochastics, Time2, dt_dyn, MOM_CSp, & do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_forcing) @@ -524,7 +526,7 @@ program MOM_main ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & Time2 = Time2 - real_to_time(dtdia - dt_dyn) - call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & + call step_MOM(forces, fluxes, sfc_state, stochastics, 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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bab2cf5a4a..f26d37b3c0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -30,7 +30,6 @@ module MOM use MOM_domains, only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : start_group_pass, complete_group_pass, Omit_Corners -use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -134,7 +133,7 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_variables, only : rotate_surface_state +use MOM_variables, only : rotate_surface_state,stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units @@ -156,9 +155,6 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline -#ifdef UFS -use stochastic_physics, only : init_stochastic_physics_ocn -#endif implicit none ; private @@ -456,13 +452,14 @@ 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_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, & +subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & end_cycle, cycle_length, reset_therm) type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields type(surface), target, intent(inout) :: sfc_state !< surface ocean state + type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM @@ -771,8 +768,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS endif ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - end_time_thermo, .true., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & + dtdia, end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. @@ -872,8 +869,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS CS%Time = CS%Time - real_to_time(0.5*US%T_to_s*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - Time_local, .false., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & + dtdia, Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then @@ -1305,8 +1302,8 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. -subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & - Time_end_thermo, update_BBL, Waves) +subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, stochastics, & + dtdia, Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure @@ -1319,6 +1316,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s] type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. @@ -1394,8 +1392,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS, CS%OBC, Waves) + call diabatic(u, v, h, tv, CS%Hml, fluxes, stochastics, CS%visc, CS%ADp, CS%CDp, dtdia, & + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1807,19 +1805,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical :: calc_dtbt ! Indicates whether the dynamically adjusted barotropic ! time step needs to be updated before it is used. logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. - logical :: do_epbl,do_sppt integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the ! calculation. integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean - integer :: mom_comm ! list of pes for this instance of the ocean - integer :: num_procs ! number of processors to pass to stochastic physics - integer :: iret ! return code from stochastic physics - integer :: me ! my pe - integer :: master ! root pe real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units @@ -2505,18 +2496,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) - do_epbl=.false. - do_sppt=.false. -#ifdef UFS - num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) - me=PE_here() - master=root_PE() - - call init_stochastic_physics_ocn(CS%dt_therm,G%geoLonT,G%geoLatT,G%ied-G%isd+1,G%jed-G%jsd+1,nz,do_epbl,do_sppt,master,mom_comm,iret) -#endif - ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then call set_first_direction(G, modulo(first_direction + turns, 2)) @@ -2968,9 +2947,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! call fix_restart_scaling(GV) ! call fix_restart_unit_scaling(US) - CS%diabatic_CSp%do_epbl=do_epbl - CS%diabatic_CSp%do_sppt=do_sppt - call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a9bf6c3dcf..4020721075 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -276,6 +276,13 @@ module MOM_variables !> Container for information about the summed layer transports !! and how they will vary as the barotropic velocity is changed. +type, public :: stochastic_pattern + logical :: do_sppt = .false. + logical :: pert_epbl = .false. + real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT + real, allocatable :: t_rp1(:,:) !< Random pattern for K.E. generation + real, allocatable :: t_rp2(:,:) !< Random pattern for K.E. dissipation +end type stochastic_pattern type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east [H L ~> m2 or kg m-1]. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 856dd30f4e..3894c7bffb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -65,13 +65,10 @@ module MOM_diabatic_driver use MOM_tracer_diabatic, only : tracer_vertdiff, tracer_vertdiff_Eulerian use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs -use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d +use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS -#ifdef UFS -use stochastic_physics, only : run_stochastic_physics_ocn -#endif implicit none ; private @@ -218,8 +215,6 @@ module MOM_diabatic_driver logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics - logical,public :: do_epbl = .false. !< If true pertrub u_start in ePBL calculation - logical,public :: do_sppt = .false. !< If true perturb all physics tendenceies in MOM_diabatic_driver real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil @@ -270,21 +265,21 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, stoch_CS, OBC, Waves) - 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_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields +subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, OBC, WAVES) + 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, - !! BBL properties and related fields - type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum + type(stochastic_pattern), intent(in) :: stochastics !< random patterns + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -305,36 +300,24 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G)) :: sppt_wts - real, dimension(SZI_(G),SZJ_(G),2) :: t_rp -#ifdef UFS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT -#endif if (G%ke == 1) return -#ifdef UFS ! save copy of the date for SPPT - if (CS%do_sppt) then - h_in=h - t_in=tv%T - s_in=tv%S - endif - call run_stochastic_physics_ocn(t_rp,sppt_wts) - if (CS%id_t_rp1 > 0) then - call post_data(CS%id_t_rp1, t_rp(:,:,1), CS%diag) - endif - if (CS%id_t_rp2 > 0) then - call post_data(CS%id_t_rp2, t_rp(:,:,2), CS%diag) - endif - if (CS%id_sppt_wts > 0) then - call post_data(CS%id_sppt_wts, sppt_wts, CS%diag) + if (stochastics%do_sppt) then + h_in=h + t_in=tv%T + s_in=tv%S + + if (CS%id_sppt_wts > 0) then + call post_data(CS%id_sppt_wts, stochastics%sppt_wts, CS%diag) + endif endif -#endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -420,10 +403,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & + call diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & @@ -490,14 +473,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) -#ifdef UFS - if (CS%do_sppt) then + if (stochastics%do_sppt) then do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*sppt_wts(i,j) + h_tend = (h(i,j,k)-h_in(i,j,k))*stochastics%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stochastics%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stochastics%sppt_wts(i,j) h_pert=h_tend+h_in(i,j,k) t_pert=t_tend+t_in(i,j,k) s_pert=s_tend+s_in(i,j,k) @@ -514,7 +496,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo enddo endif -#endif end subroutine diabatic @@ -523,7 +504,7 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -533,10 +514,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, d real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] - type(forcing), intent(inout) :: fluxes !< points to forcing fields + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + type(stochastic_pattern), intent(in) :: stochastics !< points to forcing fields !! unused fields have NULL ptrs - real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived @@ -846,7 +827,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, d endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -1109,7 +1090,7 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1122,7 +1103,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - real, dimension(SZI_(G),SZJ_(G),2), intent(in) :: t_rp !< random pattern + type(stochastic_pattern), intent(in) :: stochastics !< random patterns type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived @@ -1383,7 +1364,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, t_rp, visc, ADp, CDp, dt, Time endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, t_rp, CS%do_epbl, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -3150,12 +3131,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_dvdt_dia = register_diag_field('ocean_model', 'dvdt_dia', diag%axesCvL, Time, & 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & - 'random pattern1 for stochastics', 'None') - CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & - 'random pattern2 for stochastics', 'None') CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', diag%axesT1, Time, & - 'random pattern for sppt', 'None') + 'random pattern for sppt', 'None') if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1cf089d5ed..a0b9ee0b51 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -14,7 +14,7 @@ module MOM_energetic_PBL use MOM_grid, only : ocean_grid_type use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs +use MOM_variables, only : thermo_var_ptrs, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number use MOM_stochastics, only : stochastic_CS @@ -165,7 +165,6 @@ module MOM_energetic_PBL !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. - logical :: do_epbl type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -198,6 +197,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 + integer :: id_t_rp1=-1,id_t_rp2=-1 !>@} end type energetic_PBL_CS @@ -245,7 +245,7 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_int, G, GV, US, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -276,15 +276,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. + type(stochastic_pattern), intent(in) :: stochastics !< A structure containing array to any unsued fields + !! are not allocated real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. - real, dimension(SZI_(G),SZJ_(G),2), & - intent(in) :: t_rp !< random pattern to perturb wind - logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence @@ -429,9 +428,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, t_rp(i,j,1),t_rp(i,j,2), stoch_epbl, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, stochastics, & + B_flux, absf, u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, & + GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -470,26 +469,30 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, t_rp, stoch_epbl, dt, Kd_ enddo ! j-loop - if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) - if (stoch_CS%pert_epbl) then - if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) - if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) + if (write_diags) then + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + ! only write random patterns if running with stochastic physics, otherwise the + ! array is unallocated and will give an error + if (stochastics%pert_epbl) then + if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) + if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) + endif endif end subroutine energetic_PBL @@ -497,9 +500,9 @@ end subroutine energetic_PBL !> This subroutine determines the diffusivities from the integrated energetics !! mixed layer model for a single column of water. -subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & +subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - t_rp1,t_rp2, stoch_epbl, dt_diag, Waves, G, i, j) + dt_diag, Waves, G, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -518,6 +521,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the !! forcing that has been applied to each layer !! [R Z3 T-2 ~> J m-2]. + type(stochastic_pattern), intent(in) :: stochastics !< stochastic patterns and logic controls real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1 ~> s-1]. real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. @@ -536,9 +540,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - real, intent(in) :: t_rp1 !< random value to perturb TKE production - real, intent(in) :: t_rp2 !< random value to perturb TKE dissipation - logical, intent(in) :: stoch_epbl !< flag to pertrub production and dissipation of TKE real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two calls to mixedlayer [T ~> s]. type(wave_parameters_CS), & @@ -836,7 +837,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (stoch_epbl) mech_TKE=mech_TKE*t_rp1 + if (stochastics%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -919,8 +920,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (stoch_epbl) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * t_rp2) + if (stochastics%pert_epbl) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) else mech_TKE = mech_TKE * exp_kh endif @@ -2326,6 +2327,10 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') + CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & + 'random pattern1 for stochastics', 'None') + CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & + 'random pattern2 for stochastics', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From f874d11133a23bc4f5018589c0ad6c1193a6cd1b Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 29 Jan 2021 20:49:07 +0000 Subject: [PATCH 48/83] clean up MOM_domains --- src/framework/MOM_domains.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index b647c56534..60805b5f4a 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,6 +3,8 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_array_transform, only : rotate_array use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Get_PElist use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end From 045d5c2db9150106f55e6f52472cf998bbd8488e Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 2 Feb 2021 00:05:24 +0000 Subject: [PATCH 49/83] make stochastics optional --- .../drivers/FMS_cap/ocean_model_MOM.F90 | 17 ++- .../drivers/mct_cap/mom_ocean_model_mct.F90 | 15 ++- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 80 ++++++++----- config_src/drivers/solo_driver/MOM_driver.F90 | 13 +-- src/core/MOM.F90 | 25 ++-- src/core/MOM_variables.F90 | 2 - .../vertical/MOM_diabatic_driver.F90 | 110 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 56 ++++++--- 8 files changed, 181 insertions(+), 137 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 6292c32469..e0c512250b 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -50,7 +50,7 @@ module ocean_model_mod use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, stochastic_pattern +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -186,7 +186,6 @@ module ocean_model_mod !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -562,7 +561,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. @@ -577,12 +576,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -604,16 +603,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda "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, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time1, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -630,7 +629,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. Time1 = Time1 - real_to_time(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index 4a4f6eee05..3bd0e1e28d 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -47,7 +47,7 @@ module MOM_ocean_model_mct use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, stochastic_pattern +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -187,7 +187,6 @@ module MOM_ocean_model_mct !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -587,12 +586,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) @@ -616,16 +615,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, 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, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -642,7 +641,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 290e6b30df..3ac6ef542d 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -177,10 +177,8 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical :: do_sppt !< If true, stochastically perturb the diabatic and - !! write restarts - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and - !! genration termsand write restarts + logical :: do_sppt !< If true, allocate array for SPPT + logical :: pert_epbl !< If true, allocate arrays for energetic PBL perturbations real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -435,20 +433,38 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif - num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) - me=PE_here() - master=root_PE() - - call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& - OS%stochastics%pert_epbl,OS%stochastics%do_sppt,master,mom_comm,iret) - print*,'after init_stochastic_physics_ocn',OS%stochastics%pert_epbl,OS%stochastics%do_sppt +! get number of processors and PE list for stocasthci physics initialization + call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & + "If true, then stochastically perturb the thermodynamic "//& + "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & + "If true, then stochastically perturb the kinetic energy "//& + "production and dissipation terms. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + if (OS%do_sppt .OR. OS%pert_epbl) then + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) + me=PE_here() + master=root_PE() + + call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& + OS%pert_epbl,OS%do_sppt,master,mom_comm,iret) + if (iret/=0) then + write(6,*) 'call to init_stochastic_physics_ocn failed' + call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & + "not activated in stochastic_physics namelist ") + return + endif - if (OS%stochastics%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - if (OS%stochastics%pert_epbl) then - allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%pert_epbl) then + allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + endif endif call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -622,8 +638,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time ! update stochastic physics patterns before running next time-step - print*,'before call to stoch',OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl - if (OS%stochastics%do_sppt .OR. OS%stochastics%pert_epbl ) then + if (OS%do_sppt .OR. OS%pert_epbl ) then call run_stochastic_physics_ocn(OS%stochastics%sppt_wts,OS%stochastics%t_rp1,OS%stochastics%t_rp2) endif @@ -631,13 +646,14 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & - reset_therm=Ocn_fluxes_used) + reset_therm=Ocn_fluxes_used, stochastics=OS%stochastics) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves, & + stochastics=OS%stochastics) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -660,18 +676,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & + stochastics=OS%stochastics) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & + stochastics=OS%stochastics) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, OS%stochastics, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & + stochastics=OS%stochastics) step_thermo = .false. if (thermo_does_span_coupling) then @@ -686,9 +705,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, OS%stochastics, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & + stochastics=OS%stochastics) endif endif diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 0db4033c8d..8ed8a8559f 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -64,7 +64,7 @@ program MOM_main use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type - use MOM_variables, only : surface, stochastic_pattern + use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only : Update_Surface_Waves @@ -93,7 +93,6 @@ program MOM_main ! A structure containing pointers to the thermodynamic forcing fields ! at the ocean surface. type(forcing) :: fluxes - type(stochastic_pattern) :: stochastics !< A structure containing pointers to ! A structure containing pointers to the ocean surface state fields. type(surface) :: sfc_state @@ -495,7 +494,7 @@ program MOM_main if (offline_tracer_mode) then call step_offline(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp) elseif (single_step_call) then - call step_MOM(forces, fluxes, sfc_state, stochastics, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) + call step_MOM(forces, fluxes, sfc_state, Time1, dt_forcing, MOM_CSp, Waves=Waves_CSP) else n_max = 1 ; if (dt_forcing > dt) n_max = ceiling(dt_forcing/dt - 0.001) dt_dyn = dt_forcing / real(n_max) @@ -508,16 +507,16 @@ program MOM_main 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, stochastics, Time2, dtdia, MOM_CSp, & + 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, stochastics, Time2, dt_dyn, MOM_CSp, & + 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, stochastics, Time2, dt_dyn, MOM_CSp, & + 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) @@ -526,7 +525,7 @@ program MOM_main ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & Time2 = Time2 - real_to_time(dtdia - dt_dyn) - call step_MOM(forces, fluxes, sfc_state, stochastics, Time2, dtdia, MOM_CSp, & + 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 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f26d37b3c0..94b01b2067 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -452,14 +452,13 @@ 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_in, fluxes_in, sfc_state, stochastics, Time_start, time_int_in, CS, & +subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & - end_cycle, cycle_length, reset_therm) + end_cycle, cycle_length, reset_therm, stochastics) type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields type(surface), target, intent(inout) :: sfc_state !< surface ocean state - type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM @@ -480,6 +479,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, ti logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patternss for stochastics ! local variables type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing @@ -768,8 +768,9 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, ti endif ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & - dtdia, end_time_thermo, .true., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & + end_time_thermo, .true., Waves=Waves, & + stochastics=stochastics) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. @@ -869,8 +870,9 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, stochastics, Time_start, ti CS%Time = CS%Time - real_to_time(0.5*US%T_to_s*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, stochastics, & - dtdia, Time_local, .false., Waves=Waves) + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & + Time_local, .false., Waves=Waves, & + stochastics=stochastics) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then @@ -1302,8 +1304,8 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. -subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, stochastics, & - dtdia, Time_end_thermo, update_BBL, Waves) +subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & + Time_end_thermo, update_BBL, Waves, stochastics) 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 @@ -1392,8 +1394,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, stochastics, & call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, stochastics, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves, & + stochastics=stochastics) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4020721075..4d5c83f3bd 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -277,8 +277,6 @@ module MOM_variables !> Container for information about the summed layer transports !! and how they will vary as the barotropic velocity is changed. type, public :: stochastic_pattern - logical :: do_sppt = .false. - logical :: pert_epbl = .false. real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT real, allocatable :: t_rp1(:,:) !< Random pattern for K.E. generation real, allocatable :: t_rp2(:,:) !< Random pattern for K.E. dissipation diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 3894c7bffb..3f7d53a221 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -142,12 +142,12 @@ module MOM_diabatic_driver integer :: NKBL !< The number of buffer layers (if bulk_mixed_layer) logical :: massless_match_targets !< If true (the default), keep the T & S !! consistent with the target values. - logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless layers at the - !! bottom into the interior as though a diffusivity of - !! Kd_min_tr (see below) were operating. - logical :: mix_boundary_tracer_ALE !< If true, in ALE mode mix the passive tracers in massless - !! layers at the bottom into the interior as though a - !! diffusivity of Kd_min_tr (see below) were operating. + logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless + !! layers at the bottom into the interior as though + !! a diffusivity of Kd_min_tr (see below) were + !! operating. + logical :: do_sppt !< If true, stochastically perturb the diabatic + !! tendencies with a number between 0 and 2 real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at @@ -183,7 +183,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1=-1,id_t_rp2=-1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1 = -1, id_t_rp2 = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -265,8 +265,8 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, WAVES) +subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, OBC, WAVES, stochastics) 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] @@ -277,19 +277,18 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(stochastic_pattern), intent(in) :: stochastics !< random patterns type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(diabatic_CS), pointer :: CS !< module control structure - type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -300,16 +299,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in !< thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in !< thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickenss before thermodynamics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in ! temperature before thermodynamics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT - real :: t_pert,s_pert,h_pert ! holder for tendencey needed for SPPT + real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT if (G%ke == 1) return ! save copy of the date for SPPT - if (stochastics%do_sppt) then + if (CS%do_sppt) then h_in=h t_in=tv%T s_in=tv%S @@ -403,11 +402,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves,stochastics=stochastics) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves, stochastics=stochastics) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -473,7 +472,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, T if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) - if (stochastics%do_sppt) then + if (CS%do_sppt) then do k=1,nz do j=js,je do i=is,ie @@ -504,8 +503,8 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES, stochastics) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -516,18 +515,17 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields - type(stochastic_pattern), intent(in) :: stochastics !< points to forcing fields - !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and + !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -827,8 +825,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + waves=waves, stochastics=stochastics) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -1090,8 +1089,8 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves, stochastics) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1103,17 +1102,17 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, d real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(stochastic_pattern), intent(in) :: stochastics !< random patterns type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and + !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1364,8 +1363,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, stochastics, visc, ADp, CDp, d endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, stochastics, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + waves=waves, stochastics=stochastics) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -3087,9 +3087,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "mass loss is passed down through the column.", & units="nondim", default=0.8) - if (CS%use_energetic_PBL .and. .not.CS%useALEalgorithm) & - call MOM_error(FATAL, "diabatic_driver_init: "//& - "ENERGETICS_SFC_PBL = True is only coded to work when USE_REGRIDDING = True.") + call get_param(param_file, mdl, "DO_SPPT", CS%do_sppt, & + "If true, then stochastically perturb the thermodynamic "//& + "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) ! Register all available diagnostics for this module. thickness_units = get_thickness_units(GV) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index a0b9ee0b51..4ef7239791 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -58,6 +58,7 @@ module MOM_energetic_PBL !! self-consistent mixed layer depth. Otherwise use the false position !! after a maximum and minimum bound have been evaluated and the !! returned value from the previous guess or bisection before this. + logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms integer :: max_MLD_its !< The maximum number of iterations that can be used to find a !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. @@ -245,9 +246,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, G, GV, US, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves ) + dT_expected, dS_expected, Waves, stochastics ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -276,8 +277,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. - type(stochastic_pattern), intent(in) :: stochastics !< A structure containing array to any unsued fields - !! are not allocated real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces @@ -286,8 +285,26 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. - type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence - type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [T ~> s]. + logical, optional, intent(in) :: last_call !< If true, this is the last call to + !! mixedlayer in the current time step, so + !! diagnostics will be written. The default + !! is .true. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(out) :: dT_expected !< The values of temperature change that + !! should be expected when the returned + !! diffusivities are applied [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(out) :: dS_expected !< The values of salinity change that + !! should be expected when the returned + !! diffusivities are applied [ppt]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS + type(stochastic_pattern), optional, & + intent(in) :: stochastics !< A structure containing array to stochastic + !! patterns. Any unsued fields + !! are not allocated ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -428,9 +445,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, stochastics, & + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, & B_flux, absf, u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, & - GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + stochastics=stochastics,i=i, j=j) ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -489,7 +507,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, stochastics, dt, Kd_int, if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error - if (stochastics%pert_epbl) then + if (CS%pert_epbl) then if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) endif @@ -500,9 +518,9 @@ end subroutine energetic_PBL !> This subroutine determines the diffusivities from the integrated energetics !! mixed layer model for a single column of water. -subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics, B_flux, absf, & +subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, i, j) + dt_diag, Waves, G, stochastics, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -521,7 +539,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the !! forcing that has been applied to each layer !! [R Z3 T-2 ~> J m-2]. - type(stochastic_pattern), intent(in) :: stochastics !< stochastic patterns and logic controls real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1 ~> s-1]. real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. @@ -546,6 +563,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics optional, pointer :: Waves !< Wave CS for Langmuir turbulence type(ocean_grid_type), & optional, intent(inout) :: G !< The ocean's grid structure. + type(stochastic_pattern), & + optional, intent(in) :: stochastics !< stochastic patterns and logic controls integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) @@ -837,7 +856,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (stochastics%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) + if (CS%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -920,7 +939,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, stochastics if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (stochastics%pert_epbl) then ! perturb the TKE destruction + if (CS%pert_epbl) then ! perturb the TKE destruction mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) else mech_TKE = mech_TKE * exp_kh @@ -2153,6 +2172,11 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "This is only used if USE_MLD_ITERATION is True.", & units="nondim", default=2.0) + call get_param(param_file, mdl, "PERT_EPBL", CS%pert_epbl, & + "If true, then stochastically perturb the kinetic energy "//& + "production and dissipation terms. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) !/ Turbulent velocity scale in mixing coefficient call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & "Selects the method for translating TKE into turbulent velocities. "//& @@ -2328,9 +2352,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & - 'random pattern1 for stochastics', 'None') + 'random pattern for KE generation', 'None') CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & - 'random pattern2 for stochastics', 'None') + 'random pattern for KE dissipation', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From 121ce71b30b219a7396e801d33d9c31cb0cc5838 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 2 Feb 2021 00:13:24 +0000 Subject: [PATCH 50/83] correct coupled_driver/ocean_model_MOM.F90 and other cleanup --- config_src/drivers/FMS_cap/ocean_model_MOM.F90 | 2 +- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ++-- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index e0c512250b..97fb869ad4 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -561,7 +561,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 3f7d53a221..d2e633d390 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -299,7 +299,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickenss before thermodynamics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickness before thermodynamics real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in ! temperature before thermodynamics real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT @@ -403,7 +403,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves,stochastics=stochastics) + G, GV, US, CS, Waves, stochastics=stochastics) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves, stochastics=stochastics) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 4ef7239791..7ad3aea276 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -445,9 +445,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, & - B_flux, absf, u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, & - GV, US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & stochastics=stochastics,i=i, j=j) ! Copy the diffusivities to a 2-d array. From 65e0e71bb316c234544ce0f7f277102e22af61e2 Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Tue, 2 Feb 2021 09:45:46 -0600 Subject: [PATCH 51/83] clean up of code for MOM6 coding standards --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 8 +++--- src/core/MOM.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 27 ++++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 10 +++---- 4 files changed, 24 insertions(+), 23 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 3ac6ef542d..c20b0a08ef 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -460,10 +460,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i return endif - if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) if (OS%pert_epbl) then - allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) + allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) endif endif call close_param_file(param_file) @@ -639,7 +639,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! update stochastic physics patterns before running next time-step if (OS%do_sppt .OR. OS%pert_epbl ) then - call run_stochastic_physics_ocn(OS%stochastics%sppt_wts,OS%stochastics%t_rp1,OS%stochastics%t_rp2) + call run_stochastic_physics_ocn(OS%stochastics%sppt_wts, OS%stochastics%t_rp1, OS%stochastics%t_rp2) endif if (OS%offline_tracer_mode) then diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 94b01b2067..ddc938639f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -133,7 +133,7 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_variables, only : rotate_surface_state,stochastic_pattern +use MOM_variables, only : rotate_surface_state, stochastic_pattern use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d2e633d390..43c8c9b348 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -309,9 +309,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! save copy of the date for SPPT if (CS%do_sppt) then - h_in=h - t_in=tv%T - s_in=tv%S + h_in(:,:,:)=h(:,:,:) + t_in(:,:,:)=tv%T(:,:,:) + s_in(:,:,:)=tv%S(:,:,:) if (CS%id_sppt_wts > 0) then call post_data(CS%id_sppt_wts, stochastics%sppt_wts, CS%diag) @@ -473,23 +473,24 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) if (CS%do_sppt) then + ! perturb diabatic tendecies do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*stochastics%sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stochastics%sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stochastics%sppt_wts(i,j) - h_pert=h_tend+h_in(i,j,k) - t_pert=t_tend+t_in(i,j,k) - s_pert=s_tend+s_in(i,j,k) + h_tend = (h(i,j,k) - h_in(i,j,k)) * stochastics%sppt_wts(i,j) + t_tend = (tv%T(i,j,k) - t_in(i,j,k)) * stochastics%sppt_wts(i,j) + s_tend = (tv%S(i,j,k) - s_in(i,j,k)) * stochastics%sppt_wts(i,j) + h_pert = h_tend + h_in(i,j,k) + t_pert = t_tend + t_in(i,j,k) + s_pert = s_tend + s_in(i,j,k) if (h_pert > GV%Angstrom_H) then - h(i,j,k)=h_pert + h(i,j,k) = h_pert else - h(i,j,k)=GV%Angstrom_H + h(i,j,k) = GV%Angstrom_H endif - tv%T(i,j,k)=t_pert + tv%T(i,j,k) = t_pert if (s_pert > 0.0) then - tv%S(i,j,k)=s_pert + tv%S(i,j,k) = s_pert endif enddo enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7ad3aea276..1655cdab4c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -198,7 +198,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 - integer :: id_t_rp1=-1,id_t_rp2=-1 + integer :: id_t_rp1=-1, id_t_rp2=-1 !>@} end type energetic_PBL_CS @@ -508,8 +508,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error if (CS%pert_epbl) then - if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) - if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) + if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) + if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) endif endif end subroutine energetic_PBL @@ -856,7 +856,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (CS%pert_epbl) mech_TKE=mech_TKE*stochastics%t_rp1(i,j) + if (CS%pert_epbl) mech_TKE = mech_TKE * stochastics%t_rp1(i,j) if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -939,7 +939,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (CS%pert_epbl) then ! perturb the TKE destruction + if (CS%pert_epbl) then ! perturb the TKE dissipation mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) else mech_TKE = mech_TKE * exp_kh From 80fdfb4e87c0e78227ac5c2f5c93f8bac4d7dd3a Mon Sep 17 00:00:00 2001 From: pjpegion Date: Thu, 4 Feb 2021 16:59:22 +0000 Subject: [PATCH 52/83] remove stochastics container --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 37 ++++++------- src/core/MOM.F90 | 15 ++---- src/core/MOM_variables.F90 | 5 -- src/framework/MOM_domains.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 52 +++++++++---------- .../vertical/MOM_energetic_PBL.F90 | 45 ++++++++-------- 6 files changed, 69 insertions(+), 87 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index c20b0a08ef..ea64808f26 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -43,7 +43,7 @@ module MOM_ocean_model_nuopc use time_interp_external_mod,only : time_interp_external_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, stochastic_pattern +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart @@ -51,7 +51,7 @@ module MOM_ocean_model_nuopc use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain,mpp_get_pelist use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain use fms_mod, only : stdout use mpp_mod, only : mpp_chksum @@ -62,7 +62,7 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use MOM_domains, only : root_PE,PE_here,Get_PElist,num_PEs +use MOM_domains, only : root_PE,PE_here,num_PEs use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -192,7 +192,6 @@ module MOM_ocean_model_nuopc !! timesteps are taken per thermodynamic step. type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(stochastic_pattern) :: stochastics !< A structure containing pointers to type(ocean_grid_type), pointer :: & grid => NULL() !< A pointer to a grid structure containing metrics !! and related information. @@ -256,7 +255,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot!< If true, allocate melt_potential array ! stochastic physics - integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean integer :: mom_comm ! list of pes for this instance of the ocean integer :: num_procs ! number of processors to pass to stochastic physics integer :: iret ! return code from stochastic physics @@ -446,8 +444,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i default=.false.) if (OS%do_sppt .OR. OS%pert_epbl) then num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) + call mpp_get_pelist(Ocean_sfc%domain, mom_comm) me=PE_here() master=root_PE() @@ -460,10 +457,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i return endif - if (OS%do_sppt) allocate(OS%stochastics%sppt_wts(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) + if (OS%do_sppt) allocate(OS%fluxes%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) if (OS%pert_epbl) then - allocate(OS%stochastics%t_rp1(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) - allocate(OS%stochastics%t_rp2(OS%grid%isd:OS%grid%ied, OS%grid%jsd:OS%grid%jed)) + allocate(OS%fluxes%epbl1_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) + allocate(OS%fluxes%epbl2_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) endif endif call close_param_file(param_file) @@ -639,7 +636,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! update stochastic physics patterns before running next time-step if (OS%do_sppt .OR. OS%pert_epbl ) then - call run_stochastic_physics_ocn(OS%stochastics%sppt_wts, OS%stochastics%t_rp1, OS%stochastics%t_rp2) + call run_stochastic_physics_ocn(OS%fluxes%sppt_wts,OS%fluxes%epbl1_wts,OS%fluxes%epbl2_wts) endif if (OS%offline_tracer_mode) then @@ -648,12 +645,11 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! The call sequence is being orchestrated from outside of update_ocean_model. call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & - reset_therm=Ocn_fluxes_used, stochastics=OS%stochastics) + reset_therm=Ocn_fluxes_used) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) elseif (OS%single_step_call) then - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves, & - stochastics=OS%stochastics) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) @@ -678,19 +674,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & dtdia = dt_dyn*min(nts,n_max-(n-1)) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & - stochastics=OS%stochastics) + 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, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & - stochastics=OS%stochastics) + 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, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & - start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling, & - stochastics=OS%stochastics) + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. if (thermo_does_span_coupling) then @@ -707,8 +700,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & - start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling, & - stochastics=OS%stochastics) + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + endif endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ddc938639f..477d185e96 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -454,7 +454,7 @@ module MOM !! occur inside of diabatic. subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & - end_cycle, cycle_length, reset_therm, stochastics) + end_cycle, cycle_length, reset_therm) type(mech_forcing), target, intent(inout) :: forces_in !< A structure with the driving mechanical forces type(forcing), target, intent(inout) :: fluxes_in !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields @@ -479,7 +479,6 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patternss for stochastics ! local variables type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing @@ -769,8 +768,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - end_time_thermo, .true., Waves=Waves, & - stochastics=stochastics) + end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. @@ -871,8 +869,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & - Time_local, .false., Waves=Waves, & - stochastics=stochastics) + Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then @@ -1305,7 +1302,7 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & - Time_end_thermo, update_BBL, Waves, stochastics) + Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure @@ -1318,7 +1315,6 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(stochastic_pattern), intent(in) :: stochastics !< surface ocean state real, intent(in) :: dtdia !< The time interval over which to advance [T ~> s] type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. @@ -1395,8 +1391,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves, & - stochastics=stochastics) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4d5c83f3bd..a9bf6c3dcf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -276,11 +276,6 @@ module MOM_variables !> Container for information about the summed layer transports !! and how they will vary as the barotropic velocity is changed. -type, public :: stochastic_pattern - real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - real, allocatable :: t_rp1(:,:) !< Random pattern for K.E. generation - real, allocatable :: t_rp2(:,:) !< Random pattern for K.E. dissipation -end type stochastic_pattern type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east [H L ~> m2 or kg m-1]. diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 60805b5f4a..cfc3ee106a 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -17,7 +17,7 @@ module MOM_domains public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, PE_here, root_PE, num_PEs, Get_PElist +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast public :: pass_vector_start, pass_vector_complete public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 43c8c9b348..9ae391815b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -65,7 +65,7 @@ module MOM_diabatic_driver use MOM_tracer_diabatic, only : tracer_vertdiff, tracer_vertdiff_Eulerian use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs -use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d, stochastic_pattern +use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS @@ -183,7 +183,7 @@ module MOM_diabatic_driver integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1, id_t_rp1 = -1, id_t_rp2 = -1 + integer :: id_subMLN2 = -1, id_sppt_wts = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -266,7 +266,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, WAVES, stochastics) + G, GV, US, CS, OBC, WAVES) 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] @@ -288,7 +288,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(diabatic_CS), pointer :: CS !< module control structure type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -299,9 +298,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_in ! thickness before thermodynamics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: t_in ! temperature before thermodynamics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: s_in ! salinity before thermodynamics + real, allocatable(:,:,:) :: h_in ! thickness before thermodynamics + real, allocatable(:,:,:) :: t_in ! temperature before thermodynamics + real, allocatable(:,:,:) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT @@ -309,12 +308,15 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! save copy of the date for SPPT if (CS%do_sppt) then - h_in(:,:,:)=h(:,:,:) - t_in(:,:,:)=tv%T(:,:,:) - s_in(:,:,:)=tv%S(:,:,:) + allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + h_in(:,:) = h(:,:) + t_in(:,:) = tv%T(:,:) + s_in(:,:) = tv%S(:,:) if (CS%id_sppt_wts > 0) then - call post_data(CS%id_sppt_wts, stochastics%sppt_wts, CS%diag) + call post_data(CS%id_sppt_wts, fluxes%sppt_wts, CS%diag) endif endif @@ -403,10 +405,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves, stochastics=stochastics) + G, GV, US, CS, Waves) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves, stochastics=stochastics) + G, GV, US, CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -477,12 +479,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k) - h_in(i,j,k)) * stochastics%sppt_wts(i,j) - t_tend = (tv%T(i,j,k) - t_in(i,j,k)) * stochastics%sppt_wts(i,j) - s_tend = (tv%S(i,j,k) - s_in(i,j,k)) * stochastics%sppt_wts(i,j) - h_pert = h_tend + h_in(i,j,k) - t_pert = t_tend + t_in(i,j,k) - s_pert = s_tend + s_in(i,j,k) + h_tend = (h(i,j,k)-h_in(i,j,k))*fluxes%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*fluxes%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*fluxes%sppt_wts(i,j) + h_pert=h_tend+h_in(i,j,k) + t_pert=t_tend+t_in(i,j,k) + s_pert=s_tend+s_in(i,j,k) if (h_pert > GV%Angstrom_H) then h(i,j,k) = h_pert else @@ -505,7 +507,7 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES, stochastics) + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -525,8 +527,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and - !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -828,7 +828,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves, stochastics=stochastics) + waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -1091,7 +1091,7 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves, stochastics) + G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1112,8 +1112,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - type(stochastic_pattern), optional, intent(in) :: stochastics !< random patterns for SPPT and - !! energetic PBL perturbations ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1366,7 +1364,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves, stochastics=stochastics) + waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1655cdab4c..8a708e4861 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -14,7 +14,7 @@ module MOM_energetic_PBL use MOM_grid, only : ocean_grid_type use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, stochastic_pattern +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number use MOM_stochastics, only : stochastic_CS @@ -198,7 +198,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 - integer :: id_t_rp1=-1, id_t_rp2=-1 + integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 !>@} end type energetic_PBL_CS @@ -248,7 +248,7 @@ module MOM_energetic_PBL !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves, stochastics ) + dT_expected, dS_expected, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -301,10 +301,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! diffusivities are applied [ppt]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS - type(stochastic_pattern), optional, & - intent(in) :: stochastics !< A structure containing array to stochastic - !! patterns. Any unsued fields - !! are not allocated ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -444,11 +440,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - stochastics=stochastics,i=i, j=j) + if (CS%pert_epbl) then ! stochastics are active + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + epbl1_wt=epbl1_wts(i,j),epbl2_wt=epbl2_wts(i,j),i=i, j=j) + else + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + endif ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -508,8 +509,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error if (CS%pert_epbl) then - if (CS%id_t_rp1 > 0) call post_data(CS%id_t_rp1, stochastics%t_rp1, CS%diag) - if (CS%id_t_rp2 > 0) call post_data(CS%id_t_rp2, stochastics%t_rp2, CS%diag) + if (CS%id_epbl1_wts > 0) call post_data(CS%id_epbl1_wts, stochastics%epbl1_wts, CS%diag) + if (CS%id_epbl2_wts > 0) call post_data(CS%id_epbl2_wts, stochastics%epbl2_wts, CS%diag) endif endif end subroutine energetic_PBL @@ -520,7 +521,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, stochastics, i, j) + dt_diag, Waves, G, epbl1_wt, epbl2_wt, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -563,8 +564,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs optional, pointer :: Waves !< Wave CS for Langmuir turbulence type(ocean_grid_type), & optional, intent(inout) :: G !< The ocean's grid structure. - type(stochastic_pattern), & - optional, intent(in) :: stochastics !< stochastic patterns and logic controls + real, optional, intent(in) :: epbl1_wt ! random number to perturb KE generation + real, optional, intent(in) :: epbl2_wt ! random number to perturb KE dissipation integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) @@ -856,7 +857,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (CS%pert_epbl) mech_TKE = mech_TKE * stochastics%t_rp1(i,j) + if (CS%pert_epbl) mech_TKE=mech_TKE*epbl1_wt if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -939,8 +940,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (CS%pert_epbl) then ! perturb the TKE dissipation - mech_TKE = mech_TKE * (1+(exp_kh-1) * stochastics%t_rp2(i,j)) + if (CS%pert_epbl) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) else mech_TKE = mech_TKE * exp_kh endif @@ -2351,9 +2352,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') - CS%id_t_rp1 = register_diag_field('ocean_model', 'random_pattern1', diag%axesT1, Time, & + CS%id_epbl1_wts = register_diag_field('ocean_model', 'epbl1_wts', diag%axesT1, Time, & 'random pattern for KE generation', 'None') - CS%id_t_rp2 = register_diag_field('ocean_model', 'random_pattern2', diag%axesT1, Time, & + CS%id_epbl2_wts = register_diag_field('ocean_model', 'epbl2_wts', diag%axesT1, Time, & 'random pattern for KE dissipation', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & From b12c09cbba9df88ee6494530f7a72a78810a25e0 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 5 Feb 2021 20:18:31 +0000 Subject: [PATCH 53/83] revert MOM_domains.F90 --- src/framework/MOM_domains.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index cfc3ee106a..aedf9d5d0d 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,9 +3,8 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. - use MOM_array_transform, only : rotate_array -use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Get_PElist +use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL, is_root_pe From 077413af9f4196b07bcc929d026fb03688269fe5 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 5 Feb 2021 20:50:56 +0000 Subject: [PATCH 54/83] clean up of mom_ocean_model_nuopc.F90 --- config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index ea64808f26..9e43638751 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -51,7 +51,7 @@ module MOM_ocean_model_nuopc use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain,mpp_get_pelist +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain use fms_mod, only : stdout use mpp_mod, only : mpp_chksum @@ -444,7 +444,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i default=.false.) if (OS%do_sppt .OR. OS%pert_epbl) then num_procs=num_PEs() - call mpp_get_pelist(Ocean_sfc%domain, mom_comm) + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) me=PE_here() master=root_PE() @@ -701,7 +702,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) - endif endif From ebe9d1f6f8cab97fd8e0cdd686c6d9d0e39702bb Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 5 Feb 2021 20:54:05 +0000 Subject: [PATCH 55/83] remove PE_here from mom_ocean_model_nuopc.F90 --- config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 9e43638751..1ef5b07c06 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -62,7 +62,8 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use MOM_domains, only : root_PE,PE_here,num_PEs +use MOM_domains, only : root_PE,num_PEs +use MOM_coms, only : Get_PElist use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -446,7 +447,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) - me=PE_here() master=root_PE() call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& From 0932b9ec13643949bd217e4c034166ef06e806fd Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 26 Feb 2021 17:43:50 +0000 Subject: [PATCH 56/83] remove debug statements --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 8a708e4861..7cf8d48ae0 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -945,6 +945,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = mech_TKE * exp_kh endif + !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 199126eb7c86350b8bcc1884ea148ceba0133188 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 15:09:50 +0000 Subject: [PATCH 57/83] stochastic physics re-write --- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 38 +---- src/core/MOM.F90 | 25 +-- src/core/MOM_forcing_type.F90 | 2 - .../stochastic/MOM_stochastics.F90 | 50 +++--- .../stochastic/MOM_stochastics_stub.F90 | 64 ++++++++ .../vertical/MOM_diabatic_driver.F90 | 155 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 34 ++-- 7 files changed, 204 insertions(+), 164 deletions(-) create mode 100644 src/parameterizations/stochastic/MOM_stochastics_stub.F90 diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 1ef5b07c06..9ffe4cd794 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -64,7 +64,6 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : forcing_save_restart use MOM_domains, only : root_PE,num_PEs use MOM_coms, only : Get_PElist -use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn #include @@ -178,8 +177,8 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical :: do_sppt !< If true, allocate array for SPPT - logical :: pert_epbl !< If true, allocate arrays for energetic PBL perturbations + logical,public :: do_sppt !< If true, write stochastic physics restarts + logical,public :: pert_epbl !< If true, write stochastic physics restarts real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -255,12 +254,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot!< If true, allocate melt_potential array -! stochastic physics - integer :: mom_comm ! list of pes for this instance of the ocean - integer :: num_procs ! number of processors to pass to stochastic physics - integer :: iret ! return code from stochastic physics - integer :: me ! my pe - integer :: master ! root pe ! This include declares and sets the variable "version". #include "version_variable.h" @@ -432,7 +425,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif -! get number of processors and PE list for stocasthci physics initialization + ! check to see if stochastic physics is active call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & "If true, then stochastically perturb the thermodynamic "//& "tendemcies of T,S, amd h. Amplitude and correlations are "//& @@ -443,27 +436,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "production and dissipation terms. Amplitude and correlations are "//& "controlled by the nam_stoch namelist in the UFS model only.", & default=.false.) - if (OS%do_sppt .OR. OS%pert_epbl) then - num_procs=num_PEs() - allocate(pelist(num_procs)) - call Get_PElist(pelist,commID = mom_comm) - master=root_PE() - - call init_stochastic_physics_ocn(OS%dt_therm,OS%grid%geoLonT,OS%grid%geoLatT,OS%grid%ied-OS%grid%isd+1,OS%grid%jed-OS%grid%jsd+1,OS%grid%ke,& - OS%pert_epbl,OS%do_sppt,master,mom_comm,iret) - if (iret/=0) then - write(6,*) 'call to init_stochastic_physics_ocn failed' - call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & - "not activated in stochastic_physics namelist ") - return - endif - if (OS%do_sppt) allocate(OS%fluxes%sppt_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - if (OS%pert_epbl) then - allocate(OS%fluxes%epbl1_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - allocate(OS%fluxes%epbl2_wts(OS%grid%isd:OS%grid%ied,OS%grid%jsd:OS%grid%jed)) - endif - endif call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -635,11 +608,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time -! update stochastic physics patterns before running next time-step - if (OS%do_sppt .OR. OS%pert_epbl ) then - call run_stochastic_physics_ocn(OS%fluxes%sppt_wts,OS%fluxes%epbl1_wts,OS%fluxes%epbl2_wts) - endif - if (OS%offline_tracer_mode) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 477d185e96..a0594290ee 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -403,16 +403,6 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors - type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) & - :: por_face_areaU !< fractional open area of U-faces [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) & - :: por_face_areaV !< fractional open area of V-faces [nondim] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) & - :: por_layer_widthU !< fractional open width of U-faces [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) & - :: por_layer_widthV !< fractional open width of V-faces [nondim] - type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure end type MOM_control_struct @@ -673,7 +663,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call disable_averaging(CS%diag) endif endif - ! advance the random pattern if stochastic physics is active + if (CS%stoch_CS%do_sppt .OR. CS%stoch_CS%pert_epbl) call update_stochastics(CS%stoch_CS) if (do_dyn) then @@ -825,6 +815,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif + call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & Time_local, Waves=Waves) @@ -1391,7 +1382,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS,OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -2500,6 +2491,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else call set_first_direction(G, modulo(first_direction, 2)) endif + call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) + call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) + call destroy_dyn_horgrid(dG_in) + + if (.not. CS%rotate_index) & + G => G_in + ! initialize stochastic physics + !call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) + ! Set a few remaining fields that are specific to the ocean grid type. + call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index bdf4823f81..4a702d4c0e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -170,8 +170,6 @@ module MOM_forcing_type !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) !! or freezing (negative) [R Z T-1 ~> kg m-2 s-1] - real, pointer, dimension(:,:) :: shelf_sfc_mass_flux => NULL() !< Ice shelf surface mass flux - !! deposition from the atmosphere. [R Z T-1 ~> kg m-2 s-1] ! Scalars set by surface forcing modules real :: vPrecGlobalAdj = 0. !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 index 21a22a222e..5bcf158f7e 100644 --- a/src/parameterizations/stochastic/MOM_stochastics.F90 +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -4,10 +4,13 @@ module MOM_stochastics ! This file is part of MOM6. See LICENSE.md for the license. ! This is the top level module for the MOM6 ocean model. It contains routines -! for initialization, update, and writing restart of stochastic physics. This +! for initialization, termination and update of ocean model state. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! +! This code is a stop-gap wrapper of the MOM6 code to enable it to be called +! in the same way as MOM4. + use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type @@ -26,13 +29,11 @@ module MOM_stochastics public stochastics_init, update_stochastics -!> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms - integer :: id_sppt_wts = -1 !< Diagnostic id for SPPT - integer :: id_epbl1_wts=-1 !< Diagnostic id for epbl generation perturbation - integer :: id_epbl2_wts=-1 !< Diagnostic id for epbl dissipation perturbation + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 + integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT !! tendencies with a number between 0 and 2 @@ -42,14 +43,22 @@ module MOM_stochastics type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type stochastic_CS +!> This type is used for communication with other components via the FMS coupler. +!! The element names and types can be changed only with great deliberation, hence +!! the persistnce of things like the cutsy element name "avg_kount". contains -!! This subroutine initializes the stochastics physics control structure. +!> ocean_model_init initializes the ocean model, including registering fields +!! for restarts and reading restart files if appropriate. +!! +!! This subroutine initializes both the ocean state and the ocean surface type. +!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! been used in a previous call to cean_type. subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] - type(ocean_grid_type), intent(in) :: grid !< horizontal grid information - type(verticalGrid_type), intent(in) :: GV !< vertical grid structure - type(stochastic_CS), pointer, intent(inout):: CS !< stochastic control structure + type(ocean_grid_type), intent(in) :: grid ! horizontal grid information + type(verticalGrid_type), intent(in) :: GV ! vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output type(time_type), target :: Time !< model time @@ -59,7 +68,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) integer :: num_procs ! number of processors to pass to stochastic physics integer :: iret ! return code from stochastic physics integer :: me ! my pe - integer :: pe_zero ! root pe + integer :: master ! root pe integer :: nx ! number of x-points including halo integer :: ny ! number of x-points including halo @@ -95,13 +104,15 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) - pe_zero=root_PE() - nx = grid%ied - grid%isd + 1 - ny = grid%jed - grid%jsd + 1 + master=root_PE() + nx=grid%ied-grid%isd+1 + ny=grid%jed-grid%jsd+1 call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & - CS%pert_epbl,CS%do_sppt,pe_zero,mom_comm,iret) + CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) if (iret/=0) then - call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") + write(6,*) 'call to init_stochastic_physics_ocn failed' + call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & + "not activated in stochastic_physics namelist ") return endif @@ -122,7 +133,6 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) write(*,'(/12x,a/)') '=== COMPLETED MOM STOCHASTIC INITIALIZATION =====' call callTree_leave("ocean_model_init(") - return end subroutine stochastics_init !> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the @@ -135,9 +145,9 @@ subroutine update_stochastics(CS) call callTree_enter("update_stochastics(), MOM_stochastics.F90") ! update stochastic physics patterns before running next time-step - call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + print*,'in update_stoch',minval(CS%sppt_wts),maxval(CS%sppt_wts),minval(CS%epbl1_wts),maxval(CS%epbl1_wts) - return end subroutine update_stochastics end module MOM_stochastics diff --git a/src/parameterizations/stochastic/MOM_stochastics_stub.F90 b/src/parameterizations/stochastic/MOM_stochastics_stub.F90 new file mode 100644 index 0000000000..f03f5283d3 --- /dev/null +++ b/src/parameterizations/stochastic/MOM_stochastics_stub.F90 @@ -0,0 +1,64 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. +module MOM_stochastics + +! This file is part of MOM6. See LICENSE.md for the license. + +! This is the top level module for the MOM6 ocean model. It contains routines +! for initialization, termination and update of ocean model state. This +! particular version wraps all of the calls for MOM6 in the calls that had +! been used for MOM4. +! +! This code is a stop-gap wrapper of the MOM6 code to enable it to be called +! in the same way as MOM4. + +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use MOM_domains, only : root_PE,num_PEs +use MOM_coms, only : Get_PElist + +#include + +implicit none ; private + +public stochastics_init, update_stochastics + +type, public:: stochastic_CS + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 + integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 + ! stochastic patterns + real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT + !! tendencies with a number between 0 and 2 + real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation + real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation + type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output + type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) +end type stochastic_CS + +contains + +subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) + real, intent(in) :: dt !< time step [T ~> s] + type(ocean_grid_type), intent(in) :: grid ! horizontal grid information + type(verticalGrid_type), intent(in) :: GV ! vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output + type(time_type), target :: Time !< model time + return +end subroutine stochastics_init + +subroutine update_stochastics(CS) + type(stochastic_CS), intent(inout) :: CS !< diabatic control structure + return +end subroutine update_stochastics + +end module MOM_stochastics + diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 9ae391815b..319a6f2be6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -69,6 +69,7 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS +use MOM_stochastics, only : stochastic_CS implicit none ; private @@ -142,12 +143,12 @@ module MOM_diabatic_driver integer :: NKBL !< The number of buffer layers (if bulk_mixed_layer) logical :: massless_match_targets !< If true (the default), keep the T & S !! consistent with the target values. - logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless - !! layers at the bottom into the interior as though - !! a diffusivity of Kd_min_tr (see below) were - !! operating. - logical :: do_sppt !< If true, stochastically perturb the diabatic - !! tendencies with a number between 0 and 2 + logical :: mix_boundary_tracers !< If true, mix the passive tracers in massless layers at the + !! bottom into the interior as though a diffusivity of + !! Kd_min_tr (see below) were operating. + logical :: mix_boundary_tracer_ALE !< If true, in ALE mode mix the passive tracers in massless + !! layers at the bottom into the interior as though a + !! diffusivity of Kd_min_tr (see below) were operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at @@ -175,15 +176,20 @@ module MOM_diabatic_driver real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) - integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) - integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic - integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_ea_s = -1, id_eb_s = -1 - integer :: id_ea_t = -1, id_eb_t = -1 - integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 - integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 - integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_sppt_wts = -1 + integer :: id_cg1 = -1 ! diag handle for mode-1 speed + integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds + integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic + integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 + integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 + integer :: id_Tdif = -1, id_Sdif = -1, id_Tadv = -1, id_Sadv = -1 + ! These are handles to diagnostics related to the mixed layer properties. + integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 + integer :: id_MLD_EN1 = -1, id_MLD_EN2 = -1, id_MLD_EN3 = -1, id_subMLN2 = -1 + + ! These are handles to diatgnostics that are only available in non-ALE layered mode. + integer :: id_wd = -1 + integer :: id_dudt_dia = -1, id_dvdt_dia = -1 + integer :: id_hf_dudt_dia_2d = -1, id_hf_dvdt_dia_2d = -1 ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 @@ -266,13 +272,13 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, WAVES) - 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(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + G, GV, US, CS, stoch_CS, OBC, Waves) + 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_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -281,13 +287,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(diabatic_CS), pointer :: CS !< module control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -307,16 +314,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (G%ke == 1) return ! save copy of the date for SPPT - if (CS%do_sppt) then + if (stoch_CS%do_sppt) then allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) - h_in(:,:) = h(:,:) - t_in(:,:) = tv%T(:,:) - s_in(:,:) = tv%S(:,:) + h_in(:,:,:)=h(:,:,:) + t_in(:,:,:)=tv%T(:,:,:) + s_in(:,:,:)=tv%S(:,:,:) - if (CS%id_sppt_wts > 0) then - call post_data(CS%id_sppt_wts, fluxes%sppt_wts, CS%diag) + if (stoch_CS%id_sppt_wts > 0) then + call post_data(stoch_CS%id_sppt_wts, stoch_CS%sppt_wts, CS%diag) endif endif @@ -405,10 +412,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -474,14 +481,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) - if (CS%do_sppt) then + if (stoch_CS%do_sppt) then ! perturb diabatic tendecies do k=1,nz do j=js,je do i=is,ie - h_tend = (h(i,j,k)-h_in(i,j,k))*fluxes%sppt_wts(i,j) - t_tend = (tv%T(i,j,k)-t_in(i,j,k))*fluxes%sppt_wts(i,j) - s_tend = (tv%S(i,j,k)-s_in(i,j,k))*fluxes%sppt_wts(i,j) + h_tend = (h(i,j,k)-h_in(i,j,k))*stoch_CS%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stoch_CS%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stoch_CS%sppt_wts(i,j) h_pert=h_tend+h_in(i,j,k) t_pert=t_tend+t_in(i,j,k) s_pert=s_tend+s_in(i,j,k) @@ -507,14 +514,14 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + G, GV, US, CS, stoch_CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -522,11 +529,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -827,7 +835,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & waves=waves) if (associated(Hml)) then @@ -1091,14 +1099,14 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + G, GV, US, CS, stoch_CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -1107,11 +1115,12 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment [T ~> s] - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [T ~> s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1363,7 +1372,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & waves=waves) if (associated(Hml)) then @@ -3086,11 +3095,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "mass loss is passed down through the column.", & units="nondim", default=0.8) - call get_param(param_file, mdl, "DO_SPPT", CS%do_sppt, & - "If true, then stochastically perturb the thermodynamic "//& - "tendemcies of T,S, amd h. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) + if (CS%use_energetic_PBL .and. .not.CS%useALEalgorithm) & + call MOM_error(FATAL, "diabatic_driver_init: "//& + "ENERGETICS_SFC_PBL = True is only coded to work when USE_REGRIDDING = True.") ! Register all available diagnostics for this module. thickness_units = get_thickness_units(GV) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7cf8d48ae0..36e92c2850 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -58,7 +58,6 @@ module MOM_energetic_PBL !! self-consistent mixed layer depth. Otherwise use the false position !! after a maximum and minimum bound have been evaluated and the !! returned value from the previous guess or bisection before this. - logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms integer :: max_MLD_its !< The maximum number of iterations that can be used to find a !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. @@ -198,7 +197,6 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 - integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 !>@} end type energetic_PBL_CS @@ -246,9 +244,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & + stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, & + last_call, dT_expected, dS_expected, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -301,6 +299,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! diffusivities are applied [ppt]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS + type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous + ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -440,11 +440,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - if (CS%pert_epbl) then ! stochastics are active + if (stoch_CS%pert_epbl) then ! stochastics are active call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - epbl1_wt=epbl1_wts(i,j),epbl2_wt=epbl2_wts(i,j),i=i, j=j) + epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j), & + i=i, j=j) else call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & @@ -508,9 +509,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) ! only write random patterns if running with stochastic physics, otherwise the ! array is unallocated and will give an error - if (CS%pert_epbl) then - if (CS%id_epbl1_wts > 0) call post_data(CS%id_epbl1_wts, stochastics%epbl1_wts, CS%diag) - if (CS%id_epbl2_wts > 0) call post_data(CS%id_epbl2_wts, stochastics%epbl2_wts, CS%diag) + if (stoch_CS%pert_epbl) then + if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) + if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) endif endif end subroutine energetic_PBL @@ -857,7 +858,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif ! stochastically pertrub mech_TKE in the UFS - if (CS%pert_epbl) mech_TKE=mech_TKE*epbl1_wt + if (present(epbl1_wt)) mech_TKE=mech_TKE*epbl1_wt if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -940,7 +941,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - if (CS%pert_epbl) then ! perturb the TKE destruction + if (present(epbl2_wt)) then ! perturb the TKE destruction mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) else mech_TKE = mech_TKE * exp_kh @@ -2174,11 +2175,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "This is only used if USE_MLD_ITERATION is True.", & units="nondim", default=2.0) - call get_param(param_file, mdl, "PERT_EPBL", CS%pert_epbl, & - "If true, then stochastically perturb the kinetic energy "//& - "production and dissipation terms. Amplitude and correlations are "//& - "controlled by the nam_stoch namelist in the UFS model only.", & - default=.false.) !/ Turbulent velocity scale in mixing coefficient call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & "Selects the method for translating TKE into turbulent velocities. "//& @@ -2353,10 +2349,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') - CS%id_epbl1_wts = register_diag_field('ocean_model', 'epbl1_wts', diag%axesT1, Time, & - 'random pattern for KE generation', 'None') - CS%id_epbl2_wts = register_diag_field('ocean_model', 'epbl2_wts', diag%axesT1, Time, & - 'random pattern for KE dissipation', 'None') if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From 97bbdbf6f6db2043daeab1bdb748ba4cf4c93953 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 17:35:27 +0000 Subject: [PATCH 58/83] move stochastics to external directory --- .../external/OCEAN_stochastic_phyiscs}/MOM_stochastics.F90 | 0 .../external/OCEAN_stochastic_phyiscs}/MOM_stochastics_stub.F90 | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {src/parameterizations/stochastic => config_src/external/OCEAN_stochastic_phyiscs}/MOM_stochastics.F90 (100%) rename {src/parameterizations/stochastic => config_src/external/OCEAN_stochastic_phyiscs}/MOM_stochastics_stub.F90 (100%) diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 similarity index 100% rename from src/parameterizations/stochastic/MOM_stochastics.F90 rename to config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 diff --git a/src/parameterizations/stochastic/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 similarity index 100% rename from src/parameterizations/stochastic/MOM_stochastics_stub.F90 rename to config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 From 8382652d502cd7a5e1d42cab047d63aa08bae6df Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 18:14:44 +0000 Subject: [PATCH 59/83] doxygen cleanup --- .../external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 | 5 +++-- .../OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 | 7 +++++-- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 1 - 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index 5bcf158f7e..03b33dc2b3 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -29,6 +29,7 @@ module MOM_stochastics public stochastics_init, update_stochastics +!> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS logical :: do_sppt !< If true, stochastically perturb the diabatic logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms @@ -105,8 +106,8 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) master=root_PE() - nx=grid%ied-grid%isd+1 - ny=grid%jed-grid%jsd+1 + nx = grid%ied - grid%isd + 1 + ny = grid%jed - grid%jsd + 1 call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) if (iret/=0) then diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 index f03f5283d3..89a6d43c4f 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 @@ -28,11 +28,14 @@ module MOM_stochastics public stochastics_init, update_stochastics +!> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms + !>@{ Diagnostic IDs integer :: id_sppt_wts = -1 integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 + !>@} ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT !! tendencies with a number between 0 and 2 diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 36e92c2850..9ecba8a7b8 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -301,7 +301,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS optional, pointer :: Waves !< Wave CS type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous - ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes ! have already been applied. All calculations are done implicitly, and there From 3e573eb11e605b4af21bad4dfe319fe2436b3ee4 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 26 Jul 2021 21:41:16 +0000 Subject: [PATCH 60/83] add write_stoch_restart_ocn to MOM_stochastics --- config_src/drivers/nuopc_cap/mom_cap.F90 | 18 +++++++++++------- .../MOM_stochastics.F90 | 18 +++++++++++++++--- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 3de56c0511..25de32d526 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,8 +97,8 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM -use get_stochy_pattern_mod, only: write_stoch_restart_ocn +use MOM_stochastics, only : write_mom_restart_stoch !$use omp_lib , only : omp_set_num_threads implicit none; private @@ -1752,12 +1752,16 @@ subroutine ModelAdvance(gcomp, rc) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - ! write stochastic physics restart file if active - if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then - write(restartname,'(A)')"ocn_stoch.res.nc" - else - write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & - "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" + if (ocean_state%do_sppt .OR. ocean_state%pert_epbl) then + if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then + write(restartname,'(A)')"ocn_stoch.res.nc" + else + write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & + "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" + endif + call ESMF_LogWrite("MOM_cap: Writing stoch restart : "//trim(restartname), & + ESMF_LOGMSG_INFO) + call write_mom_restart_stoch('RESTART/'//trim(restartname)) endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) call write_stoch_restart_ocn('RESTART/'//trim(restartname)) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index 03b33dc2b3..ab33a17c29 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -22,12 +22,13 @@ module MOM_stochastics use MOM_domains, only : root_PE,num_PEs use MOM_coms, only : Get_PElist use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn +use get_stochy_pattern_mod, only: write_stoch_restart_ocn #include implicit none ; private -public stochastics_init, update_stochastics +public stochastics_init, update_stochastics, write_mom_restart_stoch !> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS @@ -146,10 +147,21 @@ subroutine update_stochastics(CS) call callTree_enter("update_stochastics(), MOM_stochastics.F90") ! update stochastic physics patterns before running next time-step - call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) - print*,'in update_stoch',minval(CS%sppt_wts),maxval(CS%sppt_wts),minval(CS%epbl1_wts),maxval(CS%epbl1_wts) + call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + return end subroutine update_stochastics +!< wrapper to write ocean stochastic restarts +subroutine write_mom_restart_stoch(filename) + character(len=*) :: filename + + call callTree_enter("write_mom_restart_stoch(), MOM_stochastics.F90") + + call write_stoch_restart_ocn(filename) + + return +end subroutine write_mom_restart_stoch + end module MOM_stochastics From 64e83b7aa1e00e989380a76b68a5aea6fa0a0e4b Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 27 Jul 2021 17:08:13 +0000 Subject: [PATCH 61/83] add logic to remove incrments from restart if outside IAU window --- src/ocean_data_assim/MOM_oda_incupd.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 5f38fa15d0..33e1c0844f 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -554,6 +554,16 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) if (CS%ncount >= CS%nstep_incupd) then if (is_root_pe()) call MOM_error(NOTE,"ended updating fields with increments. ") return + if (CS%ncount == CS%nstep_incupd) then + call register_restart_field_as_obsolete("oda_incupd_ncount", "none", CS) + call register_restart_field_as_obsolete("T_inc", "none", CS) + call register_restart_field_as_obsolete("S_inc", "none", CS) + call register_restart_field_as_obsolete("h_obs", "none", CS) + if (CS%uv_inc) then + call register_restart_field_as_obsolete("u_inc", "none", CS) + call register_restart_field_as_obsolete("v_inc", "none", CS) + endif + endif endif !ncount>CS%nstep_incupd ! update counter From 8775c6d41add72c6f71983107bc8c5be84e0fbc8 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 28 Jul 2021 17:35:21 +0000 Subject: [PATCH 62/83] revert logic wrt increments --- src/ocean_data_assim/MOM_oda_incupd.F90 | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 33e1c0844f..f087ad71c0 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -415,7 +415,7 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) enddo endif enddo; enddo - + ! remap u to h_obs to get increment if (CS%uv_inc) then call pass_var(h, G%Domain) @@ -554,16 +554,6 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) if (CS%ncount >= CS%nstep_incupd) then if (is_root_pe()) call MOM_error(NOTE,"ended updating fields with increments. ") return - if (CS%ncount == CS%nstep_incupd) then - call register_restart_field_as_obsolete("oda_incupd_ncount", "none", CS) - call register_restart_field_as_obsolete("T_inc", "none", CS) - call register_restart_field_as_obsolete("S_inc", "none", CS) - call register_restart_field_as_obsolete("h_obs", "none", CS) - if (CS%uv_inc) then - call register_restart_field_as_obsolete("u_inc", "none", CS) - call register_restart_field_as_obsolete("v_inc", "none", CS) - endif - endif endif !ncount>CS%nstep_incupd ! update counter From 71f7354d90fa8ceb8516cc476473a4c89b67823e Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 28 Jul 2021 19:40:29 +0000 Subject: [PATCH 63/83] add comments --- .../MOM_stochastics.F90 | 16 +++------------- .../MOM_stochastics_stub.F90 | 17 +++++++++-------- src/core/MOM.F90 | 4 +--- .../vertical/MOM_diabatic_driver.F90 | 2 +- 4 files changed, 14 insertions(+), 25 deletions(-) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index ab33a17c29..427b3c754b 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -4,13 +4,10 @@ module MOM_stochastics ! This file is part of MOM6. See LICENSE.md for the license. ! This is the top level module for the MOM6 ocean model. It contains routines -! for initialization, termination and update of ocean model state. This +! for initialization, update, and writing restart of stochastic physics. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! -! This code is a stop-gap wrapper of the MOM6 code to enable it to be called -! in the same way as MOM4. - use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type @@ -45,17 +42,9 @@ module MOM_stochastics type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type stochastic_CS -!> This type is used for communication with other components via the FMS coupler. -!! The element names and types can be changed only with great deliberation, hence -!! the persistnce of things like the cutsy element name "avg_kount". contains -!> ocean_model_init initializes the ocean model, including registering fields -!! for restarts and reading restart files if appropriate. -!! -!! This subroutine initializes both the ocean state and the ocean surface type. -!! Because of the way that indicies and domains are handled, Ocean_sfc must have -!! been used in a previous call to cean_type. +!! This subroutine initializes the stochastics physics control structure. subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] type(ocean_grid_type), intent(in) :: grid ! horizontal grid information @@ -135,6 +124,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) write(*,'(/12x,a/)') '=== COMPLETED MOM STOCHASTIC INITIALIZATION =====' call callTree_leave("ocean_model_init(") + return end subroutine stochastics_init !> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 index 89a6d43c4f..349d56c0c7 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 @@ -3,13 +3,11 @@ module MOM_stochastics ! This file is part of MOM6. See LICENSE.md for the license. -! This is the top level module for the MOM6 ocean model. It contains routines -! for initialization, termination and update of ocean model state. This -! particular version wraps all of the calls for MOM6 in the calls that had -! been used for MOM4. -! -! This code is a stop-gap wrapper of the MOM6 code to enable it to be called -! in the same way as MOM4. +! This is the top level module for the MOM6 ocean model. It contains +! placeholder for initialization, update, and writing restarts of ocean stochastic physics. +! The actualy stochastic physics is available at +! https://github.com/ufs-community/ufs-weather-model +! use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type use MOM_grid, only : ocean_grid_type @@ -62,6 +60,9 @@ subroutine update_stochastics(CS) type(stochastic_CS), intent(inout) :: CS !< diabatic control structure return end subroutine update_stochastics - +subroutine write_mom_restart_stoch(filename) + character(len=*) :: filename + return +end subroutine write_mom_restart_stoch end module MOM_stochastics diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a0594290ee..f62eb6a4fe 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -663,7 +663,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call disable_averaging(CS%diag) endif endif - + ! advance the random pattern if stochastic physics is active if (CS%stoch_CS%do_sppt .OR. CS%stoch_CS%pert_epbl) call update_stochastics(CS%stoch_CS) if (do_dyn) then @@ -2497,8 +2497,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not. CS%rotate_index) & G => G_in - ! initialize stochastic physics - !call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 319a6f2be6..2b15c67899 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -313,7 +313,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (G%ke == 1) return - ! save copy of the date for SPPT + ! save copy of the date for SPPT if active if (stoch_CS%do_sppt) then allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) From aac6b75dd7d095a37f9db988acb239cf868ed0b3 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Mon, 16 Aug 2021 08:53:19 -0400 Subject: [PATCH 64/83] update to gfdl 20210806 (#74) * remove white space and fix comment * Update MOM_oda_incupd.F90 remove unused index bounds, and fix sum_h2 loop. Co-authored-by: pjpegion Co-authored-by: Marshall Ward --- src/ocean_data_assim/MOM_oda_incupd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index f087ad71c0..5f38fa15d0 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -415,7 +415,7 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) enddo endif enddo; enddo - + ! remap u to h_obs to get increment if (CS%uv_inc) then call pass_var(h, G%Domain) From 1428a36aca21be2dcb6532e273f15f7c8ba573e3 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 21 Sep 2021 18:54:31 -0800 Subject: [PATCH 65/83] Several little things, one is making sponge less verbose. - Pointing to OBC wiki file from the lateral parameterizations doc. - Using the MOM6 verbosity to control the time_interp verbosity. - Making the check for negative water depths more informative. --- src/framework/MOM_horizontal_regridding.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index de511688a9..1204fc21b1 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -740,7 +740,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t if (.not.spongeDataOngrid) then if (is_root_pe()) & - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd @@ -840,6 +840,14 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) + ! now fill in missing values using "ICE-nine" algorithm. + tr_outf(:,:) = tr_out(:,:) + if (k==1) tr_prev(:,:) = tr_outf(:,:) + good2(:,:) = good(:,:) + fill2(:,:) = fill(:,:) + + call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) + ! if (debug) then ! call hchksum(tr_outf, 'field from fill_miss_2d ', G%HI) ! endif @@ -856,7 +864,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd else - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) do k=1,kd do j=js,je do i=is,ie @@ -867,6 +875,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo enddo endif + end subroutine horiz_interp_and_extrap_tracer_fms_id !> Create a 2d-mesh of grid coordinates from 1-d arrays. From a180d3316ed6eac746b3bd7ad5c3e6da989f2271 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 28 Sep 2021 18:47:57 +0000 Subject: [PATCH 66/83] return a more accurate error message in MOM_stochasics --- .../external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 index 427b3c754b..e6b0c80280 100644 --- a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 +++ b/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 @@ -101,9 +101,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) if (iret/=0) then - write(6,*) 'call to init_stochastic_physics_ocn failed' - call MOM_error(FATAL, "stochastic physics in enambled in MOM6 but "// & - "not activated in stochastic_physics namelist ") + call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") return endif From 918742bbba627eeb078babc37a5dcaa53fddfe53 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 4 Oct 2021 10:57:33 -0800 Subject: [PATCH 67/83] Working on boundary layer docs. --- src/framework/MOM_horizontal_regridding.F90 | 4 +- src/parameterizations/vertical/_EPBL.dox | 184 +------------------- 2 files changed, 5 insertions(+), 183 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 1204fc21b1..e5e651407e 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -740,7 +740,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t if (.not.spongeDataOngrid) then if (is_root_pe()) & - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd @@ -864,7 +864,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd else - call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>2), turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) do k=1,kd do j=js,je do i=is,ie diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox index d531c9ad9a..6134de31e0 100644 --- a/src/parameterizations/vertical/_EPBL.dox +++ b/src/parameterizations/vertical/_EPBL.dox @@ -57,7 +57,7 @@ Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes \f] The parameters needed to close the system of equations are then reduced to the turbulent -mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$. +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$$. We start with an equation for the turbulent kinetic energy (TKE): @@ -67,188 +67,10 @@ We start with an equation for the turbulent kinetic energy (TKE): {\partial z} + \overline{w^\prime b^\prime} - \epsilon \f] + Terms in this equation represent TKE storage (LHS), TKE flux convergence, shear production, buoyancy production, and dissipation. -\section section_WMBL Well-mixed Boundary Layers (WMBL) - -Assuming steady state and other parameterizations, integrating vertically -over the surface boundary layer, \cite reichl2018 obtains the form: - -\f[ - \frac{1}{2} H_{bl} w_e \Delta b = m_\ast u_\ast^3 - n_\ast \frac{H_{bl}}{2} - B(H_{bl}) , -\f] - -with the following variables: - - - -
Symbols used in integrated TKE equation
Symbol Meaning -
\f$H_{bl}\f$ boundary layer thickness -
\f$w_e\f$ entrainment velocity -
\f$\Delta b\f$ change in buoyancy at base of mixed layer -
\f$m_\ast\f$ sum of mechanical coefficients -
\f$u_\ast\f$ friction velocity (\f$u_\ast = (|\tau| / \rho_0)^{1/2}\f$) -
\f$\tau\f$ wind stress -
\f$n_\ast\f$ convective proportionality coefficient -
1 for stabilizing surface buoyancy flux, less otherwise -
\f$B(H_{bl})\f$ surface buoyancy flux -
- -\section section_ePBL Energetics-based Planetary Boundary Layer - -Once again, the goal is to formulate a surface mixing scheme to find the -turbulent eddy diffusivity (and viscosity) in a way that is suitable for use -in a global climate model, using long timesteps and large grid spacing. -After evaluating a well-mixed boundary layer (WMBL), the shear mixing of -\cite jackson2008 (JHL, \ref subsection_kappa_shear), as well as a more complete -boundary layer scheme, it was decided to combine a number of these ideas -into a new scheme: - -\f[ - K(z) = F_x(K_{ePBL}(z), K_{JHL}(z), K_n(z)) -\f] - -where \f$F_x\f$ is some unknown function of a new \f$K_{ePBL}\f$, -\f$K_{JHL}\f$, the diffusivity due to shear as determined by -\cite jackson2008, and \f$K_n\f$, the diffusivity from other ideas. -We start by specifying the form of \f$K_{ePBL}\f$ as being: - -\f[ - K_{ePBL}(z) = C_K w_t l , -\f] - -where \f$w_t\f$ is a turbulent velocity scale, \f$C_K\f$ is a coefficient, and -\f$l\f$ is a length scale. - -\subsection subsection_lengthscale Turbulent length scale - -We propose a form for the length scale as follows: - -\f[ - l = (z_0 + |z|) \times \max \left[ \frac{l_b}{H_{bl}} , \left( - \frac{H_{bl} - |z|}{H_{bl}} \right)^\gamma \, \right] , -\f] - -where we have the following variables: - - - -
Symbols used in ePBL length scale
Symbol Meaning -
\f$H_{bl}\f$ boundary layer thickness -
\f$z_0\f$ roughness length -
\f$\gamma\f$ coefficient, 2 is as in KPP, \cite large1994 -
\f$l_b\f$ bottom length scale -
- -\subsection subsection_velocityscale Turbulent velocity scale - -We do not predict the TKE prognostically and therefore approximate the vertical TKE -profile to estimate \f$w_t\f$. An estimate for the mechanical contribution to the velocity -scale follows the standard two-equation approach. In one and two-equation second-order -\f$K\f$ parameterizations the boundary condition for the TKE is typically employed as a -flux boundary condition. - -\f[ - K \left. \frac{\partial k}{\partial z} \right|_{z=0} = c_\mu^0 u_\ast^3 . -\f] - -The profile of \f$k\f$ decays in the vertical from \f$k \propto (c_\mu^0)^{2/3} -u_\ast^2\f$ toward the base of the OSBL. Here we assume a similar relationship to estimate -the mechanical contribution to the TKE profile. The value of \f$w_t\f$ due to mechanical -sources, \f$v_\ast\f$, is estimate as \f$v_\ast (z=0) \propto (c_\mu^0)^{1/3} u_\ast\f$ at -the surface. Since we only parameterize OSBL turbulent mixing due to surface forcing, the -value of the velocity scale is assumed to decay moving away from the surface. For -simplicity we employ a linear decay in depth: - -\f[ - v_\ast (z) = (c_\mu^0)^{1/3} u_\ast \left( 1 - a \cdot \min \left[ 1, - \frac{|z|}{H_{bl}} \right] \right) , -\f] - -where \f$1 > a > 0\f$ has the effect of making \f$v_\ast(z=H_{bl}) > 0\f$. -Making the constant coefficient \f$a\f$ close to one has the effect of reducing the mixing -rate near the base of the boundary layer, thus producing a more diffuse entrainment -region. Making \f$a\f$ close to zero has the effect of increasing the mixing at the base -of the boundary layer, producing a more 'step-like' entrainment region. - -An estimate for the buoyancy contribution is found utilizing the convective velocity -scale: - -\f[ - w_\ast (z) = C_{w_\ast} \left( \int_z^0 \overline{w^\prime b^\prime} dz \right)^{1/3} , -\f] - -where \f$C_{w_\ast}\f$ is a non-dimensional empirical coefficient. Convection in one and -two-equation closure causes a TKE profile that peaks below the surface. The quantity -\f$\overline{w^\prime b^\prime}\f$ is solved for in ePBL as \f$KN^2\f$. - -These choices for the convective and mechanical components of the velocity scale in the -OSBL are then added together to get an estimate for the total turbulent velocity scale: - -\f[ - w_t (z) = w_\ast (z) + v_\ast (z) . -\f] - -The value of \f$a\f$ is arbitrarily chosen to be 0.95 here. - -\subsection subsection_ePBL_summary Summarizing the ePBL implementation - -The ePBL mixing coefficient is found by multiplying a velocity scale -(\ref subsection_velocityscale) by a length scale (\ref subsection_lengthscale). The -precise value of the coefficient \f$C_K\f$ used does not significantly alter the -prescribed potential energy change constraint. A reasonable value is \f$C_K \approx 0.55\f$ to -be consistent with other approaches (e.g. \cite umlauf2005). - -The boundary layer thickness (\f$H_{bl}\f$) within ePBL is based on -the depth where the energy requirement for turbulent mixing of density -exceeds the available energy (\ref section_WMBL). \f$H_{bl}\f$ is -determined by the energetic constraint imposed using the value of -\f$m_\ast\f$ and \f$n_\ast\f$. An iterative solver is required because -\f$m_\ast\f$ and the mixing length are dependent on \f$H_{bl}\f$. - -We use a constant value for convectively driven TKE of \f$n_\ast = 0.066\f$. The -parameterizations for \f$m_\ast\f$ are formulated specifically for the regimes where -\f$K_{JHL}\f$ is sensitive to model numerics \f$(|f| \Delta t \approx -1)\f$ (\cite reichl2018). - -\subsection subsection_ePBL_JHL Combining ePBL and JHL mixing coefficients - -We now address the combination of the ePBL mixing coefficient and the JHL mixing -coefficient. The function \f$F_x\f$ above cannot be the linear sum of \f$K_{ePBL}\f$ and -\f$K_{JHL}\f$. One reason this sum is not valid is because the JHL mixing coefficient is -determined by resolved current shear, including that driven by the surface wind. The -wind-driven current is also included in the ePBL mixing coefficient formulation. An -alternative approach is therefore needed to avoid double counting. - -\f$K_{ePBL}\f$ is not used at the equator as scalings are only investigated when \f$|f| > -0\f$. The solution we employ is to use the maximum mixing coefficient of the two -contributions, - -\f[ - K (z) = \max (K_{ePBL} (z), K_{JHL} (z)), -\f] - -where \f$m_\ast\f$ (and hence \f$K_{ePBL}\f$) is constrained to be small as \f$|f| -\rightarrow 0\f$. This form uses the JHL mixing coefficient when the ePBL coefficient is -small. - -This approach is reasonable when the wind-driven mixing dominates, since both JHL and ePBL -give a similar solution when deployed optimally. One weakness of this approach is the -tropical region, where the shear-driven ePBL \f$m_\ast\f$ coefficient is not formulated. -The JHL parameterization is skillful to simulate this mixing, but does not include the -contribution of convection. The convective portion of \f$K_{ePBL}\f$ should be combined -with \f$K_{JHL}\f$ in the equatorial region when shear and convection occur together. -Future research is warranted. - -Finally, one should note that the mixing coefficient here (\f$K\f$) is used for both -diffusivity and viscosity, implying a turbulent Prandtl number of 1.0. - -\subsection subsection_Langmuir Langmuir circulation - -While only briefly alluded to in \cite reichl2018, the MOM6 code implementing ePBL does -support the option to add a Langmuir parameterization. There are in fact two options, both -adjusting \f$m_\ast\f$. +Following the lead of \cite jackson2008 (\ref subsection_kappa_shear). */ From 11fa1140629e8334b90fa221450879816a90cce6 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Oct 2021 13:46:54 -0800 Subject: [PATCH 68/83] Done with EPBL docs? --- docs/conf.py | 2 +- src/parameterizations/vertical/_EPBL.dox | 184 ++++++++++++++++++++++- 2 files changed, 182 insertions(+), 4 deletions(-) diff --git a/docs/conf.py b/docs/conf.py index 4407d88356..5d84b3c37a 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2022, MOM6 developers' +copyright = u'2017-2021, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/src/parameterizations/vertical/_EPBL.dox b/src/parameterizations/vertical/_EPBL.dox index 6134de31e0..d531c9ad9a 100644 --- a/src/parameterizations/vertical/_EPBL.dox +++ b/src/parameterizations/vertical/_EPBL.dox @@ -57,7 +57,7 @@ Similarly, the eddy diffusivity is used to parameterize turbulent scalar fluxes \f] The parameters needed to close the system of equations are then reduced to the turbulent -mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$$. +mixing coefficients, \f$K_\phi\f$ and \f$K_M\f$. We start with an equation for the turbulent kinetic energy (TKE): @@ -67,10 +67,188 @@ We start with an equation for the turbulent kinetic energy (TKE): {\partial z} + \overline{w^\prime b^\prime} - \epsilon \f] - Terms in this equation represent TKE storage (LHS), TKE flux convergence, shear production, buoyancy production, and dissipation. -Following the lead of \cite jackson2008 (\ref subsection_kappa_shear). +\section section_WMBL Well-mixed Boundary Layers (WMBL) + +Assuming steady state and other parameterizations, integrating vertically +over the surface boundary layer, \cite reichl2018 obtains the form: + +\f[ + \frac{1}{2} H_{bl} w_e \Delta b = m_\ast u_\ast^3 - n_\ast \frac{H_{bl}}{2} + B(H_{bl}) , +\f] + +with the following variables: + + + +
Symbols used in integrated TKE equation
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$w_e\f$ entrainment velocity +
\f$\Delta b\f$ change in buoyancy at base of mixed layer +
\f$m_\ast\f$ sum of mechanical coefficients +
\f$u_\ast\f$ friction velocity (\f$u_\ast = (|\tau| / \rho_0)^{1/2}\f$) +
\f$\tau\f$ wind stress +
\f$n_\ast\f$ convective proportionality coefficient +
1 for stabilizing surface buoyancy flux, less otherwise +
\f$B(H_{bl})\f$ surface buoyancy flux +
+ +\section section_ePBL Energetics-based Planetary Boundary Layer + +Once again, the goal is to formulate a surface mixing scheme to find the +turbulent eddy diffusivity (and viscosity) in a way that is suitable for use +in a global climate model, using long timesteps and large grid spacing. +After evaluating a well-mixed boundary layer (WMBL), the shear mixing of +\cite jackson2008 (JHL, \ref subsection_kappa_shear), as well as a more complete +boundary layer scheme, it was decided to combine a number of these ideas +into a new scheme: + +\f[ + K(z) = F_x(K_{ePBL}(z), K_{JHL}(z), K_n(z)) +\f] + +where \f$F_x\f$ is some unknown function of a new \f$K_{ePBL}\f$, +\f$K_{JHL}\f$, the diffusivity due to shear as determined by +\cite jackson2008, and \f$K_n\f$, the diffusivity from other ideas. +We start by specifying the form of \f$K_{ePBL}\f$ as being: + +\f[ + K_{ePBL}(z) = C_K w_t l , +\f] + +where \f$w_t\f$ is a turbulent velocity scale, \f$C_K\f$ is a coefficient, and +\f$l\f$ is a length scale. + +\subsection subsection_lengthscale Turbulent length scale + +We propose a form for the length scale as follows: + +\f[ + l = (z_0 + |z|) \times \max \left[ \frac{l_b}{H_{bl}} , \left( + \frac{H_{bl} - |z|}{H_{bl}} \right)^\gamma \, \right] , +\f] + +where we have the following variables: + + + +
Symbols used in ePBL length scale
Symbol Meaning +
\f$H_{bl}\f$ boundary layer thickness +
\f$z_0\f$ roughness length +
\f$\gamma\f$ coefficient, 2 is as in KPP, \cite large1994 +
\f$l_b\f$ bottom length scale +
+ +\subsection subsection_velocityscale Turbulent velocity scale + +We do not predict the TKE prognostically and therefore approximate the vertical TKE +profile to estimate \f$w_t\f$. An estimate for the mechanical contribution to the velocity +scale follows the standard two-equation approach. In one and two-equation second-order +\f$K\f$ parameterizations the boundary condition for the TKE is typically employed as a +flux boundary condition. + +\f[ + K \left. \frac{\partial k}{\partial z} \right|_{z=0} = c_\mu^0 u_\ast^3 . +\f] + +The profile of \f$k\f$ decays in the vertical from \f$k \propto (c_\mu^0)^{2/3} +u_\ast^2\f$ toward the base of the OSBL. Here we assume a similar relationship to estimate +the mechanical contribution to the TKE profile. The value of \f$w_t\f$ due to mechanical +sources, \f$v_\ast\f$, is estimate as \f$v_\ast (z=0) \propto (c_\mu^0)^{1/3} u_\ast\f$ at +the surface. Since we only parameterize OSBL turbulent mixing due to surface forcing, the +value of the velocity scale is assumed to decay moving away from the surface. For +simplicity we employ a linear decay in depth: + +\f[ + v_\ast (z) = (c_\mu^0)^{1/3} u_\ast \left( 1 - a \cdot \min \left[ 1, + \frac{|z|}{H_{bl}} \right] \right) , +\f] + +where \f$1 > a > 0\f$ has the effect of making \f$v_\ast(z=H_{bl}) > 0\f$. +Making the constant coefficient \f$a\f$ close to one has the effect of reducing the mixing +rate near the base of the boundary layer, thus producing a more diffuse entrainment +region. Making \f$a\f$ close to zero has the effect of increasing the mixing at the base +of the boundary layer, producing a more 'step-like' entrainment region. + +An estimate for the buoyancy contribution is found utilizing the convective velocity +scale: + +\f[ + w_\ast (z) = C_{w_\ast} \left( \int_z^0 \overline{w^\prime b^\prime} dz \right)^{1/3} , +\f] + +where \f$C_{w_\ast}\f$ is a non-dimensional empirical coefficient. Convection in one and +two-equation closure causes a TKE profile that peaks below the surface. The quantity +\f$\overline{w^\prime b^\prime}\f$ is solved for in ePBL as \f$KN^2\f$. + +These choices for the convective and mechanical components of the velocity scale in the +OSBL are then added together to get an estimate for the total turbulent velocity scale: + +\f[ + w_t (z) = w_\ast (z) + v_\ast (z) . +\f] + +The value of \f$a\f$ is arbitrarily chosen to be 0.95 here. + +\subsection subsection_ePBL_summary Summarizing the ePBL implementation + +The ePBL mixing coefficient is found by multiplying a velocity scale +(\ref subsection_velocityscale) by a length scale (\ref subsection_lengthscale). The +precise value of the coefficient \f$C_K\f$ used does not significantly alter the +prescribed potential energy change constraint. A reasonable value is \f$C_K \approx 0.55\f$ to +be consistent with other approaches (e.g. \cite umlauf2005). + +The boundary layer thickness (\f$H_{bl}\f$) within ePBL is based on +the depth where the energy requirement for turbulent mixing of density +exceeds the available energy (\ref section_WMBL). \f$H_{bl}\f$ is +determined by the energetic constraint imposed using the value of +\f$m_\ast\f$ and \f$n_\ast\f$. An iterative solver is required because +\f$m_\ast\f$ and the mixing length are dependent on \f$H_{bl}\f$. + +We use a constant value for convectively driven TKE of \f$n_\ast = 0.066\f$. The +parameterizations for \f$m_\ast\f$ are formulated specifically for the regimes where +\f$K_{JHL}\f$ is sensitive to model numerics \f$(|f| \Delta t \approx +1)\f$ (\cite reichl2018). + +\subsection subsection_ePBL_JHL Combining ePBL and JHL mixing coefficients + +We now address the combination of the ePBL mixing coefficient and the JHL mixing +coefficient. The function \f$F_x\f$ above cannot be the linear sum of \f$K_{ePBL}\f$ and +\f$K_{JHL}\f$. One reason this sum is not valid is because the JHL mixing coefficient is +determined by resolved current shear, including that driven by the surface wind. The +wind-driven current is also included in the ePBL mixing coefficient formulation. An +alternative approach is therefore needed to avoid double counting. + +\f$K_{ePBL}\f$ is not used at the equator as scalings are only investigated when \f$|f| > +0\f$. The solution we employ is to use the maximum mixing coefficient of the two +contributions, + +\f[ + K (z) = \max (K_{ePBL} (z), K_{JHL} (z)), +\f] + +where \f$m_\ast\f$ (and hence \f$K_{ePBL}\f$) is constrained to be small as \f$|f| +\rightarrow 0\f$. This form uses the JHL mixing coefficient when the ePBL coefficient is +small. + +This approach is reasonable when the wind-driven mixing dominates, since both JHL and ePBL +give a similar solution when deployed optimally. One weakness of this approach is the +tropical region, where the shear-driven ePBL \f$m_\ast\f$ coefficient is not formulated. +The JHL parameterization is skillful to simulate this mixing, but does not include the +contribution of convection. The convective portion of \f$K_{ePBL}\f$ should be combined +with \f$K_{JHL}\f$ in the equatorial region when shear and convection occur together. +Future research is warranted. + +Finally, one should note that the mixing coefficient here (\f$K\f$) is used for both +diffusivity and viscosity, implying a turbulent Prandtl number of 1.0. + +\subsection subsection_Langmuir Langmuir circulation + +While only briefly alluded to in \cite reichl2018, the MOM6 code implementing ePBL does +support the option to add a Langmuir parameterization. There are in fact two options, both +adjusting \f$m_\ast\f$. */ From 4a91628395dd97182ff03563adaf55463315e375 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Oct 2021 14:53:52 -0800 Subject: [PATCH 69/83] Undoing some patches from others --- src/core/MOM_barotropic.F90 | 32 +++------------------ src/framework/MOM_horizontal_regridding.F90 | 9 ------ 2 files changed, 4 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 3b5c812ba1..7d9c4facb2 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -225,10 +225,7 @@ module MOM_barotropic !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. - logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the - !! barotropic solver has the wrong sign, replicating a long-standing - !! bug. - real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim]. + real :: G_extra !< A nondimensional factor by which gtot is enhanced. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are !! given by the parameters defined below: @@ -1057,11 +1054,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - if (CS%tidal_sal_bug) then - dgeo_de = 1.0 + det_de + CS%G_extra - else - dgeo_de = (1.0 - det_de) + CS%G_extra - endif + dgeo_de = 1.0 + det_de + CS%G_extra else dgeo_de = 1.0 + CS%G_extra endif @@ -2804,11 +2797,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) det_de = 0.0 if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - if (CS%tidal_sal_bug) then - dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) - else - dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de) - endif + dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) if (present(pbce)) then do j=js,je ; do i=is,ie gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0 @@ -4299,12 +4288,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. - real :: det_de ! The partial derivative due to self-attraction and loading of the reference - ! geopotential with the sea surface height when tides are enabled. - ! This is typically ~0.09 or less. - real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points - ! that acts on the barotropic flow [Z T-1 ~> m s-1]. - + real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity @@ -4458,14 +4442,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) - det_de = 0.0 - if (CS%tides .and. associated(CS%tides_CSp)) & - call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, & - "If true, the tidal self-attraction and loading anomaly in the barotropic "//& - "solver has the wrong sign, replicating a long-standing bug with a scalar "//& - "self-attraction and loading term or the SAL term from a previous simulation.", & - default=.true., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index e5e651407e..de511688a9 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -840,14 +840,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) - ! now fill in missing values using "ICE-nine" algorithm. - tr_outf(:,:) = tr_out(:,:) - if (k==1) tr_prev(:,:) = tr_outf(:,:) - good2(:,:) = good(:,:) - fill2(:,:) = fill(:,:) - - call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true., answers_2018=answers_2018) - ! if (debug) then ! call hchksum(tr_outf, 'field from fill_miss_2d ', G%HI) ! endif @@ -875,7 +867,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo enddo endif - end subroutine horiz_interp_and_extrap_tracer_fms_id !> Create a 2d-mesh of grid coordinates from 1-d arrays. From 28003a8f76c057a284ec23944361178729f45148 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 12 Oct 2021 11:01:28 -0800 Subject: [PATCH 70/83] Adding in that SAL commit again. --- src/core/MOM_barotropic.F90 | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 7d9c4facb2..48fb35e1b8 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -225,6 +225,9 @@ module MOM_barotropic !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. + logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the + !! barotropic solver has the wrong sign, replicating a long-standing + !! bug. real :: G_extra !< A nondimensional factor by which gtot is enhanced. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are @@ -1054,7 +1057,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + det_de + CS%G_extra + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + det_de + CS%G_extra + else + dgeo_de = (1.0 - det_de) + CS%G_extra + endif else dgeo_de = 1.0 + CS%G_extra endif @@ -2797,7 +2804,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) det_de = 0.0 if (CS%tides) call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) - dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + if (CS%tidal_sal_bug) then + dgeo_de = 1.0 + max(0.0, det_de + CS%G_extra) + else + dgeo_de = 1.0 + max(0.0, CS%G_extra - det_de) + endif if (present(pbce)) then do j=js,je ; do i=is,ie gtot_E(i,j) = 0.0 ; gtot_W(i,j) = 0.0 @@ -4288,6 +4299,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! a restart file to the internal representation in this run. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. + real :: det_de ! The partial derivative due to self-attraction and loading of the reference + ! geopotential with the sea surface height when tides are enabled. + ! This is typically ~0.09 or less. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -4442,6 +4456,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) + det_de = 0.0 + if (CS%tides .and. associated(CS%tides_CSp)) & + call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) + call get_param(param_file, mdl, "BAROTROPIC_TIDAL_SAL_BUG", CS%tidal_sal_bug, & + "If true, the tidal self-attraction and loading anomaly in the barotropic "//& + "solver has the wrong sign, replicating a long-standing bug with a scalar "//& + "self-attraction and loading term or the SAL term from a previous simulation.", & + default=.true., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& From 1853352a65bfcf0724edb39bad6fcf43422e4b10 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Thu, 28 Oct 2021 15:47:25 -0400 Subject: [PATCH 71/83] correction on type in directory name --- .../MOM_stochastics.F90 | 0 .../MOM_stochastics_stub.F90 | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename config_src/external/{OCEAN_stochastic_phyiscs => OCEAN_stochastic_physics}/MOM_stochastics.F90 (100%) rename config_src/external/{OCEAN_stochastic_phyiscs => OCEAN_stochastic_physics}/MOM_stochastics_stub.F90 (100%) diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 b/config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 similarity index 100% rename from config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics.F90 rename to config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 diff --git a/config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 similarity index 100% rename from config_src/external/OCEAN_stochastic_phyiscs/MOM_stochastics_stub.F90 rename to config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 From 6f48b9d1d1499a2e3761f89cfb1fd993235536c3 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 28 Jan 2022 11:24:39 -0900 Subject: [PATCH 72/83] Oops, more cleanup. --- config_src/drivers/nuopc_cap/mom_cap.F90 | 17 +-- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 19 ++-- config_src/drivers/solo_driver/MOM_driver.F90 | 14 --- .../MOM_stochastics_stub.F90 | 68 ------------ docs/conf.py | 2 +- src/core/MOM.F90 | 37 ++++--- src/core/MOM_barotropic.F90 | 6 +- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/framework/MOM_domains.F90 | 60 ++++++++--- .../stochastic}/MOM_stochastics.F90 | 35 +++--- .../vertical/MOM_diabatic_driver.F90 | 63 +++++------ .../vertical/MOM_energetic_PBL.F90 | 102 +++++++----------- 12 files changed, 167 insertions(+), 260 deletions(-) delete mode 100644 config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 rename {config_src/external/OCEAN_stochastic_physics => src/parameterizations/stochastic}/MOM_stochastics.F90 (86%) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 25de32d526..174a659f12 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -98,7 +98,6 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM -use MOM_stochastics, only : write_mom_restart_stoch !$use omp_lib , only : omp_set_num_threads implicit none; private @@ -1750,21 +1749,9 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) + call ocean_model_restart(ocean_state, restartname=restartname, & + stoch_restartname=stoch_restartname) - if (ocean_state%do_sppt .OR. ocean_state%pert_epbl) then - if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then - write(restartname,'(A)')"ocn_stoch.res.nc" - else - write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & - "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" - endif - call ESMF_LogWrite("MOM_cap: Writing stoch restart : "//trim(restartname), & - ESMF_LOGMSG_INFO) - call write_mom_restart_stoch('RESTART/'//trim(restartname)) - endif - call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - call write_stoch_restart_ocn('RESTART/'//trim(restartname)) endif if (is_root_pe()) then diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 9ffe4cd794..448f23140e 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -62,8 +62,8 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart -use MOM_domains, only : root_PE,num_PEs -use MOM_coms, only : Get_PElist +use get_stochy_pattern_mod, only : write_stoch_restart_ocn +use iso_fortran_env, only : int64 #include @@ -177,8 +177,10 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical,public :: do_sppt !< If true, write stochastic physics restarts - logical,public :: pert_epbl !< If true, write stochastic physics restarts + logical :: do_sppt !< If true, stochastically perturb the diabatic and + !! write restarts + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and + !! genration termsand write restarts real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -253,7 +255,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! The actual depth over which melt potential is computed will !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot!< If true, allocate melt_potential array + logical :: use_melt_pot !< If true, allocate melt_potential array + logical :: use_CFC !< If true, allocated arrays for surface CFCs. + ! This include declares and sets the variable "version". #include "version_variable.h" @@ -425,10 +429,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif - ! check to see if stochastic physics is active + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) +! get number of processors and PE list for stocasthci physics initialization call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & "If true, then stochastically perturb the thermodynamic "//& - "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "tendencies of T,S, and h. Amplitude and correlations are "//& "controlled by the nam_stoch namelist in the UFS model only.", & default=.false.) call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 8ed8a8559f..c2cd0a248c 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -71,19 +71,6 @@ program MOM_main use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_size - use ensemble_manager_mod, only : ensemble_pelist_setup - use mpp_mod, only : set_current_pelist => mpp_set_current_pelist - use time_interp_external_mod, only : time_interp_external_init - use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get - - use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS - use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart -! , add_shelf_flux_forcing, add_shelf_flux_IOB - - use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init - use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves - implicit none #include @@ -93,7 +80,6 @@ program MOM_main ! A structure containing pointers to the thermodynamic forcing fields ! at the ocean surface. type(forcing) :: fluxes - ! A structure containing pointers to the ocean surface state fields. type(surface) :: sfc_state diff --git a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 b/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 deleted file mode 100644 index 349d56c0c7..0000000000 --- a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics_stub.F90 +++ /dev/null @@ -1,68 +0,0 @@ -!> Top-level module for the MOM6 ocean model in coupled mode. -module MOM_stochastics - -! This file is part of MOM6. See LICENSE.md for the license. - -! This is the top level module for the MOM6 ocean model. It contains -! placeholder for initialization, update, and writing restarts of ocean stochastic physics. -! The actualy stochastic physics is available at -! https://github.com/ufs-community/ufs-weather-model -! - -use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use MOM_domains, only : root_PE,num_PEs -use MOM_coms, only : Get_PElist - -#include - -implicit none ; private - -public stochastics_init, update_stochastics - -!> This control structure holds parameters for the MOM_stochastics module -type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms - !>@{ Diagnostic IDs - integer :: id_sppt_wts = -1 - integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 - !>@} - ! stochastic patterns - real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - !! tendencies with a number between 0 and 2 - real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation - real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation - type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output - type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) -end type stochastic_CS - -contains - -subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) - real, intent(in) :: dt !< time step [T ~> s] - type(ocean_grid_type), intent(in) :: grid ! horizontal grid information - type(verticalGrid_type), intent(in) :: GV ! vertical grid structure - type(stochastic_CS), pointer, intent(inout):: CS - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output - type(time_type), target :: Time !< model time - return -end subroutine stochastics_init - -subroutine update_stochastics(CS) - type(stochastic_CS), intent(inout) :: CS !< diabatic control structure - return -end subroutine update_stochastics -subroutine write_mom_restart_stoch(filename) - character(len=*) :: filename - return -end subroutine write_mom_restart_stoch -end module MOM_stochastics - diff --git a/docs/conf.py b/docs/conf.py index 5d84b3c37a..4407d88356 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2021, MOM6 developers' +copyright = u'2017-2022, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f62eb6a4fe..f3d8869320 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -133,7 +133,7 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_variables, only : rotate_surface_state, stochastic_pattern +use MOM_variables, only : rotate_surface_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units @@ -155,6 +155,8 @@ module MOM use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline +use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf +use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end implicit none ; private @@ -403,6 +405,16 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors + type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) & + :: por_face_areaU !< fractional open area of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) & + :: por_face_areaV !< fractional open area of V-faces [nondim] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) & + :: por_layer_widthU !< fractional open width of U-faces [nondim] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) & + :: por_layer_widthV !< fractional open width of V-faces [nondim] + type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure end type MOM_control_struct @@ -1382,7 +1394,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS,OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS, CS%OBC, Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1800,7 +1812,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt + real :: conv2watt ! A conversion factor from temperature fluxes to heat + ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] + real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] + real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -2477,28 +2492,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif - ! Shift from using the temporary dynamic grid type to using the final - ! (potentially static) ocean-specific grid type. - ! The next line would be needed if G%Domain had not already been init'd above: - ! call clone_MOM_domain(dG%Domain, G%Domain) - call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G, US) - call destroy_dyn_horgrid(dG) - ! Set a few remaining fields that are specific to the ocean grid type. if (CS%rotate_index) then call set_first_direction(G, modulo(first_direction + turns, 2)) else call set_first_direction(G, modulo(first_direction, 2)) endif - call MOM_grid_init(G_in, param_file, US, HI_in, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG_in, G_in, US) - call destroy_dyn_horgrid(dG_in) - - if (.not. CS%rotate_index) & - G => G_in - ! Set a few remaining fields that are specific to the ocean grid type. - call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 48fb35e1b8..3b5c812ba1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -228,7 +228,7 @@ module MOM_barotropic logical :: tidal_sal_bug !< If true, the tidal self-attraction and loading anomaly in the !! barotropic solver has the wrong sign, replicating a long-standing !! bug. - real :: G_extra !< A nondimensional factor by which gtot is enhanced. + real :: G_extra !< A nondimensional factor by which gtot is enhanced [nondim]. integer :: hvel_scheme !< An integer indicating how the thicknesses at !! velocity points are calculated. Valid values are !! given by the parameters defined below: @@ -4302,7 +4302,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real :: det_de ! The partial derivative due to self-attraction and loading of the reference ! geopotential with the sea surface height when tides are enabled. ! This is typically ~0.09 or less. - real, allocatable, dimension(:,:) :: lin_drag_h + real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points + ! that acts on the barotropic flow [Z T-1 ~> m s-1]. + type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 27164c2c75..ef71d9286c 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1286,8 +1286,8 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. 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] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index aedf9d5d0d..dc6c0a8996 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -3,24 +3,56 @@ module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_array_transform, only : rotate_array -use MOM_coms, only : PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end -use MOM_coms, only : broadcast, sum_across_PEs, min_across_PEs, max_across_PEs -use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end -use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL, is_root_pe -use MOM_file_parser, only : get_param, log_param, log_version -use MOM_file_parser, only : param_file_type +use MOM_coms_infra, only : MOM_infra_init, MOM_infra_end +use MOM_coms_infra, only : PE_here, root_PE, num_PEs, broadcast +use MOM_coms_infra, only : sum_across_PEs, min_across_PEs, max_across_PEs +use MOM_domain_infra, only : MOM_domain_type, domain2D, domain1D, group_pass_type +use MOM_domain_infra, only : create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain +use MOM_domain_infra, only : get_domain_extent, get_domain_components, same_domain +use MOM_domain_infra, only : compute_block_extent, get_global_shape +use MOM_domain_infra, only : pass_var, pass_vector, fill_symmetric_edges, global_field_sum +use MOM_domain_infra, only : pass_var_start, pass_var_complete +use MOM_domain_infra, only : pass_vector_start, pass_vector_complete +use MOM_domain_infra, only : create_group_pass, do_group_pass +use MOM_domain_infra, only : start_group_pass, complete_group_pass +use MOM_domain_infra, only : rescale_comp_data, global_field, redistribute_array, broadcast_domain +use MOM_domain_infra, only : MOM_thread_affinity_set, set_MOM_thread_affinity +use MOM_domain_infra, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM +use MOM_domain_infra, only : CORNER, CENTER, NORTH_FACE, EAST_FACE +use MOM_domain_infra, only : To_East, To_West, To_North, To_South, To_All, Omit_Corners +use MOM_error_handler, only : MOM_error, MOM_mesg, NOTE, WARNING, FATAL +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_io_infra, only : file_exists use MOM_string_functions, only : slasher implicit none ; private -public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 -public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, PE_here, root_PE, num_PEs -public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast -public :: pass_vector_start, pass_vector_complete -public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER +public :: MOM_infra_init, MOM_infra_end +! Domain types and creation and destruction routines +public :: MOM_domain_type, domain2D, domain1D +public :: MOM_domains_init, create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain +public :: MOM_thread_affinity_set, set_MOM_thread_affinity +! Domain query routines +public :: get_domain_extent, get_domain_components, get_global_shape, same_domain +public :: PE_here, root_PE, num_PEs +! Blocks are not actively used in MOM6, so this routine could be deprecated. +public :: compute_block_extent +! Single call communication routines +public :: pass_var, pass_vector, fill_symmetric_edges, broadcast +! Non-blocking communication routines +public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete +! Multi-variable group communication routines and type +public :: create_group_pass, do_group_pass, group_pass_type, start_group_pass, complete_group_pass +! Global reduction routines +public :: sum_across_PEs, min_across_PEs, max_across_PEs +public :: global_field, redistribute_array, broadcast_domain +! Simple index-convention-invariant array manipulation routine +public :: rescale_comp_data +!> These encoding constants are used to indicate the staggering of scalars and vectors +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR +!> These encoding constants are used to indicate the discretization position of a variable +public :: CORNER, CENTER, NORTH_FACE, EAST_FACE +!> These encoding constants indicate communication patterns. In practice they can be added. public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners ! These are no longer used by MOM6 because the reproducing sum works so well, but they are ! still referenced by some of the non-GFDL couplers. diff --git a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 similarity index 86% rename from config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 rename to src/parameterizations/stochastic/MOM_stochastics.F90 index e6b0c80280..21a22a222e 100644 --- a/config_src/external/OCEAN_stochastic_physics/MOM_stochastics.F90 +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -19,20 +19,20 @@ module MOM_stochastics use MOM_domains, only : root_PE,num_PEs use MOM_coms, only : Get_PElist use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn -use get_stochy_pattern_mod, only: write_stoch_restart_ocn #include implicit none ; private -public stochastics_init, update_stochastics, write_mom_restart_stoch +public stochastics_init, update_stochastics !> This control structure holds parameters for the MOM_stochastics module type, public:: stochastic_CS - logical :: do_sppt !< If true, stochastically perturb the diabatic - logical :: pert_epbl !! If true, then randomly perturb the KE dissipation and genration terms - integer :: id_sppt_wts = -1 - integer :: id_epbl1_wts=-1,id_epbl2_wts=-1 + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 !< Diagnostic id for SPPT + integer :: id_epbl1_wts=-1 !< Diagnostic id for epbl generation perturbation + integer :: id_epbl2_wts=-1 !< Diagnostic id for epbl dissipation perturbation ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT !! tendencies with a number between 0 and 2 @@ -47,9 +47,9 @@ module MOM_stochastics !! This subroutine initializes the stochastics physics control structure. subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] - type(ocean_grid_type), intent(in) :: grid ! horizontal grid information - type(verticalGrid_type), intent(in) :: GV ! vertical grid structure - type(stochastic_CS), pointer, intent(inout):: CS + type(ocean_grid_type), intent(in) :: grid !< horizontal grid information + type(verticalGrid_type), intent(in) :: GV !< vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS !< stochastic control structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output type(time_type), target :: Time !< model time @@ -59,7 +59,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) integer :: num_procs ! number of processors to pass to stochastic physics integer :: iret ! return code from stochastic physics integer :: me ! my pe - integer :: master ! root pe + integer :: pe_zero ! root pe integer :: nx ! number of x-points including halo integer :: ny ! number of x-points including halo @@ -95,11 +95,11 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) num_procs=num_PEs() allocate(pelist(num_procs)) call Get_PElist(pelist,commID = mom_comm) - master=root_PE() + pe_zero=root_PE() nx = grid%ied - grid%isd + 1 ny = grid%jed - grid%jsd + 1 call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & - CS%pert_epbl,CS%do_sppt,master,mom_comm,iret) + CS%pert_epbl,CS%do_sppt,pe_zero,mom_comm,iret) if (iret/=0) then call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") return @@ -140,16 +140,5 @@ subroutine update_stochastics(CS) return end subroutine update_stochastics -!< wrapper to write ocean stochastic restarts -subroutine write_mom_restart_stoch(filename) - character(len=*) :: filename - - call callTree_enter("write_mom_restart_stoch(), MOM_stochastics.F90") - - call write_stoch_restart_ocn(filename) - - return -end subroutine write_mom_restart_stoch - end module MOM_stochastics diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2b15c67899..c2b19d4160 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -71,7 +71,6 @@ module MOM_diabatic_driver use MOM_wave_interface, only : wave_parameters_CS use MOM_stochastics, only : stochastic_CS - implicit none ; private #include @@ -221,8 +220,6 @@ module MOM_diabatic_driver logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics - real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil - real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module @@ -283,8 +280,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -293,8 +291,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & @@ -305,9 +303,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree - real, allocatable(:,:,:) :: h_in ! thickness before thermodynamics - real, allocatable(:,:,:) :: t_in ! temperature before thermodynamics - real, allocatable(:,:,:) :: s_in ! salinity before thermodynamics + real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics + real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics + real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT @@ -327,7 +325,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif endif - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (GV%ke == 1) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -504,12 +504,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo enddo enddo + deallocate(h_in) + deallocate(t_in) + deallocate(s_in) endif end subroutine diabatic -end subroutine diabatic - !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. @@ -523,10 +524,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] - type(forcing), intent(inout) :: fluxes !< points to forcing fields - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -534,7 +537,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -835,8 +838,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves) + CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -1111,8 +1113,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, + !! BBL properties and related fields + type(accel_diag_ptrs), intent(inout) :: ADp !< Points to accelerations in momentum !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations @@ -1120,7 +1123,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + type(Wave_parameters_CS), pointer :: Waves !< Surface gravity waves ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -1372,8 +1375,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & - waves=waves) + CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -3135,12 +3137,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_hf_dvdt_dia_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - CS%id_dudt_dia = register_diag_field('ocean_model', 'dudt_dia', diag%axesCuL, Time, & - 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_dvdt_dia = register_diag_field('ocean_model', 'dvdt_dia', diag%axesCvL, Time, & - 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', diag%axesT1, Time, & - 'random pattern for sppt', 'None') + if ((CS%id_dudt_dia > 0) .or. (CS%id_hf_dudt_dia_2d > 0)) & + call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) + if ((CS%id_dvdt_dia > 0) .or. (CS%id_hf_dvdt_dia_2d > 0)) & + call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) + endif if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 9ecba8a7b8..99dd38135d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -244,9 +244,8 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, & - last_call, dT_expected, dS_expected, Waves) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & + stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -278,27 +277,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 s-1 ~> m2 s-1]. - type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous - !! call to mixedlayer_init. + !! [Z2 T-1 ~> m2 s-1]. + type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - logical, optional, intent(in) :: last_call !< If true, this is the last call to - !! mixedlayer in the current time step, so - !! diagnostics will be written. The default - !! is .true. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dT_expected !< The values of temperature change that - !! should be expected when the returned - !! diffusivities are applied [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dS_expected !< The values of salinity change that - !! should be expected when the returned - !! diffusivities are applied [ppt]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous ! This subroutine determines the diffusivities from the integrated energetics @@ -439,16 +422,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) + if (stoch_CS%pert_epbl) then ! stochastics are active call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & - epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j), & - i=i, j=j) + US, CS, eCD, Waves, G, i, j, & + epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j)) else call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + US, CS, eCD, Waves, G, i, j) endif ! Copy the diffusivities to a 2-d array. @@ -488,30 +471,26 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo ! j-loop - if (write_diags) then - if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) - ! only write random patterns if running with stochastic physics, otherwise the - ! array is unallocated and will give an error - if (stoch_CS%pert_epbl) then - if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) - if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) - endif + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + if (stoch_CS%pert_epbl) then + if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) + if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) endif end subroutine energetic_PBL @@ -521,7 +500,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, epbl1_wt, epbl2_wt, i, j) + Waves, G, i, j, epbl1_wt, epbl2_wt) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -558,16 +537,12 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control struct type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. - real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [T ~> s]. - type(wave_parameters_CS), & - optional, pointer :: Waves !< Wave CS for Langmuir turbulence - type(ocean_grid_type), & - optional, intent(inout) :: G !< The ocean's grid structure. - real, optional, intent(in) :: epbl1_wt ! random number to perturb KE generation - real, optional, intent(in) :: epbl2_wt ! random number to perturb KE dissipation - integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) - integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + real, optional, intent(in) :: epbl1_wt !< random number to perturb KE generation + real, optional, intent(in) :: epbl2_wt !< random number to perturb KE dissipation + integer, intent(in) :: i !< The i-index to work on (used for Waves) + integer, intent(in) :: j !< The i-index to work on (used for Waves) ! This subroutine determines the diffusivities in a single column from the integrated energetics ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes @@ -941,11 +916,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) else - mech_TKE = mech_TKE * exp_kh + mech_TKE = mech_TKE * exp_kh endif - !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. From 24f412d77ad848abc6bcc573fdeb6c974f3aa7fa Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 31 Mar 2022 12:02:08 -0800 Subject: [PATCH 73/83] Part of the fix for issue #54. --- src/framework/MOM_horizontal_regridding.F90 | 2 +- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index de511688a9..709bc3fe52 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -860,7 +860,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do k=1,kd do j=js,je do i=is,ie - tr_z(i,j,k)=data_in(i,j,k) + tr_z(i,j,k)=data_in(i,j,k) * conversion if (.not. ans_2018) mask_z(i,j,k) = 1. if (abs(tr_z(i,j,k)-missing_value) < abs(roundoff*missing_value)) mask_z(i,j,k) = 0. enddo diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 6b89a86b30..8578dd2c17 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -143,7 +143,7 @@ module MOM_ALE_sponge !> This subroutine determines the number of points which are within sponges in this computational !! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean -!! points are included in the sponges. It also stores the target interface heights. This +!! points are included in the sponges. It also stores the target interface heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, nz_data, & Iresttime_u_in, Iresttime_v_in) @@ -965,7 +965,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, 1.0, G, sp_val, mask_z, z_in, & + call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, US%m_s_to_L_T, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answers_2018=CS%hor_regrid_answers_2018) @@ -1014,7 +1014,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, 1.0, G, sp_val, mask_z, z_in, & + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, US%m_s_to_L_T, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answers_2018=CS%hor_regrid_answers_2018) From 1e6924e03009a31f023645264828018e16a52c67 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 4 Apr 2022 09:24:14 -0800 Subject: [PATCH 74/83] More fixes for issue #54. - Scaling of OBC's dz_src. - Scaling of CS%IDatu in MOM_barotropic. --- src/core/MOM_barotropic.F90 | 12 ++++++------ src/core/MOM_open_boundary.F90 | 3 ++- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 3b5c812ba1..6bf22dc14e 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1246,12 +1246,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, CS%IDatu(I,j) = 0.0 elseif (integral_BT_cont) then CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), & - CS%dy_Cu(I,j)*Htot_avg) ) + CS%dy_Cu(I,j)*Htot_avg) ) * GV%Z_to_H elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling. CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), & - CS%dy_Cu(I,j)*Htot_avg) ) + CS%dy_Cu(I,j)*Htot_avg) ) * GV%Z_to_H else - CS%IDatu(I,j) = 1.0 / Htot_avg + CS%IDatu(I,j) = GV%Z_to_H / Htot_avg endif endif @@ -1272,12 +1272,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, CS%IDatv(i,J) = 0.0 elseif (integral_BT_cont) then CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), & - CS%dx_Cv(i,J)*Htot_avg) ) + CS%dx_Cv(i,J)*Htot_avg) ) * GV%Z_to_H elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling. CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), & - CS%dx_Cv(i,J)*Htot_avg) ) + CS%dx_Cv(i,J)*Htot_avg) ) * GV%Z_to_H else - CS%IDatv(i,J) = 1.0 / Htot_avg + CS%IDatv(i,J) = GV%Z_to_H / Htot_avg endif endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6ce0940ddb..53152d75bc 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3940,7 +3940,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! no dz for tidal variables if (segment%field(m)%nk_src > 1 .and.& (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then - call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer_in) + call time_interp_external(segment%field(m)%fid_dz, Time, tmp_buffer_in) + tmp_buffer_in(:,:,:) = tmp_buffer_in(:,:,:) * US%m_to_Z if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. if (segment%is_E_or_W & From f50551ce44145d8b489eaf7e1297a3d147daaee8 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 5 Apr 2022 13:22:53 -0800 Subject: [PATCH 75/83] Fix to Z_RESCALE bug in ePBL. --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 99dd38135d..27583c43b3 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1076,7 +1076,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%wT_scheme==wT_from_cRoot_TKE) then vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_scheme==wT_from_RH18) then - Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) + Surface_Scale = max(0.05, 1.0 - htot * GV%H_to_Z / MLD_guess) vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) endif @@ -1125,7 +1125,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%wT_scheme==wT_from_cRoot_TKE) then vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_scheme==wT_from_RH18) then - Surface_Scale = max(0.05, 1. - htot/MLD_guess) + Surface_Scale = max(0.05, 1. - htot * GV%H_to_Z / MLD_guess) vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) endif From 41757c7a502f65a1cb18f515fe938ea5408c7c43 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Apr 2022 10:18:57 -0800 Subject: [PATCH 76/83] Fix the rebase --- src/core/MOM_forcing_type.F90 | 2 ++ src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4a702d4c0e..bdf4823f81 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -170,6 +170,8 @@ module MOM_forcing_type !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) !! or freezing (negative) [R Z T-1 ~> kg m-2 s-1] + real, pointer, dimension(:,:) :: shelf_sfc_mass_flux => NULL() !< Ice shelf surface mass flux + !! deposition from the atmosphere. [R Z T-1 ~> kg m-2 s-1] ! Scalars set by surface forcing modules real :: vPrecGlobalAdj = 0. !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c2b19d4160..7b180f1d65 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -838,7 +838,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) @@ -1375,7 +1375,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) From 57a1a8ae2f7eed50283b53e6308f8bad2e6ecb7c Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Apr 2022 15:50:46 -0800 Subject: [PATCH 77/83] Rest of fix for issue #54. --- src/ALE/MOM_ALE.F90 | 6 +++-- src/core/MOM_open_boundary.F90 | 24 ++++++++++++------- src/ocean_data_assim/MOM_oda_driver.F90 | 8 +++---- .../vertical/MOM_tidal_mixing.F90 | 2 +- src/tracer/MOM_lateral_boundary_diffusion.F90 | 6 +++-- 5 files changed, 29 insertions(+), 17 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index fa195d57eb..77f2613f0c 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -753,8 +753,10 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg ! remap from original grid onto new grid do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 - call remapping_core_h(CS%remapCS, nz, h_orig(i,j,:), tv%S(i,j,:), nz, h(i,j,:), tv_local%S(i,j,:)) - call remapping_core_h(CS%remapCS, nz, h_orig(i,j,:), tv%T(i,j,:), nz, h(i,j,:), tv_local%T(i,j,:)) + call remapping_core_h(CS%remapCS, nz, h_orig(i,j,:), tv%S(i,j,:), nz, h(i,j,:), tv_local%S(i,j,:), & + GV%H_subroundoff, GV%H_subroundoff) + call remapping_core_h(CS%remapCS, nz, h_orig(i,j,:), tv%T(i,j,:), nz, h(i,j,:), tv_local%T(i,j,:), & + GV%H_subroundoff, GV%H_subroundoff) enddo ; enddo ! starting grid for next iteration diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 53152d75bc..47061f9447 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4007,19 +4007,22 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & + GV%H_subroundoff, GV%H_subroundoff) elseif (G%mask2dCu(I,j)>0.) then h_stack(:) = h(i+ishift,j,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & + GV%H_subroundoff, GV%H_subroundoff) elseif (G%mask2dCu(I,j+1)>0.) then h_stack(:) = h(i+ishift,j+1,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,J,:), & - GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & + GV%H_subroundoff, GV%H_subroundoff) endif enddo else @@ -4034,7 +4037,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,j,:), & - GV%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:)) + GV%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:), & + GV%H_subroundoff, GV%H_subroundoff) endif enddo endif @@ -4053,19 +4057,22 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & + GV%H_subroundoff, GV%H_subroundoff) elseif (G%mask2dCv(i,J)>0.) then h_stack(:) = h(i,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & + GV%H_subroundoff, GV%H_subroundoff) elseif (G%mask2dCv(i+1,J)>0.) then h_stack(:) = h(i+1,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & - GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & + GV%H_subroundoff, GV%H_subroundoff) endif enddo else @@ -4080,7 +4087,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(i,J,:), & segment%field(m)%buffer_src(i,J,:), & - GV%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:)) + GV%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:), & + GV%H_subroundoff, GV%H_subroundoff) endif enddo endif diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index fc76c23480..a4c59be85c 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -415,9 +415,9 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) ! remap temperature and salinity from the ensemble member to the analysis grid do j=G%jsc,G%jec ; do i=G%isc,G%iec call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), & - CS%nk, CS%h(i,j,:), T(i,j,:)) + CS%nk, CS%h(i,j,:), T(i,j,:), GV%H_subroundoff, GV%H_subroundoff) call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & - CS%nk, CS%h(i,j,:), S(i,j,:)) + CS%nk, CS%h(i,j,:), S(i,j,:), GV%H_subroundoff, GV%H_subroundoff) enddo ; enddo ! cast ensemble members to the analysis domain do m=1,CS%ensemble_size @@ -671,9 +671,9 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) isc=G%isc; iec=G%iec; jsc=G%jsc; jec=G%jec do j=jsc,jec; do i=isc,iec call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T(i,j,:), & - G%ke, h(i,j,:), T_inc(i,j,:)) + G%ke, h(i,j,:), T_inc(i,j,:), GV%H_subroundoff, GV%H_subroundoff) call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S(i,j,:), & - G%ke, h(i,j,:), S_inc(i,j,:)) + G%ke, h(i,j,:), S_inc(i,j,:), GV%H_subroundoff, GV%H_subroundoff) enddo; enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index be574b4356..4b9fc8e182 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -875,7 +875,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! remap from input z coordinate to model coordinate: tidal_qe_md = 0.0 call remapping_core_h(CS%remap_cs, size(CS%h_src), CS%h_src, CS%tidal_qe_3d_in(i,j,:), & - GV%ke, h_m, tidal_qe_md) + GV%ke, h_m, tidal_qe_md, GV%H_subroundoff, GV%H_subroundoff) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 227e3ffb06..71016f8d8e 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -618,8 +618,10 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ allocate(F_layer_z(nk), source=0.0) ! remap tracer to dz_top - call remapping_core_h(CS%remap_cs, ke, h_L(:), phi_L(:), nk, dz_top(:), phi_L_z(:)) - call remapping_core_h(CS%remap_cs, ke, h_R(:), phi_R(:), nk, dz_top(:), phi_R_z(:)) + call remapping_core_h(CS%remap_cs, ke, h_L(:), phi_L(:), nk, dz_top(:), phi_L_z(:), & + CS%H_subroundoff, CS%H_subroundoff) + call remapping_core_h(CS%remap_cs, ke, h_R(:), phi_R(:), nk, dz_top(:), phi_R_z(:), & + CS%H_subroundoff, CS%H_subroundoff) ! Calculate vertical indices containing the boundary layer in dz_top call boundary_k_range(boundary, nk, dz_top, hbl_L, k_top_L, zeta_top_L, k_bot_L, zeta_bot_L) From 4b218c07a0e58296003b8cc70149a08c42ebf5d9 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 6 Apr 2022 22:16:14 -0800 Subject: [PATCH 78/83] Tweaks in response to Hallberg's comments. --- src/ALE/MOM_ALE.F90 | 13 +++++++++++-- src/core/MOM_barotropic.F90 | 8 ++++---- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 77f2613f0c..df4f16409c 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -719,6 +719,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg ! we have to keep track of the total dzInterface if for some reason ! we're using the old remapping algorithm for u/v real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzInterface, dzIntTotal + real :: h_neglect, h_neglect_edge nz = GV%ke @@ -744,6 +745,14 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg if (present(dt)) & call ALE_update_regrid_weights(dt, CS) + if (.not. CS%answers_2018) then + h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff + elseif (GV%Boussinesq) then + h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 + else + h_neglect = GV%kg_m2_to_H * 1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H * 1.0e-10 + endif + do k = 1, n call do_group_pass(pass_T_S_h, G%domain) @@ -754,9 +763,9 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg ! remap from original grid onto new grid do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 call remapping_core_h(CS%remapCS, nz, h_orig(i,j,:), tv%S(i,j,:), nz, h(i,j,:), tv_local%S(i,j,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) call remapping_core_h(CS%remapCS, nz, h_orig(i,j,:), tv%T(i,j,:), nz, h(i,j,:), tv_local%T(i,j,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) enddo ; enddo ! starting grid for next iteration diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6bf22dc14e..e46bfc7c37 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1245,11 +1245,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (Htot_avg*CS%dy_Cu(I,j) <= 0.0) then CS%IDatu(I,j) = 0.0 elseif (integral_BT_cont) then - CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), & - CS%dy_Cu(I,j)*Htot_avg) ) * GV%Z_to_H + CS%IDatu(I,j) = GV%Z_to_H * CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), & + CS%dy_Cu(I,j)*Htot_avg) ) elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling. - CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), & - CS%dy_Cu(I,j)*Htot_avg) ) * GV%Z_to_H + CS%IDatu(I,j) = GV%Z_to_H * CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), & + CS%dy_Cu(I,j)*Htot_avg) ) else CS%IDatu(I,j) = GV%Z_to_H / Htot_avg endif From 3c7bd19eecc9e1ce03e490d5d3e6b9e08cf73f9d Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 7 Apr 2022 12:20:56 -0800 Subject: [PATCH 79/83] More cleaning up for issue #54 --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM_barotropic.F90 | 8 +++--- src/core/MOM_open_boundary.F90 | 34 +++++++++++++++++-------- src/ocean_data_assim/MOM_oda_driver.F90 | 29 ++++++++++++++++++--- 4 files changed, 53 insertions(+), 20 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index df4f16409c..b632487cdf 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -719,7 +719,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg ! we have to keep track of the total dzInterface if for some reason ! we're using the old remapping algorithm for u/v real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzInterface, dzIntTotal - real :: h_neglect, h_neglect_edge + real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] nz = GV%ke diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index e46bfc7c37..5bc52f9fe3 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1271,11 +1271,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (Htot_avg*CS%dx_Cv(i,J) <= 0.0) then CS%IDatv(i,J) = 0.0 elseif (integral_BT_cont) then - CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), & - CS%dx_Cv(i,J)*Htot_avg) ) * GV%Z_to_H + CS%IDatv(i,J) = GV%Z_to_H * CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), & + CS%dx_Cv(i,J)*Htot_avg) ) elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling. - CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), & - CS%dx_Cv(i,J)*Htot_avg) ) * GV%Z_to_H + CS%IDatv(i,J) = GV%Z_to_H * CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), & + CS%dx_Cv(i,J)*Htot_avg) ) else CS%IDatv(i,J) = GV%Z_to_H / Htot_avg endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 47061f9447..9d87d0bc5d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -310,6 +310,9 @@ module MOM_open_boundary real :: ramp_value !< If ramp is True, where we are on the ramp from !! zero to one [nondim]. type(time_type) :: ramp_start_time !< Time when model was started. + logical :: answers_2018 !< If true, use the order of arithmetic and expressions for remapping + !! that recover the answers from the end of 2018. Otherwise, use more + !! robust and accurate forms of mathematically equivalent expressions. end type ocean_OBC_type !> Control structure for open boundaries that read from files. @@ -358,9 +361,9 @@ subroutine open_boundary_config(G, US, param_file, OBC) character(len=200) :: config1 ! String for OBC_USER_CONFIG real :: Lscale_in, Lscale_out ! parameters controlling tracer values at the boundaries [L ~> m] character(len=128) :: inputdir - logical :: answers_2018, default_2018_answers logical :: check_reconstruction, check_remapping, force_bounds_in_subcell character(len=64) :: remappingScheme + logical :: default_2018_answers ! This include declares and sets the variable "version". # include "version_variable.h" @@ -608,7 +611,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) - call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", answers_2018, & + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", OBC%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) @@ -616,7 +619,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) allocate(OBC%remap_CS) call initialize_remapping(OBC%remap_CS, remappingScheme, boundary_extrapolation = .false., & check_reconstruction=check_reconstruction, check_remapping=check_remapping, & - force_bounds_in_subcell=force_bounds_in_subcell, answers_2018=answers_2018) + force_bounds_in_subcell=force_bounds_in_subcell, answers_2018=OBC%answers_2018) endif ! OBC%number_of_segments > 0 @@ -3730,6 +3733,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] integer :: turns ! Number of index quarter turns real :: time_delta ! Time since tidal reference date [T ~> s] + real :: h_neglect, h_neglect_edge ! Small thicknesses [H ~> m or kg m-2] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3742,6 +3746,14 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (OBC%add_tide_constituents) time_delta = US%s_to_T * time_type_to_real(Time - OBC%time_ref) + if (.not. OBC%answers_2018) then + h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff + elseif (GV%Boussinesq) then + h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 + else + h_neglect = GV%kg_m2_to_H * 1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H * 1.0e-10 + endif + do n = 1, OBC%number_of_segments segment => OBC%segment(n) @@ -4008,21 +4020,21 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) elseif (G%mask2dCu(I,j)>0.) then h_stack(:) = h(i+ishift,j,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) elseif (G%mask2dCu(I,j+1)>0.) then h_stack(:) = h(i+ishift,j+1,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,J,:), & GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) endif enddo else @@ -4038,7 +4050,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,j,:), & GV%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) endif enddo endif @@ -4058,21 +4070,21 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) elseif (G%mask2dCv(i,J)>0.) then h_stack(:) = h(i,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) elseif (G%mask2dCv(i+1,J)>0.) then h_stack(:) = h(i+1,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & GV%ke, h_stack, segment%field(m)%buffer_dst(I,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) endif enddo else @@ -4088,7 +4100,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(i,J,:), & segment%field(m)%buffer_src(i,J,:), & GV%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:), & - GV%H_subroundoff, GV%H_subroundoff) + h_neglect, h_neglect_edge) endif enddo endif diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index a4c59be85c..140cf3a4d6 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -134,6 +134,9 @@ module MOM_oda_driver_mod type(INC_CS) :: INC_CS !< A Structure containing integer file handles for bias adjustment integer :: id_inc_t !< A diagnostic handle for the temperature climatological adjustment integer :: id_inc_s !< A diagnostic handle for the salinity climatological adjustment + logical :: answers_2018 !< If true, use the order of arithmetic and expressions for remapping + !! that recover the answers from the end of 2018. Otherwise, use more + !! robust and accurate forms of mathematically equivalent expressions. end type ODA_CS @@ -396,6 +399,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) integer :: isg, ieg, jsg, jeg, idg_offset, jdg_offset integer :: id logical :: used, symmetric + real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] ! return if not time for analysis if (Time < CS%Time) return @@ -407,6 +411,14 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) call set_PElist(CS%filter_pelist) !call MOM_mesg('Setting prior') + if (.not. CS%answers_2018) then + h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff + elseif (GV%Boussinesq) then + h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 + else + h_neglect = GV%kg_m2_to_H * 1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H * 1.0e-10 + endif + ! computational domain for the analysis grid isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec ! array extents for the ensemble member @@ -415,9 +427,9 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) ! remap temperature and salinity from the ensemble member to the analysis grid do j=G%jsc,G%jec ; do i=G%isc,G%iec call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), & - CS%nk, CS%h(i,j,:), T(i,j,:), GV%H_subroundoff, GV%H_subroundoff) + CS%nk, CS%h(i,j,:), T(i,j,:), h_neglect, h_neglect_edge) call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & - CS%nk, CS%h(i,j,:), S(i,j,:), GV%H_subroundoff, GV%H_subroundoff) + CS%nk, CS%h(i,j,:), S(i,j,:), h_neglect, h_neglect_edge) enddo ; enddo ! cast ensemble members to the analysis domain do m=1,CS%ensemble_size @@ -652,6 +664,7 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [g kg-1] real :: missing_value + real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] if (.not. associated(CS)) return if (CS%assim_method == NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return @@ -668,12 +681,20 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) S = S + CS%tv_bc%S endif + if (.not. CS%answers_2018) then + h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff + elseif (GV%Boussinesq) then + h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 + else + h_neglect = GV%kg_m2_to_H * 1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H * 1.0e-10 + endif + isc=G%isc; iec=G%iec; jsc=G%jsc; jec=G%jec do j=jsc,jec; do i=isc,iec call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T(i,j,:), & - G%ke, h(i,j,:), T_inc(i,j,:), GV%H_subroundoff, GV%H_subroundoff) + G%ke, h(i,j,:), T_inc(i,j,:), h_neglect, h_neglect_edge) call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S(i,j,:), & - G%ke, h(i,j,:), S_inc(i,j,:), GV%H_subroundoff, GV%H_subroundoff) + G%ke, h(i,j,:), S_inc(i,j,:), h_neglect, h_neglect_edge) enddo; enddo From 9c22ff272e29fc147f3f7ff1738bad1e5f15ee42 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 7 Apr 2022 13:34:13 -0800 Subject: [PATCH 80/83] Taking out some unused OBC constants. --- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_open_boundary.F90 | 4 ---- src/initialization/MOM_state_initialization.F90 | 2 +- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- src/user/DOME_initialization.F90 | 2 +- src/user/dyed_channel_initialization.F90 | 2 +- src/user/dyed_obcs_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 2 +- src/user/user_initialization.F90 | 2 +- 9 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5bc52f9fe3..cd84c5f7b6 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -17,7 +17,7 @@ module MOM_barotropic use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc, MOM_read_data, slasher -use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, open_boundary_query +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, open_boundary_query use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type use MOM_restart, only : register_restart_field, register_restart_pair diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 9d87d0bc5d..6eaf685971 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -63,10 +63,6 @@ module MOM_open_boundary public initialize_segment_data integer, parameter, public :: OBC_NONE = 0 !< Indicates the use of no open boundary -integer, parameter, public :: OBC_SIMPLE = 1 !< Indicates the use of a simple inflow open boundary -integer, parameter, public :: OBC_WALL = 2 !< Indicates the use of a closed wall -integer, parameter, public :: OBC_FLATHER = 3 !< Indicates the use of a Flather open boundary -integer, parameter, public :: OBC_RADIATION = 4 !< Indicates the use of a radiation open boundary integer, parameter, public :: OBC_DIRECTION_N = 100 !< Indicates the boundary is an effective northern boundary integer, parameter, public :: OBC_DIRECTION_S = 200 !< Indicates the boundary is an effective southern boundary integer, parameter, public :: OBC_DIRECTION_E = 300 !< Indicates the boundary is an effective eastern boundary diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4e8dd4f186..0167b7f220 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -20,7 +20,7 @@ module MOM_state_initialization use MOM_interface_heights, only : find_eta use MOM_io, only : file_exists, field_size, MOM_read_data, MOM_read_vector, slasher use MOM_open_boundary, only : ocean_OBC_type, open_boundary_init, set_tracer_data -use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : OBC_NONE use MOM_open_boundary, only : open_boundary_query use MOM_open_boundary, only : set_tracer_data, initialize_segment_data use MOM_open_boundary, only : open_boundary_test_extern_h diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d384500c3d..a0c14162c4 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -13,7 +13,7 @@ module MOM_vert_friction use MOM_forcing_type, only : mech_forcing use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_DIRECTION_E +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init use MOM_PointAccel, only : PointAccel_CS diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 248bf6c0f0..ed81f06b5b 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -10,7 +10,7 @@ module DOME_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_tracer_registry, only : tracer_registry_type, tracer_type use MOM_tracer_registry, only : tracer_name_lookup diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index ff98f16529..9fa672ceb6 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -8,7 +8,7 @@ module dyed_channel_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE 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, time_type_to_real diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index 0307d93d3d..15a06effd7 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -8,7 +8,7 @@ module dyed_obcs_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_tracer_registry, only : tracer_registry_type, tracer_name_lookup use MOM_tracer_registry, only : tracer_type diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index b4ceb1905d..ddb38a9cdf 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -7,7 +7,7 @@ module supercritical_initialization use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_segment_type use MOM_time_manager, only : time_type, time_type_to_real use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index d59d271471..adccc40b81 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -8,7 +8,7 @@ module user_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE 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 From 8d92579b2f8d0ed85ce0bbce9c4825d40f47ef59 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 7 Apr 2022 16:10:35 -0800 Subject: [PATCH 81/83] Deleted an unused function, made public OBC funcs. --- src/core/MOM_open_boundary.F90 | 87 ++-------------------------------- 1 file changed, 5 insertions(+), 82 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6eaf685971..ef53420cca 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -48,6 +48,9 @@ module MOM_open_boundary public open_boundary_test_extern_uv public open_boundary_test_extern_h public open_boundary_zero_normal_flow +public parse_segment_str +public parse_segment_manifest_str +public parse_segment_data_str public register_OBC, OBC_registry_init public register_file_OBC, file_OBC_end public segment_tracer_registry_init @@ -61,6 +64,8 @@ module MOM_open_boundary public rotate_OBC_config public rotate_OBC_init public initialize_segment_data +public flood_fill +public flood_fill2 integer, parameter, public :: OBC_NONE = 0 !< Indicates the use of no open boundary integer, parameter, public :: OBC_DIRECTION_N = 100 !< Indicates the boundary is an effective northern boundary @@ -1694,88 +1699,6 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) end subroutine parse_for_tracer_reservoirs -!> Parse an OBC_SEGMENT_%%%_PARAMS string -subroutine parse_segment_param_real(segment_str, var, param_value, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of - !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed - real, intent(out) :: param_value !< The value of the parameter - logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages - ! Local variables - character(len=128) :: word1, word2, word3, method - integer :: lword, nfields, n, m - logical :: continue,dbg - character(len=32), dimension(MAX_OBC_FIELDS) :: flds - - nfields = 0 - continue = .true. - dbg = .false. - if (PRESENT(debug)) dbg = debug - - do while (continue) - word1 = extract_word(segment_str,',',nfields+1) - if (trim(word1) == '') exit - nfields = nfields+1 - word2 = extract_word(word1,'=',1) - flds(nfields) = trim(word2) - enddo - - ! if (PRESENT(fields)) then - ! do n=1,nfields - ! fields(n) = flds(n) - ! enddo - ! endif - - ! if (PRESENT(num_fields)) then - ! num_fields = nfields - ! return - ! endif - - m=0 -! if (PRESENT(var)) then - do n=1,nfields - if (trim(var)==trim(flds(n))) then - m = n - exit - endif - enddo - if (m==0) then - call abort() - endif - - ! Process first word which will start with the fieldname - word3 = extract_word(segment_str,',',m) -! word1 = extract_word(word3,':',1) -! if (trim(word1) == '') exit - word2 = extract_word(word1,'=',1) - if (trim(word2) == trim(var)) then - method=trim(extract_word(word1,'=',2)) - lword=len_trim(method) - read(method(1:lword),*,err=987) param_value - ! if (method(lword-3:lword) == 'file') then - ! ! raise an error id filename/fieldname not in argument list - ! word1 = extract_word(word3,':',2) - ! filenam = extract_word(word1,'(',1) - ! fieldnam = extract_word(word1,'(',2) - ! lword=len_trim(fieldnam) - ! fieldnam = fieldnam(1:lword-1) ! remove trailing parenth - ! value=-999. - ! elseif (method(lword-4:lword) == 'value') then - ! filenam = 'none' - ! fieldnam = 'none' - ! word1 = extract_word(word3,':',2) - ! lword=len_trim(word1) - ! read(word1(1:lword),*,end=986,err=987) value - ! endif - endif -! endif - - return - 986 call MOM_error(FATAL,'End of record while parsing segment data specification! '//trim(segment_str)) - 987 call MOM_error(FATAL,'Error while parsing segment parameter specification! '//trim(segment_str)) - -end subroutine parse_segment_param_real - !> Initialize open boundary control structure and do any necessary rescaling of OBC !! fields that have been read from a restart file. subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) From 1383961072e1446acd7ca8d7a3b3baeb16bd84ee Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 7 Apr 2022 21:21:39 -0800 Subject: [PATCH 82/83] It would be good to initialize CS%answers_2018. --- src/ocean_data_assim/MOM_oda_driver.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 140cf3a4d6..867d77a495 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -182,6 +182,7 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) logical :: reentrant_x, reentrant_y, tripolar_N, symmetric character(len=80) :: remap_scheme character(len=80) :: bias_correction_file, inc_file + logical :: default_2018_answers if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) @@ -238,6 +239,14 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) "for vertical remapping for all variables. "//& "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default="PPM_H4") + call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.false., do_not_log=.true.) + call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=default_2018_answers, & + do_not_log=.true.) inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) From 861a8f14d9d70e60350ec22ec5b2f61496f5ba79 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 20 Apr 2022 13:09:48 -0400 Subject: [PATCH 83/83] Use ODA_2018_ANSWERS to specify ODA remapping Added the new run-time parameter ODA_2018_ANSWERS to recover the answers from the previous version of the code, which did not supply properly dimensional rescaled minimum thicknesses for the remapping calls in the ODA driver. When this is set to True, all answers are bitwise identical. --- src/ocean_data_assim/MOM_oda_driver.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 867d77a495..a484fddd97 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -242,10 +242,10 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false., do_not_log=.true.) - call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", CS%answers_2018, & + call get_param(PF, mdl, "ODA_2018_ANSWERS", CS%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& - "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers, & + "answers from original version of the ODA driver. Otherwise, use updated and "//& + "more robust forms of the same expressions.", default=default_2018_answers, & do_not_log=.true.) inputdir = slasher(inputdir)