diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
index 1e56486329..97d3742749 100644
--- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
+++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
@@ -1088,10 +1088,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
tau_mag = 0.0 ; gustiness = CS%gust_const
if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + &
(G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0.0) then
- tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in_B(I,J)**2 + tauy_in_B(I,J)**2) + &
- G%mask2dBu(I-1,J-1)*(taux_in_B(I-1,J-1)**2 + tauy_in_B(I-1,J-1)**2)) + &
- (G%mask2dBu(I,J-1)*(taux_in_B(I,J-1)**2 + tauy_in_B(I,J-1)**2) + &
- G%mask2dBu(I-1,J)*(taux_in_B(I-1,J)**2 + tauy_in_B(I-1,J)**2)) ) / &
+ tau_mag = sqrt(((G%mask2dBu(I,J)*((taux_in_B(I,J)**2) + (tauy_in_B(I,J)**2)) + &
+ G%mask2dBu(I-1,J-1)*((taux_in_B(I-1,J-1)**2) + (tauy_in_B(I-1,J-1)**2))) + &
+ (G%mask2dBu(I,J-1)*((taux_in_B(I,J-1)**2) + (tauy_in_B(I,J-1)**2)) + &
+ G%mask2dBu(I-1,J)*((taux_in_B(I-1,J)**2) + (tauy_in_B(I-1,J)**2))) ) / &
((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) )
if (CS%read_gust_2d) gustiness = CS%gust(i,j)
endif
@@ -1105,7 +1105,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
enddo ; enddo
elseif (wind_stagger == AGRID) then
do j=js,je ; do i=is,ie
- tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2)
+ tau_mag = G%mask2dT(i,j) * sqrt((taux_in_A(i,j)**2) + (tauy_in_A(i,j)**2))
gustiness = CS%gust_const
if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0.0)) gustiness = CS%gust(i,j)
if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag)
@@ -1120,10 +1120,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
do j=js,je ; do i=is,ie
taux2 = 0.0 ; tauy2 = 0.0
if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0.0) &
- taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / &
+ taux2 = (G%mask2dCu(I-1,j)*(taux_in_C(I-1,j)**2) + G%mask2dCu(I,j)*(taux_in_C(I,j)**2)) / &
(G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0.0) &
- tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / &
+ tauy2 = (G%mask2dCv(i,J-1)*(tauy_in_C(i,J-1)**2) + G%mask2dCv(i,J)*(tauy_in_C(i,J)**2)) / &
(G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
tau_mag = sqrt(taux2 + tauy2)
diff --git a/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
index bb57810f5b..720046d517 100644
--- a/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
+++ b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
@@ -767,10 +767,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
tau_mag = 0.0 ; gustiness = CS%gust_const
if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + &
(G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0.0) then
- tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + &
- G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + &
- (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + &
- G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / &
+ tau_mag = sqrt(((G%mask2dBu(I,J)*((taux_at_q(I,J)**2) + (tauy_at_q(I,J)**2)) + &
+ G%mask2dBu(I-1,J-1)*((taux_at_q(I-1,J-1)**2) + (tauy_at_q(I-1,J-1)**2))) + &
+ (G%mask2dBu(I,J-1)*((taux_at_q(I,J-1)**2) + (tauy_at_q(I,J-1)**2)) + &
+ G%mask2dBu(I-1,J)*((taux_at_q(I-1,J)**2) + (tauy_at_q(I-1,J)**2))) ) / &
((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) )
if (CS%read_gust_2d) gustiness = CS%gust(i,j)
endif
@@ -800,9 +800,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
do j=js,je ; do i=is,ie
gustiness = CS%gust_const
if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0.0)) gustiness = CS%gust(i,j)
- forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)
+ forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt((taux_at_h(i,j)**2) + (tauy_at_h(i,j)**2))
forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * &
- sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2))
+ sqrt((taux_at_h(i,j)**2) + (tauy_at_h(i,j)**2)))
enddo ; enddo
else ! C-grid wind stresses.
@@ -813,13 +813,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
do j=js,je ; do i=is,ie
taux2 = 0.0
if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0.0) &
- taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + &
- G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
+ taux2 = (G%mask2dCu(I-1,j)*(forces%taux(I-1,j)**2) + &
+ G%mask2dCu(I,j)*(forces%taux(I,j)**2)) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
tauy2 = 0.0
if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0.0) &
- tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + &
- G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
+ tauy2 = (G%mask2dCv(i,J-1)*(forces%tauy(i,J-1)**2) + &
+ G%mask2dCv(i,J)*(forces%tauy(i,J)**2)) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
if (CS%read_gust_2d) then
forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(taux2 + tauy2)
diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
index e7d6c9abc6..5d09c58917 100644
--- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
+++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
@@ -829,10 +829,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
tau_mag = 0.0 ; gustiness = CS%gust_const
if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + &
(G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0.0) then
- tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + &
- G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + &
- (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + &
- G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / &
+ tau_mag = sqrt(((G%mask2dBu(I,J)*((taux_at_q(I,J)**2) + (tauy_at_q(I,J)**2)) + &
+ G%mask2dBu(I-1,J-1)*((taux_at_q(I-1,J-1)**2) + (tauy_at_q(I-1,J-1)**2))) + &
+ (G%mask2dBu(I,J-1)*((taux_at_q(I,J-1)**2) + (tauy_at_q(I,J-1)**2)) + &
+ G%mask2dBu(I-1,J)*((taux_at_q(I-1,J)**2) + (tauy_at_q(I-1,J)**2))) ) / &
((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) )
if (CS%read_gust_2d) gustiness = CS%gust(i,j)
endif
@@ -862,9 +862,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
do j=js,je ; do i=is,ie
gustiness = CS%gust_const
if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0.0)) gustiness = CS%gust(i,j)
- forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)
+ forces%tau_mag(i,j) = gustiness + G%mask2dT(i,j) * sqrt((taux_at_h(i,j)**2) + (tauy_at_h(i,j)**2))
forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * &
- sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2))
+ sqrt((taux_at_h(i,j)**2) + (tauy_at_h(i,j)**2)))
!forces%omega_w2x(i,j) = atan(tauy_at_h(i,j), taux_at_h(i,j))
enddo ; enddo
call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1)
@@ -876,13 +876,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
do j=js,je ; do i=is,ie
taux2 = 0.0
if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0.0) &
- taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + &
- G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
+ taux2 = (G%mask2dCu(I-1,j)*(forces%taux(I-1,j)**2) + &
+ G%mask2dCu(I,j)*(forces%taux(I,j)**2)) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
tauy2 = 0.0
if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0.0) &
- tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + &
- G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
+ tauy2 = (G%mask2dCv(i,J-1)*(forces%tauy(i,J-1)**2) + &
+ G%mask2dCv(i,J)*(forces%tauy(i,J)**2)) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
if (CS%read_gust_2d) then
forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(taux2 + tauy2)
diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90
index 3de43eec85..b2d92c00e7 100644
--- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90
+++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90
@@ -533,13 +533,13 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS)
! set the friction velocity
if (CS%answer_date < 20190101) then
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
- forces%tau_mag(i,j) = CS%gust_const + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ forces%tau_mag(i,j) = CS%gust_const + sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt(US%L_to_Z * ((CS%gust_const/CS%Rho0) + &
- sqrt(0.5*(forces%tauy(i,J-1)*forces%tauy(i,J-1) + forces%tauy(i,J)*forces%tauy(i,J) + &
- forces%taux(I-1,j)*forces%taux(I-1,j) + forces%taux(I,j)*forces%taux(I,j)))/CS%Rho0) )
+ sqrt(0.5*((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2) + &
+ (forces%taux(I-1,j)**2) + (forces%taux(I,j)**2)))/CS%Rho0) )
enddo ; enddo ; endif
else
call stresses_to_ustar(forces, G, US, CS)
@@ -743,19 +743,19 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS)
if (.not.read_Ustar) then
if (CS%read_gust_2d) then
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
- forces%tau_mag(i,j) = CS%gust(i,j) + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)
+ forces%tau_mag(i,j) = CS%gust(i,j) + sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
- tau_mag = CS%gust(i,j) + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)
+ tau_mag = CS%gust(i,j) + sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2))
forces%ustar(i,j) = sqrt(tau_mag * US%L_to_Z / CS%Rho0)
enddo ; enddo ; endif
else
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
- forces%tau_mag(i,j) = CS%gust_const + sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)
+ forces%tau_mag(i,j) = CS%gust_const + sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt(US%L_to_Z * (CS%gust_const/CS%Rho0 + &
- sqrt(temp_x(i,j)*temp_x(i,j) + temp_y(i,j)*temp_y(i,j)) / CS%Rho0) )
+ sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2)) / CS%Rho0) )
enddo ; enddo ; endif
endif
endif
@@ -797,25 +797,25 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS)
if (CS%read_gust_2d) then
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust(i,j) + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
tau_mag = CS%gust(i,j) + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
forces%ustar(i,j) = sqrt( tau_mag * US%L_to_Z / CS%Rho0 )
enddo ; enddo ; endif
else
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust_const + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt(US%L_to_Z * ( (CS%gust_const/CS%Rho0) + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))/CS%Rho0))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))/CS%Rho0))
enddo ; enddo ; endif
endif
endif
@@ -885,21 +885,21 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS)
if (CS%read_gust_2d) then
call data_override(G%Domain, 'gust', CS%gust, day, scale=US%Pa_to_RLZ_T2)
if (associated(forces%tau_mag)) then ; do j=G%jsc,G%jec ; do i=G%isc,G%iec
- forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust(i,j)
+ forces%tau_mag(i,j) = sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2)) + CS%gust(i,j)
enddo ; enddo ; endif
do j=G%jsc,G%jec ; do i=G%isc,G%iec
- tau_mag = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust(i,j)
+ tau_mag = sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2)) + CS%gust(i,j)
ustar_loc(i,j) = sqrt( tau_mag * US%L_to_Z / CS%Rho0 )
enddo ; enddo
else
if (associated(forces%tau_mag)) then
do j=G%jsc,G%jec ; do i=G%isc,G%iec
- forces%tau_mag(i,j) = sqrt(temp_x(i,j)**2 + temp_y(i,j)**2) + CS%gust_const
+ forces%tau_mag(i,j) = sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2)) + CS%gust_const
! ustar_loc(i,j) = sqrt( forces%tau_mag(i,j) * US%L_to_Z / CS%Rho0 )
enddo ; enddo
endif
do j=G%jsc,G%jec ; do i=G%isc,G%iec
- ustar_loc(i,j) = sqrt(US%L_to_Z * (sqrt(temp_x(i,j)**2 + temp_y(i,j)**2)/CS%Rho0 + &
+ ustar_loc(i,j) = sqrt(US%L_to_Z * (sqrt((temp_x(i,j)**2) + (temp_y(i,j)**2))/CS%Rho0 + &
CS%gust_const/CS%Rho0))
enddo ; enddo
endif
@@ -945,25 +945,25 @@ subroutine stresses_to_ustar(forces, G, US, CS)
if (CS%read_gust_2d) then
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust(i,j) + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
tau_mag = CS%gust(i,j) + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
forces%ustar(i,j) = sqrt( tau_mag * I_rho )
enddo ; enddo ; endif
else
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = CS%gust_const + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
enddo ; enddo ; endif
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
tau_mag = CS%gust_const + &
- sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + &
- (forces%taux(I-1,j)**2 + forces%taux(I,j)**2)))
+ sqrt(0.5*(((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)) + &
+ ((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2))))
forces%ustar(i,j) = sqrt( tau_mag * I_rho )
enddo ; enddo ; endif
endif
diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90
index 7d4ea94603..559291b225 100644
--- a/config_src/drivers/solo_driver/user_surface_forcing.F90
+++ b/config_src/drivers/solo_driver/user_surface_forcing.F90
@@ -91,8 +91,8 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS)
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
! This expression can be changed if desired, but need not be.
forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gust_const + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2)))
+ sqrt(0.5*((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2)) + &
+ 0.5*((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2))))
if (associated(forces%ustar)) &
forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(forces%tau_mag(i,j) * (US%L_to_Z/CS%Rho0))
enddo ; enddo ; endif
diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90
index 0814c6a907..8aaeb12654 100644
--- a/src/ALE/regrid_edge_values.F90
+++ b/src/ALE/regrid_edge_values.F90
@@ -748,10 +748,10 @@ subroutine end_value_h4(dz, u, Csys)
Wt(2,4) = -4.0 * I_h1234 * (I_h23 * (I_h123 + I_h234)) ! Wt*h1^3 > -4* (h1/h23)*(1+h1/h234)
Wt(3,4) = 4.0 * I_denom ! = 4.0*I_h1234 * I_h234 * I_h34 ! Wt*h1^3 < 4 * (h1/h234)*(h1/h34)
- Csys(1) = ((u(1) + Wt(1,1) * (u(2)-u(1))) + Wt(2,1) * (u(3)-u(2))) + Wt(3,1) * (u(4)-u(3))
- Csys(2) = (Wt(1,2) * (u(2)-u(1)) + Wt(2,2) * (u(3)-u(2))) + Wt(3,2) * (u(4)-u(3))
- Csys(3) = (Wt(1,3) * (u(2)-u(1)) + Wt(2,3) * (u(3)-u(2))) + Wt(3,3) * (u(4)-u(3))
- Csys(4) = (Wt(1,4) * (u(2)-u(1)) + Wt(2,4) * (u(3)-u(2))) + Wt(3,4) * (u(4)-u(3))
+ Csys(1) = ((u(1) + (Wt(1,1) * (u(2)-u(1)))) + (Wt(2,1) * (u(3)-u(2)))) + (Wt(3,1) * (u(4)-u(3)))
+ Csys(2) = ((Wt(1,2) * (u(2)-u(1))) + (Wt(2,2) * (u(3)-u(2)))) + (Wt(3,2) * (u(4)-u(3)))
+ Csys(3) = ((Wt(1,3) * (u(2)-u(1))) + (Wt(2,3) * (u(3)-u(2)))) + (Wt(3,3) * (u(4)-u(3)))
+ Csys(4) = ((Wt(1,4) * (u(2)-u(1))) + (Wt(2,4) * (u(3)-u(2)))) + (Wt(3,4) * (u(4)-u(3)))
! endif ! End of non-uniform layer thickness branch.
diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90
index 00a289ab9a..3cb78a1cb4 100644
--- a/src/core/MOM_CoriolisAdv.F90
+++ b/src/core/MOM_CoriolisAdv.F90
@@ -291,36 +291,36 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
if (Stokes_VF) then
if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- dvSdx(I,J) = ((-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - &
- (-Waves%us_y(i,J,k))*G%dyCv(i,J))
- duSdy(I,J) = ((-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - &
- (-Waves%us_x(I,j,k))*G%dxCu(I,j))
+ dvSdx(I,J) = (-Waves%us_y(i+1,J,k)*G%dyCv(i+1,J)) - &
+ (-Waves%us_y(i,J,k)*G%dyCv(i,J))
+ duSdy(I,J) = (-Waves%us_x(I,j+1,k)*G%dxCu(I,j+1)) - &
+ (-Waves%us_x(I,j,k)*G%dxCu(I,j))
enddo; enddo
endif
if (.not. Waves%Passive_Stokes_VF) then
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - &
- (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J))
- dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - &
- (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j))
+ dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J)) - &
+ ((v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J))
+ dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1)) - &
+ ((u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j))
enddo; enddo
else
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J))
- dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j))
+ dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J)) - (v(i,J,k)*G%dyCv(i,J))
+ dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1)) - (u(I,j,k)*G%dxCu(I,j))
enddo; enddo
endif
else
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J))
- dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j))
+ dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J)) - (v(i,J,k)*G%dyCv(i,J))
+ dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1)) - (u(I,j,k)*G%dxCu(I,j))
enddo; enddo
endif
do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2
- hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k))
+ hArea_v(i,J) = 0.5*((Area_h(i,j) * h(i,j,k)) + (Area_h(i,j+1) * h(i,j+1,k)))
enddo ; enddo
do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1
- hArea_u(I,j) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i+1,j) * h(i+1,j,k))
+ hArea_u(I,j) = 0.5*((Area_h(i,j) * h(i,j,k)) + (Area_h(i+1,j) * h(i+1,j,k)))
enddo ; enddo
if (CS%Coriolis_En_Dis) then
@@ -667,8 +667,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
! Energy conserving scheme, Sadourny 1975
do j=js,je ; do I=Isq,Ieq
CAu(I,j,k) = 0.25 * &
- (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + &
- q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j)
+ ((q(I,J) * (vh(i+1,J,k) + vh(i,J,k))) + &
+ (q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k)))) * G%IdxCu(I,j)
enddo ; enddo
endif
elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then
@@ -681,8 +681,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
(CS%Coriolis_Scheme == AL_BLEND)) then
! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990
do j=js,je ; do I=Isq,Ieq
- CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + &
- (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j)
+ CAu(I,j,k) = (((a(I,j) * vh(i+1,J,k)) + (c(I,j) * vh(i,J-1,k))) + &
+ ((b(I,j) * vh(i,J,k)) + (d(I,j) * vh(i+1,J-1,k)))) * G%IdxCu(I,j)
enddo ; enddo
elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then
! An enstrophy conserving scheme robust to vanishing layers
@@ -707,8 +707,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
(h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * G%IdxCu(I,j)
elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then
VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) )
- QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff &
- -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) )
+ QVHeff = 0.5*( ((abs_vort(I,J)+abs_vort(I,J-1))*VHeff) &
+ - ((abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff)) )
CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * G%IdxCu(I,j)
endif
enddo ; enddo
@@ -717,7 +717,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. &
(CS%Coriolis_Scheme == AL_BLEND)) then ; do j=js,je ; do I=Isq,Ieq
CAu(I,j,k) = CAu(I,j,k) + &
- (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * G%IdxCu(I,j)
+ ((ep_u(i,j)*uh(I-1,j,k)) - (ep_u(i+1,j)*uh(I+1,j,k))) * G%IdxCu(I,j)
enddo ; enddo ; endif
if (Stokes_VF) then
@@ -725,8 +725,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
! Computing the diagnostic Stokes contribution to CAu
do j=js,je ; do I=Isq,Ieq
CAuS(I,j,k) = 0.25 * &
- (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + &
- qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j)
+ ((qS(I,J) * (vh(i+1,J,k) + vh(i,J,k))) + &
+ (qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k)))) * G%IdxCu(I,j)
enddo ; enddo
endif
endif
@@ -786,8 +786,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
! Energy conserving scheme, Sadourny 1975
do J=Jsq,Jeq ; do i=is,ie
CAv(i,J,k) = - 0.25* &
- (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + &
- q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J)
+ ((q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k))) + &
+ (q(I,J)*(uh(I,j,k) + uh(I,j+1,k)))) * G%IdyCv(i,J)
enddo ; enddo
endif
elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then
@@ -800,10 +800,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
(CS%Coriolis_Scheme == AL_BLEND)) then
! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990
do J=Jsq,Jeq ; do i=is,ie
- CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + &
- c(I,j+1) * uh(I,j+1,k)) &
- + (b(I,j) * uh(I,j,k) + &
- d(I-1,j+1) * uh(I-1,j+1,k))) * G%IdyCv(i,J)
+ CAv(i,J,k) = - (((a(I-1,j) * uh(I-1,j,k)) + &
+ (c(I,j+1) * uh(I,j+1,k))) &
+ + ((b(I,j) * uh(I,j,k)) + &
+ (d(I-1,j+1) * uh(I-1,j+1,k)))) * G%IdyCv(i,J)
enddo ; enddo
elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then
! An enstrophy conserving scheme robust to vanishing layers
@@ -830,8 +830,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then
UHeff = ((uh(I ,j ,k)+uh(I-1,j+1,k)) + &
(uh(I-1,j ,k)+uh(I ,j+1,k)) )
- QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff &
- -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) )
+ QUHeff = 0.5*( ((abs_vort(I,J)+abs_vort(I-1,J))*UHeff) &
+ - ((abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff)) )
CAv(i,J,k) = - QUHeff / &
(h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J)
endif
@@ -841,7 +841,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. &
(CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie
CAv(i,J,k) = CAv(i,J,k) + &
- (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * G%IdyCv(i,J)
+ ((ep_v(i,j)*vh(i,J-1,k)) - (ep_v(i,j+1)*vh(i,J+1,k))) * G%IdyCv(i,J)
enddo ; enddo ; endif
if (Stokes_VF) then
@@ -849,8 +849,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav
! Computing the diagnostic Stokes contribution to CAv
do J=Jsq,Jeq ; do i=is,ie
CAvS(I,j,k) = 0.25 * &
- (qS(I,J) * (uh(I,j+1,k) + uh(I,j,k)) + &
- qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k))) * G%IdyCv(i,J)
+ ((qS(I,J) * (uh(I,j+1,k) + uh(I,j,k))) + &
+ (qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k)))) * G%IdyCv(i,J)
enddo; enddo
endif
endif
@@ -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
@@ -997,10 +997,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS)
! identified in Arakawa & Lamb 1982 as important for KE conservation. It
! also includes the possibility of partially-blocked tracer cell faces.
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) + &
- G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) + &
- ( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) + &
- G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) )*0.25*G%IareaT(i,j)
+ KE(i,j) = ( ( (G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k))) + &
+ (G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k))) ) + &
+ ( (G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k))) + &
+ (G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k))) ) )*0.25*G%IareaT(i,j)
enddo ; enddo
elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then
! The following discretization of KE is based on the one-dimensional Gudonov
diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90
index 6d982bc7e3..1529af9d83 100644
--- a/src/core/MOM_PressureForce_Montgomery.F90
+++ b/src/core/MOM_PressureForce_Montgomery.F90
@@ -337,14 +337,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb
do j=js,je ; do I=Isq,Ieq
! PFu_bc = p* grad alpha*
PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * &
- ((dp_star(i,j)*dp_star(i+1,j) + (p(i,j,K)*dp_star(i+1,j) + p(i+1,j,K)*dp_star(i,j))) / &
+ ((dp_star(i,j)*dp_star(i+1,j) + ((p(i,j,K)*dp_star(i+1,j)) + (p(i+1,j,K)*dp_star(i,j)))) / &
(dp_star(i,j) + dp_star(i+1,j))))
PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc
if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc
enddo ; enddo
do J=Jsq,Jeq ; do i=is,ie
PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * &
- ((dp_star(i,j)*dp_star(i,j+1) + (p(i,j,K)*dp_star(i,j+1) + p(i,j+1,K)*dp_star(i,j))) / &
+ ((dp_star(i,j)*dp_star(i,j+1) + ((p(i,j,K)*dp_star(i,j+1)) + (p(i,j+1,K)*dp_star(i,j)))) / &
(dp_star(i,j) + dp_star(i,j+1))))
PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc
if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc
@@ -586,15 +586,15 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce,
enddo ; enddo
do j=js,je ; do I=Isq,Ieq
PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (G%IdxCu(I,j) * &
- ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + &
- e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_star(i+1,j))))
+ ((h_star(i,j) * h_star(i+1,j) - ((e(i,j,K) * h_star(i+1,j)) + &
+ (e(i+1,j,K) * h_star(i,j)))) / (h_star(i,j) + h_star(i+1,j))))
PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc
if (allocated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc
enddo ; enddo
do J=Jsq,Jeq ; do i=is,ie
PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * &
- ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + &
- e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1))))
+ ((h_star(i,j) * h_star(i,j+1) - ((e(i,j,K) * h_star(i,j+1)) + &
+ (e(i,j+1,K) * h_star(i,j)))) / (h_star(i,j) + h_star(i,j+1))))
PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc
if (allocated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc
enddo ; enddo
diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90
index 83bfab0820..0d30cd8671 100644
--- a/src/core/MOM_barotropic.F90
+++ b/src/core/MOM_barotropic.F90
@@ -915,10 +915,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do J=js-1,je ; do I=is-1,ie
q(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / &
- (max((G%areaT(i,j) * max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0) + &
- G%areaT(i+1,j+1) * max(GV%Z_to_H*G%bathyT(i+1,j+1) + eta_in(i+1,j+1), 0.0)) + &
- (G%areaT(i+1,j) * max(GV%Z_to_H*G%bathyT(i+1,j) + eta_in(i+1,j), 0.0) + &
- G%areaT(i,j+1) * max(GV%Z_to_H*G%bathyT(i,j+1) + eta_in(i,j+1), 0.0)), h_neglect) )
+ (max(((G%areaT(i,j) * max(GV%Z_to_H*G%bathyT(i,j) + eta_in(i,j), 0.0)) + &
+ (G%areaT(i+1,j+1) * max(GV%Z_to_H*G%bathyT(i+1,j+1) + eta_in(i+1,j+1), 0.0))) + &
+ ((G%areaT(i+1,j) * max(GV%Z_to_H*G%bathyT(i+1,j) + eta_in(i+1,j), 0.0)) + &
+ (G%areaT(i,j+1) * max(GV%Z_to_H*G%bathyT(i,j+1) + eta_in(i,j+1), 0.0))), h_neglect) )
enddo ; enddo
else
!$OMP parallel do default(shared)
@@ -933,8 +933,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do J=js-1,je ; do I=is-1,ie
q(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / &
- (max((G%areaT(i,j) * eta_in(i,j) + G%areaT(i+1,j+1) * eta_in(i+1,j+1)) + &
- (G%areaT(i+1,j) * eta_in(i+1,j) + G%areaT(i,j+1) * eta_in(i,j+1)), h_neglect) )
+ (max(((G%areaT(i,j) * eta_in(i,j)) + (G%areaT(i+1,j+1) * eta_in(i+1,j+1))) + &
+ ((G%areaT(i+1,j) * eta_in(i+1,j)) + (G%areaT(i,j+1) * eta_in(i,j+1))), h_neglect) )
enddo ; enddo
endif
@@ -1477,14 +1477,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
!$OMP parallel do default(shared)
do j=js,je ; do I=is-1,ie
Cor_ref_u(I,j) = &
- ((azon(I,j) * vbt_Cor(i+1,j) + czon(I,j) * vbt_Cor(i ,j-1)) + &
- (bzon(I,j) * vbt_Cor(i ,j) + dzon(I,j) * vbt_Cor(i+1,j-1)))
+ (((azon(I,j) * vbt_Cor(i+1,j)) + (czon(I,j) * vbt_Cor(i ,j-1))) + &
+ ((bzon(I,j) * vbt_Cor(i ,j)) + (dzon(I,j) * vbt_Cor(i+1,j-1))))
enddo ; enddo
!$OMP parallel do default(shared)
do J=js-1,je ; do i=is,ie
Cor_ref_v(i,J) = -1.0 * &
- ((amer(I-1,j) * ubt_Cor(I-1,j) + cmer(I ,j+1) * ubt_Cor(I ,j+1)) + &
- (bmer(I ,j) * ubt_Cor(I ,j) + dmer(I-1,j+1) * ubt_Cor(I-1,j+1)))
+ (((amer(I-1,j) * ubt_Cor(I-1,j)) + (cmer(I ,j+1) * ubt_Cor(I ,j+1))) + &
+ ((bmer(I ,j) * ubt_Cor(I ,j)) + (dmer(I-1,j+1) * ubt_Cor(I-1,j+1))))
enddo ; enddo
! Now start new halo updates.
@@ -1645,16 +1645,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! gravity waves, but it is a conservative estimate since it ignores the
! stabilizing effect of the bottom drag.
Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (G%IareaT(i,j) * &
- ((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j)) + &
- gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + &
- (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + &
- gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + &
- ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) * CS%BT_Coriolis_scale**2 )
- H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j))**2 + (G%IdyT(i,j))**2), &
+ (((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j))) + &
+ (gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j)))) + &
+ ((gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J))) + &
+ (gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1))))) + &
+ ((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1))) * CS%BT_Coriolis_scale**2 )
+ H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j)**2) + (G%IdyT(i,j)**2)), &
G%IareaT(i,j) * &
- ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + &
- (Datv(i,J)*G%IdyCv(i,J) + Datv(i,J-1)*G%IdyCv(i,J-1)) ) )
+ (((Datu(I,j)*G%IdxCu(I,j)) + (Datu(I-1,j)*G%IdxCu(I-1,j))) + &
+ ((Datv(i,J)*G%IdyCv(i,J)) + (Datv(i,J-1)*G%IdyCv(i,J-1))) ) )
dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / &
(dtbt**2 * H_eff_dx2)
@@ -1974,10 +1974,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! On odd-steps, update v first.
!$OMP do schedule(static)
do J=jsv-1,jev ; do i=isv-1,iev+1
- Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + &
- (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J)
- PFv(i,J) = ((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j) - &
- (eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1)) * &
+ Cor_v(i,J) = -1.0*(((amer(I-1,j) * ubt(I-1,j)) + (cmer(I,j+1) * ubt(I,j+1))) + &
+ ((bmer(I,j) * ubt(I,j)) + (dmer(I-1,j+1) * ubt(I-1,j+1)))) - Cor_ref_v(i,J)
+ PFv(i,J) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j)) - &
+ ((eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1))) * &
dgeo_de * CS%IdyCv(i,J)
enddo ; enddo
!$OMP end do nowait
@@ -2049,11 +2049,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! Now update the zonal velocity.
!$OMP do schedule(static)
do j=jsv,jev ; do I=isv-1,iev
- Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + &
- (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - &
+ Cor_u(I,j) = (((azon(I,j) * vbt(i+1,J)) + (czon(I,j) * vbt(i,J-1))) + &
+ ((bzon(I,j) * vbt(i,J)) + (dzon(I,j) * vbt(i+1,J-1)))) - &
Cor_ref_u(I,j)
- PFu(I,j) = ((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_E(i,j) - &
- (eta_PF_BT(i+1,j)-eta_PF(i+1,j))*gtot_W(i+1,j)) * &
+ PFu(I,j) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_E(i,j)) - &
+ ((eta_PF_BT(i+1,j)-eta_PF(i+1,j))*gtot_W(i+1,j))) * &
dgeo_de * CS%IdxCu(I,j)
enddo ; enddo
!$OMP end do nowait
@@ -2128,11 +2128,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
! On even steps, update u first.
!$OMP do schedule(static)
do j=jsv-1,jev+1 ; do I=isv-1,iev
- Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + &
- (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - &
+ Cor_u(I,j) = (((azon(I,j) * vbt(i+1,J)) + (czon(I,j) * vbt(i,J-1))) + &
+ ((bzon(I,j) * vbt(i,J)) + (dzon(I,j) * vbt(i+1,J-1)))) - &
Cor_ref_u(I,j)
- PFu(I,j) = ((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_E(i,j) - &
- (eta_PF_BT(i+1,j)-eta_PF(i+1,j))*gtot_W(i+1,j)) * &
+ PFu(I,j) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_E(i,j)) - &
+ ((eta_PF_BT(i+1,j)-eta_PF(i+1,j))*gtot_W(i+1,j))) * &
dgeo_de * CS%IdxCu(I,j)
enddo ; enddo
!$OMP end do nowait
@@ -2206,20 +2206,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
if (CS%use_old_coriolis_bracket_bug) then
!$OMP do schedule(static)
do J=jsv-1,jev ; do i=isv,iev
- Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + bmer(I,j) * ubt(I,j)) + &
- (cmer(I,j+1) * ubt(I,j+1) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J)
- PFv(i,J) = ((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j) - &
- (eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1)) * &
+ Cor_v(i,J) = -1.0*(((amer(I-1,j) * ubt(I-1,j)) + (bmer(I,j) * ubt(I,j))) + &
+ ((cmer(I,j+1) * ubt(I,j+1)) + (dmer(I-1,j+1) * ubt(I-1,j+1)))) - Cor_ref_v(i,J)
+ PFv(i,J) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j)) - &
+ ((eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1))) * &
dgeo_de * CS%IdyCv(i,J)
enddo ; enddo
!$OMP end do nowait
else
!$OMP do schedule(static)
do J=jsv-1,jev ; do i=isv,iev
- Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + &
- (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J)
- PFv(i,J) = ((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j) - &
- (eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1)) * &
+ Cor_v(i,J) = -1.0*(((amer(I-1,j) * ubt(I-1,j)) + (cmer(I,j+1) * ubt(I,j+1))) + &
+ ((bmer(I,j) * ubt(I,j)) + (dmer(I-1,j+1) * ubt(I-1,j+1)))) - Cor_ref_v(i,J)
+ PFv(i,J) = (((eta_PF_BT(i,j)-eta_PF(i,j))*gtot_N(i,j)) - &
+ ((eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1))) * &
dgeo_de * CS%IdyCv(i,J)
enddo ; enddo
!$OMP end do nowait
@@ -2576,14 +2576,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce,
do k=1,nz
do j=js,je ; do I=is-1,ie
accel_layer_u(I,j,k) = (u_accel_bt(I,j) - &
- ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - &
- (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) )
+ (((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j)) - &
+ ((pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j))) * CS%IdxCu(I,j) )
if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0
enddo ; enddo
do J=js-1,je ; do i=is,ie
accel_layer_v(i,J,k) = (v_accel_bt(i,J) - &
- ((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1) - &
- (pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j)) * CS%IdyCv(i,J) )
+ (((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1)) - &
+ ((pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j))) * CS%IdyCv(i,J) )
if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0
enddo ; enddo
enddo
@@ -2904,10 +2904,10 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add)
! This is pretty accurate for gravity waves, but it is a conservative
! estimate since it ignores the stabilizing effect of the bottom drag.
Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * &
- ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + &
- (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + &
- ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) * CS%BT_Coriolis_scale**2 )
+ (((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j)) + (gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j))) + &
+ ((gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J)) + (gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1)))) + &
+ ((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1))) * CS%BT_Coriolis_scale**2 )
if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2
enddo ; enddo
dtbt_max = sqrt(min_max_dt2 / dgeo_de)
@@ -4850,10 +4850,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS,
if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then
CS%q_D(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * &
((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / &
- (Z_to_H * max(((G%areaT(i,j) * max(Mean_SL+G%bathyT(i,j),0.0) + &
- G%areaT(i+1,j+1) * max(Mean_SL+G%bathyT(i+1,j+1),0.0)) + &
- (G%areaT(i+1,j) * max(Mean_SL+G%bathyT(i+1,j),0.0) + &
- G%areaT(i,j+1) * max(Mean_SL+G%bathyT(i,j+1),0.0))), GV%H_subroundoff) )
+ (Z_to_H * max((((G%areaT(i,j) * max(Mean_SL+G%bathyT(i,j),0.0)) + &
+ (G%areaT(i+1,j+1) * max(Mean_SL+G%bathyT(i+1,j+1),0.0))) + &
+ ((G%areaT(i+1,j) * max(Mean_SL+G%bathyT(i+1,j),0.0)) + &
+ (G%areaT(i,j+1) * max(Mean_SL+G%bathyT(i,j+1),0.0)))), GV%H_subroundoff) )
else ! All four h points are masked out so q_D(I,J) will is meaningless
CS%q_D(I,J) = 0.
endif
diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90
index ba8c234bc2..13181902ec 100644
--- a/src/core/MOM_continuity_PPM.F90
+++ b/src/core/MOM_continuity_PPM.F90
@@ -937,14 +937,14 @@ subroutine zonal_flux_layer(u, h, h_W, h_E, uh, duhdu, visc_rem, dt, G, US, j, &
if (u(I) > 0.0) then
if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j))
else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif
- curv_3 = h_W(i) + h_E(i) - 2.0*h(i)
+ curv_3 = (h_W(i) + h_E(i)) - 2.0*h(i)
uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * &
(h_E(i) + CFL * (0.5*(h_W(i) - h_E(i)) + curv_3*(CFL - 1.5)))
h_marg = h_E(i) + CFL * ((h_W(i) - h_E(i)) + 3.0*curv_3*(CFL - 1.0))
elseif (u(I) < 0.0) then
if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j))
else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif
- curv_3 = h_W(i+1) + h_E(i+1) - 2.0*h(i+1)
+ curv_3 = (h_W(i+1) + h_E(i+1)) - 2.0*h(i+1)
uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * &
(h_W(i+1) + CFL * (0.5*(h_E(i+1)-h_W(i+1)) + curv_3*(CFL - 1.5)))
h_marg = h_W(i+1) + CFL * ((h_E(i+1)-h_W(i+1)) + 3.0*curv_3*(CFL - 1.0))
@@ -1019,13 +1019,13 @@ subroutine zonal_flux_thickness(u, h, h_W, h_E, h_u, dt, G, GV, US, LB, vol_CFL,
if (u(I,j,k) > 0.0) then
if (vol_CFL) then ; CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j))
else ; CFL = u(I,j,k) * dt * G%IdxT(i,j) ; endif
- curv_3 = h_W(i,j,k) + h_E(i,j,k) - 2.0*h(i,j,k)
+ curv_3 = (h_W(i,j,k) + h_E(i,j,k)) - 2.0*h(i,j,k)
h_avg = h_E(i,j,k) + CFL * (0.5*(h_W(i,j,k) - h_E(i,j,k)) + curv_3*(CFL - 1.5))
h_marg = h_E(i,j,k) + CFL * ((h_W(i,j,k) - h_E(i,j,k)) + 3.0*curv_3*(CFL - 1.0))
elseif (u(I,j,k) < 0.0) then
if (vol_CFL) then ; CFL = (-u(I,j,k)*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j))
else ; CFL = -u(I,j,k) * dt * G%IdxT(i+1,j) ; endif
- curv_3 = h_W(i+1,j,k) + h_E(i+1,j,k) - 2.0*h(i+1,j,k)
+ curv_3 = (h_W(i+1,j,k) + h_E(i+1,j,k)) - 2.0*h(i+1,j,k)
h_avg = h_W(i+1,j,k) + CFL * (0.5*(h_E(i+1,j,k)-h_W(i+1,j,k)) + curv_3*(CFL - 1.5))
h_marg = h_W(i+1,j,k) + CFL * ((h_E(i+1,j,k)-h_W(i+1,j,k)) + &
3.0*curv_3*(CFL - 1.0))
@@ -1832,7 +1832,7 @@ subroutine merid_flux_layer(v, h, h_S, h_N, vh, dvhdv, visc_rem, dt, G, US, J, &
if (v(i) > 0.0) then
if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j))
else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif
- curv_3 = h_S(i,j) + h_N(i,j) - 2.0*h(i,j)
+ curv_3 = (h_S(i,j) + h_N(i,j)) - 2.0*h(i,j)
vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * ( h_N(i,j) + CFL * &
(0.5*(h_S(i,j) - h_N(i,j)) + curv_3*(CFL - 1.5)) )
h_marg = h_N(i,j) + CFL * ((h_S(i,j) - h_N(i,j)) + &
@@ -1840,7 +1840,7 @@ subroutine merid_flux_layer(v, h, h_S, h_N, vh, dvhdv, visc_rem, dt, G, US, J, &
elseif (v(i) < 0.0) then
if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1))
else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif
- curv_3 = h_S(i,j+1) + h_N(i,j+1) - 2.0*h(i,j+1)
+ curv_3 = (h_S(i,j+1) + h_N(i,j+1)) - 2.0*h(i,j+1)
vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * ( h_S(i,j+1) + CFL * &
(0.5*(h_N(i,j+1)-h_S(i,j+1)) + curv_3*(CFL - 1.5)) )
h_marg = h_S(i,j+1) + CFL * ((h_N(i,j+1)-h_S(i,j+1)) + &
@@ -1919,14 +1919,14 @@ subroutine meridional_flux_thickness(v, h, h_S, h_N, h_v, dt, G, GV, US, LB, vol
if (v(i,J,k) > 0.0) then
if (vol_CFL) then ; CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j))
else ; CFL = v(i,J,k) * dt * G%IdyT(i,j) ; endif
- curv_3 = h_S(i,j,k) + h_N(i,j,k) - 2.0*h(i,j,k)
+ curv_3 = (h_S(i,j,k) + h_N(i,j,k)) - 2.0*h(i,j,k)
h_avg = h_N(i,j,k) + CFL * (0.5*(h_S(i,j,k) - h_N(i,j,k)) + curv_3*(CFL - 1.5))
h_marg = h_N(i,j,k) + CFL * ((h_S(i,j,k) - h_N(i,j,k)) + &
3.0*curv_3*(CFL - 1.0))
elseif (v(i,J,k) < 0.0) then
if (vol_CFL) then ; CFL = (-v(i,J,k)*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1))
else ; CFL = -v(i,J,k) * dt * G%IdyT(i,j+1) ; endif
- curv_3 = h_S(i,j+1,k) + h_N(i,j+1,k) - 2.0*h(i,j+1,k)
+ curv_3 = (h_S(i,j+1,k) + h_N(i,j+1,k)) - 2.0*h(i,j+1,k)
h_avg = h_S(i,j+1,k) + CFL * (0.5*(h_N(i,j+1,k)-h_S(i,j+1,k)) + curv_3*(CFL - 1.5))
h_marg = h_S(i,j+1,k) + CFL * ((h_N(i,j+1,k)-h_S(i,j+1,k)) + &
3.0*curv_3*(CFL - 1.0))
@@ -2601,7 +2601,7 @@ subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie)
do j=jis,jie ; do i=iis,iie
! This limiter prevents undershooting minima within the domain with
! values less than h_min.
- curv = 3.0*(h_L(i,j) + h_R(i,j) - 2.0*h_in(i,j))
+ curv = 3.0*((h_L(i,j) + h_R(i,j)) - 2.0*h_in(i,j))
if (curv > 0.0) then ! Only minima are limited.
dh = h_R(i,j) - h_L(i,j)
if (abs(dh) < curv) then ! The parabola's minimum is within the cell.
diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90
index 6d80d4dd55..bf6b2f6fef 100644
--- a/src/core/MOM_density_integrals.F90
+++ b/src/core/MOM_density_integrals.F90
@@ -254,12 +254,12 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
! T, S, and z are interpolated in the horizontal. The z interpolation
! is linear, but for T and S it may be thickness weighted.
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
- dz_x(m,i) = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
+ dz_x(m,i) = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i+1,j) - z_b(i+1,j)))
pos = i*15+(m-2)*5
- T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i+1,j)
- S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i+1,j)
- p15(pos+1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i+1,j)) - z0pres)
+ T15(pos+1) = (wtT_L*T(i,j)) + (wtT_R*T(i+1,j))
+ S15(pos+1) = (wtT_L*S(i,j)) + (wtT_R*S(i+1,j))
+ p15(pos+1) = -GxRho*(((wt_L*z_t(i,j)) + (wt_R*z_t(i+1,j))) - z0pres)
do n=2,5
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_x(m,i)
@@ -279,16 +279,16 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
if (use_rho_ref) then
do m=2,4
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_x(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_x(m,i)*(C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)))
+ 12.0*r15(pos+3)) ))
enddo
else
do m=2,4
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_x(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_x(m,i)*(C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) - rho_ref )
+ 12.0*r15(pos+3)) - rho_ref ))
enddo
endif
! Use Boole's rule to integrate the bottom pressure anomaly values in x.
@@ -320,12 +320,12 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
! T, S, and z are interpolated in the horizontal. The z interpolation
! is linear, but for T and S it may be thickness weighted.
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
- dz_y(m,i) = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
+ dz_y(m,i) = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i,j+1) - z_b(i,j+1)))
pos = i*15+(m-2)*5
- T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i,j+1)
- S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i,j+1)
- p15(pos+1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i,j+1)) - z0pres)
+ T15(pos+1) = (wtT_L*T(i,j)) + (wtT_R*T(i,j+1))
+ S15(pos+1) = (wtT_L*S(i,j)) + (wtT_R*S(i,j+1))
+ p15(pos+1) = -GxRho*(((wt_L*z_t(i,j)) + (wt_R*z_t(i,j+1))) - z0pres)
do n=2,5
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_y(m,i)
@@ -347,13 +347,13 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
do m=2,4
pos = i*15+(m-2)*5
if (use_rho_ref) then
- intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_y(m,i)*(C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)))
+ 12.0*r15(pos+3)) ))
else
- intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_y(m,i)*(C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) - rho_ref )
+ 12.0*r15(pos+3)) - rho_ref ))
endif
enddo
! Use Boole's rule to integrate the values.
@@ -600,20 +600,20 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
do m=2,4
w_left = wt_t(m) ; w_right = wt_b(m)
- dz_x(m,i) = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i+1,j,K) - e(i+1,j,K+1))
+ dz_x(m,i) = (w_left*(e(i,j,K) - e(i,j,K+1))) + (w_right*(e(i+1,j,K) - e(i+1,j,K+1)))
! Salinity and temperature points are linearly interpolated in
! the horizontal. The subscript (1) refers to the top value in
! the vertical profile while subscript (5) refers to the bottom
! value in the vertical profile.
pos = i*15+(m-2)*5
- T15(pos+1) = w_left*Ttl + w_right*Ttr
- T15(pos+5) = w_left*Tbl + w_right*Tbr
+ T15(pos+1) = (w_left*Ttl) + (w_right*Ttr)
+ T15(pos+5) = (w_left*Tbl) + (w_right*Tbr)
- S15(pos+1) = w_left*Stl + w_right*Str
- S15(pos+5) = w_left*Sbl + w_right*Sbr
+ S15(pos+1) = (w_left*Stl) + (w_right*Str)
+ S15(pos+5) = (w_left*Sbl) + (w_right*Sbr)
- p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i+1,j,K)) - z0pres)
+ p15(pos+1) = -GxRho*(((w_left*e(i,j,K)) + (w_right*e(i+1,j,K))) - z0pres)
! Pressure
do n=2,5
@@ -625,9 +625,9 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
S15(pos+n) = wt_t(n) * S15(pos+1) + wt_b(n) * S15(pos+5)
T15(pos+n) = wt_t(n) * T15(pos+1) + wt_b(n) * T15(pos+5)
enddo
- if (use_varT) T215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
- if (use_covarTS) TS15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
- if (use_varS) S215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k)
+ if (use_varT) T215(pos+1:pos+5) = (w_left*tv%varT(i,j,k)) + (w_right*tv%varT(i+1,j,k))
+ if (use_covarTS) TS15(pos+1:pos+5) = (w_left*tv%covarTS(i,j,k)) + (w_right*tv%covarTS(i+1,j,k))
+ if (use_varS) S215(pos+1:pos+5) = (w_left*tv%varS(i,j,k)) + (w_right*tv%varS(i+1,j,k))
enddo
enddo
@@ -648,14 +648,14 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
if (use_rho_ref) then
do m = 2,4
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) )
+ intz(m) = (G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + &
+ 12.0*r15(pos+3)) ))
enddo
else
do m = 2,4
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) - rho_ref )
+ intz(m) = (G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + &
+ 12.0*r15(pos+3)) - rho_ref ))
enddo
endif
! Use Boole's rule to integrate the bottom pressure anomaly values in x.
@@ -696,20 +696,20 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
do m=2,4
w_left = wt_t(m) ; w_right = wt_b(m)
- dz_y(m,i) = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i,j+1,K) - e(i,j+1,K+1))
+ dz_y(m,i) = (w_left*(e(i,j,K) - e(i,j,K+1))) + (w_right*(e(i,j+1,K) - e(i,j+1,K+1)))
! Salinity and temperature points are linearly interpolated in
! the horizontal. The subscript (1) refers to the top value in
! the vertical profile while subscript (5) refers to the bottom
! value in the vertical profile.
pos = i*15+(m-2)*5
- T15(pos+1) = w_left*Ttl + w_right*Ttr
- T15(pos+5) = w_left*Tbl + w_right*Tbr
+ T15(pos+1) = (w_left*Ttl) + (w_right*Ttr)
+ T15(pos+5) = (w_left*Tbl) + (w_right*Tbr)
- S15(pos+1) = w_left*Stl + w_right*Str
- S15(pos+5) = w_left*Sbl + w_right*Sbr
+ S15(pos+1) = (w_left*Stl) + (w_right*Str)
+ S15(pos+5) = (w_left*Sbl) + (w_right*Sbr)
- p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i,j+1,K)) - z0pres)
+ p15(pos+1) = -GxRho*(((w_left*e(i,j,K)) + (w_right*e(i,j+1,K))) - z0pres)
! Pressure
do n=2,5
@@ -721,9 +721,9 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
S15(pos+n) = wt_t(n) * S15(pos+1) + wt_b(n) * S15(pos+5)
T15(pos+n) = wt_t(n) * T15(pos+1) + wt_b(n) * T15(pos+5)
enddo
- if (use_varT) T215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k)
- if (use_covarTS) TS15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k)
- if (use_varS) S215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k)
+ if (use_varT) T215(pos+1:pos+5) = (w_left*tv%varT(i,j,k)) + (w_right*tv%varT(i,j+1,k))
+ if (use_covarTS) TS15(pos+1:pos+5) = (w_left*tv%covarTS(i,j,k)) + (w_right*tv%covarTS(i,j+1,k))
+ if (use_varS) S215(pos+1:pos+5) = (w_left*tv%varS(i,j,k)) + (w_right*tv%varS(i,j+1,k))
enddo
enddo
@@ -748,16 +748,16 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
if (use_rho_ref) then
do m = 2,4
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) )
+ 12.0*r15(pos+3)) ))
enddo
else
do m = 2,4
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) - rho_ref )
+ 12.0*r15(pos+3)) - rho_ref ))
enddo
endif
! Use Boole's rule to integrate the values.
@@ -1004,19 +1004,19 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
! the horizontal. The subscript (1) refers to the top value in
! the vertical profile while subscript (5) refers to the bottom
! value in the vertical profile.
- T_top = w_left*Ttl + w_right*Ttr
- T_mn = w_left*Tml + w_right*Tmr
- T_bot = w_left*Tbl + w_right*Tbr
+ T_top = (w_left*Ttl) + (w_right*Ttr)
+ T_mn = (w_left*Tml) + (w_right*Tmr)
+ T_bot = (w_left*Tbl) + (w_right*Tbr)
- S_top = w_left*Stl + w_right*Str
- S_mn = w_left*Sml + w_right*Smr
- S_bot = w_left*Sbl + w_right*Sbr
+ S_top = (w_left*Stl) + (w_right*Str)
+ S_mn = (w_left*Sml) + (w_right*Smr)
+ S_bot = (w_left*Sbl) + (w_right*Sbr)
! Pressure
- dz_x(m,i) = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i+1,j,K) - e(i+1,j,K+1))
+ dz_x(m,i) = (w_left*(e(i,j,K) - e(i,j,K+1))) + (w_right*(e(i+1,j,K) - e(i+1,j,K+1)))
pos = i*15+(m-2)*5
- p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i+1,j,K)) - z0pres)
+ p15(pos+1) = -GxRho*(((w_left*e(i,j,K)) + (w_right*e(i+1,j,K))) - z0pres)
do n=2,5
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_x(m,i)
enddo
@@ -1032,9 +1032,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
T15(pos+n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) )
enddo
if (use_stanley_eos) then
- if (use_varT) T215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
- if (use_covarTS) TS15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
- if (use_varS) S215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i+1,j,k)
+ if (use_varT) T215(pos+1:pos+5) = (w_left*tv%varT(i,j,k)) + (w_right*tv%varT(i+1,j,k))
+ if (use_covarTS) TS15(pos+1:pos+5) = (w_left*tv%covarTS(i,j,k)) + (w_right*tv%covarTS(i+1,j,k))
+ if (use_varS) S215(pos+1:pos+5) = (w_left*tv%varS(i,j,k)) + (w_right*tv%varS(i+1,j,k))
endif
if (use_stanley_eos) then
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, EOS, rho_ref=rho_ref)
@@ -1054,9 +1054,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
do m=2,4
pos = i*15+(m-2)*5
! Use Boole's rule to estimate the pressure anomaly change.
- intz(m) = G_e*dz_x(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_x(m,i)*(C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) )
+ 12.0*r15(pos+3)) ))
enddo ! m
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
@@ -1109,19 +1109,19 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
! the horizontal. The subscript (1) refers to the top value in
! the vertical profile while subscript (5) refers to the bottom
! value in the vertical profile.
- T_top = w_left*Ttl + w_right*Ttr
- T_mn = w_left*Tml + w_right*Tmr
- T_bot = w_left*Tbl + w_right*Tbr
+ T_top = (w_left*Ttl) + (w_right*Ttr)
+ T_mn = (w_left*Tml) + (w_right*Tmr)
+ T_bot = (w_left*Tbl) + (w_right*Tbr)
- S_top = w_left*Stl + w_right*Str
- S_mn = w_left*Sml + w_right*Smr
- S_bot = w_left*Sbl + w_right*Sbr
+ S_top = (w_left*Stl) + (w_right*Str)
+ S_mn = (w_left*Sml) + (w_right*Smr)
+ S_bot = (w_left*Sbl) + (w_right*Sbr)
! Pressure
- dz_y(m,i) = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i,j+1,K) - e(i,j+1,K+1))
+ dz_y(m,i) = (w_left*(e(i,j,K) - e(i,j,K+1))) + (w_right*(e(i,j+1,K) - e(i,j+1,K+1)))
pos = i*15+(m-2)*5
- p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i,j+1,K)) - z0pres)
+ p15(pos+1) = -GxRho*(((w_left*e(i,j,K)) + (w_right*e(i,j+1,K))) - z0pres)
do n=2,5
p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_y(m,i)
enddo
@@ -1138,9 +1138,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
enddo
if (use_stanley_eos) then
- if (use_varT) T215(pos+1:pos+5) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i,j+1,k)
- if (use_covarTS) TS15(pos+1:pos+5) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i,j+1,k)
- if (use_varS) S215(pos+1:pos+5) = w_left*tv%varS(i,j,k) + w_right*tv%varS(i,j+1,k)
+ if (use_varT) T215(pos+1:pos+5) = (w_left*tv%varT(i,j,k)) + (w_right*tv%varT(i,j+1,k))
+ if (use_covarTS) TS15(pos+1:pos+5) = (w_left*tv%covarTS(i,j,k)) + (w_right*tv%covarTS(i,j+1,k))
+ if (use_varS) S215(pos+1:pos+5) = (w_left*tv%varS(i,j,k)) + (w_right*tv%varS(i,j+1,k))
endif
enddo
enddo
@@ -1158,9 +1158,9 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
do m=2,4
! Use Boole's rule to estimate the pressure anomaly change.
pos = i*15+(m-2)*5
- intz(m) = G_e*dz_y(m,i)*( C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
+ intz(m) = (G_e*dz_y(m,i)*(C1_90*( 7.0*(r15(pos+1)+r15(pos+5)) + &
32.0*(r15(pos+2)+r15(pos+4)) + &
- 12.0*r15(pos+3)) )
+ 12.0*r15(pos+3)) ))
enddo ! m
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
@@ -1381,15 +1381,15 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
pos = i*15+(m-2)*5
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- p15(pos+1) = wt_L*p_b(i,j) + wt_R*p_b(i+1,j)
- dp_x(m,I) = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
- T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i+1,j)
- S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i+1,j)
+ p15(pos+1) = (wt_L*p_b(i,j)) + (wt_R*p_b(i+1,j))
+ dp_x(m,I) = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i+1,j) - p_t(i+1,j)))
+ T15(pos+1) = (wtT_L*T(i,j)) + (wtT_R*T(i+1,j))
+ S15(pos+1) = (wtT_L*S(i,j)) + (wtT_R*S(i+1,j))
do n=2,5
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
@@ -1406,8 +1406,8 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
! Use Boole's rule to estimate the interface height anomaly change.
do m=2,4
pos = i*15+(m-2)*5
- intp(m) = dp_x(m,I)*( C1_90*(7.0*(a15(pos+1)+a15(pos+5)) + 32.0*(a15(pos+2)+a15(pos+4)) + &
- 12.0*a15(pos+3)))
+ intp(m) = (dp_x(m,I)*( C1_90*(7.0*(a15(pos+1)+a15(pos+5)) + 32.0*(a15(pos+2)+a15(pos+4)) + &
+ 12.0*a15(pos+3)) ))
enddo
! Use Boole's rule to integrate the interface height anomaly values in x.
intx_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
@@ -1436,15 +1436,15 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
pos = i*15+(m-2)*5
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- p15(pos+1) = wt_L*p_b(i,j) + wt_R*p_b(i,j+1)
- dp_y(m,i) = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
- T15(pos+1) = wtT_L*T(i,j) + wtT_R*T(i,j+1)
- S15(pos+1) = wtT_L*S(i,j) + wtT_R*S(i,j+1)
+ p15(pos+1) = (wt_L*p_b(i,j)) + (wt_R*p_b(i,j+1))
+ dp_y(m,i) = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i,j+1) - p_t(i,j+1)))
+ T15(pos+1) = (wtT_L*T(i,j)) + (wtT_R*T(i,j+1))
+ S15(pos+1) = (wtT_L*S(i,j)) + (wtT_R*S(i,j+1))
do n=2,5
T15(pos+n) = T15(pos+1) ; S15(pos+n) = S15(pos+1)
p15(pos+n) = p15(pos+n-1) - 0.25*dp_y(m,i)
@@ -1461,8 +1461,8 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d
! Use Boole's rule to estimate the interface height anomaly change.
do m=2,4
pos = i*15+(m-2)*5
- intp(m) = dp_y(m,i)*( C1_90*(7.0*(a15(pos+1)+a15(pos+5)) + 32.0*(a15(pos+2)+a15(pos+4)) + &
- 12.0*a15(pos+3)))
+ intp(m) = (dp_y(m,i)*( C1_90*(7.0*(a15(pos+1)+a15(pos+5)) + 32.0*(a15(pos+2)+a15(pos+4)) + &
+ 12.0*a15(pos+3)) ))
enddo
! Use Boole's rule to integrate the interface height anomaly values in y.
inty_dza(i,j) = C1_90*(7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4)) + &
@@ -1622,16 +1622,16 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- P_top = wt_L*p_t(i,j) + wt_R*p_t(i+1,j)
- P_bot = wt_L*p_b(i,j) + wt_R*p_b(i+1,j)
- T_top = wtT_L*T_t(i,j) + wtT_R*T_t(i+1,j)
- T_bot = wtT_L*T_b(i,j) + wtT_R*T_b(i+1,j)
- S_top = wtT_L*S_t(i,j) + wtT_R*S_t(i+1,j)
- S_bot = wtT_L*S_b(i,j) + wtT_R*S_b(i+1,j)
+ P_top = (wt_L*p_t(i,j)) + (wt_R*p_t(i+1,j))
+ P_bot = (wt_L*p_b(i,j)) + (wt_R*p_b(i+1,j))
+ T_top = (wtT_L*T_t(i,j)) + (wtT_R*T_t(i+1,j))
+ T_bot = (wtT_L*T_b(i,j)) + (wtT_R*T_b(i+1,j))
+ S_top = (wtT_L*S_t(i,j)) + (wtT_R*S_t(i+1,j))
+ S_bot = (wtT_L*S_b(i,j)) + (wtT_R*S_b(i+1,j))
dp_90(m,I) = C1_90*(P_bot - P_top)
! Salinity, temperature and pressure with linear interpolation in the vertical.
@@ -1652,8 +1652,8 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
! Use Boole's rule to estimate the interface height anomaly change.
! The integrals at the ends of the segment are already known.
pos = I*15+(m-2)*5
- intp(m) = dp_90(m,I)*((7.0*(a15(pos+1)+a15(pos+5)) + &
- 32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
+ intp(m) = (dp_90(m,I)*((7.0*(a15(pos+1)+a15(pos+5)) + &
+ 32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3) ))
enddo
! Use Boole's rule to integrate the interface height anomaly values in x.
intx_dza(I,j) = C1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
@@ -1683,16 +1683,16 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- P_top = wt_L*p_t(i,j) + wt_R*p_t(i,j+1)
- P_bot = wt_L*p_b(i,j) + wt_R*p_b(i,j+1)
- T_top = wtT_L*T_t(i,j) + wtT_R*T_t(i,j+1)
- T_bot = wtT_L*T_b(i,j) + wtT_R*T_b(i,j+1)
- S_top = wtT_L*S_t(i,j) + wtT_R*S_t(i,j+1)
- S_bot = wtT_L*S_b(i,j) + wtT_R*S_b(i,j+1)
+ P_top = (wt_L*p_t(i,j)) + (wt_R*p_t(i,j+1))
+ P_bot = (wt_L*p_b(i,j)) + (wt_R*p_b(i,j+1))
+ T_top = (wtT_L*T_t(i,j)) + (wtT_R*T_t(i,j+1))
+ T_bot = (wtT_L*T_b(i,j)) + (wtT_R*T_b(i,j+1))
+ S_top = (wtT_L*S_t(i,j)) + (wtT_R*S_t(i,j+1))
+ S_bot = (wtT_L*S_b(i,j)) + (wtT_R*S_b(i,j+1))
dp_90(m,i) = C1_90*(P_bot - P_top)
! Salinity, temperature and pressure with linear interpolation in the vertical.
@@ -1714,8 +1714,8 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref,
! Use Boole's rule to estimate the interface height anomaly change.
! The integrals at the ends of the segment are already known.
pos = i*15+(m-2)*5
- intp(m) = dp_90(m,i) * ((7.0*(a15(pos+1)+a15(pos+5)) + &
- 32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3))
+ intp(m) = (dp_90(m,i) * ((7.0*(a15(pos+1)+a15(pos+5)) + &
+ 32.0*(a15(pos+2)+a15(pos+4))) + 12.0*a15(pos+3)))
enddo
! Use Boole's rule to integrate the interface height anomaly values in x.
inty_dza(i,J) = C1_90*((7.0*(intp(1)+intp(5)) + 32.0*(intp(2)+intp(4))) + &
diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90
index 72c67253ed..02855c9fe6 100644
--- a/src/core/MOM_forcing_type.F90
+++ b/src/core/MOM_forcing_type.F90
@@ -2425,13 +2425,13 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0)
do j=js,je ; do i=is,ie
taux2 = 0.0
if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0.0) &
- taux2 = (G%mask2dCu(I-1,j) * forces%taux(I-1,j)**2 + &
- G%mask2dCu(I,j) * forces%taux(I,j)**2) / &
+ taux2 = (G%mask2dCu(I-1,j) * (forces%taux(I-1,j)**2) + &
+ G%mask2dCu(I,j) * (forces%taux(I,j)**2)) / &
(G%mask2dCu(I-1,j) + G%mask2dCu(I,j))
tauy2 = 0.0
if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0.0) &
- tauy2 = (G%mask2dCv(i,J-1) * forces%tauy(i,J-1)**2 + &
- G%mask2dCv(i,J) * forces%tauy(i,J)**2) / &
+ tauy2 = (G%mask2dCv(i,J-1) * (forces%tauy(i,J-1)**2) + &
+ G%mask2dCv(i,J) * (forces%tauy(i,J)**2)) / &
(G%mask2dCv(i,J-1) + G%mask2dCv(i,J))
if (associated(fluxes%ustar_gustless)) then
@@ -3822,7 +3822,7 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar)
if (G%mask2dCv(i,J) > 0.0) forces%tauy(i,J) = ty_mean
enddo ; enddo
if (tau2ustar) then
- tau_mag = sqrt(tx_mean**2 + ty_mean**2)
+ tau_mag = sqrt((tx_mean**2) + (ty_mean**2))
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
forces%tau_mag(i,j) = tau_mag
endif ; enddo ; enddo ; endif
diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90
index 52e37f1a9b..6fb8426395 100644
--- a/src/core/MOM_grid.F90
+++ b/src/core/MOM_grid.F90
@@ -171,7 +171,8 @@ module MOM_grid
Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m].
Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m].
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: &
- CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1].
+ CoriolisBu, & !< The Coriolis parameter at corner points [T-1 ~> s-1].
+ Coriolis2Bu !< The square of the Coriolis parameter at corner points [T-2 ~> s-2].
real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: &
df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1].
df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1].
@@ -581,6 +582,7 @@ subroutine allocate_metrics(G)
ALLOC_(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = -G%Z_ref
ALLOC_(G%CoriolisBu(IsdB:IedB, JsdB:JedB)) ; G%CoriolisBu(:,:) = 0.0
+ ALLOC_(G%Coriolis2Bu(IsdB:IedB, JsdB:JedB)) ; G%Coriolis2Bu(:,:) = 0.0
ALLOC_(G%dF_dx(isd:ied, jsd:jed)) ; G%dF_dx(:,:) = 0.0
ALLOC_(G%dF_dy(isd:ied, jsd:jed)) ; G%dF_dy(:,:) = 0.0
@@ -626,8 +628,8 @@ subroutine MOM_grid_end(G)
DEALLOC_(G%dx_Cv) ; DEALLOC_(G%dy_Cu)
- DEALLOC_(G%bathyT) ; DEALLOC_(G%CoriolisBu)
- DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy)
+ DEALLOC_(G%bathyT) ; DEALLOC_(G%CoriolisBu) ; DEALLOC_(G%Coriolis2Bu)
+ DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy)
DEALLOC_(G%sin_rot) ; DEALLOC_(G%cos_rot)
DEALLOC_(G%porous_DminU) ; DEALLOC_(G%porous_DmaxU) ; DEALLOC_(G%porous_DavgU)
diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90
index 9defa597ab..ede5137cb6 100644
--- a/src/core/MOM_isopycnal_slopes.F90
+++ b/src/core/MOM_isopycnal_slopes.F90
@@ -334,7 +334,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
wtA = hg2A*haB ; wtB = hg2B*haA
wtL = hg2L*(haR*dzaR) ; wtR = hg2R*(haL*dzaL)
- drdz = (wtL * drdkL + wtR * drdkR) / (dzaL*wtL + dzaR*wtR)
+ drdz = ((wtL * drdkL) + (wtR * drdkR)) / ((dzaL*wtL) + (dzaR*wtR))
! The expression for drdz above is mathematically equivalent to:
! drdz = ((hg2L/haL) * drdkL/dzaL + (hg2R/haR) * drdkR/dzaR) / &
! ((hg2L/haL) + (hg2R/haR))
@@ -376,8 +376,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
endif
slope_x(I,j,K) = slope
if (present(dzSxN)) &
- dzSxN(I,j,K) = sqrt( GxSpV_u(I) * max(0., wtL * ( dzaL * drdkL ) &
- + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N
+ dzSxN(I,j,K) = sqrt( GxSpV_u(I) * max(0., (wtL * ( dzaL * drdkL )) &
+ + (wtR * ( dzaR * drdkR ))) / (wtL + wtR) ) & ! dz * N
* abs(slope) * G%mask2dCu(I,j) ! x-direction contribution to S^2
enddo ! I
@@ -485,7 +485,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
wtA = hg2A*haB ; wtB = hg2B*haA
wtL = hg2L*(haR*dzaR) ; wtR = hg2R*(haL*dzaL)
- drdz = (wtL * drdkL + wtR * drdkR) / (dzaL*wtL + dzaR*wtR)
+ drdz = ((wtL * drdkL) + (wtR * drdkR)) / ((dzaL*wtL) + (dzaR*wtR))
! The expression for drdz above is mathematically equivalent to:
! drdz = ((hg2L/haL) * drdkL/dzaL + (hg2R/haR) * drdkR/dzaR) / &
! ((hg2L/haL) + (hg2R/haR))
@@ -527,8 +527,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan
endif
slope_y(i,J,K) = slope
if (present(dzSyN)) &
- dzSyN(i,J,K) = sqrt( GxSpV_v(i) * max(0., wtL * ( dzaL * drdkL ) &
- + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N
+ dzSyN(i,J,K) = sqrt( GxSpV_v(i) * max(0., (wtL * ( dzaL * drdkL )) &
+ + (wtR * ( dzaR * drdkR ))) / (wtL + wtR) ) & ! dz * N
* abs(slope) * G%mask2dCv(i,J) ! x-direction contribution to S^2
enddo ! i
diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90
index 8394735cb9..4dcbad4388 100644
--- a/src/core/MOM_open_boundary.F90
+++ b/src/core/MOM_open_boundary.F90
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90
index 2bd742be6d..909c2e9a6a 100644
--- a/src/core/MOM_stoch_eos.F90
+++ b/src/core/MOM_stoch_eos.F90
@@ -100,7 +100,7 @@ logical function MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS, resta
! fill array with approximation of grid area needed for decorrelation time-scale calculation
do j=G%jsc,G%jec
do i=G%isc,G%iec
- CS%l2_inv(i,j) = 1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2)
+ CS%l2_inv(i,j) = 1.0 / ( (G%dxT(i,j)**2) + (G%dyT(i,j)**2) )
enddo
enddo
@@ -173,7 +173,7 @@ subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS)
do i=G%isc,G%iec
ubar = 0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j))
vbar = 0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1))
- phi = exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j)))
+ phi = exp(-delt*CS%tfac * sqrt(((ubar**2) + (vbar**2))*CS%l2_inv(i,j)))
CS%pattern(i,j) = phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j)
CS%phi(i,j) = phi
enddo
@@ -233,12 +233,12 @@ subroutine MOM_calc_varT(G, GV, US, h, tv, CS, dt)
hl(5) = h(i,j+1,k) * G%mask2dCv(i,J)
! SGS variance in i-direction [C2 ~> degC2]
- dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) &
- + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) &
+ dTdi2 = ( ( G%mask2dCu(I ,j) * (G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) )) &
+ + G%mask2dCu(I-1,j) * (G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) )) &
) * G%dxT(i,j) * 0.5 )**2
! SGS variance in j-direction [C2 ~> degC2]
- dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) &
- + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) &
+ dTdj2 = ( ( G%mask2dCv(i,J ) * (G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) )) &
+ + G%mask2dCv(i,J-1) * (G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) )) &
) * G%dyT(i,j) * 0.5 )**2
tv%varT(i,j,k) = CS%stanley_coeff * ( dTdi2 + dTdj2 )
! Turn off scheme near land
diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90
index b8e213fa62..f8ae58d9e1 100644
--- a/src/core/MOM_transcribe_grid.F90
+++ b/src/core/MOM_transcribe_grid.F90
@@ -105,6 +105,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US)
oG%dyBu(I,J) = dG%dyBu(I+ido,J+jdo)
oG%areaBu(I,J) = dG%areaBu(I+ido,J+jdo)
oG%CoriolisBu(I,J) = dG%CoriolisBu(I+ido,J+jdo)
+ oG%Coriolis2Bu(I,J) = dG%Coriolis2Bu(I+ido,J+jdo)
oG%mask2dBu(I,J) = dG%mask2dBu(I+ido,J+jdo)
enddo ; enddo
@@ -165,6 +166,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US)
call pass_var(oG%geoLatBu, oG%Domain, position=CORNER)
call pass_vector(oG%dxBu, oG%dyBu, oG%Domain, To_All+Scalar_Pair, BGRID_NE)
call pass_var(oG%CoriolisBu, oG%Domain, position=CORNER)
+ call pass_var(oG%Coriolis2Bu, oG%Domain, position=CORNER)
call pass_var(oG%mask2dBu, oG%Domain, position=CORNER)
if (oG%bathymetry_at_vel) then
@@ -263,6 +265,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US)
dG%dyBu(I,J) = oG%dyBu(I+ido,J+jdo)
dG%areaBu(I,J) = oG%areaBu(I+ido,J+jdo)
dG%CoriolisBu(I,J) = oG%CoriolisBu(I+ido,J+jdo)
+ dG%Coriolis2Bu(I,J) = oG%Coriolis2Bu(I+ido,J+jdo)
dG%mask2dBu(I,J) = oG%mask2dBu(I+ido,J+jdo)
enddo ; enddo
@@ -324,6 +327,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US)
call pass_var(dG%geoLatBu, dG%Domain, position=CORNER)
call pass_vector(dG%dxBu, dG%dyBu, dG%Domain, To_All+Scalar_Pair, BGRID_NE)
call pass_var(dG%CoriolisBu, dG%Domain, position=CORNER)
+ call pass_var(dG%Coriolis2Bu, dG%Domain, position=CORNER)
call pass_var(dG%mask2dBu, dG%Domain, position=CORNER)
if (dG%bathymetry_at_vel) then
diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90
index fd8057c38f..3376dc9be8 100644
--- a/src/diagnostics/MOM_diagnostics.F90
+++ b/src/diagnostics/MOM_diagnostics.F90
@@ -679,13 +679,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
do j=js,je ; do i=is,ie
! Blend the equatorial deformation radius with the standard one.
f2_h = absurdly_small_freq2 + 0.25 * &
- ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
+ ((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
@@ -729,13 +729,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
do j=js,je ; do i=is,ie
! Blend the equatorial deformation radius with the standard one.
f2_h = absurdly_small_freq2 + 0.25 * &
- ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
+ ((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
@@ -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)
@@ -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
diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90
index fb95b79a91..736856d75f 100644
--- a/src/diagnostics/MOM_sum_output.F90
+++ b/src/diagnostics/MOM_sum_output.F90
@@ -683,7 +683,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci
tmp1(:,:,:) = 0.0
do k=1,nz ; do j=js,je ; do i=is,ie
tmp1(i,j,k) = (0.25 * KE_scale_factor * (areaTm(i,j) * h(i,j,k))) * &
- ((u(I-1,j,k)**2 + u(I,j,k)**2) + (v(i,J-1,k)**2 + v(i,J,k)**2))
+ (((u(I-1,j,k)**2) + (u(I,j,k)**2)) + ((v(i,J-1,k)**2) + (v(i,J,k)**2)))
enddo ; enddo ; enddo
KE_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=KE)
diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90
index d4b091b7b2..38eeab7c81 100644
--- a/src/equation_of_state/MOM_EOS_Wright.F90
+++ b/src/equation_of_state/MOM_EOS_Wright.F90
@@ -578,14 +578,14 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i+1,j))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i+1,j))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i+1,j))
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
- p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i+1,j)+z_b(i+1,j))) - z0pres)
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i+1,j) - z_b(i+1,j)))
+ p_ave = -GxRho*(0.5*((wt_L*(z_t(i,j)+z_b(i,j))) + (wt_R*(z_t(i+1,j)+z_b(i+1,j)))) - z0pres)
I_al0 = 1.0 / al0
I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave)
@@ -619,14 +619,14 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i,j+1)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i,j+1)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i,j+1)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i,j+1))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i,j+1))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i,j+1))
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
- p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i,j+1)+z_b(i,j+1))) - z0pres)
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i,j+1) - z_b(i,j+1)))
+ p_ave = -GxRho*(0.5*((wt_L*(z_t(i,j)+z_b(i,j))) + (wt_R*(z_t(i,j+1)+z_b(i,j+1)))) - z0pres)
I_al0 = 1.0 / al0
I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave)
@@ -818,16 +818,16 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, &
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i+1,j))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i+1,j))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i+1,j))
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
- p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i+1,j)+p_b(i+1,j)))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i+1,j) - p_t(i+1,j)))
+ p_ave = 0.5*((wt_L*(p_t(i,j)+p_b(i,j))) + (wt_R*(p_t(i+1,j)+p_b(i+1,j))))
eps = 0.5 * dp / (p0 + p_ave) ; eps2 = eps*eps
intp(m) = (al0 + lambda / (p0 + p_ave) - spv_ref)*dp + 2.0*eps* &
@@ -859,16 +859,16 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, &
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1)
- p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1)
- lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1)
+ al0 = (wt_L*al0_2d(i,j)) + (wt_R*al0_2d(i,j+1))
+ p0 = (wt_L*p0_2d(i,j)) + (wt_R*p0_2d(i,j+1))
+ lambda = (wt_L*lambda_2d(i,j)) + (wt_R*lambda_2d(i,j+1))
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
- p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i,j+1)+p_b(i,j+1)))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i,j+1) - p_t(i,j+1)))
+ p_ave = 0.5*((wt_L*(p_t(i,j)+p_b(i,j))) + (wt_R*(p_t(i,j+1)+p_b(i,j+1))))
eps = 0.5 * dp / (p0 + p_ave) ; eps2 = eps*eps
intp(m) = (al0 + lambda / (p0 + p_ave) - spv_ref)*dp + 2.0*eps* &
diff --git a/src/equation_of_state/MOM_EOS_Wright_full.F90 b/src/equation_of_state/MOM_EOS_Wright_full.F90
index 31b82e6190..41d3608db7 100644
--- a/src/equation_of_state/MOM_EOS_Wright_full.F90
+++ b/src/equation_of_state/MOM_EOS_Wright_full.F90
@@ -583,14 +583,14 @@ subroutine int_density_dz_wright_full(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i+1,j))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i+1,j))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i+1,j))
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
- p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i+1,j)+z_b(i+1,j))) - z0pres)
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i+1,j) - z_b(i+1,j)))
+ p_ave = -GxRho*(0.5*((wt_L*(z_t(i,j)+z_b(i,j))) + (wt_R*(z_t(i+1,j)+z_b(i+1,j)))) - z0pres)
I_al0 = 1.0 / al0
I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0)
@@ -624,14 +624,14 @@ subroutine int_density_dz_wright_full(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i,j+1)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i,j+1)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i,j+1)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i,j+1))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i,j+1))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i,j+1))
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
- p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i,j+1)+z_b(i,j+1))) - z0pres)
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i,j+1) - z_b(i,j+1)))
+ p_ave = -GxRho*(0.5*((wt_L*(z_t(i,j)+z_b(i,j))) + (wt_R*(z_t(i,j+1)+z_b(i,j+1)))) - z0pres)
I_al0 = 1.0 / al0
I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0)
@@ -825,16 +825,16 @@ subroutine int_spec_vol_dp_wright_full(T, S, p_t, p_b, spv_ref, HI, dza, &
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i+1,j))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i+1,j))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i+1,j))
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
- p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i+1,j)+p_b(i+1,j)))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i+1,j) - p_t(i+1,j)))
+ p_ave = 0.5*((wt_L*(p_t(i,j)+p_b(i,j))) + (wt_R*(p_t(i+1,j)+p_b(i+1,j))))
I_pterm = 1.0 / (p0 + p_ave)
eps = 0.5 * dp * I_pterm ; eps2 = eps*eps
@@ -867,16 +867,16 @@ subroutine int_spec_vol_dp_wright_full(T, S, p_t, p_b, spv_ref, HI, dza, &
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1)
- p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1)
- lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1)
+ al0 = (wt_L*al0_2d(i,j)) + (wt_R*al0_2d(i,j+1))
+ p0 = (wt_L*p0_2d(i,j)) + (wt_R*p0_2d(i,j+1))
+ lambda = (wt_L*lambda_2d(i,j)) + (wt_R*lambda_2d(i,j+1))
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
- p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i,j+1)+p_b(i,j+1)))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i,j+1) - p_t(i,j+1)))
+ p_ave = 0.5*((wt_L*(p_t(i,j)+p_b(i,j))) + (wt_R*(p_t(i,j+1)+p_b(i,j+1))))
I_pterm = 1.0 / (p0 + p_ave)
eps = 0.5 * dp * I_pterm ; eps2 = eps*eps
diff --git a/src/equation_of_state/MOM_EOS_Wright_red.F90 b/src/equation_of_state/MOM_EOS_Wright_red.F90
index 65bdb9e521..dc637e6700 100644
--- a/src/equation_of_state/MOM_EOS_Wright_red.F90
+++ b/src/equation_of_state/MOM_EOS_Wright_red.F90
@@ -585,14 +585,14 @@ subroutine int_density_dz_wright_red(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i+1,j))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i+1,j))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i+1,j))
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
- p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i+1,j)+z_b(i+1,j))) - z0pres)
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i+1,j) - z_b(i+1,j)))
+ p_ave = -GxRho*(0.5*((wt_L*(z_t(i,j)+z_b(i,j))) + (wt_R*(z_t(i+1,j)+z_b(i+1,j)))) - z0pres)
I_al0 = 1.0 / al0
I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0)
@@ -626,14 +626,14 @@ subroutine int_density_dz_wright_red(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i,j+1)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i,j+1)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i,j+1)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i,j+1))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i,j+1))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i,j+1))
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
- p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i,j+1)+z_b(i,j+1))) - z0pres)
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i,j+1) - z_b(i,j+1)))
+ p_ave = -GxRho*(0.5*((wt_L*(z_t(i,j)+z_b(i,j))) + (wt_R*(z_t(i,j+1)+z_b(i,j+1)))) - z0pres)
I_al0 = 1.0 / al0
I_Lzz = 1.0 / ((p0 + p_ave) + lambda * I_al0)
@@ -827,16 +827,16 @@ subroutine int_spec_vol_dp_wright_red(T, S, p_t, p_b, spv_ref, HI, dza, &
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j)
- p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j)
- lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j)
+ al0 = (wtT_L*al0_2d(i,j)) + (wtT_R*al0_2d(i+1,j))
+ p0 = (wtT_L*p0_2d(i,j)) + (wtT_R*p0_2d(i+1,j))
+ lambda = (wtT_L*lambda_2d(i,j)) + (wtT_R*lambda_2d(i+1,j))
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
- p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i+1,j)+p_b(i+1,j)))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i+1,j) - p_t(i+1,j)))
+ p_ave = 0.5*((wt_L*(p_t(i,j)+p_b(i,j))) + (wt_R*(p_t(i+1,j)+p_b(i+1,j))))
I_pterm = 1.0 / (p0 + p_ave)
eps = 0.5 * dp * I_pterm ; eps2 = eps*eps
@@ -869,16 +869,16 @@ subroutine int_spec_vol_dp_wright_red(T, S, p_t, p_b, spv_ref, HI, dza, &
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1)
- p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1)
- lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1)
+ al0 = (wt_L*al0_2d(i,j)) + (wt_R*al0_2d(i,j+1))
+ p0 = (wt_L*p0_2d(i,j)) + (wt_R*p0_2d(i,j+1))
+ lambda = (wt_L*lambda_2d(i,j)) + (wt_R*lambda_2d(i,j+1))
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
- p_ave = 0.5*(wt_L*(p_t(i,j)+p_b(i,j)) + wt_R*(p_t(i,j+1)+p_b(i,j+1)))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i,j+1) - p_t(i,j+1)))
+ p_ave = 0.5*((wt_L*(p_t(i,j)+p_b(i,j))) + (wt_R*(p_t(i,j+1)+p_b(i,j+1))))
I_pterm = 1.0 / (p0 + p_ave)
eps = 0.5 * dp * I_pterm ; eps2 = eps*eps
diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90
index 8984fbca88..490885aacc 100644
--- a/src/equation_of_state/MOM_EOS_linear.F90
+++ b/src/equation_of_state/MOM_EOS_linear.F90
@@ -356,7 +356,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, &
raL = (Rho_T0_S0 - rho_ref) + (dRho_dT*T(i,j) + dRho_dS*S(i,j))
raR = (Rho_T0_S0 - rho_ref) + (dRho_dT*T(i+1,j) + dRho_dS*S(i+1,j))
- intx_dpa(i,j) = G_e*C1_6 * (dzL*(2.0*raL + raR) + dzR*(2.0*raR + raL))
+ intx_dpa(i,j) = G_e*C1_6 * ((dzL*(2.0*raL + raR)) + (dzR*(2.0*raR + raL)))
else
hL = (z_t(i,j) - z_b(i,j)) + dz_neglect
hR = (z_t(i+1,j) - z_b(i+1,j)) + dz_neglect
@@ -368,12 +368,12 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j))
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i+1,j) - z_b(i+1,j)))
rho_anom = (Rho_T0_S0 - rho_ref) + &
- (dRho_dT * (wtT_L*T(i,j) + wtT_R*T(i+1,j)) + &
- dRho_dS * (wtT_L*S(i,j) + wtT_R*S(i+1,j)))
+ (dRho_dT * ((wtT_L*T(i,j)) + (wtT_R*T(i+1,j))) + &
+ dRho_dS * ((wtT_L*S(i,j)) + (wtT_R*S(i+1,j))))
intz(m) = G_e*rho_anom*dz
enddo
! Use Boole's rule to integrate the values.
@@ -395,7 +395,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, &
raL = (Rho_T0_S0 - rho_ref) + (dRho_dT*T(i,j) + dRho_dS*S(i,j))
raR = (Rho_T0_S0 - rho_ref) + (dRho_dT*T(i,j+1) + dRho_dS*S(i,j+1))
- inty_dpa(i,j) = G_e*C1_6 * (dzL*(2.0*raL + raR) + dzR*(2.0*raR + raL))
+ inty_dpa(i,j) = G_e*C1_6 * ((dzL*(2.0*raL + raR)) + (dzR*(2.0*raR + raL)))
else
hL = (z_t(i,j) - z_b(i,j)) + dz_neglect
hR = (z_t(i,j+1) - z_b(i,j+1)) + dz_neglect
@@ -407,12 +407,12 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, &
intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
- dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1))
+ dz = (wt_L*(z_t(i,j) - z_b(i,j))) + (wt_R*(z_t(i,j+1) - z_b(i,j+1)))
rho_anom = (Rho_T0_S0 - rho_ref) + &
- (dRho_dT * (wtT_L*T(i,j) + wtT_R*T(i,j+1)) + &
- dRho_dS * (wtT_L*S(i,j) + wtT_R*S(i,j+1)))
+ (dRho_dT * ((wtT_L*T(i,j)) + (wtT_R*T(i,j+1))) + &
+ dRho_dS * ((wtT_L*S(i,j)) + (wtT_R*S(i,j+1))))
intz(m) = G_e*rho_anom*dz
enddo
! Use Boole's rule to integrate the values.
@@ -530,7 +530,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, &
dRho_TS = dRho_dT*T(i+1,j) + dRho_dS*S(i+1,j)
aaR = ((1.0 - Rho_T0_S0*alpha_ref) - dRho_TS*alpha_ref) / (Rho_T0_S0 + dRho_TS)
- intx_dza(i,j) = C1_6 * (2.0*(dpL*aaL + dpR*aaR) + (dpL*aaR + dpR*aaL))
+ intx_dza(i,j) = C1_6 * (2.0*((dpL*aaL) + (dpR*aaR)) + ((dpL*aaR) + (dpR*aaL)))
else
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
hR = (p_b(i+1,j) - p_t(i+1,j)) + dP_neglect
@@ -542,14 +542,14 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, &
intp(1) = dza(i,j) ; intp(5) = dza(i+1,j)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i+1,j) - p_t(i+1,j)))
- dRho_TS = dRho_dT*(wtT_L*T(i,j) + wtT_R*T(i+1,j)) + &
- dRho_dS*(wtT_L*S(i,j) + wtT_R*S(i+1,j))
+ dRho_TS = dRho_dT*((wtT_L*T(i,j)) + (wtT_R*T(i+1,j))) + &
+ dRho_dS*((wtT_L*S(i,j)) + (wtT_R*S(i+1,j)))
! alpha_anom = 1.0/(Rho_T0_S0 + dRho_TS)) - alpha_ref
alpha_anom = ((1.0-Rho_T0_S0*alpha_ref) - dRho_TS*alpha_ref) / (Rho_T0_S0 + dRho_TS)
intp(m) = alpha_anom*dp
@@ -575,7 +575,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, &
dRho_TS = dRho_dT*T(i,j+1) + dRho_dS*S(i,j+1)
aaR = ((1.0 - Rho_T0_S0*alpha_ref) - dRho_TS*alpha_ref) / (Rho_T0_S0 + dRho_TS)
- inty_dza(i,j) = C1_6 * (2.0*(dpL*aaL + dpR*aaR) + (dpL*aaR + dpR*aaL))
+ inty_dza(i,j) = C1_6 * (2.0*((dpL*aaL) + (dpR*aaR)) + ((dpL*aaR) + (dpR*aaL)))
else
hL = (p_b(i,j) - p_t(i,j)) + dP_neglect
hR = (p_b(i,j+1) - p_t(i,j+1)) + dP_neglect
@@ -587,14 +587,14 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, &
intp(1) = dza(i,j) ; intp(5) = dza(i,j+1)
do m=2,4
wt_L = 0.25*real(5-m) ; wt_R = 1.0-wt_L
- wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR
+ wtT_L = (wt_L*hWt_LL) + (wt_R*hWt_RL) ; wtT_R = (wt_L*hWt_LR) + (wt_R*hWt_RR)
! T, S, and p are interpolated in the horizontal. The p interpolation
! is linear, but for T and S it may be thickness weighted.
- dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1))
+ dp = (wt_L*(p_b(i,j) - p_t(i,j))) + (wt_R*(p_b(i,j+1) - p_t(i,j+1)))
- dRho_TS = dRho_dT*(wtT_L*T(i,j) + wtT_R*T(i,j+1)) + &
- dRho_dS*(wtT_L*S(i,j) + wtT_R*S(i,j+1))
+ dRho_TS = dRho_dT*((wtT_L*T(i,j)) + (wtT_R*T(i,j+1))) + &
+ dRho_dS*((wtT_L*S(i,j)) + (wtT_R*S(i,j+1)))
! alpha_anom = 1.0/(Rho_T0_S0 + dRho_TS)) - alpha_ref
alpha_anom = ((1.0-Rho_T0_S0*alpha_ref) - dRho_TS*alpha_ref) / (Rho_T0_S0 + dRho_TS)
intp(m) = alpha_anom*dp
diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90
index b973b08d4b..987d5bf502 100644
--- a/src/framework/MOM_dyn_horgrid.F90
+++ b/src/framework/MOM_dyn_horgrid.F90
@@ -169,7 +169,8 @@ module MOM_dyn_horgrid
Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m].
Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m].
real, allocatable, dimension(:,:) :: &
- CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1].
+ CoriolisBu, & !< The Coriolis parameter at corner points [T-1 ~> s-1].
+ Coriolis2Bu !< The square of the Coriolis parameter at corner points [T-2 ~> s-2].
real, allocatable, dimension(:,:) :: &
df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1].
df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1].
@@ -289,6 +290,7 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel)
allocate(G%bathyT(isd:ied, jsd:jed), source=0.0)
allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB), source=0.0)
+ allocate(G%Coriolis2Bu(IsdB:IedB, JsdB:JedB), source=0.0)
allocate(G%dF_dx(isd:ied, jsd:jed), source=0.0)
allocate(G%dF_dy(isd:ied, jsd:jed), source=0.0)
@@ -360,6 +362,7 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns)
call rotate_array_pair(G_in%dxBu, G_in%dyBu, turns, G%dxBu, G%dyBu)
call rotate_array(G_in%areaBu, turns, G%areaBu)
call rotate_array(G_in%CoriolisBu, turns, G%CoriolisBu)
+ call rotate_array(G_in%Coriolis2Bu, turns, G%Coriolis2Bu)
call rotate_array(G_in%mask2dBu, turns, G%mask2dBu)
! Topography at the cell faces
@@ -528,8 +531,8 @@ subroutine destroy_dyn_horgrid(G)
deallocate(G%porous_DminU) ; deallocate(G%porous_DmaxU) ; deallocate(G%porous_DavgU)
deallocate(G%porous_DminV) ; deallocate(G%porous_DmaxV) ; deallocate(G%porous_DavgV)
- deallocate(G%bathyT) ; deallocate(G%CoriolisBu)
- deallocate(G%dF_dx) ; deallocate(G%dF_dy)
+ deallocate(G%bathyT) ; deallocate(G%CoriolisBu) ; deallocate(G%Coriolis2Bu)
+ deallocate(G%dF_dx) ; deallocate(G%dF_dy)
deallocate(G%sin_rot) ; deallocate(G%cos_rot)
if (allocated(G%Dblock_u)) deallocate(G%Dblock_u)
diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90
index 8635eb71b5..3fec94e499 100644
--- a/src/ice_shelf/MOM_marine_ice.F90
+++ b/src/ice_shelf/MOM_marine_ice.F90
@@ -80,7 +80,7 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, time_step, CS)
do j=js,je ; do I=is-1,ie
if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) &
forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + &
- (forces%area_berg(i,j)*G%areaT(i,j) + forces%area_berg(i+1,j)*G%areaT(i+1,j)) / &
+ ((forces%area_berg(i,j)*G%areaT(i,j)) + (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / &
(G%areaT(i,j) + G%areaT(i+1,j))
forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * &
min(forces%mass_berg(i,j), forces%mass_berg(i+1,j))
@@ -88,7 +88,7 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, time_step, CS)
do J=js-1,je ; do i=is,ie
if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) &
forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + &
- (forces%area_berg(i,j)*G%areaT(i,j) + forces%area_berg(i,j+1)*G%areaT(i,j+1)) / &
+ ((forces%area_berg(i,j)*G%areaT(i,j)) + (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / &
(G%areaT(i,j) + G%areaT(i,j+1))
forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * &
min(forces%mass_berg(i,j), forces%mass_berg(i,j+1))
diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90
index 322abc6d5e..8b172eacb9 100644
--- a/src/initialization/MOM_fixed_initialization.F90
+++ b/src/initialization/MOM_fixed_initialization.F90
@@ -60,14 +60,15 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir)
logical, intent(in) :: write_geom !< If true, write grid geometry files.
character(len=*), intent(in) :: output_dir !< The directory into which to write files.
- ! Local
+ ! Local variables
character(len=200) :: inputdir ! The directory where NetCDF input files are.
character(len=200) :: config
logical :: read_porous_file
character(len=40) :: mdl = "MOM_fixed_initialization" ! This module's name.
+ integer :: I, J
logical :: debug
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+ ! This include declares and sets the variable "version".
+# include "version_variable.h"
call callTree_enter("MOM_initialize_fixed(), MOM_fixed_initialization.F90")
call log_version(PF, mdl, version, "")
@@ -156,8 +157,14 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir)
call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US)
! Calculate the components of grad f (beta)
call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US)
+! Calculate the square of the Coriolis parameter
+ do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB
+ G%Coriolis2Bu(I,J) = G%CoriolisBu(I,J)**2
+ enddo ; enddo
+
if (debug) then
call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T)
+ call qchksum(G%Coriolis2Bu, "MOM_initialize_fixed: f2 ", G%HI, scale=US%s_to_T**2)
call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L*US%s_to_T)
call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L*US%s_to_T)
endif
diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90
index c18752c83d..8841ca90e6 100644
--- a/src/initialization/MOM_state_initialization.F90
+++ b/src/initialization/MOM_state_initialization.F90
@@ -1595,7 +1595,7 @@ real function my_psi(ig,jg)
x = 2.0*(G%geoLonBu(ig,jg)-G%west_lon) / G%len_lon - 1.0 ! -1<x<1
y = 2.0*(G%geoLatBu(ig,jg)-G%south_lat) / G%len_lat - 1.0 ! -1<y<1
- r = sqrt( x**2 + y**2 ) ! Circular stream function is a function of radius only
+ r = sqrt( (x**2) + (y**2) ) ! Circular stream function is a function of radius only
r = min(1.0, r) ! Flatten stream function in corners of box
my_psi = 0.5*(1.0 - cos(dpi*r))
my_psi = my_psi * (circular_max_u * G%US%m_to_L*G%len_lon*1e3 / dpi) ! len_lon is in km
diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90
index a44eec7727..24d04b6b54 100644
--- a/src/parameterizations/lateral/MOM_MEKE.F90
+++ b/src/parameterizations/lateral/MOM_MEKE.F90
@@ -322,10 +322,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h
!$OMP parallel do default(shared)
do j=js,je ; do i=is,ie
drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * &
- ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + &
- G%areaCu(I,j)*drag_vel_u(I,j)) + &
- (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + &
- G%areaCv(i,J)*drag_vel_v(i,J)) ) )
+ (((G%areaCu(I-1,j)*drag_vel_u(I-1,j)) + &
+ (G%areaCu(I,j)*drag_vel_u(I,j))) + &
+ ((G%areaCv(i,J-1)*drag_vel_v(i,J-1)) + &
+ (G%areaCv(i,J)*drag_vel_v(i,J))) ) )
enddo ; enddo
else
!$OMP parallel do default(shared)
@@ -821,8 +821,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
(depth_tot(i,j)-depth_tot(i,j-1)) * G%IdyCv(i,J-1) &
/ max(depth_tot(i,j), depth_tot(i,j-1), h_neglect) )
endif
- beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + &
- (G%dF_dy(i,j) + beta_topo_y)**2 )
+ beta = sqrt(((G%dF_dx(i,j) + beta_topo_x)**2) + &
+ ((G%dF_dy(i,j) + beta_topo_y)**2) )
if (KhCoeff*SN*I_mass(i,j)>0.) then
! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E
@@ -1001,8 +1001,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, &
(depth_tot(i,j)-depth_tot(i,j-1)) * G%IdyCv(i,J-1) &
/ max(depth_tot(i,j), depth_tot(i,j-1), h_neglect) )
endif
- beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + &
- (G%dF_dy(i,j) + beta_topo_y)**2 )
+ beta = sqrt(((G%dF_dx(i,j) + beta_topo_x)**2) + &
+ ((G%dF_dy(i,j) + beta_topo_y)**2) )
else
beta = 0.
@@ -1618,9 +1618,9 @@ subroutine ML_MEKE_calculate_features(G, GV, US, CS, Rd_dx_h, u, v, tv, h, dt, f
endif
! Calculate mean kinetic energy
- u_t = a_e*u(I,j,1)+a_w*u(I-1,j,1)
- v_t = a_n*v(i,J,1)+a_s*v(i,J-1,1)
- mke(i,j) = 0.5*( u_t*u_t + v_t*v_t )
+ u_t = (a_e*u(I,j,1)) + (a_w*u(I-1,j,1))
+ v_t = (a_n*v(i,J,1)) + (a_s*v(i,J-1,1))
+ mke(i,j) = 0.5*( (u_t*u_t) + (v_t*v_t) )
! Calculate the magnitude of the slope
slope_t = slope_x_vert_avg(I,j)*a_e+slope_x_vert_avg(I-1,j)*a_w
@@ -1632,8 +1632,8 @@ subroutine ML_MEKE_calculate_features(G, GV, US, CS, Rd_dx_h, u, v, tv, h, dt, f
! Calculate relative vorticity
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- dvdx = (v(i+1,J,1)*G%dyCv(i+1,J) - v(i,J,1)*G%dyCv(i,J))
- dudy = (u(I,j+1,1)*G%dxCu(I,j+1) - u(I,j,1)*G%dxCu(I,j))
+ dvdx = ((v(i+1,J,1)*G%dyCv(i+1,J)) - (v(i,J,1)*G%dyCv(i,J)))
+ dudy = ((u(I,j+1,1)*G%dxCu(I,j+1)) - (u(I,j,1)*G%dxCu(I,j)))
! Assumed no slip
rv_z(I,J) = (2.0-G%mask2dBu(I,J)) * (dvdx - dudy) * G%IareaBu(I,J)
enddo; enddo
diff --git a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90
index f472118e7d..db3542764d 100644
--- a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90
+++ b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90
@@ -484,9 +484,9 @@ subroutine compute_c_diss(G, GV, CS)
if (CS%Klower_shear == 0) then
do j=js-1,je+1 ; do i=is-1,ie+1
shear = sqrt(CS%sh_xx(i,j,k)**2 + 0.25 * ( &
- (CS%sh_xy(I-1,J-1,k)**2 + CS%sh_xy(I,J ,k)**2) &
- + (CS%sh_xy(I-1,J ,k)**2 + CS%sh_xy(I,J-1,k)**2) &
- ))
+ ((CS%sh_xy(I-1,J-1,k)**2) + (CS%sh_xy(I,J ,k)**2)) &
+ + ((CS%sh_xy(I-1,J ,k)**2) + (CS%sh_xy(I,J-1,k)**2)) &
+ ))
CS%c_diss(i,j,k) = 1. / (1. + shear * CS%ICoriolis_h(i,j))
enddo; enddo
@@ -494,11 +494,11 @@ subroutine compute_c_diss(G, GV, CS)
elseif (CS%Klower_shear == 1) then
do j=js-1,je+1 ; do i=is-1,ie+1
shear = sqrt(CS%sh_xx(i,j,k)**2 + 0.25 * ( &
- ((CS%sh_xy(I-1,J-1,k)**2 + CS%vort_xy(I-1,J-1,k)**2) &
- + (CS%sh_xy(I,J,k)**2 + CS%vort_xy(I,J,k)**2)) &
- + ((CS%sh_xy(I-1,J,k)**2 + CS%vort_xy(I-1,J,k)**2) &
- + (CS%sh_xy(I,J-1,k)**2 + CS%vort_xy(I,J-1,k)**2)) &
- ))
+ ((CS%sh_xy(I-1,J-1,k)**2 + CS%vort_xy(I-1,J-1,k)**2) &
+ + (CS%sh_xy(I,J,k)**2 + CS%vort_xy(I,J,k)**2)) &
+ + ((CS%sh_xy(I-1,J,k)**2 + CS%vort_xy(I-1,J,k)**2) &
+ + (CS%sh_xy(I,J-1,k)**2 + CS%vort_xy(I,J-1,k)**2)) &
+ ))
CS%c_diss(i,j,k) = 1. / (1. + shear * CS%ICoriolis_h(i,j))
enddo; enddo
endif
@@ -583,10 +583,10 @@ subroutine compute_stress(G, GV, CS)
if (vort_sh_scheme_1) then
! It is assumed that B.C. is applied to sh_xy and vort_xy
vort_sh = 0.25 * ( &
- ((G%areaBu(I-1,J-1) * CS%vort_xy(I-1,J-1,k)) * CS%sh_xy(I-1,J-1,k) + &
- (G%areaBu(I ,J ) * CS%vort_xy(I ,J ,k)) * CS%sh_xy(I ,J ,k)) + &
- ((G%areaBu(I-1,J ) * CS%vort_xy(I-1,J ,k)) * CS%sh_xy(I-1,J ,k) + &
- (G%areaBu(I ,J-1) * CS%vort_xy(I ,J-1,k)) * CS%sh_xy(I ,J-1,k)) &
+ (((G%areaBu(I-1,J-1) * CS%vort_xy(I-1,J-1,k)) * CS%sh_xy(I-1,J-1,k)) + &
+ ((G%areaBu(I ,J ) * CS%vort_xy(I ,J ,k)) * CS%sh_xy(I ,J ,k))) + &
+ (((G%areaBu(I-1,J ) * CS%vort_xy(I-1,J ,k)) * CS%sh_xy(I-1,J ,k)) + &
+ ((G%areaBu(I ,J-1) * CS%vort_xy(I ,J-1,k)) * CS%sh_xy(I ,J-1,k))) &
) * G%IareaT(i,j)
endif
@@ -717,10 +717,8 @@ subroutine compute_stress_divergence(u, v, h, diffu, diffv, dx2h, dy2h, dx2q, dy
! but here is the discretization of div(S)
do j=js,je ; do I=Isq,Ieq
h_u = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i+1,j)*h(i+1,j,k)) + h_neglect
- fx = -((G%IdyCu(I,j)*(Mxx(i,j) - &
- Mxx(i+1,j)) + &
- G%IdxCu(I,j)*(dx2q(I,J-1)*Mxy(I,J-1) - &
- dx2q(I,J) *Mxy(I,J))) * &
+ fx = -((G%IdyCu(I,j)*(Mxx(i,j) - Mxx(i+1,j)) + &
+ G%IdxCu(I,j)*(dx2q(I,J-1)*Mxy(I,J-1) - dx2q(I,J)*Mxy(I,J))) * &
G%IareaCu(I,j)) / h_u
diffu(I,j,k) = diffu(I,j,k) + fx
if (save_ZB2020u) &
@@ -730,10 +728,8 @@ subroutine compute_stress_divergence(u, v, h, diffu, diffv, dx2h, dy2h, dx2q, dy
! Evaluate 1/h y.Div(h S) (Line 1517 of MOM_hor_visc.F90)
do J=Jsq,Jeq ; do i=is,ie
h_v = 0.5 * (G%mask2dT(i,j)*h(i,j,k) + G%mask2dT(i,j+1)*h(i,j+1,k)) + h_neglect
- fy = -((G%IdyCv(i,J)*(dy2q(I-1,J)*Mxy(I-1,J) - &
- dy2q(I,J) *Mxy(I,J)) + & ! NOTE this plus
- G%IdxCv(i,J)*(Myy(i,j) - &
- Myy(i,j+1))) * &
+ fy = -((G%IdxCv(i,J)*(Myy(i,j) - Myy(i,j+1)) + &
+ G%IdyCv(i,J)*(dy2q(I-1,J)*Mxy(I-1,J) - dy2q(I,J)*Mxy(I,J))) * &
G%IareaCv(i,J)) / h_v
diffv(i,J,k) = diffv(i,J,k) + fy
if (save_ZB2020v) &
diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90
index 2eef171bf5..4a794a19fe 100644
--- a/src/parameterizations/lateral/MOM_hor_visc.F90
+++ b/src/parameterizations/lateral/MOM_hor_visc.F90
@@ -512,10 +512,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Calculate the barotropic horizontal tension
do j=js-2,je+2 ; do i=is-2,ie+2
- dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - &
- G%IdyCu(I-1,j) * ubtav(I-1,j))
- dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - &
- G%IdxCv(i,J-1) * vbtav(i,J-1))
+ dudx_bt(i,j) = CS%DY_dxT(i,j)*((G%IdyCu(I,j) * ubtav(I,j)) - &
+ (G%IdyCu(I-1,j) * ubtav(I-1,j)))
+ dvdy_bt(i,j) = CS%DX_dyT(i,j)*((G%IdxCv(i,J) * vbtav(i,J)) - &
+ (G%IdxCv(i,J-1) * vbtav(i,J-1)))
enddo ; enddo
do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j)
@@ -523,10 +523,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Components for the barotropic shearing strain
do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2
- dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) &
- - vbtav(i,J)*G%IdyCv(i,J))
- dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) &
- - ubtav(I,j)*G%IdxCu(I,j))
+ dvdx_bt(I,J) = CS%DY_dxBu(I,J)*((vbtav(i+1,J)*G%IdyCv(i+1,J)) &
+ - (vbtav(i,J)*G%IdyCv(i,J)))
+ dudy_bt(I,J) = CS%DX_dyBu(I,J)*((ubtav(I,j+1)*G%IdxCu(I,j+1)) &
+ - (ubtav(I,j)*G%IdxCu(I,j)))
enddo ; enddo
if (CS%no_slip) then
@@ -653,35 +653,35 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Calculate horizontal tension
do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2
- dudx(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - &
- G%IdyCu(I-1,j) * u(I-1,j,k))
- dvdy(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - &
- G%IdxCv(i,J-1) * v(i,J-1,k))
+ dudx(i,j) = CS%DY_dxT(i,j)*((G%IdyCu(I,j) * u(I,j,k)) - &
+ (G%IdyCu(I-1,j) * u(I-1,j,k)))
+ dvdy(i,j) = CS%DX_dyT(i,j)*((G%IdxCv(i,J) * v(i,J,k)) - &
+ (G%IdxCv(i,J-1) * v(i,J-1,k)))
sh_xx(i,j) = dudx(i,j) - dvdy(i,j)
enddo ; enddo
! Components for the shearing strain
do J=js_vort,je_vort ; do I=is_vort,ie_vort
- dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J))
- dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j))
+ dvdx(I,J) = CS%DY_dxBu(I,J)*((v(i+1,J,k)*G%IdyCv(i+1,J)) - (v(i,J,k)*G%IdyCv(i,J)))
+ dudy(I,J) = CS%DX_dyBu(I,J)*((u(I,j+1,k)*G%IdxCu(I,j+1)) - (u(I,j,k)*G%IdxCu(I,j)))
enddo ; enddo
if (CS%use_Leithy) then
! Calculate horizontal tension from smoothed velocity
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- dudx_smooth(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u_smooth(I,j,k) - &
- G%IdyCu(I-1,j) * u_smooth(I-1,j,k))
- dvdy_smooth(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v_smooth(i,J,k) - &
- G%IdxCv(i,J-1) * v_smooth(i,J-1,k))
+ dudx_smooth(i,j) = CS%DY_dxT(i,j)*((G%IdyCu(I,j) * u_smooth(I,j,k)) - &
+ (G%IdyCu(I-1,j) * u_smooth(I-1,j,k)))
+ dvdy_smooth(i,j) = CS%DX_dyT(i,j)*((G%IdxCv(i,J) * v_smooth(i,J,k)) - &
+ (G%IdxCv(i,J-1) * v_smooth(i,J-1,k)))
sh_xx_smooth(i,j) = dudx_smooth(i,j) - dvdy_smooth(i,j)
enddo ; enddo
! Components for the shearing strain from smoothed velocity
do J=js_Kh-1,je_Kh ; do I=is_Kh-1,ie_Kh
dvdx_smooth(I,J) = CS%DY_dxBu(I,J) * &
- (v_smooth(i+1,J,k)*G%IdyCv(i+1,J) - v_smooth(i,J,k)*G%IdyCv(i,J))
+ ((v_smooth(i+1,J,k)*G%IdyCv(i+1,J)) - (v_smooth(i,J,k)*G%IdyCv(i,J)))
dudy_smooth(I,J) = CS%DX_dyBu(I,J) * &
- (u_smooth(I,j+1,k)*G%IdxCu(I,j+1) - u_smooth(I,j,k)*G%IdxCu(I,j))
+ ((u_smooth(I,j+1,k)*G%IdxCu(I,j+1)) - (u_smooth(I,j,k)*G%IdxCu(I,j)))
enddo ; enddo
endif ! use Leith+E
@@ -873,12 +873,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u)
if (CS%biharmonic) then
do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1
- Del2u(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + &
- CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1))
+ Del2u(I,j) = CS%Idx2dyCu(I,j) * ((CS%dx2q(I,J)*sh_xy(I,J)) - (CS%dx2q(I,J-1)*sh_xy(I,J-1))) + &
+ CS%Idxdy2u(I,j) * ((CS%dy2h(i+1,j)*sh_xx(i+1,j)) - (CS%dy2h(i,j)*sh_xx(i,j)))
enddo ; enddo
do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1
- Del2v(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - &
- CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j))
+ Del2v(i,J) = CS%Idxdy2v(i,J) * ((CS%dy2q(I,J)*sh_xy(I,J)) - (CS%dy2q(I-1,J)*sh_xy(I-1,J))) - &
+ CS%Idx2dyCv(i,J) * ((CS%dx2h(i,j+1)*sh_xx(i,j+1)) - (CS%dx2h(i,j)*sh_xx(i,j)))
enddo ; enddo
if (apply_OBC) then ; if (OBC%zero_biharmonic) then
do n=1,OBC%number_of_segments
@@ -927,12 +927,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Vorticity gradient
do J=js-2,je_Kh ; do i=is_Kh-1,ie_Kh+1
DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J)
- vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j))
+ vort_xy_dx(i,J) = DY_dxBu * ((vort_xy(I,J) * G%IdyCu(I,j)) - (vort_xy(I-1,J) * G%IdyCu(I-1,j)))
enddo ; enddo
do j=js_Kh-1,je_Kh+1 ; do I=is-2,ie_Kh
DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J)
- vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1))
+ vort_xy_dy(I,j) = DX_dyBu * ((vort_xy(I,J) * G%IdxCv(i,J)) - (vort_xy(I,J-1) * G%IdxCv(i,J-1)))
enddo ; enddo
if (CS%use_Leithy) then
@@ -940,13 +940,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
do J=js_Kh-1,je_Kh ; do i=is_Kh,ie_Kh
DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J)
vort_xy_dx_smooth(i,J) = DY_dxBu * &
- (vort_xy_smooth(I,J) * G%IdyCu(I,j) - vort_xy_smooth(I-1,J) * G%IdyCu(I-1,j))
+ ((vort_xy_smooth(I,J) * G%IdyCu(I,j)) - (vort_xy_smooth(I-1,J) * G%IdyCu(I-1,j)))
enddo ; enddo
do j=js_Kh,je_Kh ; do I=is_Kh-1,ie_Kh
DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J)
vort_xy_dy_smooth(I,j) = DX_dyBu * &
- (vort_xy_smooth(I,J) * G%IdxCv(i,J) - vort_xy_smooth(I,J-1) * G%IdxCv(i,J-1))
+ ((vort_xy_smooth(I,J) * G%IdxCv(i,J)) - (vort_xy_smooth(I,J-1) * G%IdxCv(i,J-1)))
enddo ; enddo
endif ! If Leithy
@@ -956,8 +956,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J)
DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J)
- Del2vort_q(I,J) = DY_dxBu * (vort_xy_dx(i+1,J) * G%IdyCv(i+1,J) - vort_xy_dx(i,J) * G%IdyCv(i,J)) + &
- DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j))
+ Del2vort_q(I,J) = DY_dxBu * ((vort_xy_dx(i+1,J) * G%IdyCv(i+1,J)) - (vort_xy_dx(i,J) * G%IdyCv(i,J))) + &
+ DX_dyBu * ((vort_xy_dy(I,j+1) * G%IdyCu(I,j+1)) - (vort_xy_dy(I,j) * G%IdyCu(I,j)))
enddo ; enddo
! endif
@@ -978,12 +978,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Magnitude of divergence gradient
do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
- grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + &
- (0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2)
+ grad_div_mag_h(i,j) = sqrt(((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2) + &
+ ((0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2))
enddo ; enddo
do J=js-1,Jeq ; do I=is-1,Ieq
- grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + &
- (0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2)
+ grad_div_mag_q(I,J) = sqrt(((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2) + &
+ ((0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2))
enddo ; enddo
else
@@ -1016,12 +1016,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%use_QG_Leith_visc) then
do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
- grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + &
- (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 )
+ grad_vort_mag_h_2d(i,j) = SQRT(((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2) + &
+ ((0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2) )
enddo ; enddo
do J=js-1,Jeq ; do I=is-1,Ieq
- grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + &
- (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 )
+ grad_vort_mag_q_2d(I,J) = SQRT(((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2) + &
+ ((0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2) )
enddo ; enddo
! This accumulates terms, some of which are in VarMix.
@@ -1031,20 +1031,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
- grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + &
- (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 )
+ grad_vort_mag_h(i,j) = SQRT(((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2) + &
+ ((0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2) )
enddo ; enddo
do J=js-1,Jeq ; do I=is-1,Ieq
- grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + &
- (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 )
+ grad_vort_mag_q(I,J) = SQRT(((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2) + &
+ ((0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2) )
enddo ; enddo
if (CS%use_Leithy) then
do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
- vert_vort_mag_smooth(i,j) = SQRT((0.5*(vort_xy_dx_smooth(i,J) + &
- vort_xy_dx_smooth(i,J-1)))**2 + &
- (0.5*(vort_xy_dy_smooth(I,j) + &
- vort_xy_dy_smooth(I-1,j)))**2 )
+ vert_vort_mag_smooth(i,j) = SQRT(((0.5*(vort_xy_dx_smooth(i,J) + &
+ vort_xy_dx_smooth(i,J-1)))**2) + &
+ ((0.5*(vort_xy_dy_smooth(I,j) + &
+ vort_xy_dy_smooth(I-1,j)))**2) )
enddo ; enddo
endif ! Leithy
@@ -1053,8 +1053,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then
do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh
sh_xx_sq = sh_xx(i,j)**2
- sh_xy_sq = 0.25 * ( (sh_xy(I-1,J-1)**2 + sh_xy(I,J)**2) &
- + (sh_xy(I-1,J)**2 + sh_xy(I,J-1)**2) )
+ sh_xy_sq = 0.25 * ( ((sh_xy(I-1,J-1)**2) + (sh_xy(I,J)**2)) &
+ + ((sh_xy(I-1,J)**2) + (sh_xy(I,J-1)**2)) )
Shear_mag(i,j) = sqrt(sh_xx_sq + sh_xy_sq)
enddo ; enddo
endif
@@ -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
@@ -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
@@ -1353,16 +1353,16 @@ 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
endif
do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1
- d_del2u = G%IdyCu(I,j) * Del2u(I,j) - G%IdyCu(I-1,j) * Del2u(I-1,j)
- d_del2v = G%IdxCv(i,J) * Del2v(i,J) - G%IdxCv(i,J-1) * Del2v(i,J-1)
- d_str = Ah(i,j) * (CS%DY_dxT(i,j) * d_del2u - CS%DX_dyT(i,j) * d_del2v)
+ d_del2u = (G%IdyCu(I,j) * Del2u(I,j)) - (G%IdyCu(I-1,j) * Del2u(I-1,j))
+ d_del2v = (G%IdxCv(i,J) * Del2v(i,J)) - (G%IdxCv(i,J-1) * Del2v(i,J-1))
+ d_str = Ah(i,j) * ((CS%DY_dxT(i,j) * d_del2u) - (CS%DX_dyT(i,j) * d_del2v))
str_xx(i,j) = str_xx(i,j) + d_str
@@ -1376,8 +1376,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%biharmonic) then
! Gradient of Laplacian, for use in bi-harmonic term
do J=js-1,Jeq ; do I=is-1,Ieq
- dDel2vdx(I,J) = CS%DY_dxBu(I,J)*(Del2v(i+1,J)*G%IdyCv(i+1,J) - Del2v(i,J)*G%IdyCv(i,J))
- dDel2udy(I,J) = CS%DX_dyBu(I,J)*(Del2u(I,j+1)*G%IdxCu(I,j+1) - Del2u(I,j)*G%IdxCu(I,j))
+ dDel2vdx(I,J) = CS%DY_dxBu(I,J)*((Del2v(i+1,J)*G%IdyCv(i+1,J)) - (Del2v(i,J)*G%IdyCv(i,J)))
+ dDel2udy(I,J) = CS%DX_dyBu(I,J)*((Del2u(I,j+1)*G%IdxCu(I,j+1)) - (Del2u(I,j)*G%IdxCu(I,j)))
enddo ; enddo
! Adjust contributions to shearing strain on open boundaries.
if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then
@@ -1409,8 +1409,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then
do J=js-1,Jeq ; do I=is-1,Ieq
sh_xy_sq = sh_xy(I,J)**2
- sh_xx_sq = 0.25 * ( (sh_xx(i,j)**2 + sh_xx(i+1,j+1)**2) &
- + (sh_xx(i,j+1)**2 + sh_xx(i+1,j)**2) )
+ sh_xx_sq = 0.25 * ( ((sh_xx(i,j)**2) + (sh_xx(i+1,j+1)**2)) &
+ + ((sh_xx(i,j+1)**2) + (sh_xx(i+1,j)**2)) )
Shear_mag(I,J) = sqrt(sh_xy_sq + sh_xx_sq)
enddo ; enddo
endif
@@ -1641,7 +1641,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
if (CS%Re_Ah > 0.0) then
do J=js-1,Jeq ; do I=is-1,Ieq
- KE = 0.125 * ((u(I,j,k) + u(I,j+1,k))**2 + (v(i,J,k) + v(i+1,J,k))**2)
+ KE = 0.125 * (((u(I,j,k) + u(I,j+1,k))**2) + ((v(i,J,k) + v(i+1,J,k))**2))
Ah(I,J) = sqrt(KE) * CS%Re_Ah_const_xy(I,J)
enddo ; enddo
endif
@@ -1743,8 +1743,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent.
do j=js,je ; do I=Isq,Ieq
- diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%dy2h(i,j)*str_xx(i,j) - CS%dy2h(i+1,j)*str_xx(i+1,j)) + &
- G%IdxCu(I,j)*(CS%dx2q(I,J-1)*str_xy(I,J-1) - CS%dx2q(I,J)*str_xy(I,J))) * &
+ diffu(I,j,k) = ((G%IdxCu(I,j)*((CS%dx2q(I,J-1)*str_xy(I,J-1)) - (CS%dx2q(I,J)*str_xy(I,J))) + &
+ G%IdyCu(I,j)*((CS%dy2h(i,j)*str_xx(i,j)) - (CS%dy2h(i+1,j)*str_xx(i+1,j)))) * &
G%IareaCu(I,j)) / (h_u(I,j) + h_neglect)
enddo ; enddo
@@ -1763,8 +1763,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent.
do J=Jsq,Jeq ; do i=is,ie
- diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%dy2q(I-1,J)*str_xy(I-1,J) - CS%dy2q(I,J)*str_xy(I,J)) - &
- G%IdxCv(i,J)*(CS%dx2h(i,j)*str_xx(i,j) - CS%dx2h(i,j+1)*str_xx(i,j+1))) * &
+ diffv(i,J,k) = ((G%IdyCv(i,J)*((CS%dy2q(I-1,J)*str_xy(I-1,J)) - (CS%dy2q(I,J)*str_xy(I,J))) - &
+ G%IdxCv(i,J)*((CS%dx2h(i,j)*str_xx(i,j)) - (CS%dx2h(i,j+1)*str_xx(i,j+1)))) * &
G%IareaCv(i,J)) / (h_v(i,J) + h_neglect)
enddo ; enddo
@@ -1785,40 +1785,40 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
! 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
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)) ) ) )
+ ((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 ; endif
if (CS%use_GME) then ; do j=js,je ; do i=is,ie
! Diagnose str_xx_GME*d_x u - str_yy_GME*d_y v + str_xy_GME*(d_y u + d_x v)
! This is the old formulation that includes energy diffusion
FrictWork_GME(i,j,k) = GV%H_to_RZ * ( &
- (str_xx_GME(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
- - str_xx_GME(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
- + 0.25*((str_xy_GME(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_GME(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_GME(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_GME(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)) ) ) )
+ ((str_xx_GME(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j)) &
+ - (str_xx_GME(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j))) &
+ + 0.25*(( (str_xy_GME(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_GME(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_GME(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_GME(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 ; endif
! Make a similar calculation as for FrictWork above but accumulating into
@@ -1840,8 +1840,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
FatH = 0.25*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + &
(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) )
Shear_mag_bc = sqrt(sh_xx(i,j) * sh_xx(i,j) + &
- 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + &
- (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1))))
+ 0.25*(((sh_xy(I-1,J-1)*sh_xy(I-1,J-1)) + (sh_xy(I,J)*sh_xy(I,J))) + &
+ ((sh_xy(I-1,J)*sh_xy(I-1,J)) + (sh_xy(I,J-1)*sh_xy(I,J-1)))))
if (CS%answer_date > 20190101) then
FatH = (US%s_to_T*FatH)**MEKE%backscatter_Ro_pow ! f^n
! Note the hard-coded dimensional constant in the following line that can not
@@ -1861,20 +1861,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US,
endif
MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_RZ * ( &
- ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) &
- -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) &
- + 0.25*(((str_xy(I,J)-RoScl*bhstr_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)-RoScl*bhstr_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)-RoScl*bhstr_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)-RoScl*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)) ) ) )
+ (((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j)) &
+ - ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j))) &
+ + 0.25*( (((str_xy(I,J)-RoScl*bhstr_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)-RoScl*bhstr_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)-RoScl*bhstr_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)-RoScl*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)))) ) ) )
enddo ; enddo
endif ! MEKE%backscatter_Ro_c
@@ -2640,34 +2640,34 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
! empirically work for CS%bound_coef <~ 1.0
if (CS%biharmonic .and. CS%better_bound_Ah) then
do j=js-1,Jeq+1 ; do I=is-2,Ieq+1
- u0u(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + &
- CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + &
- CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + &
- CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) )
- u0v(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + &
- CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + &
- CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + &
- CS%dx2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) )
+ u0u(I,j) = ((CS%Idxdy2u(I,j)*((CS%dy2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j))) + &
+ (CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j))) )) + &
+ (CS%Idx2dyCu(I,j)*((CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j))) + &
+ (CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1))) )) )
+ u0v(I,j) = ((CS%Idxdy2u(I,j)*((CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1))) + &
+ (CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1))) )) + &
+ (CS%Idx2dyCu(I,j)*((CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J))) + &
+ (CS%dx2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1))) )) )
enddo ; enddo
do J=js-2,Jeq+1 ; do i=is-1,Ieq+1
- v0u(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + &
- CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + &
- CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + &
- CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) )
- v0v(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + &
- CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + &
- CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + &
- CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) )
+ v0u(i,J) = ((CS%Idxdy2v(i,J)*((CS%dy2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j))) + &
+ (CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j))) )) + &
+ (CS%Idx2dyCv(i,J)*((CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1))) + &
+ (CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j))) ) ))
+ v0v(i,J) = ((CS%Idxdy2v(i,J)*((CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J))) + &
+ (CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J))) )) + &
+ (CS%Idx2dyCv(i,J)*((CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J))) + &
+ (CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1))) )) )
enddo ; enddo
do j=js-1,Jeq+1 ; do i=is-1,Ieq+1
denom = max( &
(CS%dy2h(i,j) * &
- (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + &
- CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * &
- max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), &
+ ((CS%DY_dxT(i,j)*((G%IdyCu(I,j)*u0u(I,j)) + (G%IdyCu(I-1,j)*u0u(I-1,j)))) + &
+ (CS%DX_dyT(i,j)*((G%IdxCv(i,J)*v0u(i,J)) + (G%IdxCv(i,J-1)*v0u(i,J-1))))) * &
+ max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), &
(CS%dx2h(i,j) * &
- (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + &
- CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * &
+ ((CS%DY_dxT(i,j)*((G%IdyCu(I,j)*u0v(I,j)) + (G%IdyCu(I-1,j)*u0v(I-1,j)))) + &
+ (CS%DX_dyT(i,j)*((G%IdxCv(i,J)*v0v(i,J)) + (G%IdxCv(i,J-1)*v0v(i,J-1))))) * &
max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) )
CS%Ah_Max_xx(I,J) = 0.0
if (denom > 0.0) &
@@ -2676,12 +2676,12 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp)
do J=js-1,Jeq ; do I=is-1,Ieq
denom = max( &
(CS%dx2q(I,J) * &
- (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + &
- CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * &
- max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), &
+ ((CS%DX_dyBu(I,J)*((u0u(I,j+1)*G%IdxCu(I,j+1)) + (u0u(I,j)*G%IdxCu(I,j)))) + &
+ (CS%DY_dxBu(I,J)*((v0u(i+1,J)*G%IdyCv(i+1,J)) + (v0u(i,J)*G%IdyCv(i,J))))) * &
+ max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), &
(CS%dy2q(I,J) * &
- (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + &
- CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * &
+ ((CS%DX_dyBu(I,J)*((u0v(I,j+1)*G%IdxCu(I,j+1)) + (u0v(I,j)*G%IdxCu(I,j)))) + &
+ (CS%DY_dxBu(I,J)*((v0v(i+1,J)*G%IdyCv(i+1,J)) + (v0v(i,J)*G%IdyCv(i,J))))) * &
max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) )
CS%Ah_Max_xy(I,J) = 0.0
if (denom > 0.0) &
@@ -2857,12 +2857,12 @@ subroutine align_aniso_tensor_to_grid(CS, n1, n2)
! Local variables
real :: recip_n2_norm ! The inverse of the squared magnitude of n1 and n2 [nondim]
! For normalizing n=(n1,n2) in case arguments are not a unit vector
- recip_n2_norm = n1**2 + n2**2
+ recip_n2_norm = (n1**2) + (n2**2)
if (recip_n2_norm > 0.) recip_n2_norm = 1. / recip_n2_norm
CS%n1n2_h(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm
CS%n1n2_q(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm
- CS%n1n1_m_n2n2_h(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm
- CS%n1n1_m_n2n2_q(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm
+ CS%n1n1_m_n2n2_h(:,:) = ( (n1 * n1) - (n2 * n2) ) * recip_n2_norm
+ CS%n1n1_m_n2n2_q(:,:) = ( (n1 * n1) - (n2 * n2) ) * recip_n2_norm
end subroutine align_aniso_tensor_to_grid
!> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any
diff --git a/src/parameterizations/lateral/MOM_interface_filter.F90 b/src/parameterizations/lateral/MOM_interface_filter.F90
index 07b698e294..42782e86a1 100644
--- a/src/parameterizations/lateral/MOM_interface_filter.F90
+++ b/src/parameterizations/lateral/MOM_interface_filter.F90
@@ -123,11 +123,11 @@ subroutine interface_filter(h, uhtr, vhtr, tv, dt, G, GV, US, CDp, CS)
if (CS%isotropic_filter) then
!$OMP parallel do default(shared)
do j=js-hs,je+hs ; do I=is-(hs+1),ie+hs
- Lsm2_u(I,j) = (0.25*filter_strength) / (G%IdxCu(I,j)**2 + G%IdyCu(I,j)**2)
+ Lsm2_u(I,j) = (0.25*filter_strength) / ((G%IdxCu(I,j)**2) + (G%IdyCu(I,j)**2))
enddo ; enddo
!$OMP parallel do default(shared)
do J=js-(hs+1),je+hs ; do i=is-hs,ie+hs
- Lsm2_v(i,J) = (0.25*filter_strength) / (G%IdxCv(i,J)**2 + G%IdyCv(i,J)**2)
+ Lsm2_v(i,J) = (0.25*filter_strength) / ((G%IdxCv(i,J)**2) + (G%IdyCv(i,J)**2))
enddo ; enddo
else
!$OMP parallel do default(shared)
diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90
index 5b9ce4934c..b1e84a74f7 100644
--- a/src/parameterizations/lateral/MOM_internal_tides.F90
+++ b/src/parameterizations/lateral/MOM_internal_tides.F90
@@ -361,8 +361,8 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
if (CS%energized_angle <= 0) then
frac_per_sector = 1.0 / real(CS%nAngle)
do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie
- f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
+ f2 = 0.25*((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
if (CS%frequency(fr)**2 > f2) &
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * &
CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr)
@@ -371,8 +371,8 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
frac_per_sector = 1.0
a = CS%energized_angle
do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie
- f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
+ f2 = 0.25*((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
if (CS%frequency(fr)**2 > f2) &
CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + dt*frac_per_sector*(1.0-CS%q_itides) * &
CS%fraction_tidal_input(fr,m) * TKE_itidal_input(i,j,fr)
@@ -630,8 +630,8 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C
do j=js,je ; do i=is,ie
id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging
! Calculate horizontal phase velocity magnitudes
- f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))
+ f2 = 0.25*((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1)))
Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2)
c_phase = 0.0
if (Kmag2 > 0.0) then
@@ -1134,8 +1134,8 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang)
! Do the refraction.
do i=is,ie
- f2 = 0.25* ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2))
+ f2 = 0.25* ((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I,J-1) + G%Coriolis2Bu(I-1,J)))
favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + &
(G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J)))
df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - &
@@ -1355,7 +1355,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss)
! Fix indexing here later
speed(:,:) = 0.0
do J=jsh-1,jeh ; do I=ish-1,ieh
- f2 = G%CoriolisBu(I,J)**2
+ f2 = G%Coriolis2Bu(I,J)
speed(I,J) = 0.25*((cn(i,j) + cn(i+1,j+1)) + (cn(i+1,j) + cn(i,j+1))) * &
sqrt(max(freq2 - f2, 0.0)) * Ifreq
enddo ; enddo
@@ -1385,12 +1385,12 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss)
enddo
do j=jsh,jeh ; do I=ish-1,ieh
- f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2)
+ f2 = 0.5 * (G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I,J-1))
speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * &
sqrt(max(freq2 - f2, 0.0)) * Ifreq
enddo ; enddo
do J=jsh-1,jeh ; do i=ish,ieh
- f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2)
+ f2 = 0.5 * (G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J))
speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * &
sqrt(max(freq2 - f2, 0.0)) * Ifreq
enddo ; enddo
@@ -1580,28 +1580,28 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS
!a3 = (yW - yNW)*(0.5*(xW + xNW))
!a4 = (yNW - yN)*(0.5*(xNW + xN))
!aW = a1 + a2 + a3 + a4
- aW = 0.5 * ((yCrn - yNW)*(xW - xN) + (xCrn - xNW)*(yN - yW))
+ aW = 0.5 * (((yCrn - yNW)*(xW - xN)) + ((xCrn - xNW)*(yN - yW)))
! southwest area
!a1 = (yCrn - yS)*(0.5*(xCrn + xS))
!a2 = (yS - ySW)*(0.5*(xS + xSW))
!a3 = (ySW - yW)*(0.5*(xSW + xW))
!a4 = (yW - yCrn)*(0.5*(xW + xCrn))
!aSW = a1 + a2 + a3 + a4
- aSW = 0.5 * ((yCrn - ySW)*(xS - xW) + (xCrn - xSW)*(yW - yS))
+ aSW = 0.5 * (((yCrn - ySW)*(xS - xW)) + ((xCrn - xSW)*(yW - yS)))
! south area
!a1 = (yE - ySE)*(0.5*(xE + xSE))
!a2 = (ySE - yS)*(0.5*(xSE + xS))
!a3 = (yS - yCrn)*(0.5*(xS + xCrn))
!a4 = (yCrn - yE)*(0.5*(xCrn + xE))
!aS = a1 + a2 + a3 + a4
- aS = 0.5 * ((yCrn - ySE)*(xE - xS) + (xCrn - xSE)*(yS - yE))
+ aS = 0.5 * (((yCrn - ySE)*(xE - xS)) + ((xCrn - xSE)*(yS - yE)))
! area within cell
!a1 = (yNE - yE)*(0.5*(xNE + xE))
!a2 = (yE - yCrn)*(0.5*(xE + xCrn))
!a3 = (yCrn - yN)*(0.5*(xCrn + xN))
!a4 = (yN - yNE)*(0.5*(xN + xNE))
!aC = a1 + a2 + a3 + a4
- aC = 0.5 * ((yCrn - yNE)*(xN - xE) + (xCrn - xNE)*(yE - yN))
+ aC = 0.5 * (((yCrn - yNE)*(xN - xE)) + ((xCrn - xNE)*(yE - yN)))
elseif (0.25*TwoPi <= theta .and. theta < 0.5*TwoPi) then
xCrn = x(I,J-1); yCrn = y(I,J-1)
! south area
@@ -1610,28 +1610,28 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS
!a3 = (ySW - yW)*(0.5*(xSW + xW))
!a4 = (yW - yCrn)*(0.5*(xW + xCrn))
!aS = a1 + a2 + a3 + a4
- aS = 0.5 * ((yCrn - ySW)*(xS - xW) + (xCrn - xSW)*(yW - yS))
+ aS = 0.5 * (((yCrn - ySW)*(xS - xW)) + ((xCrn - xSW)*(yW - yS)))
! southeast area
!a1 = (yE - ySE)*(0.5*(xE + xSE))
!a2 = (ySE - yS)*(0.5*(xSE + xS))
!a3 = (yS - yCrn)*(0.5*(xS + xCrn))
!a4 = (yCrn - yE)*(0.5*(xCrn + xE))
!aSE = a1 + a2 + a3 + a4
- aSE = 0.5 * ((yCrn - ySE)*(xE - xS) + (xCrn - xSE)*(yS - yE))
+ aSE = 0.5 * (((yCrn - ySE)*(xE - xS)) + ((xCrn - xSE)*(yS - yE)))
! east area
!a1 = (yNE - yE)*(0.5*(xNE + xE))
!a2 = (yE - yCrn)*(0.5*(xE + xCrn))
!a3 = (yCrn - yN)*(0.5*(xCrn + xN))
!a4 = (yN - yNE)*(0.5*(xN + xNE))
!aE = a1 + a2 + a3 + a4
- aE = 0.5 * ((yCrn - yNE)*(xN - xE) + (xCrn - xNE)*(yE - yN))
+ aE = 0.5 * (((yCrn - yNE)*(xN - xE)) + ((xCrn - xNE)*(yE - yN)))
! area within cell
!a1 = (yN - yCrn)*(0.5*(xN + xCrn))
!a2 = (yCrn - yW)*(0.5*(xCrn + xW))
!a3 = (yW - yNW)*(0.5*(xW + xNW))
!a4 = (yNW - yN)*(0.5*(xNW + xN))
!aC = a1 + a2 + a3 + a4
- aC = 0.5 * ((yCrn - yNW)*(xW - xN) + (xCrn - xNW)*(yN - yW))
+ aC = 0.5 * (((yCrn - yNW)*(xW - xN)) + ((xCrn - xNW)*(yN - yW)))
elseif (0.5*TwoPi <= theta .and. theta < 0.75*TwoPi) then
xCrn = x(I,J); yCrn = y(I,J)
! east area
@@ -1640,28 +1640,28 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS
!a3 = (yS - yCrn)*(0.5*(xS + xCrn))
!a4 = (yCrn - yE)*(0.5*(xCrn + xE))
!aE = a1 + a2 + a3 + a4
- aE = 0.5 * ((yCrn - ySE)*(xE - xS) + (xCrn - xSE)*(yS - yE))
+ aE = 0.5 * (((yCrn - ySE)*(xE - xS)) + ((xCrn - xSE)*(yS - yE)))
! northeast area
!a1 = (yNE - yE)*(0.5*(xNE + xE))
!a2 = (yE - yCrn)*(0.5*(xE + xCrn))
!a3 = (yCrn - yN)*(0.5*(xCrn + xN))
!a4 = (yN - yNE)*(0.5*(xN + xNE))
!aNE = a1 + a2 + a3 + a4
- aNE = 0.5 * ((yCrn - yNE)*(xN - xE) + (xCrn - xNE)*(yE - yN))
+ aNE = 0.5 * (((yCrn - yNE)*(xN - xE)) + ((xCrn - xNE)*(yE - yN)))
! north area
!a1 = (yN - yCrn)*(0.5*(xN + xCrn))
!a2 = (yCrn - yW)*(0.5*(xCrn + xW))
!a3 = (yW - yNW)*(0.5*(xW + xNW))
!a4 = (yNW - yN)*(0.5*(xNW + xN))
!aN = a1 + a2 + a3 + a4
- aN = 0.5 * ((yCrn - yNW)*(xW - xN) + (xCrn - xNW)*(yN - yW))
+ aN = 0.5 * (((yCrn - yNW)*(xW - xN)) + ((xCrn - xNW)*(yN - yW)))
! area within cell
!a1 = (yCrn - yS)*(0.5*(xCrn + xS))
!a2 = (yS - ySW)*(0.5*(xS + xSW))
!a3 = (ySW - yW)*(0.5*(xSW + xW))
!a4 = (yW - yCrn)*(0.5*(xW + xCrn))
!aC = a1 + a2 + a3 + a4
- aC = 0.5 * ((yCrn - ySW)*(xS - xW) + (xCrn - xSW)*(yW - yS))
+ aC = 0.5 * (((yCrn - ySW)*(xS - xW)) + ((xCrn - xSW)*(yW - yS)))
elseif (0.75*TwoPi <= theta .and. theta <= 1.00*TwoPi) then
xCrn = x(I-1,J); yCrn = y(I-1,J)
! north area
@@ -1670,37 +1670,37 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS
!a3 = (yCrn - yN)*(0.5*(xCrn + xN))
!a4 = (yN - yNE)*(0.5*(xN + xNE))
!aN = a1 + a2 + a3 + a4
- aN = 0.5 * ((yCrn - yNE)*(xN - xE) + (xCrn - xNE)*(yE - yN))
+ aN = 0.5 * (((yCrn - yNE)*(xN - xE)) + ((xCrn - xNE)*(yE - yN)))
! northwest area
!a1 = (yN - yCrn)*(0.5*(xN + xCrn))
!a2 = (yCrn - yW)*(0.5*(xCrn + xW))
!a3 = (yW - yNW)*(0.5*(xW + xNW))
!a4 = (yNW - yN)*(0.5*(xNW + xN))
!aNW = a1 + a2 + a3 + a4
- aNW = 0.5 * ((yCrn - yNW)*(xW - xN) + (xCrn - xNW)*(yN - yW))
+ aNW = 0.5 * (((yCrn - yNW)*(xW - xN)) + ((xCrn - xNW)*(yN - yW)))
! west area
!a1 = (yCrn - yS)*(0.5*(xCrn + xS))
!a2 = (yS - ySW)*(0.5*(xS + xSW))
!a3 = (ySW - yW)*(0.5*(xSW + xW))
!a4 = (yW - yCrn)*(0.5*(xW + xCrn))
!aW = a1 + a2 + a3 + a4
- aW = 0.5 * ((yCrn - ySW)*(xS - xW) + (xCrn - xSW)*(yW - yS))
+ aW = 0.5 * (((yCrn - ySW)*(xS - xW)) + ((xCrn - xSW)*(yW - yS)))
! area within cell
!a1 = (yE - ySE)*(0.5*(xE + xSE))
!a2 = (ySE - yS)*(0.5*(xSE + xS))
!a3 = (yS - yCrn)*(0.5*(xS + xCrn))
!a4 = (yCrn - yE)*(0.5*(xCrn + xE))
!aC = a1 + a2 + a3 + a4
- aC = 0.5 * ((yCrn - ySE)*(xE - xS) + (xCrn - xSE)*(yS - yE))
+ aC = 0.5 * (((yCrn - ySE)*(xE - xS)) + ((xCrn - xSE)*(yS - yE)))
endif
! energy weighting ----------------------------------------
a_total = (((aNE + aSW) + (aNW + aSE)) + ((aN + aS) + (aW + aE))) + aC
- E_new(m) = ( ( ( ( aNE*En(i+1,j+1) + aSW*En(i-1,j-1) ) + &
- ( aNW*En(i-1,j+1) + aSE*En(i+1,j-1) ) ) + &
- ( ( aN*En(i,j+1) + aS*En(i,j-1) ) + &
- ( aW*En(i-1,j) + aE*En(i+1,j) ) ) ) + &
+ E_new(m) = ( ( ( ( (aNE*En(i+1,j+1)) + (aSW*En(i-1,j-1)) ) + &
+ ( (aNW*En(i-1,j+1)) + (aSE*En(i+1,j-1)) ) ) + &
+ ( ( (aN*En(i,j+1)) + (aS*En(i,j-1)) ) + &
+ ( (aW*En(i-1,j)) + (aE*En(i+1,j)) ) ) ) + &
aC*En(i,j) ) / ( dx(i,j)*dy(i,j) )
enddo ! m-loop
! update energy in cell
@@ -1767,8 +1767,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res
Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J]
residual_loss(i,j,a) = residual_loss(i,j,a) + &
- (abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + &
- abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j))
+ ((abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j)) + &
+ (abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j)))
enddo ; enddo
enddo ! a-loop
@@ -1848,8 +1848,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, res
Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J]
residual_loss(i,j,a) = residual_loss(i,j,a) + &
- (abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + &
- abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j))
+ ((abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j)) + &
+ (abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j)))
!if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging
! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.)
diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
index defbd78aa7..d124450536 100644
--- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
+++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
@@ -593,8 +593,8 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C
wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) )
wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) )
S2 = slope_x(I,j,K)**2 + &
- ((wNW*slope_y(i,J,K)**2 + wSE*slope_y(i+1,J-1,K)**2) + &
- (wNE*slope_y(i+1,J,K)**2 + wSW*slope_y(i,J-1,K)**2) ) / &
+ (((wNW*slope_y(i,J,K)**2) + (wSE*slope_y(i+1,J-1,K)**2)) + &
+ ((wNE*slope_y(i+1,J,K)**2) + (wSW*slope_y(i,J-1,K)**2)) ) / &
( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 )
if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2
@@ -629,8 +629,8 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C
wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) )
wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) )
S2 = slope_y(i,J,K)**2 + &
- ((wSE*slope_x(I,j,K)**2 + wNW*slope_x(I-1,j+1,K)**2) + &
- (wNE*slope_x(I,j+1,K)**2 + wSW*slope_x(I-1,j,K)**2) ) / &
+ (((wSE*slope_x(I,j,K)**2) + (wNW*slope_x(I-1,j+1,K)**2)) + &
+ ((wNE*slope_x(I,j+1,K)**2) + (wSW*slope_x(I-1,j,K)**2)) ) / &
( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 )
if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2
@@ -800,15 +800,15 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN,
do j=G%jsc,G%jec
do I=G%isc-1,G%iec
CS%SN_u(I,j) = sqrt( SN_cpy(I,j)**2 &
- + 0.25*( (CS%SN_v(i,J)**2 + CS%SN_v(i+1,J-1)**2) &
- + (CS%SN_v(i+1,J)**2 + CS%SN_v(i,J-1)**2) ) )
+ + 0.25*( ((CS%SN_v(i,J)**2) + (CS%SN_v(i+1,J-1)**2)) &
+ + ((CS%SN_v(i+1,J)**2) + (CS%SN_v(i,J-1)**2)) ) )
enddo
enddo
do J=G%jsc-1,G%jec
do i=G%isc,G%iec
CS%SN_v(i,J) = sqrt( CS%SN_v(i,J)**2 &
- + 0.25*( (SN_cpy(I,j)**2 + SN_cpy(I-1,j+1)**2) &
- + (SN_cpy(I,j+1)**2 + SN_cpy(I-1,j)**2) ) )
+ + 0.25*( ((SN_cpy(I,j)**2) + (SN_cpy(I-1,j+1)**2)) &
+ + ((SN_cpy(I,j+1)**2) + (SN_cpy(I-1,j)**2)) ) )
enddo
enddo
@@ -920,7 +920,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
! Calculate N*S*h from this layer and add to the sum
do j=js,je ; do I=is-1,ie
S2 = ( E_x(I,j)**2 + 0.25*( &
- (E_y(i,J)**2+E_y(i+1,J-1)**2) + (E_y(i+1,J)**2+E_y(i,J-1)**2) ) )
+ ((E_y(i,J)**2) + (E_y(i+1,J-1)**2)) + ((E_y(i+1,J)**2) + (E_y(i,J-1)**2)) ) )
if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) S2 = 0.0
Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect)
@@ -931,7 +931,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop
enddo ; enddo
do J=js-1,je ; do i=is,ie
S2 = ( E_y(i,J)**2 + 0.25*( &
- (E_x(I,j)**2+E_x(I-1,j+1)**2) + (E_x(I,j+1)**2+E_x(I-1,j)**2) ) )
+ ((E_x(I,j)**2) + (E_x(I-1,j+1)**2)) + ((E_x(I,j+1)**2) + (E_x(I-1,j)**2)) ) )
if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) S2 = 0.0
Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect)
@@ -1105,16 +1105,16 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, dz, k, div_xx_dx, div_xx_dy
do J=js-2,je+1 ; do i=is-1,ie+1
f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) )
vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * &
- ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) &
- + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / &
+ ( ( (h_at_u(I,j) * dslopex_dz(I,j)) + (h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1)) ) &
+ + ( (h_at_u(I-1,j) * dslopex_dz(I-1,j)) + (h_at_u(I,j+1) * dslopex_dz(I,j+1)) ) ) / &
( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff)
enddo ; enddo
do j=js-1,je+1 ; do I=is-2,ie+1
f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) )
vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * &
- ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) &
- + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / &
+ ( ( (h_at_v(i,J) * dslopey_dz(i,J)) + (h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1)) ) &
+ + ( (h_at_v(i,J-1) * dslopey_dz(i,J-1)) + (h_at_v(i+1,J) * dslopey_dz(i+1,J)) ) ) / &
( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff)
enddo ; enddo
endif ! k > 1
@@ -1515,35 +1515,35 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
endif
do J=js-1,Jeq ; do I=is-1,Ieq
- CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * &
- max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2)
- CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * &
- ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + &
- ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + &
- (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + &
- ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2) ) ))
+ CS%f2_dx2_q(I,J) = ((G%dxBu(I,J)**2) + (G%dyBu(I,J)**2)) * &
+ max(G%Coriolis2Bu(I,J), absurdly_small_freq**2)
+ CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J)**2) + (G%dyBu(I,J)**2)) * (sqrt(0.5 * &
+ ( ((((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) + &
+ (((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2)) + &
+ ((((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2) + &
+ (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2)) ) ))
enddo ; enddo
do j=js,je ; do I=is-1,Ieq
- CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * &
- max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2)
- CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( &
- 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + &
- ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + &
- (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + &
- ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) ) + &
- ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 ))
+ CS%f2_dx2_u(I,j) = ((G%dxCu(I,j)**2) + (G%dyCu(I,j)**2)) * &
+ max(0.5* (G%Coriolis2Bu(I,J)+G%Coriolis2Bu(I,J-1)), absurdly_small_freq**2)
+ CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j)**2) + (G%dyCu(I,j)**2)) * (sqrt( &
+ ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + &
+ 0.25*( ((((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + &
+ (((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2)) + &
+ ((((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2) + &
+ (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2)) ) ))
enddo ; enddo
do J=js-1,Jeq ; do i=is,ie
- CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * &
- max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2)
- CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * (sqrt( &
+ CS%f2_dx2_v(i,J) = ((G%dxCv(i,J)**2) + (G%dyCv(i,J)**2)) * &
+ max(0.5*(G%Coriolis2Bu(I,J)+G%Coriolis2Bu(I-1,J)), absurdly_small_freq**2)
+ CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J)**2) + (G%dyCv(i,J)**2)) * (sqrt( &
((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + &
- 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + &
- ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + &
- (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2 + &
- ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) ))
+ 0.25*( ((((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2) + &
+ (((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2)) + &
+ ((((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2) + &
+ (((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2)) ) ))
enddo ; enddo
endif
@@ -1571,15 +1571,15 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
allocate(CS%beta_dx2_h(isd:ied,jsd:jed), source=0.0)
allocate(CS%f2_dx2_h(isd:ied,jsd:jed), source=0.0)
do j=js-1,je+1 ; do i=is-1,ie+1
- CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * &
- max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), &
+ CS%f2_dx2_h(i,j) = ((G%dxT(i,j)**2) + (G%dyT(i,j)**2)) * &
+ max(0.25 * ((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I-1,J) + G%Coriolis2Bu(I,J-1))), &
absurdly_small_freq**2)
- CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * (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) ) ))
+ CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j)**2) + (G%dyT(i,j)**2)) * (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)) ) ))
enddo ; enddo
endif
diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
index e7ada31430..7f3403aef5 100644
--- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
+++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
@@ -504,7 +504,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix,
absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J)))
! If needed, res_scaling_fac = min( ds, L_d ) / l_f
if (res_upscale) res_scaling_fac = &
- ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) &
+ ( sqrt( 0.5 * ( (G%dxCu(I,j)**2) + (G%dyCu(I,j)**2) ) ) * I_LFront ) &
* min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) )
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
@@ -591,7 +591,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix,
absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J)))
! If needed, res_scaling_fac = min( ds, L_d ) / l_f
if (res_upscale) res_scaling_fac = &
- ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) &
+ ( sqrt( 0.5 * ( (G%dxCv(i,J)**2) + (G%dyCv(i,J)**2) ) ) * I_LFront ) &
* min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) )
! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star)
diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
index 178e6f76e2..d42d9600ce 100644
--- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90
+++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
@@ -218,12 +218,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp
!$OMP parallel do default(shared)
do j=js,je ; do I=is-1,ie
KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / &
- (dt * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j)))
+ (dt * ((G%IdxCu(I,j)*G%IdxCu(I,j)) + (G%IdyCu(I,j)*G%IdyCu(I,j))))
enddo ; enddo
!$OMP parallel do default(shared)
do j=js-1,je ; do I=is,ie
KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / &
- (dt * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J)))
+ (dt * ((G%IdxCv(i,J)*G%IdxCv(i,J)) + (G%IdyCv(i,J)*G%IdyCv(i,J))))
enddo ; enddo
! Calculates interface heights, e, in [Z ~> m].
@@ -535,8 +535,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp
enddo ; enddo
! diagnose diffusivity at T-points
do j=js,je ; do i=is,ie
- Kh_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j) + hu(I,j)*KH_u_lay(I,j)) + &
- (hv(i,J-1)*KH_v_lay(i,J-1) + hv(i,J)*KH_v_lay(i,J))) / &
+ Kh_t(i,j,k) = (((hu(I-1,j)*KH_u_lay(i-1,j)) + (hu(I,j)*KH_u_lay(I,j))) + &
+ ((hv(i,J-1)*KH_v_lay(i,J-1)) + (hv(i,J)*KH_v_lay(i,J)))) / &
((hu(I-1,j)+hu(I,j)) + (hv(i,J-1)+hv(i,J)) + 1.0e-20)
! Use this denominator instead if hu and hv are actual thicknesses rather than a 0/1 mask:
! ((hu(I-1,j)+hu(I,j)) + (hv(i,J-1)+hv(i,J)) + h_neglect)
@@ -916,9 +916,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
drho_dS_u(I) * (S(i,j,k)-S(i,j,k-1)))
drdkR = (drho_dT_u(I) * (T(i+1,j,k)-T(i+1,j,k-1)) + &
drho_dS_u(I) * (S(i+1,j,k)-S(i+1,j,k-1)))
- drdkDe_u(I,K) = drdkR * e(i+1,j,K) - drdkL * e(i,j,K)
+ drdkDe_u(I,K) = (drdkR * e(i+1,j,K)) - (drdkL * e(i,j,K))
elseif (find_work) then ! This is used in pure stacked SW mode
- drdkDe_u(I,K) = drdkR * e(i+1,j,K) - drdkL * e(i,j,K)
+ drdkDe_u(I,K) = (drdkR * e(i+1,j,K)) - (drdkL * e(i,j,K))
endif
if (use_stanley) then
! Correction to the horizontal density gradient due to nonlinearity in
@@ -950,7 +950,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! These unnormalized weights have been rearranged to minimize divisions.
wtL = hg2L*(haR*dzaR) ; wtR = hg2R*(haL*dzaL)
- drdz = (wtL * drdkL + wtR * drdkR) / (dzaL*wtL + dzaR*wtR)
+ drdz = ((wtL * drdkL) + (wtR * drdkR)) / ((dzaL*wtL) + (dzaR*wtR))
! The expression for drdz above is mathematically equivalent to:
! drdz = ((hg2L/haL) * drdkL/dzaL + (hg2R/haR) * drdkR/dzaR) / &
! ((hg2L/haL) + (hg2R/haR))
@@ -963,7 +963,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
N2_unlim = drdz*G_rho0
else
N2_unlim = (GV%g_Earth*GV%RZ_to_H) * &
- ((wtL * drdkL + wtR * drdkR) / (haL*wtL + haR*wtR))
+ (((wtL * drdkL) + (wtR * drdkR)) / ((haL*wtL) + (haR*wtR)))
endif
dzg2A = dz(i,j,k-1)*dz(i+1,j,k-1) + dz_neglect2
@@ -1082,10 +1082,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (allocated(tv%SpV_avg) .and. (find_work .or. (k > nk_linear)) ) then
Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i+1,j,k) + h(i+1,j,k-1))) + 4.0*hn_2 ) / &
- ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + &
- ((h(i+1,j,k)+hn_2)*tv%SpV_avg(i+1,j,k) + (h(i+1,j,k-1)+hn_2)*tv%SpV_avg(i+1,j,k-1)) )
+ ( (((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k)) + ((h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1))) + &
+ (((h(i+1,j,k)+hn_2)*tv%SpV_avg(i+1,j,k)) + ((h(i+1,j,k-1)+hn_2)*tv%SpV_avg(i+1,j,k-1))) )
! Use an average density to convert the volume streamfunction estimate into a mass streamfunction.
- Z_to_H = (GV%RZ_to_H*Rho_avg)
+ Z_to_H = GV%RZ_to_H*Rho_avg
else
Z_to_H = GV%Z_to_H
endif
@@ -1235,9 +1235,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
drho_dS_v(i) * (S(i,j,k)-S(i,j,k-1)))
drdkR = (drho_dT_v(i) * (T(i,j+1,k)-T(i,j+1,k-1)) + &
drho_dS_v(i) * (S(i,j+1,k)-S(i,j+1,k-1)))
- drdkDe_v(i,K) = drdkR * e(i,j+1,K) - drdkL * e(i,j,K)
+ drdkDe_v(i,K) = (drdkR * e(i,j+1,K)) - (drdkL * e(i,j,K))
elseif (find_work) then ! This is used in pure stacked SW mode
- drdkDe_v(i,K) = drdkR * e(i,j+1,K) - drdkL * e(i,j,K)
+ drdkDe_v(i,K) = (drdkR * e(i,j+1,K)) - (drdkL * e(i,j,K))
endif
if (use_stanley) then
! Correction to the horizontal density gradient due to nonlinearity in
@@ -1271,7 +1271,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! These unnormalized weights have been rearranged to minimize divisions.
wtL = hg2L*(haR*dzaR) ; wtR = hg2R*(haL*dzaL)
- drdz = (wtL * drdkL + wtR * drdkR) / (dzaL*wtL + dzaR*wtR)
+ drdz = ((wtL * drdkL) + (wtR * drdkR)) / ((dzaL*wtL) + (dzaR*wtR))
! The expression for drdz above is mathematically equivalent to:
! drdz = ((hg2L/haL) * drdkL/dzaL + (hg2R/haR) * drdkR/dzaR) / &
! ((hg2L/haL) + (hg2R/haR))
@@ -1284,7 +1284,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
N2_unlim = drdz*G_rho0
else
N2_unlim = (GV%g_Earth*GV%RZ_to_H) * &
- ((wtL * drdkL + wtR * drdkR) / (haL*wtL + haR*wtR))
+ (((wtL * drdkL) + (wtR * drdkR)) / ((haL*wtL) + (haR*wtR)))
endif
dzg2A = dz(i,j,k-1)*dz(i,j+1,k-1) + dz_neglect2
@@ -1401,10 +1401,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
do i=is,ie
if (allocated(tv%SpV_avg) .and. (find_work .or. (k > nk_linear)) ) then
Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i,j+1,k) + h(i,j+1,k-1))) + 4.0*hn_2 ) / &
- ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + &
- ((h(i,j+1,k)+hn_2)*tv%SpV_avg(i,j+1,k) + (h(i,j+1,k-1)+hn_2)*tv%SpV_avg(i,j+1,k-1)) )
+ ( (((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k)) + ((h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1))) + &
+ (((h(i,j+1,k)+hn_2)*tv%SpV_avg(i,j+1,k)) + ((h(i,j+1,k-1)+hn_2)*tv%SpV_avg(i,j+1,k-1))) )
! Use an average density to convert the volume streamfunction estimate into a mass streamfunction.
- Z_to_H = (GV%RZ_to_H*Rho_avg)
+ Z_to_H = GV%RZ_to_H*Rho_avg
else
Z_to_H = GV%Z_to_H
endif
@@ -1510,7 +1510,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1))
if (allocated(tv%SpV_avg)) then
G_scale = GV%H_to_RZ * GV%g_Earth * &
- ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1) + (h(i+1,j,1)+hn_2) * tv%SpV_avg(i+1,j,1)) / &
+ ( ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1)) + ((h(i+1,j,1)+hn_2) * tv%SpV_avg(i+1,j,1)) ) / &
( (h(i,j,1) + h(i+1,j,1)) + 2.0*hn_2 ) )
endif
endif
@@ -1547,7 +1547,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1))
if (allocated(tv%SpV_avg)) then
G_scale = GV%H_to_RZ * GV%g_Earth * &
- ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1) + (h(i,j+1,1)+hn_2) * tv%SpV_avg(i,j+1,1)) / &
+ ( ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1)) + ((h(i,j+1,1)+hn_2) * tv%SpV_avg(i,j+1,1)) ) / &
( (h(i,j,1) + h(i,j+1,1)) + 2.0*hn_2 ) )
endif
endif
@@ -1572,22 +1572,23 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (CS%MEKE_src_answer_date >= 20240601) then
do j=js,je ; do i=is,ie ; do k=nz,1,-1
PE_release_h = -0.25 * GV%H_to_RZ * &
- ( (KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + &
- Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k)) + &
- (Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + &
- Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) )
+ ( ((KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k)) + &
+ (Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k))) + &
+ ((Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k)) + &
+ (Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k))) )
MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h
enddo ; enddo ; enddo
else
do j=js,je ; do i=is,ie ; do k=nz,1,-1
PE_release_h = -0.25 * GV%H_to_RZ * &
- (KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + &
- Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + &
- Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + &
- Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k))
+ ((KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k)) + &
+ (Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k)) + &
+ (Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k)) + &
+ (Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)))
MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h
enddo ; enddo ; enddo
endif
+
if (CS%debug) then
call hchksum(MEKE%GM_src, 'MEKE%GM_src', G%HI, scale=US%RZ3_T3_to_W_m2*US%L_to_Z**2)
call uvchksum("KH_[uv]", Kh_u, Kh_v, G%HI, scale=US%L_to_m**2*US%s_to_T, &
@@ -2198,11 +2199,11 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS)
allocate(CS%Kh_eta_u(G%IsdB:G%IedB, G%jsd:G%jed), source=0.)
allocate(CS%Kh_eta_v(G%isd:G%ied, G%JsdB:G%JedB), source=0.)
do j=G%jsc,G%jec ; do I=G%isc-1,G%iec
- grid_sp = sqrt((2.0*G%dxCu(I,j)**2 * G%dyCu(I,j)**2) / (G%dxCu(I,j)**2 + G%dyCu(I,j)**2))
+ grid_sp = sqrt((2.0*G%dxCu(I,j)**2 * G%dyCu(I,j)**2) / ((G%dxCu(I,j)**2) + (G%dyCu(I,j)**2)))
CS%Kh_eta_u(I,j) = G%OBCmaskCu(I,j) * MAX(0.0, CS%Kh_eta_bg + CS%Kh_eta_vel * grid_sp)
enddo ; enddo
do J=G%jsc-1,G%jec ; do i=G%isc,G%iec
- grid_sp = sqrt((2.0*G%dxCv(i,J)**2 * G%dyCv(i,J)**2) / (G%dxCv(i,J)**2 + G%dyCv(i,J)**2))
+ grid_sp = sqrt((2.0*G%dxCv(i,J)**2 * G%dyCv(i,J)**2) / ((G%dxCv(i,J)**2) + (G%dyCv(i,J)**2)))
CS%Kh_eta_v(i,J) = G%OBCmaskCv(i,J) * MAX(0.0, CS%Kh_eta_bg + CS%Kh_eta_vel * grid_sp)
enddo ; enddo
endif
diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
index f480c655d7..a21b992147 100644
--- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
@@ -1143,7 +1143,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
Vk = Vk + (0.5*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) - surfVs )
endif
- deltaU2(k) = US%L_T_to_m_s**2 * (Uk**2 + Vk**2)
+ deltaU2(k) = US%L_T_to_m_s**2 * ((Uk**2) + (Vk**2))
! pressure, temperature, and salinity for calling the equation of state
! kk+1 = surface fields
diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90
index 829318b606..46d7b98502 100644
--- a/src/parameterizations/vertical/MOM_CVMix_shear.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90
@@ -145,7 +145,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS )
endif
dz_int = 0.5*(dz(i,km1) + dz(i,k)) + GV%dZ_subroundoff
N2 = DRHO / dz_int
- S2 = US%L_to_Z**2*(DU*DU + DV*DV) / (dz_int*dz_int)
+ S2 = US%L_to_Z**2*((DU*DU) + (DV*DV)) / (dz_int*dz_int)
Ri_Grad(k) = max(0., N2) / max(S2, 1.e-10*US%T_to_s**2)
! fill 3d arrays, if user asks for diagnostics
diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
index 561ace60a7..930e4f9513 100644
--- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
+++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90
@@ -912,7 +912,7 @@ subroutine convective_adjustment(h, u, v, R0, SpV0, Rcv, T, S, eps, d_eb, &
do k1=min(nzc-1,nkmb),1,-1
do i=is,ie
h_orig_k1(i) = h(i,k1)
- KE_orig(i) = 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2)
+ KE_orig(i) = 0.5*h(i,k1)*((u(i,k1)**2) + (v(i,k1)**2))
uhtot(i) = h(i,k1)*u(i,k1) ; vhtot(i) = h(i,k1)*v(i,k1)
if (CS%nonBous_energetics) then
SpV0_tot(i) = SpV0(i,k1) * h(i,k1)
@@ -949,7 +949,7 @@ subroutine convective_adjustment(h, u, v, R0, SpV0, Rcv, T, S, eps, d_eb, &
dKE_CA(i,k1) = dKE_CA(i,k1) + dKE_CA(i,k)
endif
KE_orig(i) = KE_orig(i) + 0.5*h_ent* &
- (u(i,k)*u(i,k) + v(i,k)*v(i,k))
+ ((u(i,k)*u(i,k)) + (v(i,k)*v(i,k)))
uhtot(i) = uhtot(i) + h_ent*u(i,k)
vhtot(i) = vhtot(i) + h_ent*v(i,k)
@@ -974,7 +974,7 @@ subroutine convective_adjustment(h, u, v, R0, SpV0, Rcv, T, S, eps, d_eb, &
endif
u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih
dKE_CA(i,k1) = dKE_CA(i,k1) + CS%bulk_Ri_convective * &
- (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))
+ (KE_orig(i) - 0.5*h(i,k1)*((u(i,k1)**2) + (v(i,k1)**2)))
Rcv(i,k1) = Rcv_tot(i) * Ih
T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih
endif ; enddo
@@ -1407,7 +1407,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
if ((h_ent > 0.0) .and. (htot(i) > 0.0)) &
dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * &
((h_ent) / (htot(i)*(h_ent+htot(i)))) * &
- ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2)
+ (((uhtot(i)-u(i,k)*htot(i))**2) + ((vhtot(i)-v(i,k)*htot(i))**2))
if (h_ent > 0.0) then
htot(i) = htot(i) + h_ent
@@ -1785,7 +1785,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, &
dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) )
endif
dMKE = CS%bulk_Ri_ML * 0.5 * &
- ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2)
+ (((uhtot(i)-u(i,k)*htot(i))**2) + ((vhtot(i)-v(i,k)*htot(i))**2))
! Find the TKE that would remain if the entire layer were entrained.
kh = Idecay_len_TKE(i)*h_avail ; exp_kh = exp(-kh)
diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90
index aa31024b24..51e9b33d97 100644
--- a/src/parameterizations/vertical/MOM_diabatic_aux.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90
@@ -574,17 +574,17 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix)
b_denom_1 = h(i,j,1) + h_neglect
b1(i) = 1.0 / (b_denom_1 + eb(i,j,1))
d1(i) = b_denom_1 * b1(i)
- u_h(i,j,1) = (h(i,j,1)*b1(i)) * (a_e(i)*u(I,j,1) + a_w(i)*u(I-1,j,1))
- v_h(i,j,1) = (h(i,j,1)*b1(i)) * (a_n(i)*v(i,J,1) + a_s(i)*v(i,J-1,1))
+ u_h(i,j,1) = (h(i,j,1)*b1(i)) * ((a_e(i)*u(I,j,1)) + (a_w(i)*u(I-1,j,1)))
+ v_h(i,j,1) = (h(i,j,1)*b1(i)) * ((a_n(i)*v(i,J,1)) + (a_s(i)*v(i,J-1,1)))
enddo
do k=2,nz ; do i=is,ie
c1(i,k) = eb(i,j,k-1) * b1(i)
b_denom_1 = h(i,j,k) + d1(i)*ea(i,j,k) + h_neglect
b1(i) = 1.0 / (b_denom_1 + eb(i,j,k))
d1(i) = b_denom_1 * b1(i)
- u_h(i,j,k) = (h(i,j,k) * (a_e(i)*u(I,j,k) + a_w(i)*u(I-1,j,k)) + &
+ u_h(i,j,k) = (h(i,j,k) * ((a_e(i)*u(I,j,k)) + (a_w(i)*u(I-1,j,k))) + &
ea(i,j,k)*u_h(i,j,k-1))*b1(i)
- v_h(i,j,k) = (h(i,j,k) * (a_n(i)*v(i,J,k) + a_s(i)*v(i,J-1,k)) + &
+ v_h(i,j,k) = (h(i,j,k) * ((a_n(i)*v(i,J,k)) + (a_s(i)*v(i,J-1,k))) + &
ea(i,j,k)*v_h(i,j,k-1))*b1(i)
enddo ; enddo
do k=nz-1,1,-1 ; do i=is,ie
@@ -594,18 +594,18 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix)
elseif (zero_mixing) then
do i=is,ie
b1(i) = 1.0 / (h(i,j,1) + h_neglect)
- u_h(i,j,1) = (h(i,j,1)*b1(i)) * (a_e(i)*u(I,j,1) + a_w(i)*u(I-1,j,1))
- v_h(i,j,1) = (h(i,j,1)*b1(i)) * (a_n(i)*v(i,J,1) + a_s(i)*v(i,J-1,1))
+ u_h(i,j,1) = (h(i,j,1)*b1(i)) * ((a_e(i)*u(I,j,1)) + (a_w(i)*u(I-1,j,1)))
+ v_h(i,j,1) = (h(i,j,1)*b1(i)) * ((a_n(i)*v(i,J,1)) + (a_s(i)*v(i,J-1,1)))
enddo
do k=2,nz ; do i=is,ie
b1(i) = 1.0 / (h(i,j,k) + h_neglect)
- u_h(i,j,k) = (h(i,j,k) * (a_e(i)*u(I,j,k) + a_w(i)*u(I-1,j,k))) * b1(i)
- v_h(i,j,k) = (h(i,j,k) * (a_n(i)*v(i,J,k) + a_s(i)*v(i,J-1,k))) * b1(i)
+ u_h(i,j,k) = (h(i,j,k) * ((a_e(i)*u(I,j,k)) + (a_w(i)*u(I-1,j,k)))) * b1(i)
+ v_h(i,j,k) = (h(i,j,k) * ((a_n(i)*v(i,J,k)) + (a_s(i)*v(i,J-1,k)))) * b1(i)
enddo ; enddo
else
do k=1,nz ; do i=is,ie
- u_h(i,j,k) = a_e(i)*u(I,j,k) + a_w(i)*u(I-1,j,k)
- v_h(i,j,k) = a_n(i)*v(i,J,k) + a_s(i)*v(i,J-1,k)
+ u_h(i,j,k) = (a_e(i)*u(I,j,k)) + (a_w(i)*u(I-1,j,k))
+ v_h(i,j,k) = (a_n(i)*v(i,J,k)) + (a_s(i)*v(i,J-1,k))
enddo ; enddo
endif
enddo
diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90
index 10907c04ed..f10e2f445d 100644
--- a/src/parameterizations/vertical/MOM_energetic_PBL.F90
+++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90
@@ -1171,7 +1171,7 @@ subroutine ePBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, TKE_forcing,
! velocities between layer k and the layers above.
dMKE_max = (US%L_to_Z**2*GV%H_to_RZ * CS%MKE_to_TKE_effic) * 0.5 * &
(h(k) / ((htot + h(k))*htot)) * &
- ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2)
+ (((uhtot-u(k)*htot)**2) + ((vhtot-v(k)*htot)**2))
! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be
! extracted by mixing with a finite viscosity.
MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / &
diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90
index 8a1974d8ea..536d25e595 100644
--- a/src/parameterizations/vertical/MOM_kappa_shear.F90
+++ b/src/parameterizations/vertical/MOM_kappa_shear.F90
@@ -279,8 +279,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, &
do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo
endif
- f2 = 0.25 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2))
+ f2 = 0.25 * ((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I,J-1) + G%Coriolis2Bu(I-1,J)))
surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j)
! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d
@@ -442,26 +442,26 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
! Interpolate the various quantities to the corners, using masks.
do k=1,nz ; do I=IsB,IeB
- u_2d(I,k) = (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + &
- u_in(I,j+1,k) * (G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) ) / &
+ u_2d(I,k) = (G%mask2dCu(I,j) * (u_in(I,j,k) * (h(i,j,k) + h(i+1,j,k))) + &
+ G%mask2dCu(I,j+1) * (u_in(I,j+1,k) * (h(i,j+1,k) + h(i+1,j+1,k))) ) / &
((G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k)) + &
G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) + GV%H_subroundoff)
- v_2d(I,k) = (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + &
- v_in(i+1,J,k) * (G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) ) / &
+ v_2d(I,k) = (G%mask2dCv(i,J) * (v_in(i,J,k) * (h(i,j,k) + h(i,j+1,k))) + &
+ G%mask2dCv(i+1,J) * (v_in(i+1,J,k) * (h(i+1,j,k) + h(i+1,j+1,k))) ) / &
((G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k)) + &
G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) + GV%H_subroundoff)
I_hwt = 1.0 / (((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + &
(G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k))) + &
GV%H_subroundoff)
if (use_temperature) then
- T_2d(I,k) = ( ((G%mask2dT(i,j) * h(i,j,k)) * T_in(i,j,k) + &
- (G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) * T_in(i+1,j+1,k)) + &
- ((G%mask2dT(i+1,j) * h(i+1,j,k)) * T_in(i+1,j,k) + &
- (G%mask2dT(i,j+1) * h(i,j+1,k)) * T_in(i,j+1,k)) ) * I_hwt
- S_2d(I,k) = ( ((G%mask2dT(i,j) * h(i,j,k)) * S_in(i,j,k) + &
- (G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) * S_in(i+1,j+1,k)) + &
- ((G%mask2dT(i+1,j) * h(i+1,j,k)) * S_in(i+1,j,k) + &
- (G%mask2dT(i,j+1) * h(i,j+1,k)) * S_in(i,j+1,k)) ) * I_hwt
+ T_2d(I,k) = ( (G%mask2dT(i,j) * (h(i,j,k) * T_in(i,j,k)) + &
+ G%mask2dT(i+1,j+1) * (h(i+1,j+1,k) * T_in(i+1,j+1,k))) + &
+ (G%mask2dT(i+1,j) * (h(i+1,j,k) * T_in(i+1,j,k)) + &
+ G%mask2dT(i,j+1) * (h(i,j+1,k) * T_in(i,j+1,k))) ) * I_hwt
+ S_2d(I,k) = ( (G%mask2dT(i,j) * (h(i,j,k) * S_in(i,j,k)) + &
+ G%mask2dT(i+1,j+1) * (h(i+1,j+1,k) * S_in(i+1,j+1,k))) + &
+ (G%mask2dT(i+1,j) * (h(i+1,j,k) * S_in(i+1,j,k)) + &
+ G%mask2dT(i,j+1) * (h(i,j+1,k) * S_in(i,j+1,k))) ) * I_hwt
endif
h_2d(I,k) = ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + &
(G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / &
@@ -472,8 +472,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + &
(G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 )
! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))
-! h_2d(I,k) = ((h(i,j,k)**2 + h(i+1,j+1,k)**2) + &
-! (h(i+1,j,k)**2 + h(i,j+1,k)**2)) * I_hwt
+! h_2d(I,k) = (((h(i,j,k)**2) + (h(i+1,j+1,k)**2)) + &
+! ((h(i+1,j,k)**2) + (h(i,j+1,k)**2))) * I_hwt
enddo ; enddo
if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB
rho_2d(I,k) = GV%Rlay(k)
@@ -551,7 +551,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_
do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo
endif
- f2 = G%CoriolisBu(I,J)**2
+ f2 = G%Coriolis2Bu(I,J)
surface_pres = 0.0
if (associated(p_surf)) then
if (CS%psurf_bug) then
@@ -1224,12 +1224,12 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int
! Store the squared shear at interfaces
S2(1) = 0.0 ; S2(nz+1) = 0.0
if (ks > 1) &
- S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (US%L_to_Z*I_dz_int(ks))**2
+ S2(ks) = (((u(ks)-u0(ks-1))**2) + ((v(ks)-v0(ks-1))**2)) * (US%L_to_Z*I_dz_int(ks))**2
do K=ks+1,ke
- S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (US%L_to_Z*I_dz_int(K))**2
+ S2(K) = (((u(k)-u(k-1))**2) + ((v(k)-v(k-1))**2)) * (US%L_to_Z*I_dz_int(K))**2
enddo
if (ke<nz) &
- S2(ke+1) = ((u0(ke+1)-u(ke))**2 + (v0(ke+1)-v(ke))**2) * (US%L_to_Z*I_dz_int(ke+1))**2
+ S2(ke+1) = (((u0(ke+1)-u(ke))**2) + ((v0(ke+1)-v(ke))**2)) * (US%L_to_Z*I_dz_int(ke+1))**2
! Store the buoyancy frequency at interfaces
N2(1) = 0.0 ; N2(nz+1) = 0.0
diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90
index ef2e4ed5f6..658bdca31d 100644
--- a/src/parameterizations/vertical/MOM_set_diffusivity.F90
+++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90
@@ -1324,10 +1324,10 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, maxTKE,
! TKE_Ray has been initialized to 0 above.
if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * &
- ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + &
- G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + &
- (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + &
- G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2))
+ (((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2) + &
+ (G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2)) + &
+ ((G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2) + &
+ (G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)))
if (TKE_to_layer + TKE_Ray > 0.0) then
if (CS%BBL_mixing_as_max) then
@@ -1514,10 +1514,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Rho_bo
! Add in additional energy input from bottom-drag against slopes (sides)
if (Rayleigh_drag) TKE_remaining = TKE_remaining + &
0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * &
- ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + &
- G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + &
- (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + &
- G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2))
+ (((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2) + &
+ (G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2)) + &
+ ((G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2) + &
+ (G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)))
! Exponentially decay TKE across the thickness of the layer.
! This is energy loss in addition to work done as mixing, apparently to Joule heating.
@@ -1631,8 +1631,8 @@ subroutine add_MLrad_diffusivity(dz, fluxes, tv, j, Kd_int, G, GV, US, CS, TKE_t
if (CS%ML_omega_frac >= 1.0) then
f_sq = 4.0 * Omega2
else
- f_sq = 0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + &
- (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2))
+ f_sq = 0.25 * ((G%Coriolis2Bu(I,J) + G%Coriolis2Bu(I-1,J-1)) + &
+ (G%Coriolis2Bu(I,J-1) + G%Coriolis2Bu(I-1,J)))
if (CS%ML_omega_frac > 0.0) &
f_sq = CS%ML_omega_frac * 4.0 * Omega2 + (1.0 - CS%ML_omega_frac) * f_sq
endif
@@ -1910,15 +1910,15 @@ subroutine set_BBL_TKE(u, v, h, tv, fluxes, visc, G, GV, US, CS, OBC)
do i=is,ie
visc%ustar_BBL(i,j) = sqrt(0.5*G%IareaT(i,j) * &
- ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + &
- G%areaCu(I,j)*(ustar(I)*ustar(I))) + &
- (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + &
- G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) )
+ (((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1))) + &
+ (G%areaCu(I,j)*(ustar(I)*ustar(I)))) + &
+ ((G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1))) + &
+ (G%areaCv(i,J)*(vstar(i,J)*vstar(i,J)))) ) )
visc%TKE_BBL(i,j) = US%L_to_Z**2 * &
- (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + &
- G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + &
- (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + &
- G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j))
+ ((((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1))) + &
+ (G%areaCu(I,j) * (ustar(I)*u2_bbl(I)))) + &
+ ((G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1))) + &
+ (G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J)))) )*G%IareaT(i,j))
enddo
enddo
!$OMP end parallel
diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90
index d1d333b5ce..7687d91e17 100644
--- a/src/parameterizations/vertical/MOM_set_viscosity.F90
+++ b/src/parameterizations/vertical/MOM_set_viscosity.F90
@@ -1840,8 +1840,8 @@ function set_v_at_u(v, h, G, GV, i, j, k, mask2dCv, OBC)
hwt_tot = (hwt(0,-1) + hwt(1,0)) + (hwt(1,-1) + hwt(0,0))
set_v_at_u = 0.0
if (hwt_tot > 0.0) set_v_at_u = &
- ((hwt(0,0) * v(i,J,k) + hwt(1,-1) * v(i+1,J-1,k)) + &
- (hwt(1,0) * v(i+1,J,k) + hwt(0,-1) * v(i,J-1,k))) / hwt_tot
+ (((hwt(0,0) * v(i,J,k)) + (hwt(1,-1) * v(i+1,J-1,k))) + &
+ ((hwt(1,0) * v(i+1,J,k)) + (hwt(0,-1) * v(i,J-1,k)))) / hwt_tot
end function set_v_at_u
@@ -1885,8 +1885,8 @@ function set_u_at_v(u, h, G, GV, i, j, k, mask2dCu, OBC)
hwt_tot = (hwt(-1,0) + hwt(0,1)) + (hwt(0,0) + hwt(-1,1))
set_u_at_v = 0.0
if (hwt_tot > 0.0) set_u_at_v = &
- ((hwt(0,0) * u(I,j,k) + hwt(-1,1) * u(I-1,j+1,k)) + &
- (hwt(-1,0) * u(I-1,j,k) + hwt(0,1) * u(I,j+1,k))) / hwt_tot
+ (((hwt(0,0) * u(I,j,k)) + (hwt(-1,1) * u(I-1,j+1,k))) + &
+ ((hwt(-1,0) * u(I-1,j,k)) + (hwt(0,1) * u(I,j+1,k)))) / hwt_tot
end function set_u_at_v
@@ -2154,8 +2154,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (associated(tv%p_surf)) press(I) = press(I) + 0.5*(tv%p_surf(i,j)+tv%p_surf(i+1,j))
k2 = max(1,nkml)
I_2hlay = 1.0 / (h(i,j,k2) + h(i+1,j,k2) + h_neglect)
- T_EOS(I) = (h(i,j,k2)*tv%T(i,j,k2) + h(i+1,j,k2)*tv%T(i+1,j,k2)) * I_2hlay
- S_EOS(I) = (h(i,j,k2)*tv%S(i,j,k2) + h(i+1,j,k2)*tv%S(i+1,j,k2)) * I_2hlay
+ T_EOS(I) = ((h(i,j,k2)*tv%T(i,j,k2)) + (h(i+1,j,k2)*tv%T(i+1,j,k2))) * I_2hlay
+ S_EOS(I) = ((h(i,j,k2)*tv%S(i,j,k2)) + (h(i+1,j,k2)*tv%S(i+1,j,k2))) * I_2hlay
enddo
call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, tv%eqn_of_state, &
(/Isq-G%IsdB+1,Ieq-G%IsdB+1/) )
@@ -2170,13 +2170,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
hlay = 0.5*(h(i,j,k) + h(i+1,j,k))
if (hlay > h_tiny) then ! Only consider non-vanished layers.
I_2hlay = 1.0 / (h(i,j,k) + h(i+1,j,k))
- v_at_u = 0.5 * (h(i,j,k) * (v(i,J,k) + v(i,J-1,k)) + &
- h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k))) * I_2hlay
- Uh2 = ((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2)
+ v_at_u = 0.5 * ((h(i,j,k) * (v(i,J,k) + v(i,J-1,k))) + &
+ (h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k)))) * I_2hlay
+ Uh2 = (uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2
if (use_EOS) then
- T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i+1,j,k)*tv%T(i+1,j,k)) * I_2hlay
- S_lay = (h(i,j,k)*tv%S(i,j,k) + h(i+1,j,k)*tv%S(i+1,j,k)) * I_2hlay
+ T_lay = ((h(i,j,k)*tv%T(i,j,k)) + (h(i+1,j,k)*tv%T(i+1,j,k))) * I_2hlay
+ S_lay = ((h(i,j,k)*tv%S(i,j,k)) + (h(i+1,j,k)*tv%S(i+1,j,k))) * I_2hlay
if (nonBous_ML) then
gHprime = (GV%g_Earth * GV%H_to_RZ) * (dSpV_dT(I) * (Thtot(I) - T_lay*htot(I)) + &
dSpV_dS(I) * (Shtot(I) - S_lay*htot(I)))
@@ -2211,11 +2211,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
do I=Isq,Ieq ; if (do_i(I)) then
htot(I) = htot(I) + 0.5 * (h(i,j,k) + h(i+1,j,k))
uhtot(I) = uhtot(I) + 0.5 * (h(i,j,k) + h(i+1,j,k)) * u(I,j,k)
- vhtot(I) = vhtot(I) + 0.25 * (h(i,j,k) * (v(i,J,k) + v(i,J-1,k)) + &
- h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k)))
+ vhtot(I) = vhtot(I) + 0.25 * ((h(i,j,k) * (v(i,J,k) + v(i,J-1,k))) + &
+ (h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k))))
if (use_EOS) then
- Thtot(I) = Thtot(I) + 0.5 * (h(i,j,k)*tv%T(i,j,k) + h(i+1,j,k)*tv%T(i+1,j,k))
- Shtot(I) = Shtot(I) + 0.5 * (h(i,j,k)*tv%S(i,j,k) + h(i+1,j,k)*tv%S(i+1,j,k))
+ Thtot(I) = Thtot(I) + 0.5 * ((h(i,j,k)*tv%T(i,j,k)) + (h(i+1,j,k)*tv%T(i+1,j,k)))
+ Shtot(I) = Shtot(I) + 0.5 * ((h(i,j,k)*tv%S(i,j,k)) + (h(i+1,j,k)*tv%S(i+1,j,k)))
else
Rhtot(i) = Rhtot(i) + 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%Rlay(k)
endif
@@ -2379,8 +2379,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
! visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, &
! dztot(I) / (0.5 + sqrt(0.25 + &
- ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / &
- ! (ustar(i))**2 )) )
+ ! ((htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2) / &
+ ! (ustar(i)**2) )) )
ustar1 = ustar(i)
h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2
tbl_thick = max(CS%Htbl_shelf_min, &
@@ -2433,8 +2433,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
if (associated(tv%p_surf)) press(i) = press(i) + 0.5*(tv%p_surf(i,j)+tv%p_surf(i,j+1))
k2 = max(1,nkml)
I_2hlay = 1.0 / (h(i,j,k2) + h(i,j+1,k2) + h_neglect)
- T_EOS(i) = (h(i,j,k2)*tv%T(i,j,k2) + h(i,j+1,k2)*tv%T(i,j+1,k2)) * I_2hlay
- S_EOS(i) = (h(i,j,k2)*tv%S(i,j,k2) + h(i,j+1,k2)*tv%S(i,j+1,k2)) * I_2hlay
+ T_EOS(i) = ((h(i,j,k2)*tv%T(i,j,k2)) + (h(i,j+1,k2)*tv%T(i,j+1,k2))) * I_2hlay
+ S_EOS(i) = ((h(i,j,k2)*tv%S(i,j,k2)) + (h(i,j+1,k2)*tv%S(i,j+1,k2))) * I_2hlay
enddo
call calculate_density_derivs(T_EOS, S_EOS, press, dR_dT, dR_dS, &
tv%eqn_of_state, (/is-G%IsdB+1,ie-G%IsdB+1/) )
@@ -2449,13 +2449,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
hlay = 0.5*(h(i,j,k) + h(i,j+1,k))
if (hlay > h_tiny) then ! Only consider non-vanished layers.
I_2hlay = 1.0 / (h(i,j,k) + h(i,j+1,k))
- u_at_v = 0.5 * (h(i,j,k) * (u(I-1,j,k) + u(I,j,k)) + &
- h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k))) * I_2hlay
- Uh2 = ((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2)
+ u_at_v = 0.5 * ((h(i,j,k) * (u(I-1,j,k) + u(I,j,k))) + &
+ (h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k)))) * I_2hlay
+ Uh2 = (vhtot(i) - htot(i)*v(i,J,k))**2 + (uhtot(i) - htot(i)*u_at_v)**2
if (use_EOS) then
- T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i,j+1,k)*tv%T(i,j+1,k)) * I_2hlay
- S_lay = (h(i,j,k)*tv%S(i,j,k) + h(i,j+1,k)*tv%S(i,j+1,k)) * I_2hlay
+ T_lay = ((h(i,j,k)*tv%T(i,j,k)) + (h(i,j+1,k)*tv%T(i,j+1,k))) * I_2hlay
+ S_lay = ((h(i,j,k)*tv%S(i,j,k)) + (h(i,j+1,k)*tv%S(i,j+1,k))) * I_2hlay
if (nonBous_ML) then
gHprime = (GV%g_Earth * GV%H_to_RZ) * (dSpV_dT(i) * (Thtot(i) - T_lay*htot(i)) + &
dSpV_dS(i) * (Shtot(i) - S_lay*htot(i)))
@@ -2490,11 +2490,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS)
do i=is,ie ; if (do_i(i)) then
htot(i) = htot(i) + 0.5 * (h(i,J,k) + h(i,j+1,k))
vhtot(i) = vhtot(i) + 0.5 * (h(i,j,k) + h(i,j+1,k)) * v(i,J,k)
- uhtot(i) = uhtot(i) + 0.25 * (h(i,j,k) * (u(I-1,j,k) + u(I,j,k)) + &
- h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k)))
+ uhtot(i) = uhtot(i) + 0.25 * ((h(i,j,k) * (u(I-1,j,k) + u(I,j,k))) + &
+ (h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k))))
if (use_EOS) then
- Thtot(i) = Thtot(i) + 0.5 * (h(i,j,k)*tv%T(i,j,k) + h(i,j+1,k)*tv%T(i,j+1,k))
- Shtot(i) = Shtot(i) + 0.5 * (h(i,j,k)*tv%S(i,j,k) + h(i,j+1,k)*tv%S(i,j+1,k))
+ Thtot(i) = Thtot(i) + 0.5 * ((h(i,j,k)*tv%T(i,j,k)) + (h(i,j+1,k)*tv%T(i,j+1,k)))
+ Shtot(i) = Shtot(i) + 0.5 * ((h(i,j,k)*tv%S(i,j,k)) + (h(i,j+1,k)*tv%S(i,j+1,k)))
else
Rhtot(i) = Rhtot(i) + 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%Rlay(k)
endif
diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90
index c26ee4ac75..b1556aa42d 100644
--- a/src/parameterizations/vertical/MOM_vert_friction.F90
+++ b/src/parameterizations/vertical/MOM_vert_friction.F90
@@ -390,7 +390,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
do k=1,nz
kp1 = MIN(k+1 , nz)
- tau_u(I,j,k+1) = sqrt( tauxDG_u(I,j,k+1)*tauxDG_u(I,j,k+1) + tauyDG_u(I,j,k+1)*tauyDG_u(I,j,k+1))
+ tau_u(I,j,k+1) = sqrt( (tauxDG_u(I,j,k+1)*tauxDG_u(I,j,k+1)) + (tauyDG_u(I,j,k+1)*tauyDG_u(I,j,k+1)) )
Omega_tau2x = atan2( tauyDG_u(I,j,k+1) , tauxDG_u(I,j,k+1) )
omega_tmp = Omega_tau2x !- omega_w2x_u(I,j)
if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi
@@ -412,7 +412,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
do k=1,nz-1
kp1 = MIN(k+1 , nz)
- tau_v(i,J,k+1) = sqrt ( tauxDG_v(i,J,k+1)*tauxDG_v(i,J,k+1) + tauyDG_v(i,J,k+1)*tauyDG_v(i,J,k+1) )
+ tau_v(i,J,k+1) = sqrt ( (tauxDG_v(i,J,k+1)*tauxDG_v(i,J,k+1)) + (tauyDG_v(i,J,k+1)*tauyDG_v(i,J,k+1)) )
omega_tau2x = atan2( tauyDG_v(i,J,k+1) , tauxDG_v(i,J,k+1) )
omega_tmp = omega_tau2x !- omega_w2x_v(i,J)
if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi
@@ -472,7 +472,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
! diagnostics
Omega_tau2s_u(I,j,k+1) = atan2(tauNL_CG , (tau_u(I,j,k+1)+tauNL_DG))
- tau_u(I,j,k+1) = sqrt((tauxDG_u(I,j,k+1) + tauNL_X)**2 + (tauyDG_u(I,j,k+1) + tauNL_Y)**2)
+ tau_u(I,j,k+1) = sqrt(((tauxDG_u(I,j,k+1) + tauNL_X)**2) + ((tauyDG_u(I,j,k+1) + tauNL_Y)**2))
omega_tau2x = atan2((tauyDG_u(I,j,k+1) + tauNL_Y), (tauxDG_u(I,j,k+1) + tauNL_X))
omega_tau2w = omega_tau2x !- omega_w2x_u(I,j)
if (omega_tau2w >= pi ) omega_tau2w = omega_tau2w - 2.*pi
@@ -532,7 +532,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, G, GV, US, CS, OB
! diagnostics
Omega_tau2s_v(i,J,k+1) = atan2(tauNL_CG, tau_v(i,J,k+1) + tauNL_DG)
- tau_v(i,J,k+1) = sqrt((tauxDG_v(i,J,k+1) + tauNL_X)**2 + (tauyDG_v(i,J,k+1) + tauNL_Y)**2)
+ tau_v(i,J,k+1) = sqrt(((tauxDG_v(i,J,k+1) + tauNL_X)**2) + ((tauyDG_v(i,J,k+1) + tauNL_Y)**2))
!omega_tau2x = atan2((tauyDG_v(i,J,k+1) + tauNL_Y) , (tauxDG_v(i,J,k+1) + tauNL_X))
!omega_tau2w = omega_tau2x - omega_w2x_v(i,J)
if (omega_tau2w > pi) omega_tau2w = omega_tau2w - 2.*pi
diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90
index e927f2f89d..7118fdd401 100644
--- a/src/tracer/MOM_tracer_advect.F90
+++ b/src/tracer/MOM_tracer_advect.F90
@@ -540,9 +540,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, &
if (G%mask2dCu(I_up,j)*G%mask2dCu(I_up-1,j)*(Tp-Tc)*(Tc-Tm) <= 0.) then
aL = Tc ; aR = Tc ! PCM for local extrema and boundary cells
elseif ( dA*(Tc-mA) > (dA*dA)/6. ) then
- aL = 3.*Tc - 2.*aR
+ aL = (3.*Tc) - 2.*aR
elseif ( dA*(Tc-mA) < - (dA*dA)/6. ) then
- aR = 3.*Tc - 2.*aL
+ aR = (3.*Tc) - 2.*aL
endif
a6 = 6.*Tc - 3. * (aR + aL) ! Curvature
@@ -925,9 +925,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, &
if (G%mask2dCv(i,J_up)*G%mask2dCv(i,J_up-1)*(Tp-Tc)*(Tc-Tm) <= 0.) then
aL = Tc ; aR = Tc ! PCM for local extrema and boundary cells
elseif ( dA*(Tc-mA) > (dA*dA)/6. ) then
- aL = 3.*Tc - 2.*aR
+ aL = (3.*Tc) - 2.*aR
elseif ( dA*(Tc-mA) < - (dA*dA)/6. ) then
- aR = 3.*Tc - 2.*aL
+ aR = (3.*Tc) - 2.*aL
endif
a6 = 6.*Tc - 3. * (aR + aL) ! Curvature
diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90
index 2b1530e94d..8cab315db9 100644
--- a/src/tracer/MOM_tracer_hor_diff.F90
+++ b/src/tracer/MOM_tracer_hor_diff.F90
@@ -546,10 +546,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_
do m=1,ntr
do j=js,je ; do i=is,ie
dTr(i,j) = Ihdxdy(i,j) * &
- ((Coef_x(I-1,j,1) * (Reg%Tr(m)%t(i-1,j,k) - Reg%Tr(m)%t(i,j,k)) - &
- Coef_x(I,j,1) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))) + &
- (Coef_y(i,J-1,1) * (Reg%Tr(m)%t(i,j-1,k) - Reg%Tr(m)%t(i,j,k)) - &
- Coef_y(i,J,1) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))))
+ ( ((Coef_x(I-1,j,1) * (Reg%Tr(m)%t(i-1,j,k) - Reg%Tr(m)%t(i,j,k))) - &
+ (Coef_x(I,j,1) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k)))) + &
+ ((Coef_y(i,J-1,1) * (Reg%Tr(m)%t(i,j-1,k) - Reg%Tr(m)%t(i,j,k))) - &
+ (Coef_y(i,J,1) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) )
enddo ; enddo
if (associated(Reg%Tr(m)%df_x)) then ; do j=js,je ; do I=G%IscB,G%IecB
Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j,1) &
diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90
index d8eb4d57fb..2684901b37 100644
--- a/src/tracer/advection_test_tracer.F90
+++ b/src/tracer/advection_test_tracer.F90
@@ -226,13 +226,13 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS
do j=js,je ; do i=is,ie
locx = abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width
locy = abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width
- if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0
+ if ((locx**2) + (locy**2) <= 1.0) CS%tr(i,j,k,m) = 1.0
enddo ; enddo
k=5 ! Cut cylinder
do j=js,je ; do i=is,ie
locx = (G%geoLonT(i,j)-CS%x_origin)/CS%x_width
locy = (G%geoLatT(i,j)-CS%y_origin)/CS%y_width
- if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0
+ if ((locx**2) + (locy**2) <= 1.0) CS%tr(i,j,k,m) = 1.0
if (locx>0.0 .and. abs(locy)<0.2) CS%tr(i,j,k,m) = 0.0
enddo ; enddo
diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90
index 0c9d5cd330..d37b1d70ae 100644
--- a/src/user/Idealized_Hurricane.F90
+++ b/src/user/Idealized_Hurricane.F90
@@ -312,15 +312,15 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS)
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
! This expression can be changed if desired, but need not be.
forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0))
+ sqrt(0.5*((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2)) + &
+ 0.5*((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)))/CS%Rho0))
enddo ; enddo ; endif
!> Get tau_mag [R L Z T-2 ~> Pa]
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gustiness + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2)))
+ sqrt(0.5*((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2)) + &
+ 0.5*((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2))))
enddo ; enddo ; endif
end subroutine idealized_hurricane_wind_forcing
@@ -368,7 +368,7 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx
! Implementing Holland (1980) parameteric wind profile
- radius = SQRT(XX**2 + YY**2)
+ radius = SQRT((XX**2) + (YY**2))
!/ BGR
! rkm - r converted to km for Holland prof.
@@ -451,7 +451,7 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx
dV = U10*cos(Adir-Alph) - Vocn + V_TS
! Use a simple drag coefficient as a function of U10 (from Sullivan et al., 2010)
- du10 = sqrt(du**2+dv**2)
+ du10 = sqrt((du**2) + (dv**2))
if (dU10 < 11.0*US%m_s_to_L_T) then
Cd = 1.2e-3
elseif (dU10 < 20.0*US%m_s_to_L_T) then
@@ -465,8 +465,8 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx
endif
! Compute stress vector
- TX = US%L_to_Z * CS%rho_a * Cd * sqrt(dU**2 + dV**2) * dU
- TY = US%L_to_Z * CS%rho_a * Cd * sqrt(dU**2 + dV**2) * dV
+ TX = US%L_to_Z * CS%rho_a * Cd * sqrt((dU**2) + (dV**2)) * dU
+ TY = US%L_to_Z * CS%rho_a * Cd * sqrt((dU**2) + (dV**2)) * dV
end subroutine idealized_hurricane_wind_profile
@@ -541,7 +541,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C
!/ BR
! Calculate x position as a function of time.
xx = US%s_to_T*( t0 - time_type_to_real(day)) * CS%hurr_translation_spd * cos(transdir)
- rad = sqrt(xx**2 + CS%dy_from_center**2)
+ rad = sqrt((xx**2) + (CS%dy_from_center**2))
!/ BR
! rkm - rad converted to km for Holland prof.
! used in km due to error, correct implementation should
@@ -619,7 +619,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C
!BR
! Add a simple drag coefficient as a function of U10 |
!/----------------------------------------------------|
- du10 = sqrt(du**2+dv**2)
+ du10 = sqrt((du**2) + (dv**2))
if (dU10 < 11.0*US%m_s_to_L_T) then
Cd = 1.2e-3
elseif (dU10 < 20.0*US%m_s_to_L_T) then
@@ -641,7 +641,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C
Vocn = 0. ! sfc_state%v(i,J)
dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS
dV = U10*cos(Adir-Alph) - Vocn + V_TS
- du10=sqrt(du**2+dv**2)
+ du10 = sqrt((du**2) + (dv**2))
if (dU10 < 11.0*US%m_s_to_L_T) then
Cd = 1.2e-3
elseif (dU10 < 20.0*US%m_s_to_L_T) then
@@ -660,15 +660,15 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
! This expression can be changed if desired, but need not be.
forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(US%L_to_Z * (CS%gustiness/CS%Rho0 + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0))
+ sqrt(0.5*((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2)) + &
+ 0.5*((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2)))/CS%Rho0))
enddo ; enddo ; endif
!> Set magnitude of the wind stress [R L Z T-2 ~> Pa]
if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie
forces%tau_mag(i,j) = G%mask2dT(i,j) * (CS%gustiness + &
- sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + &
- 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2)))
+ sqrt(0.5*((forces%taux(I-1,j)**2) + (forces%taux(I,j)**2)) + &
+ 0.5*((forces%tauy(i,J-1)**2) + (forces%tauy(i,J)**2))))
enddo ; enddo ; endif
end subroutine SCM_idealized_hurricane_wind_forcing
diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90
index 656ff5b569..08484da1f8 100644
--- a/src/user/MOM_wave_interface.F90
+++ b/src/user/MOM_wave_interface.F90
@@ -1216,7 +1216,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, dz, Waves, &
enddo
call Get_SL_Average_Prof( GV, Dpt_LASL, dz, US_H, LA_STKx)
call Get_SL_Average_Prof( GV, Dpt_LASL, dz, VS_H, LA_STKy)
- LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY)
+ LA_STK = sqrt((LA_STKX*LA_STKX) + (LA_STKY*LA_STKY))
elseif (Waves%WaveMethod==SURFBANDS) then
allocate(StkBand_X(Waves%NumBands), StkBand_Y(Waves%NumBands))
do bb = 1,Waves%NumBands
@@ -1225,7 +1225,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, dz, Waves, &
enddo
call Get_SL_Average_Band(GV, Dpt_LASL, Waves%NumBands, Waves%WaveNum_Cen, StkBand_X, LA_STKx )
call Get_SL_Average_Band(GV, Dpt_LASL, Waves%NumBands, Waves%WaveNum_Cen, StkBand_Y, LA_STKy )
- LA_STK = sqrt(LA_STKX**2 + LA_STKY**2)
+ LA_STK = sqrt((LA_STKX**2) + (LA_STKY**2))
deallocate(StkBand_X, StkBand_Y)
elseif (Waves%WaveMethod==DHH85) then
! Temporarily integrating profile rather than spectrum for simplicity
@@ -1235,7 +1235,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, dz, Waves, &
enddo
call Get_SL_Average_Prof( GV, Dpt_LASL, dz, US_H, LA_STKx)
call Get_SL_Average_Prof( GV, Dpt_LASL, dz, VS_H, LA_STKy)
- LA_STK = sqrt(LA_STKX**2 + LA_STKY**2)
+ LA_STK = sqrt((LA_STKX**2) + (LA_STKY**2))
elseif (Waves%WaveMethod==LF17) then
call get_StokesSL_LiFoxKemper(ustar, HBL*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA)
elseif (Waves%WaveMethod==Null_WaveMethod) then
@@ -1655,8 +1655,8 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, Waves)
do k = 1, GV%ke
do j = G%jsc, G%jec
do I = G%iscB, G%iecB
- DVel = 0.25*(Waves%us_y(i,j+1,k)+Waves%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + &
- 0.25*(Waves%us_y(i,j,k)+Waves%us_y(i-1,j,k))*G%CoriolisBu(i,j)
+ DVel = 0.25*((Waves%us_y(i,J+1,k)+Waves%us_y(i-1,J+1,k)) * G%CoriolisBu(I,J+1)) + &
+ 0.25*((Waves%us_y(i,J,k)+Waves%us_y(i-1,J,k)) * G%CoriolisBu(I,J))
u(I,j,k) = u(I,j,k) + DVEL*dt
enddo
enddo
@@ -1665,8 +1665,8 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, Waves)
do k = 1, GV%ke
do J = G%jscB, G%jecB
do i = G%isc, G%iec
- DVel = 0.25*(Waves%us_x(i+1,j,k)+Waves%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + &
- 0.25*(Waves%us_x(i,j,k)+Waves%us_x(i,j-1,k))*G%CoriolisBu(i,j)
+ DVel = 0.25*((Waves%us_x(I+1,j,k)+Waves%us_x(I+1,j-1,k)) * G%CoriolisBu(I+1,J)) + &
+ 0.25*((Waves%us_x(I,j,k)+Waves%us_x(I,j-1,k)) * G%CoriolisBu(I,J))
v(i,J,k) = v(i,j,k) - DVEL*dt
enddo
enddo
diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90
index 6885b6881a..98eca06d6b 100644
--- a/src/user/Neverworld_initialization.F90
+++ b/src/user/Neverworld_initialization.F90
@@ -157,7 +157,7 @@ real function dist_line_fixed_x(x, y, x0, y0, y1)
dx = x - x0
yr = min( max(y0,y1), max( min(y0,y1), y ) ) ! bound y by y0,y1
dy = y - yr ! =0 within y0<y<y1, =y0-y for y<y0, =y-y1 for y>y1
- dist_line_fixed_x = sqrt( dx*dx + dy*dy )
+ dist_line_fixed_x = sqrt( (dx*dx) + (dy*dy) )
end function dist_line_fixed_x
!> Distance between points x,y and a line segment (x0,y0) and (x1,y0).
@@ -229,7 +229,7 @@ real function circ_ridge(lon, lat, lon0, lat0, ring_radius, ring_thickness, ridg
real :: r ! A relative position [degrees]
real :: frac_ht ! The fractional height of the topography [nondim]
- r = sqrt( (lon - lon0)**2 + (lat - lat0)**2 ) ! Pseudo-distance from a point
+ r = sqrt( ((lon - lon0)**2) + ((lat - lat0)**2) ) ! Pseudo-distance from a point
r = abs( r - ring_radius) ! Pseudo-distance from a circle
frac_ht = cone(r, 0., ring_thickness, ridge_height) ! 0 .. frac_ridge_height
circ_ridge = 1. - frac_ht ! Fractional depths (1-frac_ridge_height) .. 1
@@ -292,8 +292,8 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file,
h(i,j,k) = e0(k) - e_interface ! Nominal thickness
x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon
y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat
- r1 = sqrt((x-0.7)**2+(y-0.2)**2)
- r2 = sqrt((x-0.3)**2+(y-0.25)**2)
+ r1 = sqrt(((x-0.7)**2) + ((y-0.2)**2))
+ r2 = sqrt(((x-0.3)**2) + ((y-0.25)**2))
h(i,j,k) = h(i,j,k) + pert_amp * (e0(k) - e0(nz+1)) * &
(spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation
if (h_noise /= 0.) then
diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90
index be515f22ca..46cf6423d4 100644
--- a/src/user/SCM_CVMix_tests.F90
+++ b/src/user/SCM_CVMix_tests.F90
@@ -217,7 +217,7 @@ subroutine SCM_CVMix_tests_wind_forcing(sfc_state, forces, day, G, US, CS)
enddo ; enddo
call pass_vector(forces%taux, forces%tauy, G%Domain, To_All)
- mag_tau = sqrt(CS%tau_x*CS%tau_x + CS%tau_y*CS%tau_y)
+ mag_tau = sqrt((CS%tau_x*CS%tau_x) + (CS%tau_y*CS%tau_y))
if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt( US%L_to_Z * mag_tau / CS%Rho0 )
enddo ; enddo ; endif
diff --git a/src/user/basin_builder.F90 b/src/user/basin_builder.F90
index 705925a97d..c9faa0739c 100644
--- a/src/user/basin_builder.F90
+++ b/src/user/basin_builder.F90
@@ -208,7 +208,7 @@ real function dist_line_fixed_x(x, y, x0, y0, y1)
dx = x - x0
yr = min( max(y0,y1), max( min(y0,y1), y ) ) ! bound y by y0,y1
dy = y - yr ! =0 within y0<y<y1, =y0-y for y<y0, =y-y1 for y>y1
- dist_line_fixed_x = sqrt( dx*dx + dy*dy )
+ dist_line_fixed_x = sqrt( (dx*dx) + (dy*dy) )
end function dist_line_fixed_x
!> Distance between points x,y and a line segment (x0,y0) and (x1,y0).
@@ -310,7 +310,7 @@ real function circ_conic_ridge(lon, lat, lon0, lat0, ring_radius, ring_thickness
real :: r ! A relative position [degrees]
real :: frac_ht ! The fractional height of the topography [nondim]
- r = sqrt( (lon - lon0)**2 + (lat - lat0)**2 ) ! Pseudo-distance from a point
+ r = sqrt( ((lon - lon0)**2) + ((lat - lat0)**2) ) ! Pseudo-distance from a point
r = abs( r - ring_radius) ! Pseudo-distance from a circle
frac_ht = cone(r, 0., ring_thickness, ridge_height) ! 0 .. frac_ridge_height
circ_conic_ridge = 1. - frac_ht ! nondim depths (1-frac_ridge_height) .. 1
@@ -329,7 +329,7 @@ real function circ_scurve_ridge(lon, lat, lon0, lat0, ring_radius, ring_thicknes
real :: s ! A function of the normalized position [nondim]
real :: frac_ht ! The fractional height of the topography [nondim]
- r = sqrt( (lon - lon0)**2 + (lat - lat0)**2 ) ! Pseudo-distance from a point
+ r = sqrt( ((lon - lon0)**2) + ((lat - lat0)**2) ) ! Pseudo-distance from a point
r = abs( r - ring_radius) ! Pseudo-distance from a circle
s = 1. - scurve(r, 0., ring_thickness) ! 0 .. 1
frac_ht = s * ridge_height ! 0 .. frac_ridge_height
diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90
index ab9ab385de..98b5bd4705 100644
--- a/src/user/circle_obcs_initialization.F90
+++ b/src/user/circle_obcs_initialization.F90
@@ -102,7 +102,7 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, US, param_file,
latC = G%south_lat + 0.5*G%len_lat
lonC = G%west_lon + 0.5*G%len_lon + xOffset
do j=js,je ; do i=is,ie
- rad = sqrt((G%geoLonT(i,j)-lonC)**2+(G%geoLatT(i,j)-latC)**2)/(diskrad)
+ rad = sqrt(((G%geoLonT(i,j)-lonC)**2) + ((G%geoLatT(i,j)-latC)**2)) / diskrad
! if (rad <= 6.*diskrad) h(i,j,k) = h(i,j,k)+10.0*exp( -0.5*( rad**2 ) )
rad = min( rad, 1. ) ! Flatten outside radius of diskrad
rad = rad*(2.*asin(1.)) ! Map 0-1 to 0-pi
diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90
index 60aef08cb4..59709ecde7 100644
--- a/src/user/seamount_initialization.F90
+++ b/src/user/seamount_initialization.F90
@@ -72,7 +72,7 @@ subroutine seamount_initialize_topography( D, G, param_file, max_depth )
! Compute normalized zonal coordinates (x,y=0 at center of domain)
x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon - 0.5
y = ( G%geoLatT(i,j) - G%south_lat ) / G%len_lat - 0.5
- D(i,j) = G%max_depth * ( 1.0 - delta * exp(-(rLx*x)**2 -(rLy*y)**2) )
+ D(i,j) = G%max_depth * ( 1.0 - delta * exp(-((rLx*x)**2) - ((rLy*y)**2)) )
enddo ; enddo
end subroutine seamount_initialize_topography