From 7de295c86cf9c2c88975a361418b945066bd11d0 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 2 Dec 2020 15:35:05 +0000 Subject: [PATCH] cleanup of code and enhancement of ePBL perts --- .../mom_surface_forcing_nuopc.F90 | 2 - src/core/MOM.F90 | 28 ++++--- src/core/MOM_forcing_type.F90 | 37 ++++++--- src/diagnostics/MOM_diagnostics.F90 | 13 +--- .../vertical/MOM_diabatic_driver.F90 | 76 +++++++++++++++++-- .../vertical/MOM_energetic_PBL.F90 | 24 ++++-- 6 files changed, 129 insertions(+), 51 deletions(-) diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 8279619fd1..3516ad3803 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -298,8 +298,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 dd422ab445..6ed974708e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -142,7 +142,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 @@ -761,9 +761,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) @@ -911,7 +908,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_diag, 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) @@ -1672,6 +1670,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. This can be altered during the course @@ -1680,7 +1679,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 @@ -2342,14 +2342,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. call set_first_direction(G, first_direction) @@ -2763,6 +2766,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 5f48f4d7d6..930f54566d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -141,8 +141,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 @@ -240,8 +242,10 @@ 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(:,:) :: 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. @@ -2082,11 +2086,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 @@ -3031,7 +3041,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) @@ -3187,7 +3198,8 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt) 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) @@ -3212,7 +3224,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 c8b5d6ac4e..50873863fd 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -169,8 +169,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 @@ -1199,7 +1197,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 @@ -1210,8 +1208,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 [m] @@ -1336,11 +1332,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 @@ -1842,8 +1833,6 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 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) - 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/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d753afc97b..fc76e87a0c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -68,6 +68,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 stochastic_physics, only : run_stochastic_physics_ocn implicit none ; private @@ -175,7 +176,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 + 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 @@ -207,6 +208,8 @@ 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 @@ -286,8 +289,35 @@ 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 + 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 + if (G%ke == 1) return + ! 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 + 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: "// & @@ -369,10 +399,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, visc, ADp, CDp, dt, Time_end, & + 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, & + 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, & @@ -435,13 +465,37 @@ 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 + 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_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 + h(i,j,k)=GV%Angstrom_H + endif + tv%T(i,j,k)=t_pert + if (s_pert > 0.0) then + tv%S(i,j,k)=s_pert + endif + enddo + enddo + enddo + endif + 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, & +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 @@ -454,6 +508,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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(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 @@ -836,7 +891,7 @@ 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, & + 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 @@ -1222,7 +1277,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, & +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 @@ -1235,6 +1290,7 @@ 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 + 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 @@ -1565,7 +1621,7 @@ 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, & + 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 @@ -3385,6 +3441,12 @@ 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') 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 9fe95cac56..4f93c47e95 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -163,6 +163,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. @@ -245,7 +246,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, dt, Kd_int, G, GV, US, CS, & +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. @@ -282,6 +283,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! [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]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less @@ -435,7 +438,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 @@ -459,9 +463,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS 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, 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 Kd_2d(i,K) = Kd(K) @@ -542,7 +547,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, i, j) + 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]. @@ -580,6 +585,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. 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, 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), & @@ -878,6 +885,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 if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -959,8 +968,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 - mech_TKE = mech_TKE * exp_kh + !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.