Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Merge latest main (05d8cc3) #322

Merged
merged 39 commits into from
Nov 7, 2024
Merged

Merge latest main (05d8cc3) #322

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
39 commits
Select commit Hold shift + click to select a range
8d05f39
initialize cpl_scalar field when created
DeniseWorthen Jul 8, 2024
6628dbf
(*)Parenthesize squares of wind stresses for FMAs
Hallberg-NOAA Mar 1, 2024
f0e61f3
(*)Parenthesize continuity_PPM curv_3 expressions
Hallberg-NOAA Feb 29, 2024
4f710ef
(*)Add parentheses for oblique OBCs with FMAs
Hallberg-NOAA Mar 1, 2024
9172cd5
(*)Add parentheses for density_integrals with FMAs
Hallberg-NOAA Mar 1, 2024
24091cc
(*)Add parentheses to 4 EOS int_density routines
Hallberg-NOAA Mar 1, 2024
8066a3d
(*)Simplify density integral parentheses
Hallberg-NOAA Mar 4, 2024
99fd957
(*)Parenthesize PressureForce_Montgomery for FMAs
Hallberg-NOAA Mar 1, 2024
307a4e2
(*)Parenthesize calc_isoneutral_slopes for FMAs
Hallberg-NOAA Mar 1, 2024
ce559ce
(*)Parenthesize MOM_calc_varT for FMAs
Hallberg-NOAA Mar 1, 2024
c344a11
(*)Parenthesize tracer_hordiff for FMAs
Hallberg-NOAA Mar 1, 2024
b2beab2
(*)Parenthesize iceberg_forces for FMAs
Hallberg-NOAA Mar 1, 2024
5398e6f
(*)Parenthesize CoriolisStokes and LA_Stk for FMAs
Hallberg-NOAA Mar 1, 2024
56d053a
+(*)Add and use G%Coriolis2Bu
Hallberg-NOAA Mar 1, 2024
49419f7
(*)Parenthesize thickness_diffuse for FMAs
Hallberg-NOAA Mar 1, 2024
03dc6f9
(*)Parenthesize Zanna_Bolton for FMAs
Hallberg-NOAA Mar 1, 2024
654cd4a
(*)Parenthesize MOM_internal_tides for FMAs
Hallberg-NOAA Mar 1, 2024
ebf02a9
(*)Parenthesize find_uv_at_h for FMAs
Hallberg-NOAA Mar 1, 2024
c0bef18
(*)Parenthesize set_viscous_ML for FMAs
Hallberg-NOAA Mar 1, 2024
0b50a15
(*)Rearrange calc_kappa_shear_vertex for FMAs
Hallberg-NOAA Mar 1, 2024
f0c52dd
(*)Parenthesize MOM_set_diffusivity for FMAs
Hallberg-NOAA Mar 1, 2024
64b851c
(*)Parenthesize CorAdCalc for FMAs
Hallberg-NOAA Mar 1, 2024
46e8b66
(*)Parenthesize MOM_barotropic for FMAs
Hallberg-NOAA Mar 1, 2024
6216fa1
(*)Parenthesize MOM_lateral_mixing_coeffs for FMAs
Hallberg-NOAA Mar 2, 2024
ffef92f
(*)Parenthesize MOM_hor_visc for FMAs
Hallberg-NOAA Apr 18, 2024
fc2af28
(*)Parenthesize initialization squares for FMAs
Hallberg-NOAA Mar 3, 2024
44f1130
(*)Parenthesize parameterization squares for FMAs
Hallberg-NOAA Mar 3, 2024
182223c
(*)Parenthesize diagnostics for FMAs
Hallberg-NOAA Apr 30, 2024
e810ac5
(*)Parenthesize tracer_advect PPM edge values
Hallberg-NOAA May 5, 2024
ffa766b
(*)More parentheses in density_integrals for FMAs
Hallberg-NOAA Jul 31, 2024
fd82861
(*)Add parentheses in end_value_h4 for FMAs
Hallberg-NOAA Aug 2, 2024
4b8777e
Merge pull request #135 from DeniseWorthen/bugfix/initcplscalars
jiandewang Aug 6, 2024
5c9aee9
Merge branch 'NOAA-EMC:dev/emc' into feature/update-to-main-20240531
jiandewang Aug 6, 2024
00f8ea2
Merge pull request #136 from jiandewang/feature/update-to-main-20240531
jiandewang Aug 16, 2024
ce58a32
Merge pull request #1634 from Hallberg-NOAA/FMA_rotational_symmetry_main
Hallberg-NOAA Aug 24, 2024
e4df846
Merge remote-tracking branch 'MAIN/main' into feature/update-to-main-…
jiandewang Aug 25, 2024
5e0c21f
Merge pull request #138 from jiandewang/feature/update-to-main-20240824
jiandewang Sep 9, 2024
05d8cc3
Merge pull request #1639 from jiandewang/dev-emc-20240909-cpl-scalar
jiandewang Sep 14, 2024
a775c4d
merge latest main and resolve conflicts
alperaltuntas Nov 7, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 7 additions & 7 deletions config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
View file
Open in desktop
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
Open in desktop
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
5 changes: 5 additions & 0 deletions config_src/drivers/nuopc_cap/mom_cap.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2461,6 +2461,11 @@ subroutine SetScalarField(field, rc)
ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! initialize fldptr to zero
call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
fldptr2d(:,:) = 0.0

end subroutine SetScalarField

end subroutine MOM_RealizeFields
Expand Down
20 changes: 10 additions & 10 deletions config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -887,10 +887,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 @@ -920,9 +920,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 @@ -934,13 +934,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
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -541,13 +541,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 @@ -751,19 +751,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 @@ -805,25 +805,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 @@ -893,21 +893,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 @@ -953,25 +953,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
Open in desktop
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
Open in desktop
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
Loading