Skip to content

Commit

Permalink
(*)Revise 13 diagnostics for rotational symmetry
Browse files Browse the repository at this point in the history 
  Refactored 10 diagnostics related to terms in the kinetic energy budgets and
2 diagnostics of nonlinear relative-vorticity related accelerations to respect
rotational symmetry.  These diagnostics are mathematically equivalent but will
change at roundoff due to changes in the order of arthmetic.  Only diagnostics
are changed, and the solutions themselves are bitwise identical in all cases.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Apr 20, 2024
1 parent f7a4491 commit fcc3f32
Show file tree
Hide file tree
Showing 3 changed files with 20 additions and 20 deletions.
16 changes: 8 additions & 8 deletions src/core/MOM_CoriolisAdv.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -902,20 +902,20 @@ 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) = -G%IdyCv(i,J) * C1_12 * &
((q2(I,J) + q2(I-1,J) + q2(I-1,J-1)) * uh(I-1,j,k) + &
(q2(I-1,J) + q2(I,J) + q2(I,J-1)) * uh(I,j,k) + &
(q2(I-1,J) + q2(I,J+1) + q2(I,J)) * uh(I,j+1,k) + &
(q2(I,J) + q2(I-1,J+1) + q2(I-1,J)) * uh(I-1,j+1,k))
(((((q2(I,J) + q2(I-1,J-1)) + q2(I-1,J)) * uh(I-1,j,k)) + &
(((q2(I-1,J) + q2(I,J+1)) + q2(I,J)) * uh(I,j+1,k))) + &
((((q2(I-1,J) + q2(I,J-1)) + q2(I,J)) * uh(I,j,k))+ &
(((q2(I,J) + q2(I-1,J+1)) + q2(I-1,J)) * uh(I-1,j+1,k))))
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) = G%IdxCu(I,j) * C1_12 * &
((q2(I+1,J) + q2(I,J) + q2(I,J-1)) * vh(i+1,J,k) + &
(q2(I-1,J) + q2(I,J) + q2(I,J-1)) * vh(i,J,k) + &
(q2(I-1,J-1) + q2(I,J) + q2(I,J-1)) * vh(i,J-1,k) + &
(q2(I+1,J-1) + q2(I,J) + q2(I,J-1)) * vh(i+1,J-1,k))
(((((q2(I+1,J) + q2(I,J-1)) + q2(I,J)) * vh(i+1,J,k)) + &
(((q2(I-1,J-1) + q2(I,J)) + q2(I,J-1)) * vh(i,J-1,k))) + &
((((q2(I-1,J) + q2(I,J-1)) + q2(I,J)) * vh(i,J,k)) + &
(((q2(I+1,J-1) + q2(I,J)) + q2(I,J-1)) * vh(i+1,J-1,k))))
enddo ; enddo
endif
endif
Expand Down
20 changes: 10 additions & 10 deletions src/diagnostics/MOM_diagnostics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -999,7 +999,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_dKEdt, KE_term, CS%diag)
Expand All @@ -1018,7 +1018,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, KE_term, CS%diag)
Expand All @@ -1037,7 +1037,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_KE_BT, KE_term, CS%diag)
Expand All @@ -1056,13 +1056,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
enddo ; enddo
do j=js,je ; do i=is,ie
KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) &
* (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k))
* ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k)))
enddo ; enddo
if (.not.G%symmetric) &
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_KE_Coradv, KE_term, CS%diag)
Expand All @@ -1085,13 +1085,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
enddo ; enddo
do j=js,je ; do i=is,ie
KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) &
* (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k))
* ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k)))
enddo ; enddo
if (.not.G%symmetric) &
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_KE_adv, KE_term, CS%diag)
Expand All @@ -1110,7 +1110,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_KE_visc, KE_term, CS%diag)
Expand Down Expand Up @@ -1167,7 +1167,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_KE_horvisc, KE_term, CS%diag)
Expand All @@ -1189,7 +1189,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS
call do_group_pass(CS%pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo
call post_data(CS%id_KE_dia, KE_term, CS%diag)
Expand Down
4 changes: 2 additions & 2 deletions src/parameterizations/lateral/MOM_Zanna_Bolton.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1083,7 +1083,7 @@ subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS)
call do_group_pass(pass_KE_uv, G%domain)
do j=js,je ; do i=is,ie
KE_term(i,j,k) = 0.5 * G%IareaT(i,j) &
* (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))
* ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1)))
enddo ; enddo
enddo

Expand All @@ -1096,4 +1096,4 @@ subroutine compute_energy_source(u, v, h, fx, fy, G, GV, CS)

end subroutine compute_energy_source

end module MOM_Zanna_Bolton
end module MOM_Zanna_Bolton

0 comments on commit fcc3f32

Please sign in to comment.