From fcc3f32e76f1c5bffb4b6e86ee562951191f73cb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 20 Apr 2024 07:08:15 -0400 Subject: [PATCH] (*)Revise 13 diagnostics for rotational symmetry 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. --- src/core/MOM_CoriolisAdv.F90 | 16 +++++++-------- src/diagnostics/MOM_diagnostics.F90 | 20 +++++++++---------- .../lateral/MOM_Zanna_Bolton.F90 | 4 ++-- 3 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 056b171ba8..00a289ab9a 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -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 diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index aeb25bc351..167b2e81f3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -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) @@ -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) @@ -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) @@ -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) @@ -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) @@ -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) @@ -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) @@ -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) diff --git a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 index b49d123377..f472118e7d 100644 --- a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 +++ b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 @@ -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 @@ -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 \ No newline at end of file +end module MOM_Zanna_Bolton