Skip to content

Commit 3042eff

Browse files
iangroomsiangrooms
committed
Code cleanup
This commit does two main things. First it cleans up various code style infractions noted by Bob Hallberg. Second, it updates the API for the stochastic physics package.
1 parent 35ed06b commit 3042eff

File tree

4 files changed

+46
-42
lines changed

4 files changed

+46
-42
lines changed

‎src/ALE/MOM_ALE.F90

+4
Original file line numberDiff line numberDiff line change
@@ -1174,6 +1174,10 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u
11741174
ke_c_tgt = ke_c_tgt + h2(k) * (u_tgt(k) - u_bt)**2
11751175
enddo
11761176
! Next rescale baroclinic component on target grid to conserve ke
1177+
! The values 1.5625 = 1.25**2 and 1.25 below mean that the KE-conserving
1178+
! correction cannot amplify the baroclinic part of velocity by more
1179+
! than 25%. This threshold is somewhat arbitrary. It was added to
1180+
! prevent unstable behavior when the amplification factor is large.
11771181
if (ke_c_src < 1.5625 * ke_c_tgt) then
11781182
rescale_coef = sqrt(ke_c_src / ke_c_tgt)
11791183
else

‎src/core/MOM_dynamics_split_RK2.F90

+1-1
Original file line numberDiff line numberDiff line change
@@ -333,7 +333,7 @@ subroutine step_MOM_dyn_split_RK2(u_inst, v_inst, h, tv, visc, Time_local, dt, f
333333
type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing
334334
!! interface height diffusivities
335335
type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics
336-
type(stochastic_CS), intent(inout) :: STOCH !< Stochastic control structure
336+
type(stochastic_CS), optional, intent(inout) :: STOCH !< Stochastic control structure
337337
type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing
338338
!! fields related to the surface wave conditions
339339

‎src/parameterizations/lateral/MOM_thickness_diffuse.F90

+9-3
Original file line numberDiff line numberDiff line change
@@ -1614,10 +1614,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
16141614
MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h
16151615
endif ; endif
16161616
if (skeb_use_gm) then
1617-
h_tot = sum(h(i,j,1:nz))
1617+
h_tot = 0.0
1618+
do k=1,nz
1619+
h_tot = h_tot + h(i,j,nz)
1620+
enddo
16181621
skeb_gm_work(i,j) = STOCH%skeb_gm_coef * Work_h
1619-
skeb_ebt_norm2(i,j) = GV%H_to_RZ * &
1620-
(sum(h(i,j,1:nz) * VarMix%ebt_struct(i,j,1:nz)**2) + h_neglect)
1622+
skeb_ebt_norm2(i,j) = 0.0
1623+
do k=1,nz
1624+
skeb_ebt_norm2(i,j) = skeb_ebt_norm2(i,j) + h(i,j,k) * VarMix%ebt_struct(i,j,k)**2
1625+
enddo
1626+
skeb_ebt_norm2(i,j) = GV%H_to_RZ * (skeb_ebt_norm2(i,j) + h_neglect)
16211627
endif
16221628
enddo ; enddo ; endif
16231629

‎src/parameterizations/stochastic/MOM_stochastics.F90

+32-38
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ module MOM_stochastics
3434
!> This control structure holds parameters for the MOM_stochastics module
3535
type, public:: stochastic_CS
3636
logical :: do_sppt !< If true, stochastically perturb the diabatic
37-
logical :: do_skeb !< If true, stochastically perturb the diabatic
37+
logical :: do_skeb !< If true, stochastically perturb the horizontal velocity
3838
logical :: skeb_use_gm !< If true, adds GM work to the amplitude of SKEBS
3939
logical :: skeb_use_frict !< If true, adds viscous dissipation rate to the amplitude of SKEBS
4040
logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms
@@ -155,29 +155,29 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time)
155155
default=.false.)
156156

