Skip to content

Commit

Permalink
(*)Parenthesize diagnostics for FMAs
Browse files Browse the repository at this point in the history 
  Added parentheses to 9 diagnostics of Coriolis accelerations or expressions
used in the kinetic energy budgets to give rotationally consistent solutions
when fused-multiply-adds are enabled.  All answers are bitwise identical in
cases without FMAs, but answers could change when FMAs are enabled.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Jul 29, 2024
1 parent 44f1130 commit 182223c
Show file tree
Hide file tree
Showing 3 changed files with 19 additions and 19 deletions.
8 changes: 4 additions & 4 deletions src/core/MOM_CoriolisAdv.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -886,16 +886,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
if (associated(AD%rv_x_u)) then
do J=Jsq,Jeq ; do i=is,ie
AD%rv_x_u(i,J,k) = - 0.25* &
(q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + &
q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J)
((q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k))) + &
(q2(I,j)*(uh(I,j,k) + uh(I,j+1,k)))) * G%IdyCv(i,J)
enddo ; enddo
endif

if (associated(AD%rv_x_v)) then
do j=js,je ; do I=Isq,Ieq
AD%rv_x_v(I,j,k) = 0.25 * &
(q2(I,j) * (vh(i+1,J,k) + vh(i,J,k)) + &
q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j)
((q2(I,j) * (vh(i+1,J,k) + vh(i,J,k))) + &
(q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k)))) * G%IdxCu(I,j)
enddo ; enddo
endif
else
Expand Down
24 changes: 12 additions & 12 deletions src/diagnostics/MOM_diagnostics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -682,10 +682,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
mag_beta = sqrt(0.5 * ( &
(((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + &
((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + &
(((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + &
((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ))
((((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) + &
(((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2)) + &
((((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2) + &
(((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2)) ))
Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta)

enddo ; enddo
Expand Down Expand Up @@ -732,10 +732,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
(G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
mag_beta = sqrt(0.5 * ( &
(((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + &
((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + &
(((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + &
((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ))
((((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) + &
(((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2)) + &
((((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2) + &
(((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2)) ))
Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta)

enddo ; enddo
Expand Down Expand Up @@ -975,8 +975,8 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
enddo ; enddo

do k=1,nz ; do j=js,je ; do i=is,ie
KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) &
+ (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25
KE(i,j,k) = (((u(I,j,k) * u(I,j,k)) + (u(I-1,j,k) * u(I-1,j,k))) &
+ ((v(i,J,k) * v(i,J,k)) + (v(i,J-1,k) * v(i,J-1,k)))) * 0.25
enddo ; enddo ; enddo
if (CS%id_KE > 0) call post_data(CS%id_KE, KE, CS%diag)

Expand Down Expand Up @@ -1301,8 +1301,8 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh)

if (IDs%id_speed > 0) then
do j=js,je ; do i=is,ie
speed(i,j) = sqrt(0.5*(sfc_state%u(I-1,j)**2 + sfc_state%u(I,j)**2) + &
0.5*(sfc_state%v(i,J-1)**2 + sfc_state%v(i,J)**2))
speed(i,j) = sqrt(0.5*((sfc_state%u(I-1,j)**2) + (sfc_state%u(I,j)**2)) + &
0.5*((sfc_state%v(i,J-1)**2) + (sfc_state%v(i,J)**2)))
enddo ; enddo
call post_data(IDs%id_speed, speed, diag, mask=G%mask2dT)
endif
Expand Down
6 changes: 3 additions & 3 deletions src/parameterizations/lateral/MOM_hor_visc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1180,7 +1180,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,

if (CS%id_grid_Re_Kh>0) then
do j=js,je ; do i=is,ie
KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2)
KE = 0.125*(((u(I,j,k)+u(I-1,j,k))**2) + ((v(i,J,k)+v(i,J-1,k))**2))
grid_Kh = max(Kh(i,j), CS%min_grid_Kh)
grid_Re_Kh(i,j,k) = (sqrt(KE) * sqrt(CS%grid_sp_h2(i,j))) / grid_Kh
enddo ; enddo
Expand Down Expand Up @@ -1319,7 +1319,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,

if (CS%Re_Ah > 0.0) then
do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2)
KE = 0.125*(((u(I,j,k)+u(I-1,j,k))**2) + ((v(i,J,k)+v(i,J-1,k))**2))
Ah(i,j) = sqrt(KE) * CS%Re_Ah_const_xx(i,j)
enddo ; enddo
endif
Expand Down Expand Up @@ -1353,7 +1353,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,

if (CS%id_grid_Re_Ah>0) then
do j=js,je ; do i=is,ie
KE = 0.125 * ((u(I,j,k) + u(I-1,j,k))**2 + (v(i,J,k) + v(i,J-1,k))**2)
KE = 0.125 * (((u(I,j,k) + u(I-1,j,k))**2) + ((v(i,J,k) + v(i,J-1,k))**2))
grid_Ah = max(Ah(i,j), CS%min_grid_Ah)
grid_Re_Ah(i,j,k) = (sqrt(KE) * CS%grid_sp_h3(i,j)) / grid_Ah
enddo ; enddo
Expand Down

0 comments on commit 182223c

Please sign in to comment.