Skip to content

Commit

Permalink
Merge branch 'main' into dev/gfdl
Browse files Browse the repository at this point in the history 
  This merge updates dev/gfdl following PR mom-ocean#1634 to main that added parentheses
to give rotational symmetry when fused-multiply-adds are enabled.
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA committed Sep 4, 2024
2 parents a6dd0fd + ce58a32 commit 1eccd28
Show file tree
Hide file tree
Showing 54 changed files with 849 additions and 836 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 @@ -1099,10 +1099,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 @@ -1117,7 +1117,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 @@ -1133,10 +1133,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
8 changes: 4 additions & 4 deletions src/ALE/regrid_edge_values.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.

Expand Down
Loading

0 comments on commit 1eccd28

Please sign in to comment.