Skip to content

Commit

Permalink
+Added 6 more ..._ANSWER_DATE runtime parameters
Browse files Browse the repository at this point in the history 
  Added 6 ..._ANSWER_DATE runtime parameters controlling the expressions and
order of arithmetic in the core, ocean_data_assim, user, and driver modules,
which take precedence over their older ..._ANSWERS_2018 counterparts.  The new
runtime parameters are SURFACE_ANSWER_DATE, BAROTROPIC_ANSWER_DATE,
ODA_ANSWER_DATE, IDL_HURR_ANSWER_DATE SURFACE_FORCING_ANSWER_DATE and
WIND_GYRES_ANSWER_DATE. All answers are bitwise identical, but there are
numerous new entries in the MOM_parameter_doc.all files.
  • Loading branch information
@Hallberg-NOAA @marshallward
Hallberg-NOAA authored and marshallward committed Aug 4, 2022
1 parent 83acd43 commit 16c3126
Show file tree
Hide file tree
Showing 6 changed files with 165 additions and 60 deletions.
40 changes: 29 additions & 11 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 @@ -129,9 +129,10 @@ module MOM_surface_forcing_gfdl
real :: max_delta_srestore !< Maximum delta salinity used for restoring [S ~> ppt]
real :: max_delta_trestore !< Maximum delta sst used for restoring [C ~> degC]
real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin
logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover
!! the answers from the end of 2018. Otherwise, use a simpler
!! expression to calculate gustiness.
integer :: answer_date !< The vintage of the order of arithmetic and expressions in the
!! gustiness calculations. Values below 20190101 recover the answers
!! from the end of 2018, while higher values use a simpler expression
!! to calculate gustiness.
logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the
!! gustless wind friction velocity.
logical :: check_no_land_fluxes !< Return warning if IOB flux over land is non-zero
Expand Down Expand Up @@ -533,7 +534,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G)
endif
if (CS%answers_2018) then
if (CS%answer_date < 20190101) then
fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + &
fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j)
else
Expand Down Expand Up @@ -1038,7 +1039,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
endif
ustar(i,j) = sqrt(gustiness*IRho0 + IRho0*Pa_conversion*IOB%stress_mag(i-i0,j-j0))
enddo ; enddo ; endif
if (CS%answers_2018) then
if (CS%answer_date < 20190101) then
if (do_gustless) then ; do j=js,je ; do i=is,ie
gustless_ustar(i,j) = sqrt(Pa_conversion*US%L_to_Z*IOB%stress_mag(i-i0,j-j0) / CS%Rho0)
enddo ; enddo ; endif
Expand All @@ -1060,7 +1061,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
if (CS%read_gust_2d) gustiness = CS%gust(i,j)
endif
if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag)
if (CS%answers_2018) then
if (CS%answer_date < 20190101) then
if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0)
else
if (do_gustless) gustless_ustar(i,j) = sqrt(IRho0 * tau_mag)
Expand All @@ -1072,7 +1073,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
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)
if (CS%answers_2018) then
if (CS%answer_date < 20190101) then
if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0)
else
if (do_gustless) gustless_ustar(i,j) = sqrt(IRho0 * tau_mag)
Expand All @@ -1093,7 +1094,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy,
if (CS%read_gust_2d) gustiness = CS%gust(i,j)

if (do_ustar) ustar(i,j) = sqrt(gustiness*IRho0 + IRho0 * tau_mag)
if (CS%answers_2018) then
if (CS%answer_date < 20190101) then
if (do_gustless) gustless_ustar(i,j) = sqrt(US%L_to_Z*tau_mag / CS%Rho0)
else
if (do_gustless) gustless_ustar(i,j) = sqrt(IRho0 * tau_mag)
Expand Down Expand Up @@ -1250,7 +1251,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1].
type(directories) :: dirs
logical :: new_sim, iceberg_flux_diags
logical :: default_2018_answers
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover
! the answers from the end of 2018. Otherwise, use a simpler
! expression to calculate gustiness.
type(time_type) :: Time_frc
character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names.
! This include declares and sets the variable "version".
Expand Down Expand Up @@ -1531,13 +1536,26 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, &
scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa
endif
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
"This sets the default value for the various _2018_ANSWERS parameters.", &
default=.false.)
call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", CS%answers_2018, &
default=(default_answer_date<20190101))
call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", answers_2018, &
"If true, use the order of arithmetic and expressions that recover the answers "//&
"from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", &
default=default_2018_answers)
! Revise inconsistent default answer dates.
if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "SURFACE_FORCING_ANSWER_DATE", CS%answer_date, &
"The vintage of the order of arithmetic and expressions in the gustiness "//&
"calculations. Values below 20190101 recover the answers from the end "//&
"of 2018, while higher values use a simpler expression to calculate gustiness. "//&
"If both SURFACE_FORCING_2018_ANSWERS and SURFACE_FORCING_ANSWER_DATE are "//&
"specified, the latter takes precedence.", default=default_answer_date)

