Skip to content

Commit

Permalink
Merge branch 'ocn_stoch' into dev/emc_merge
Browse files Browse the repository at this point in the history
  • Loading branch information
pjpegion authored Oct 1, 2020
2 parents 3cad1ba + c2aa2a8 commit 0a62737
Show file tree
Hide file tree
Showing 6 changed files with 59 additions and 6 deletions.
2 changes: 2 additions & 0 deletions config_src/nuopc_driver/mom_surface_forcing_nuopc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -298,6 +298,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
Expand Down
25 changes: 24 additions & 1 deletion src/core/MOM.F90
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,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
Expand Down Expand Up @@ -141,6 +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

implicit none ; private

Expand Down Expand Up @@ -227,6 +229,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]
Expand Down Expand Up @@ -757,6 +761,9 @@ 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)
Expand Down Expand Up @@ -904,7 +911,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_diag, CS%tv, ssh,fluxes%t_rp, CS%ave_ssh_ibc)
endif
call disable_averaging(CS%diag)
call cpu_clock_end(id_clock_diagnostics)
Expand Down Expand Up @@ -1672,6 +1679,11 @@ 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.
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
real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors
character(len=48) :: flux_units, S_flux_units
Expand Down Expand Up @@ -2328,6 +2340,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call copy_dyngrid_to_MOM_grid(dG_in, G_in, US)
call destroy_dyn_horgrid(dG_in)

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.
call set_first_direction(G, first_direction)
! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes.
Expand Down
13 changes: 13 additions & 0 deletions src/core/MOM_forcing_type.F90
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,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
Expand Down Expand Up @@ -238,6 +240,8 @@ 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 :: 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.
Expand Down Expand Up @@ -2078,6 +2082,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)
Expand Down Expand Up @@ -3021,6 +3031,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)
Expand Down Expand Up @@ -3176,6 +3187,7 @@ 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%p_surf)) deallocate(fluxes%p_surf)
if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal)
if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal)
Expand All @@ -3200,6 +3212,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)
Expand Down
16 changes: 14 additions & 2 deletions src/diagnostics/MOM_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -169,7 +169,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


Expand Down Expand Up @@ -1197,7 +1199,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
Expand All @@ -1208,6 +1210,8 @@ 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]

Expand Down Expand Up @@ -1332,6 +1336,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
Expand Down Expand Up @@ -1833,6 +1842,9 @@ 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

Expand Down
7 changes: 5 additions & 2 deletions src/framework/MOM_domains.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,11 @@ 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 : 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, 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
Expand Down Expand Up @@ -35,7 +38,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
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
Expand Down
2 changes: 1 addition & 1 deletion src/parameterizations/vertical/MOM_energetic_PBL.F90
Original file line number Diff line number Diff line change
Expand Up @@ -435,7 +435,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
Expand Down

0 comments on commit 0a62737

Please sign in to comment.