Skip to content

Commit

Permalink
(*)Add parentheses for oblique OBCs with FMAs
Browse files Browse the repository at this point in the history 
  Added parentheses to 16 expressions setting the grad_gradient arrays with
oblique_grad open boundary conditions and setting cff_new with all kinds of
oblique boundary conditions so that they will be rotationally invariant when
fused-multiply-adds are enabled.  All answers are bitwise identical in cases
without FMAs, but answers with certain types of open boundary conditions could
change with FMAs.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Jul 29, 2024
1 parent f0e61f3 commit 4f710ef
Showing 1 changed file with 16 additions and 16 deletions.
32 changes: 16 additions & 16 deletions src/core/MOM_open_boundary.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2359,7 +2359,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
dhdy = segment%grad_normal(J,1,k)
endif
if (dhdt*dhdx < 0.0) dhdt = 0.0
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
rx_new = min(dhdt*dhdx, cff_new*rx_max)
ry_new = min(cff_new,max(dhdt*dhdy,-cff_new))
if (gamma_u < 1.0) then
Expand Down Expand Up @@ -2501,7 +2501,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
dhdy = segment%grad_tan(j+1,1,k)
endif
if (dhdt*dhdx < 0.0) dhdt = 0.0
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
rx_new = min(dhdt*dhdx, cff_new*rx_max)
ry_new = min(cff_new,max(dhdt*dhdy,-cff_new))
rx_tang_obl(I,J,k) = rx_new
Expand Down Expand Up @@ -2604,7 +2604,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
endif
if (dhdt*dhdx < 0.0) dhdt = 0.0

cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
rx_new = min(dhdt*dhdx, cff_new*rx_max)
ry_new = min(cff_new,max(dhdt*dhdy,-cff_new))
if (gamma_u < 1.0) then
Expand Down Expand Up @@ -2746,7 +2746,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
dhdy = segment%grad_tan(j+1,1,k)
endif
if (dhdt*dhdx < 0.0) dhdt = 0.0
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
rx_new = min(dhdt*dhdx, cff_new*rx_max)
ry_new = min(cff_new,max(dhdt*dhdy,-cff_new))
rx_tang_obl(I,J,k) = rx_new
Expand Down Expand Up @@ -2848,7 +2848,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
dhdx = segment%grad_normal(I,1,k)
endif
if (dhdt*dhdy < 0.0) dhdt = 0.0
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
ry_new = min(dhdt*dhdy, cff_new*ry_max)
rx_new = min(cff_new,max(dhdt*dhdx,-cff_new))
if (gamma_u < 1.0) then
Expand Down Expand Up @@ -2990,7 +2990,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
dhdx = segment%grad_tan(i+1,1,k)
endif
if (dhdt*dhdy < 0.0) dhdt = 0.0
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
ry_new = min(dhdt*dhdy, cff_new*ry_max)
rx_new = min(cff_new,max(dhdt*dhdx,-cff_new))
rx_tang_obl(I,J,k) = rx_new
Expand Down Expand Up @@ -3093,7 +3093,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
endif
if (dhdt*dhdy < 0.0) dhdt = 0.0

cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
ry_new = min(dhdt*dhdy, cff_new*ry_max)
rx_new = min(cff_new,max(dhdt*dhdx,-cff_new))
if (gamma_u < 1.0) then
Expand Down Expand Up @@ -3235,7 +3235,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US,
dhdx = segment%grad_tan(i+1,1,k)
endif
if (dhdt*dhdy < 0.0) dhdt = 0.0
cff_new = max(dhdx*dhdx + dhdy*dhdy, eps)
cff_new = max((dhdx*dhdx) + (dhdy*dhdy), eps)
ry_new = min(dhdt*dhdy, cff_new*ry_max)
rx_new = min(cff_new,max(dhdt*dhdx,-cff_new))
rx_tang_obl(I,J,k) = rx_new
Expand Down Expand Up @@ -3435,9 +3435,9 @@ subroutine gradient_at_q_points(G, GV, segment, uvel, vvel)
do k=1,GV%ke
do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1)
segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - &
(vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-2,j)
((vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1))) * G%mask2dCu(I-2,j)
segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - &
(vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I-1,j)
((vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1))) * G%mask2dCu(I-1,j)
enddo
enddo
endif
Expand All @@ -3461,9 +3461,9 @@ subroutine gradient_at_q_points(G, GV, segment, uvel, vvel)
do k=1,GV%ke
do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1)
segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - &
(vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j)
((vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1))) * G%mask2dCu(I+2,j)
segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - &
(vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j)
((vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1))) * G%mask2dCu(I+1,j)
enddo
enddo
endif
Expand All @@ -3489,9 +3489,9 @@ subroutine gradient_at_q_points(G, GV, segment, uvel, vvel)
do k=1,GV%ke
do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1)
segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdyBu(I,J-2)) - &
(uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdyBu(I-1,J-2)) * G%mask2dCv(i,J-2)
((uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdyBu(I-1,J-2))) * G%mask2dCv(i,J-2)
segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - &
(uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J-1)
((uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1))) * G%mask2dCv(i,J-1)
enddo
enddo
endif
Expand All @@ -3515,9 +3515,9 @@ subroutine gradient_at_q_points(G, GV, segment, uvel, vvel)
do k=1,GV%ke
do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1)
segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdyBu(I,J+2)) - &
(uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2)
((uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2))) * G%mask2dCv(i,J+2)
segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdyBu(I,J+1)) - &
(uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1)
((uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1))) * G%mask2dCv(i,J+1)
enddo
enddo
endif
Expand Down

0 comments on commit 4f710ef

Please sign in to comment.