call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, &
"If true correct a bug in the time-averaging of the gustless wind friction velocity", &
default=.true.)
Expand Down
37 changes: 28 additions & 9 deletions config_src/drivers/solo_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,10 +105,11 @@ module MOM_surface_forcing
real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres'
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'
logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover
!! the answers from the end of 2018. Otherwise, use a form of the gyre
!! wind stresses that are rotationally invariant and more likely to be
!! the same between compilers.
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.
!! 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.
logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the
!! gustless wind friction velocity.
! if WIND_CONFIG=='scurves' then use the following to define a piecewise scurve profile
Expand Down Expand Up @@ -522,7 +523,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS)
enddo ; enddo

! set the friction velocity
if (CS%answers_2018) then
if (CS%answer_date < 20190101) 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) + &
Expand Down Expand Up @@ -1504,7 +1505,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
real :: flux_const_default ! The unscaled value of FLUXCONST [m day-1]
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]
logical :: default_2018_answers
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover
! the answers from the end of 2018. Otherwise, use a form of the gyre
! wind stresses that are rotationally invariant and more likely to be
! the same between compilers.
character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name.
character(len=200) :: filename, gust_file ! The name of the gustiness input file.

Expand Down Expand Up @@ -1736,16 +1742,29 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C
"the zonal wind stress profile: "//&
" n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", &
units="nondim", default=0.0)
call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
"This sets the default value for the various _2018_ANSWERS parameters.", &
default=.false.)
call get_param(param_file, mdl, "WIND_GYRES_2018_ANSWERS", CS%answers_2018, &
default=(default_answer_date<20190101))
call get_param(param_file, mdl, "WIND_GYRES_2018_ANSWERS", answers_2018, &
"If true, use the order of arithmetic and expressions that recover the answers "//&
"from the end of 2018. Otherwise, use expressions for the gyre friction velocities "//&
"that are rotationally invariant and more likely to be the same between compilers.", &
default=default_2018_answers)
! Revise inconsistent default answer dates.
if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, mdl, "WIND_GYRES_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions used to set gyre wind stresses. "//&
"Values below 20190101 recover the answers from the end of 2018, "//&
"while higher values use a form of the gyre wind stresses that are "//&
"rotationally invariant and more likely to be the same between compilers. "//&
"If both WIND_GYRES_2018_ANSWERS and WIND_GYRES_ANSWER_DATE are specified, "//&
"the latter takes precedence.", default=default_answer_date)
else
CS%answers_2018 = .false.
CS%answer_date = 20190101
endif
if (trim(CS%wind_config) == "scurves") then
call get_param(param_file, mdl, "WIND_SCURVES_LATS", CS%scurves_ydata, &
Expand Down
36 changes: 27 additions & 9 deletions src/core/MOM.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -333,9 +333,10 @@ module MOM
real :: bad_val_sst_min !< Minimum SST before triggering bad value message [C ~> degC]
real :: bad_val_sss_max !< Maximum SSS before triggering bad value message [S ~> ppt]
real :: bad_val_col_thick !< Minimum column thickness before triggering bad value message [Z ~> m]
logical :: answers_2018 !< If true, use expressions for the surface properties that recover
!! the answers from the end of 2018. Otherwise, use more appropriate
!! expressions that differ at roundoff for non-Boussinesq cases.
integer :: answer_date !< The vintage of the expressions for the surface properties. Values
!! below 20190101 recover the answers from the end of 2018, while
!! higher values use more appropriate expressions that differ at
!! roundoff for non-Boussinesq cases.
logical :: use_particles !< Turns on the particles package
character(len=10) :: particle_type !< Particle types include: surface(default), profiling and sail drone.

Expand Down Expand Up @@ -1823,7 +1824,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
! with accumulated heat deficit returned to surface ocean.
logical :: bound_salinity ! If true, salt is added to keep salinity above
! a minimum value, and the deficit is reported.
integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags.
logical :: answers_2018 ! If true, use expressions for the surface properties that recover
! the answers from the end of 2018. Otherwise, use more appropriate
! expressions that differ at roundoff for non-Boussinesq cases.
logical :: use_conT_absS ! If true, the prognostics T & S are conservative temperature
! and absolute salinity. Care should be taken to convert them
! to potential temperature and practical salinity before
Expand Down Expand Up @@ -2147,13 +2152,26 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
"triggered, if CHECK_BAD_SURFACE_VALS is true.", &
units="m", default=0.0, scale=US%m_to_Z)
endif
call get_param(param_file, "MOM", "DEFAULT_ANSWER_DATE", default_answer_date, &
"This sets the default value for the various _ANSWER_DATE parameters.", &
default=99991231)
call get_param(param_file, "MOM", "DEFAULT_2018_ANSWERS", default_2018_answers, &
"This sets the default value for the various _2018_ANSWERS parameters.", &
default=.false.)
call get_param(param_file, "MOM", "SURFACE_2018_ANSWERS", CS%answers_2018, &
default=(default_answer_date<20190101))
call get_param(param_file, "MOM", "SURFACE_2018_ANSWERS", answers_2018, &
"If true, use expressions for the surface properties that recover the answers "//&
"from the end of 2018. Otherwise, use more appropriate expressions that differ "//&
"at roundoff for non-Boussinesq cases.", default=default_2018_answers)
! Revise inconsistent default answer dates.
if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231
if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101
call get_param(param_file, "MOM", "SURFACE_ANSWER_DATE", CS%answer_date, &
"The vintage of the expressions for the surface properties. Values below "//&
"20190101 recover the answers from the end of 2018, while higher values "//&
"use updated and more robust forms of the same expressions. "//&
"If both SURFACE_2018_ANSWERS and SURFACE_ANSWER_DATE are specified, the "//&
"latter takes precedence.", default=default_answer_date)

