Skip to content

Commit

Permalink
MEKE: Move flag test outside of FrictWork loop
Browse files Browse the repository at this point in the history 
The if-test inside of the FrictWork loops are likely to impede
performance.  Even if the total work is reduced, they are likely to
interrupt pipelines.  When EY24_EBT_BS is disabled, they will clearly
reduce performance.

This patch moves those tests outside of the if-block and applies them
separately.

(Calculation would be slightly improved if the meaning of the flag were
reversed, but I don't want to make additional changes.)
  • Loading branch information
@marshallward
marshallward committed Dec 17, 2024
1 parent aec6c0d commit 0795212
Showing 1 changed file with 71 additions and 74 deletions.
145 changes: 71 additions & 74 deletions src/parameterizations/lateral/MOM_hor_visc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -482,12 +482,14 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
inv_PI2 = 1.0/((4.0*atan(1.0))**2)
inv_PI6 = inv_PI3 * inv_PI3

visc_limit_h(:,:,:) = 0.
visc_limit_q(:,:,:) = 0.
visc_limit_h_flag(:,:,:) = 0.
visc_limit_q_flag(:,:,:) = 0.
visc_limit_h_frac(:,:,:) = 0.
visc_limit_q_frac(:,:,:) = 0.
if (CS%EY24_EBT_BS) then
visc_limit_h(:,:,:) = 0.
visc_limit_q(:,:,:) = 0.
visc_limit_h_flag(:,:,:) = 0.
visc_limit_q_flag(:,:,:) = 0.
visc_limit_h_frac(:,:,:) = 0.
visc_limit_q_frac(:,:,:) = 0.
endif

m_leithy(:,:) = 0.0 ! Initialize

Expand Down Expand Up @@ -1946,33 +1948,27 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,

if (find_FrictWork) then
if (CS%FrictWork_bug) then
! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
! This is the old formulation that includes energy diffusion
do j=js,je ; do i=is,ie
! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
! This is the old formulation that includes energy diffusion
if (visc_limit_h_flag(i,j,k) > 0) then
FrictWork(i,j,k) = 0
else
FrictWork(i,j,k) = GV%H_to_RZ * ( &
((str_xx(i,j) * (u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j)) &
- (str_xx(i,j) * (v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j))) &
+ 0.25*(( (str_xy(I,J) * &
(((u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J)) &
+ ((v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J)))) &
+ (str_xy(I-1,J-1) * &
(((u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1)) &
+ ((v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1)))) ) &
+ ( (str_xy(I-1,J) * &
(((u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J)) &
+ ((v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J)))) &
+ (str_xy(I,J-1) * &
(((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1)) &
+ ((v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)))) ) ) )
endif
FrictWork(i,j,k) = GV%H_to_RZ * ( &
((str_xx(i,j) * (u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j)) &
- (str_xx(i,j) * (v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j))) &
+ 0.25*(( (str_xy(I,J) * &
(((u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J)) &
+ ((v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J)))) &
+ (str_xy(I-1,J-1) * &
(((u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1)) &
+ ((v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1)))) ) &
+ ( (str_xy(I-1,J) * &
(((u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J)) &
+ ((v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J)))) &
+ (str_xy(I,J-1) * &
(((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1)) &
+ ((v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)))) ) ) )
enddo ; enddo
else ; do j=js,je ; do i=is,ie
if (visc_limit_h_flag(i,j,k) > 0) then
FrictWork(i,j,k) = 0
else
else
do j=js,je ; do i=is,ie
FrictWork(i,j,k) = GV%H_to_RZ * G%IareaT(i,j) * ( &
((str_xx(i,j)*CS%dy2h(i,j) * ( &
(uh(I,j,k)*G%dxCu(I,j)*G%IdyCu(I,j)*G%IareaCu(I,j)/(h_u(I,j)+h_neglect)) &
Expand Down Expand Up @@ -2001,19 +1997,21 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
+ (CS%dy2q(I,J-1)*((vh(i+1,J-1,k)*G%IareaCv(i+1,J-1)/(h_v(i+1,J-1)+h_neglect)) &
- (vh(i,J-1,k)*G%IareaCv(i,J-1)/(h_v(i,J-1)+h_neglect)))) )) ) )) )

endif
enddo ; enddo ; endif
enddo ; enddo
endif

if (CS%EY24_EBT_BS) then
do j=js,je ; do i=is,ie
FrictWork(i,j,k) = (1. - visc_limit_h_flag(i,j,k)) * FrictWork(i,j,k)
enddo ; enddo
endif
endif

