Skip to content

Commit

Permalink
Merge branch 'dev/gfdl' into obs_henyey_new
Browse files Browse the repository at this point in the history
  • Loading branch information
@Hallberg-NOAA
Hallberg-NOAA authored Sep 11, 2022
2 parents 97dfe71 + de3f260 commit 13b40a3
Show file tree
Hide file tree
Showing 19 changed files with 1,093 additions and 278 deletions.
2 changes: 2 additions & 0 deletions .testing/Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -602,6 +602,7 @@ report.cov: run.cov codecov
2> build/cov/codecov.err \
&& echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" \
|| { \
cat build/cov/codecov.err ; \
echo -e "${RED}Failed to upload report.${RESET}" ; \
if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \
}
Expand Down Expand Up @@ -740,6 +741,7 @@ report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov
2> build/unit/codecov.err \
&& echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" \
|| { \
cat build/unit/codecov.err ; \
echo -e "${RED}Failed to upload report.${RESET}" ; \
if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \
}
Expand Down
31 changes: 19 additions & 12 deletions ac/configure.ac
View file
Original file line number Diff line number Diff line change
Expand Up @@ -234,21 +234,28 @@ AC_SUBST([SRC_DIRS],
AC_CONFIG_COMMANDS(Makefile.dep, [make depend])


# setjmp verification
# POSIX verification tests
AC_LANG_PUSH([C])

# Verify that either sigsetjmp (POSIX) or __sigsetjmp (glibc) are available.
AC_CHECK_FUNC([sigsetjmp])
AS_IF([test "$ac_cv_func_sigsetjmp" == "yes"], [
SIGSETJMP_NAME="sigsetjmp"
], [
AC_CHECK_FUNC([__sigsetjmp], [
SIGSETJMP_NAME="__sigsetjmp"
], [
AC_MSG_ERROR([Could not find a symbol for sigsetjmp.])
# These symbols may be defined as macros, making them inaccessible by Fortran.
# The following exist in BSD and Linux, so we just test for them.
AC_CHECK_FUNC([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])])
AC_CHECK_FUNC([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])])
AC_CHECK_FUNC([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])])

# Determine the sigsetjmp symbol. If missing, then point to sigsetjmp_missing.
#
# Supported symbols:
# sigsetjmp POSIX, BSD libc (MacOS)
# __sigsetjmp glibc (Linux)
SIGSETJMP="sigsetjmp_missing"
for sigsetjmp_fn in sigsetjmp __sigsetjmp; do
AC_CHECK_FUNC([${sigsetjmp_fn}], [
SIGSETJMP=${sigsetjmp_fn}
break
])
])
AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["$SIGSETJMP_NAME"])
done
AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["${SIGSETJMP}"])

# Determine the size of jmp_buf and sigjmp_buf
AC_CHECK_SIZEOF([jmp_buf], [], [#include <setjmp.h>])
Expand Down
72 changes: 41 additions & 31 deletions config_src/drivers/solo_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,7 +106,7 @@ module MOM_surface_forcing
real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres'
real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres'
integer :: answer_date !< This 8-digit integer gives the approximate date with which the order
!! of arithmetic and and expressions were added to the code.
!! of arithmetic and expressions were added to the code.
!! Dates before 20190101 use original answers.
!! Dates after 20190101 use a form of the gyre wind stresses that are
!! rotationally invariant and more likely to be the same between compilers.
Expand Down Expand Up @@ -161,8 +161,8 @@ module MOM_surface_forcing
character(len=200) :: salinityrestore_file = '' !< The file from which to read the sea surface
!! salinity to restore toward

character(len=80) :: stress_x_var = '' !< X-windstress variable name in the input file
character(len=80) :: stress_y_var = '' !< Y-windstress variable name in the input file
character(len=80) :: stress_x_var = '' !< X-wind stress variable name in the input file
character(len=80) :: stress_y_var = '' !< Y-wind stress variable name in the input file
character(len=80) :: ustar_var = '' !< ustar variable name in the input file
character(len=80) :: LW_var = '' !< longwave heat flux variable name in the input file
character(len=80) :: SW_var = '' !< shortwave heat flux variable name in the input file
Expand Down Expand Up @@ -447,6 +447,8 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS)
forces%tauy(i,J) = 0.0
enddo ; enddo

if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS)