call get_param(param_file, "MOM", "USE_DIABATIC_TIME_BUG", CS%use_diabatic_time_bug, &
"If true, uses the wrong calendar time for diabatic processes, as was "//&
"done in MOM6 versions prior to February 2018. This is not recommended.", &
Expand Down Expand Up @@ -3343,9 +3361,9 @@ subroutine extract_surface_state(CS, sfc_state_in)
enddo ; enddo

else ! (CS%Hmix >= 0.0)
H_rescale = 1.0 ; if (CS%answers_2018) H_rescale = GV%H_to_Z
H_rescale = 1.0 ; if (CS%answer_date < 20190101) H_rescale = GV%H_to_Z
depth_ml = CS%Hmix
if (.not.CS%answers_2018) depth_ml = CS%Hmix*GV%Z_to_H
if (CS%answer_date >= 20190101) depth_ml = CS%Hmix*GV%Z_to_H
! Determine the mean tracer properties of the uppermost depth_ml fluid.

!$OMP parallel do default(shared) private(depth,dh)
Expand Down Expand Up @@ -3377,7 +3395,7 @@ subroutine extract_surface_state(CS, sfc_state_in)
enddo ; enddo
! Calculate the average properties of the mixed layer depth.
do i=is,ie
if (CS%answers_2018) then
if (CS%answer_date < 20190101) then
if (depth(i) < GV%H_subroundoff*H_rescale) &
depth(i) = GV%H_subroundoff*H_rescale
if (use_temperature) then
Expand Down Expand Up @@ -3416,7 +3434,7 @@ subroutine extract_surface_state(CS, sfc_state_in)
! This assumes that u and v halos have already been updated.
if (CS%Hmix_UV>0.) then
depth_ml = CS%Hmix_UV
if (.not.CS%answers_2018) depth_ml = CS%Hmix_UV*GV%Z_to_H
if (CS%answer_date >= 20190101) depth_ml = CS%Hmix_UV*GV%Z_to_H
!$OMP parallel do default(shared) private(depth,dh,hv)
do J=js-1,ie
do i=is,ie
Expand Down
Loading

0 comments on commit 16c3126

Please sign in to comment.