if (CS%id_FrictWork_bh>0 .or. CS%id_FrictWorkIntz_bh > 0 .or. allocated(MEKE%mom_src_bh)) then
if (CS%FrictWork_bug) then ; do j=js,je ; do i=is,ie
! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v)
! This is the old formulation that includes energy diffusion
if (visc_limit_h_flag(i,j,k) > 0) then
FrictWork_bh(i,j,k) = 0
else
if (CS%FrictWork_bug) then
! Diagnose bhstr_xx*d_x u - bhstr_yy*d_y v + bhstr_xy*(d_y u + d_x v)
! This is the old formulation that includes energy diffusion !cyc
do j=js,je ; do i=is,ie
FrictWork_bh(i,j,k) = GV%H_to_RZ * ( &
(bhstr_xx(i,j) * (u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
- bhstr_xx(i,j) * (v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
Expand All @@ -2029,12 +2027,9 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
+ bhstr_xy(I,J-1) * &
((u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) &
+ (v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1)) ) ) )
endif
enddo ; enddo
else ; do j=js,je ; do i=is,ie
if (visc_limit_h_flag(i,j,k) > 0) then
FrictWork_bh(i,j,k) = 0
else
enddo ; enddo
else
do j=js,je ; do i=is,ie
! Diagnose bhstr_xx*d_x u - bhstr_yy*d_y v + bhstr_xy*(d_y u + d_x v)
FrictWork_bh(i,j,k) = GV%H_to_RZ * G%IareaT(i,j) * ( &
((bhstr_xx(i,j)*CS%dy2h(i,j) * ( &
Expand Down Expand Up @@ -2063,11 +2058,15 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
- (uh(I,j-1,k)*G%IareaCu(I,j-1)/(h_u(I,j-1)+h_neglect)))) &
+ (CS%dy2q(I,J-1)*((vh(i+1,J-1,k)*G%IareaCv(i+1,J-1)/(h_v(i+1,J-1)+h_neglect)) &
- (vh(i,J-1,k)*G%IareaCv(i,J-1)/(h_v(i,J-1)+h_neglect)))) )) ) )) )
endif
enddo ; enddo ; endif
endif

enddo ; enddo
endif

if (CS%EY24_EBT_BS) then
do j=js,je ; do i=is,ie
FrictWork_bh(i,j,k) = (1. - visc_limit_h_flag(i,j,k)) * FrictWork_bh(i,j,k)
enddo ; enddo
endif
endif

if (CS%use_GME) then
if (CS%FrictWork_bug) then ; do j=js,je ; do i=is,ie
Expand Down Expand Up @@ -2117,7 +2116,6 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
- (uh(I,j-1,k)*G%IareaCu(I,j-1)/(h_u(I,j-1)+h_neglect)))) &
+ (CS%dy2q(I,J-1)*((vh(i+1,J-1,k)*G%IareaCv(i+1,J-1)/(h_v(i+1,J-1)+h_neglect)) &
- (vh(i,J-1,k)*G%IareaCv(i,J-1)/(h_v(i,J-1)+h_neglect)))) )) ) )) )

enddo ; enddo ; endif
endif

Expand Down Expand Up @@ -2232,9 +2230,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k)
enddo ; enddo
endif

endif ! find_FrictWork and associated(mom_src)

enddo ! end of k loop

! Offer fields for diagnostic averaging.
Expand Down Expand Up @@ -2263,16 +2259,15 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G,
if (CS%id_dudy_bt > 0) call post_data(CS%id_dudy_bt, dudy_bt, CS%diag)
if (CS%id_dvdx_bt > 0) call post_data(CS%id_dvdx_bt, dvdx_bt, CS%diag)
endif
if (CS%id_visc_limit_h>0) call post_data(CS%id_visc_limit_h, visc_limit_h, CS%diag)
if (CS%id_visc_limit_q>0) call post_data(CS%id_visc_limit_q, visc_limit_q, CS%diag)
if (CS%id_visc_limit_h_frac>0) call post_data(CS%id_visc_limit_h_frac, visc_limit_h_frac, CS%diag)
if (CS%id_visc_limit_q_frac>0) call post_data(CS%id_visc_limit_q_frac, visc_limit_q_frac, CS%diag)
if (CS%id_visc_limit_h_flag>0) call post_data(CS%id_visc_limit_h_flag, visc_limit_h_flag, CS%diag)
if (CS%id_visc_limit_q_flag>0) call post_data(CS%id_visc_limit_q_flag, visc_limit_q_flag, CS%diag)