157157
if (CS%do_sppt .OR. CS%pert_epbl .OR. CS%do_skeb) then
158-
num_procs = num_PEs()
159-
allocate(pelist(num_procs))
160-
call Get_PElist(pelist,commID = mom_comm)
161-
pe_zero = root_PE()
162-
nxT = grid%ied - grid%isd + 1
163-
nyT = grid%jed - grid%jsd + 1
164-
nxB = grid%iedB - grid%isdB + 1
165-
nyB = grid%jedB - grid%jsdB + 1
166-
call init_stochastic_physics_ocn(dt, grid%geoLonT, grid%geoLatT, nxT, nyT, GV%ke, &
167-
grid%geoLonBu, grid%geoLatBu, nxB, nyB, &
168-
CS%pert_epbl, CS%do_sppt, CS%do_skeb, pe_zero, mom_comm, iret)
169-
if (iret/=0) then
170-
call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed")
171-
return
172-
endif
173-
174-
if (CS%do_sppt) allocate(CS%sppt_wts(grid%isd:grid%ied,grid%jsd:grid%jed))
175-
if (CS%do_skeb) allocate(CS%skeb_wts(grid%isdB:grid%iedB,grid%jsdB:grid%jedB))
176-
if (CS%do_skeb) allocate(CS%skeb_diss(grid%isd:grid%ied,grid%jsd:grid%jed,GV%ke), source=0.)
177-
if (CS%pert_epbl) then
178-
allocate(CS%epbl1_wts(grid%isd:grid%ied,grid%jsd:grid%jed))
179-
allocate(CS%epbl2_wts(grid%isd:grid%ied,grid%jsd:grid%jed))
180-
endif
158+
num_procs = num_PEs()
159+
allocate(pelist(num_procs))
160+
call Get_PElist(pelist,commID = mom_comm)
161+
pe_zero = root_PE()
162+
nxT = grid%ied - grid%isd + 1
163+
nyT = grid%jed - grid%jsd + 1
164+
nxB = grid%iedB - grid%isdB + 1
165+
nyB = grid%jedB - grid%jsdB + 1
166+
call init_stochastic_physics_ocn(dt, grid%geoLonT, grid%geoLatT, nxT, nyT, GV%ke, &
167+
grid%geoLonBu, grid%geoLatBu, nxB, nyB, &
168+
CS%pert_epbl, CS%do_sppt, CS%do_skeb, pe_zero, mom_comm, iret)
169+
if (iret/=0) then
170+
call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed")
171+
return
172+
endif
173+
174+
if (CS%do_sppt) allocate(CS%sppt_wts(grid%isd:grid%ied,grid%jsd:grid%jed))
175+
if (CS%do_skeb) allocate(CS%skeb_wts(grid%isdB:grid%iedB,grid%jsdB:grid%jedB))
176+
if (CS%do_skeb) allocate(CS%skeb_diss(grid%isd:grid%ied,grid%jsd:grid%jed,GV%ke), source=0.)
177+
if (CS%pert_epbl) then
178+
allocate(CS%epbl1_wts(grid%isd:grid%ied,grid%jsd:grid%jed))
179+
allocate(CS%epbl2_wts(grid%isd:grid%ied,grid%jsd:grid%jed))
180+
endif
181181
endif
182182

183183
CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', CS%diag%axesT1, Time, &
@@ -279,22 +279,20 @@ subroutine apply_skeb(grid,GV,CS,uc,vc,thickness,tv,dt,Time_end)
279279
type(time_type), intent(in) :: Time_end !< Time at the end of the interval
280280
! locals
281281

282-
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_,NKMEM_) :: psi
283-
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: ustar
284-
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: vstar
285-
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: diss_tmp
286-
287-
real, dimension(3,3) :: local_weights
282+
real, dimension(SZIB_(grid),SZJB_(grid),SZK_(GV)) :: psi !< Streamfunction for stochastic velocity increments
283+
!! [L2 T-1 ~> m2 s-1]
284+
real, dimension(SZIB_(grid),SZJ_(grid) ,SZK_(GV)) :: ustar !< Stochastic u velocity increment [L T-1 ~> m s-1]
285+
real, dimension(SZI_(grid) ,SZJB_(grid),SZK_(GV)) :: vstar !< Stochastic v velocity increment [L T-1 ~> m s-1]
286+
real, dimension(SZI_(grid),SZJ_(grid)) :: diss_tmp !< Temporary array used in smoothing skeb_diss
287+
!! [L2 T-3 ~> m2 s-2]
288+
real, dimension(3,3) :: local_weights !< 3x3 stencil weights used in smoothing skeb_diss
289+
!! [L2 ~> m2]
288290

289291
real :: shr,ten,tot,kh
290292
integer :: i,j,k,iter
291293
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
292294

293295
call callTree_enter("apply_skeb(), MOM_stochastics.F90")
294-
ALLOC_(diss_tmp(grid%isd:grid%ied,grid%jsd:grid%jed))
295-
ALLOC_(psi(grid%isdB:grid%iedB,grid%jsdB:grid%jedB,GV%ke))
296-
ALLOC_(ustar(grid%isdB:grid%iedB,grid%jsd:grid%jed,GV%ke))
297-
ALLOC_(vstar(grid%isd:grid%ied,grid%jsdB:grid%jedB,GV%ke))
298296

299297
if ((.not. CS%skeb_use_gm) .and. (.not. CS%skeb_use_frict)) then
300298
! fill in halos with zeros
@@ -382,10 +380,6 @@ subroutine apply_skeb(grid,GV,CS,uc,vc,thickness,tv,dt,Time_end)
382380
call post_data(CS%id_psi, psi(:,:,:), CS%diag)
383381
endif
384382
call disable_averaging(CS%diag)
385-
DEALLOC_(diss_tmp)
386-
DEALLOC_(ustar)
387-
DEALLOC_(vstar)
388-
DEALLOC_(psi)
389383
CS%skeb_diss(:,:,:) = 0.0 ! Must zero before next time step.
390384

391385
call callTree_leave("apply_skeb(), MOM_stochastics.F90")

0 commit comments

Comments
 (0)