Skip to content

Commit

Permalink
(*)Parenthesize squares of wind stresses for FMAs
Browse files Browse the repository at this point in the history 
  Added parentheses to expressions taking the squares of the wind stress
components in 70 lines in 7 files so that these expressions will be rotationally
invariant when fused-multiply-adds are enabled.  All answers are bitwise
identical in cases without FMAs, but answers could change with FMAs.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Jul 29, 2024
1 parent aacb909 commit 6628dbf
Show file tree
Hide file tree
Showing 7 changed files with 70 additions and 70 deletions.
14 changes: 7 additions & 7 deletions config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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)

Expand Down
20 changes: 10 additions & 10 deletions config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -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)
Expand Down
20 changes: 10 additions & 10 deletions config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down
56 changes: 28 additions & 28 deletions config_src/drivers/solo_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions config_src/drivers/solo_driver/user_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions src/core/MOM_forcing_type.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 6628dbf

Please sign in to comment.