if (CS%EY24_EBT_BS) then
if (CS%id_BS_coeff_h>0) call post_data(CS%id_BS_coeff_h, BS_coeff_h, CS%diag)
if (CS%id_BS_coeff_q>0) call post_data(CS%id_BS_coeff_q, BS_coeff_q, CS%diag)
if (CS%EY24_EBT_BS > 0) then
if (CS%id_visc_limit_h>0) call post_data(CS%id_visc_limit_h, visc_limit_h, CS%diag)
if (CS%id_visc_limit_q>0) call post_data(CS%id_visc_limit_q, visc_limit_q, CS%diag)
if (CS%id_visc_limit_h_frac>0) call post_data(CS%id_visc_limit_h_frac, visc_limit_h_frac, CS%diag)
if (CS%id_visc_limit_q_frac>0) call post_data(CS%id_visc_limit_q_frac, visc_limit_q_frac, CS%diag)
if (CS%id_visc_limit_h_flag>0) call post_data(CS%id_visc_limit_h_flag, visc_limit_h_flag, CS%diag)
if (CS%id_visc_limit_q_flag>0) call post_data(CS%id_visc_limit_q_flag, visc_limit_q_flag, CS%diag)
if (CS%id_BS_coeff_h>0) call post_data(CS%id_BS_coeff_h, BS_coeff_h, CS%diag)
if (CS%id_BS_coeff_q>0) call post_data(CS%id_BS_coeff_q, BS_coeff_q, CS%diag)
endif

if (CS%debug) then
Expand Down Expand Up @@ -3210,18 +3205,20 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T)
CS%id_grid_Re_Ah = register_diag_field('ocean_model', 'grid_Re_Ah', diag%axesTL, Time, &
'Grid Reynolds number for the Biharmonic horizontal viscosity at h points', 'nondim')
CS%id_visc_limit_h_flag = register_diag_field('ocean_model', 'visc_limit_h_flag', diag%axesTL, Time, &
'Locations where the biharmonic viscosity reached the better_bound limiter at h points', 'nondim')
CS%id_visc_limit_q_flag = register_diag_field('ocean_model', 'visc_limit_q_flag', diag%axesBL, Time, &
'Locations where the biharmonic viscosity reached the better_bound limiter at q points', 'nondim')
CS%id_visc_limit_h = register_diag_field('ocean_model', 'visc_limit_h', diag%axesTL, Time, &
'Value of the biharmonic viscosity limiter at h points', 'nondim')
CS%id_visc_limit_q = register_diag_field('ocean_model', 'visc_limit_q', diag%axesBL, Time, &
'Value of the biharmonic viscosity limiter at q points', 'nondim')
CS%id_visc_limit_h_frac = register_diag_field('ocean_model', 'visc_limit_h_frac', diag%axesTL, Time, &
'Value of the biharmonic viscosity limiter at h points', 'nondim')
CS%id_visc_limit_q_frac = register_diag_field('ocean_model', 'visc_limit_q_frac', diag%axesBL, Time, &
'Value of the biharmonic viscosity limiter at q points', 'nondim')
if (CS%EY24_EBT_BS) then
CS%id_visc_limit_h_flag = register_diag_field('ocean_model', 'visc_limit_h_flag', diag%axesTL, Time, &
'Locations where the biharmonic viscosity reached the better_bound limiter at h points', 'nondim')
CS%id_visc_limit_q_flag = register_diag_field('ocean_model', 'visc_limit_q_flag', diag%axesBL, Time, &
'Locations where the biharmonic viscosity reached the better_bound limiter at q points', 'nondim')
CS%id_visc_limit_h = register_diag_field('ocean_model', 'visc_limit_h', diag%axesTL, Time, &
'Value of the biharmonic viscosity limiter at h points', 'nondim')
CS%id_visc_limit_q = register_diag_field('ocean_model', 'visc_limit_q', diag%axesBL, Time, &
'Value of the biharmonic viscosity limiter at q points', 'nondim')
CS%id_visc_limit_h_frac = register_diag_field('ocean_model', 'visc_limit_h_frac', diag%axesTL, Time, &
'Value of the biharmonic viscosity limiter at h points', 'nondim')
CS%id_visc_limit_q_frac = register_diag_field('ocean_model', 'visc_limit_q_frac', diag%axesBL, Time, &
'Value of the biharmonic viscosity limiter at q points', 'nondim')
endif

if (CS%id_grid_Re_Ah > 0) &
! Compute the smallest biharmonic viscosity capable of modifying the
Expand Down

0 comments on commit 0795212

Please sign in to comment.