call callTree_leave("wind_forcing_2gyre")
end subroutine wind_forcing_2gyre

Expand Down Expand Up @@ -484,6 +486,8 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS)
forces%tauy(i,J) = 0.0
enddo ; enddo

if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS)

call callTree_leave("wind_forcing_1gyre")
end subroutine wind_forcing_1gyre

Expand All @@ -499,8 +503,6 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS)
!! a previous surface_forcing_init call
! Local variables
real :: PI ! A common irrational number, 3.1415926535... [nondim]
real :: I_rho ! The inverse of the reference density times a ratio of scaling
! factors [Z L-1 R-1 ~> m3 kg-1]
real :: y ! The latitude relative to the south normalized by the domain extent [nondim]
integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq

Expand Down Expand Up @@ -530,12 +532,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS)
forces%taux(i-1,j)*forces%taux(i-1,j) + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0) )
enddo ; enddo
else
I_rho = US%L_to_Z / CS%Rho0
do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt( (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))) ) * I_rho )
enddo ; enddo
call stresses_to_ustar(forces, G, US, CS)
endif

call callTree_leave("wind_forcing_gyres")
Expand All @@ -558,8 +555,6 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS)
real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units
! for wind stresses [R Z L T-2 Pa-1 ~> 1]
real :: PI ! A common irrational number, 3.1415926535... [nondim]
real :: I_rho ! The inverse of the reference density times a ratio of scaling
! factors [Z L-1 R-1 ~> m3 kg-1]
real :: y ! The latitude relative to the south normalized by the domain extent [nondim]
real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa]
real :: off ! An offset in the relative latitude [nondim]
Expand Down Expand Up @@ -602,14 +597,7 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS)
enddo ; enddo

! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive.
if (associated(forces%ustar)) then
I_rho = US%L_to_Z / CS%Rho0
do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt( (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))) ) * I_rho )
enddo ; enddo
endif
if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS)

end subroutine Neverworld_wind_forcing

Expand All @@ -625,8 +613,6 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS)
!! a previous surface_forcing_init call
! Local variables
integer :: i, j, kseg
real :: I_rho ! The inverse of the reference density times a ratio of scaling
! factors [Z L-1 R-1 ~> m3 kg-1]
real :: y_curve ! The latitude relative to the southern end of a curve segment [degreesN]
real :: L_curve ! The latitudinal extent of a curve segment [degreesN]
! real :: ydata(7) = (/ -70., -45., -15., 0., 15., 45., 70. /)
Expand Down Expand Up @@ -657,14 +643,7 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS)
enddo ; enddo

! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive.
if (associated(forces%ustar)) then
I_rho = US%L_to_Z / CS%Rho0
do j=G%jsc,G%jec ; do i=G%isc,G%iec
forces%ustar(i,j) = sqrt( (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))) ) * I_rho )
enddo ; enddo
endif
if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS)

end subroutine scurve_wind_forcing

Expand Down Expand Up @@ -892,6 +871,37 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS)
call callTree_leave("wind_forcing_by_data_override")
end subroutine wind_forcing_by_data_override

!> Translate the wind stresses into the friction velocity, including effects of background gustiness.
subroutine stresses_to_ustar(forces, G, US, CS)
type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
type(ocean_grid_type), intent(in) :: G !< Grid structure.
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by
!! a previous surface_forcing_init call
! Local variables
real :: I_rho ! The inverse of the reference density times a ratio of scaling
! factors [Z L-1 R-1 ~> m3 kg-1]
integer :: i, j, is, ie, js, je

is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec

I_rho = US%L_to_Z / CS%Rho0

if (CS%read_gust_2d) then
do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt( (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))) ) * I_rho )
enddo ; enddo
else
do j=js,je ; do i=is,ie
forces%ustar(i,j) = sqrt( (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))) ) * I_rho )
enddo ; enddo
endif

end subroutine stresses_to_ustar

!> Specifies zero surface buoyancy fluxes from input files.
subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS)
Expand Down
Loading

0 comments on commit 13b40a3

Please sign in to comment.