From 8fd122990afab650b2aa6cfd14a5f24256953cd7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 29 Jul 2022 12:02:19 -0400 Subject: [PATCH 1/9] +Add answer_date optional arguments Added optional answer_date arguments to various remapping routines. These are vintage-encoding integers intended to replace the logical answers_2018 arguments, and allow for multiple generations of improved algorithms rather than just two choices, without requiring added interface changes. However, this change is backward compatible, and these two arguments are both offered for now. All answers are bitwise identical, but there are new optional arguments to numerous publicly visible routines. --- src/ALE/P1M_functions.F90 | 6 ++- src/ALE/P3M_functions.F90 | 11 ++++-- src/ALE/PPM_functions.F90 | 10 +++-- src/ALE/PQM_functions.F90 | 10 +++-- src/ALE/regrid_edge_values.F90 | 25 ++++++++++--- src/ALE/regrid_solvers.F90 | 8 +++- src/framework/MOM_horizontal_regridding.F90 | 41 ++++++++++++++------- 7 files changed, 76 insertions(+), 35 deletions(-) diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index d99c611229..281971cca4 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -24,7 +24,7 @@ module P1M_functions !! !! It is assumed that the size of the array 'u' is equal to the number of cells !! defining 'grid' and 'ppoly'. No consistency check is performed here. -subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018 ) +subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] @@ -33,13 +33,15 @@ subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answe !! piecewise polynomial coefficients, mainly [A] real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! loop index real :: u0_l, u0_r ! edge values (left and right) ! Bound edge values (routine found in 'edge_values.F90') - call bound_edge_values( N, h, u, edge_values, h_neglect, answers_2018 ) + call bound_edge_values( N, h, u, edge_values, h_neglect, & + answers_2018=answers_2018, answer_date=answer_date ) ! Systematically average discontinuous edge values (routine found in ! 'edge_values.F90') diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index e3a9f75a3c..4d39542337 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -25,7 +25,7 @@ module P3M_functions !! !! It is assumed that the size of the array 'u' is equal to the number of cells !! defining 'grid' and 'ppoly'. No consistency check is performed here. -subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018 ) +subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell averages (size N) in arbitrary units [A] @@ -35,13 +35,15 @@ subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_negle real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Call the limiter for p3m, which takes care of everything from ! computing the coefficients of the cubic to monotonizing it. ! This routine could be called directly instead of having to call ! 'P3M_interpolation' first but we do that to provide an homogeneous ! interface. - call P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018 ) + call P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, & + answers_2018=answers_2018, answer_date=answer_date ) end subroutine P3M_interpolation @@ -58,7 +60,7 @@ end subroutine P3M_interpolation !! c. If not, monotonize cubic curve and rebuild it !! !! Step 3 of the monotonization process leaves all edge values unchanged. -subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018 ) +subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell averages (size N) in arbitrary units [A] @@ -68,6 +70,7 @@ subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, an real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! loop index @@ -86,7 +89,7 @@ subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, an eps = 1e-10 ! 1. Bound edge values (boundary cells are assumed to be local extrema) - call bound_edge_values( N, h, u, edge_values, hNeglect, answers_2018 ) + call bound_edge_values( N, h, u, edge_values, hNeglect, answers_2018=answers_2018, answer_date=answer_date ) ! 2. Systematically average discontinuous edge values call average_discontinuous_edge_values( N, edge_values ) diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index bbf93b4a81..16441565ac 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -25,7 +25,7 @@ module PPM_functions contains !> Builds quadratic polynomials coefficients from cell mean and edge values. -subroutine PPM_reconstruction( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018) +subroutine PPM_reconstruction( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018, answer_date) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< Cell widths [H] real, dimension(N), intent(in) :: u !< Cell averages [A] @@ -33,13 +33,14 @@ subroutine PPM_reconstruction( N, h, u, edge_values, ppoly_coef, h_neglect, answ real, dimension(N,3), intent(inout) :: ppoly_coef !< Polynomial coefficients, mainly [A] real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! Loop index real :: edge_l, edge_r ! Edge values (left and right) ! PPM limiter - call PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018 ) + call PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018=answers_2018, answer_date=answer_date ) ! Loop over all cells do k = 1,N @@ -59,13 +60,14 @@ end subroutine PPM_reconstruction !> Adjusts edge values using the standard PPM limiter (Colella & Woodward, JCP 1984) !! after first checking that the edge values are bounded by neighbors cell averages !! and that the edge values are monotonic between cell averages. -subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018 ) +subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] real, dimension(:,:), intent(inout) :: edge_values !< Potentially modified edge values [A] real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! Loop index @@ -74,7 +76,7 @@ subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018 ) real :: expr1, expr2 ! Bound edge values - call bound_edge_values( N, h, u, edge_values, h_neglect, answers_2018 ) + call bound_edge_values( N, h, u, edge_values, h_neglect, answers_2018=answers_2018, answer_date=answer_date ) ! Make discontinuous edge values monotonic call check_discontinuous_edge_values( N, u, edge_values ) diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90 index 630ecb34fc..d3809a5d1c 100644 --- a/src/ALE/PQM_functions.F90 +++ b/src/ALE/PQM_functions.F90 @@ -17,7 +17,7 @@ module PQM_functions !! !! It is assumed that the dimension of 'u' is equal to the number of cells !! defining 'grid' and 'ppoly'. No consistency check is performed. -subroutine PQM_reconstruction( N, h, u, edge_values, edge_slopes, ppoly_coef, h_neglect, answers_2018 ) +subroutine PQM_reconstruction( N, h, u, edge_values, edge_slopes, ppoly_coef, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell averages (size N) [A] @@ -27,6 +27,7 @@ subroutine PQM_reconstruction( N, h, u, edge_values, edge_slopes, ppoly_coef, h_ real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! loop index @@ -36,7 +37,7 @@ subroutine PQM_reconstruction( N, h, u, edge_values, edge_slopes, ppoly_coef, h_ real :: a, b, c, d, e ! parabola coefficients ! PQM limiter - call PQM_limiter( N, h, u, edge_values, edge_slopes, h_neglect, answers_2018 ) + call PQM_limiter( N, h, u, edge_values, edge_slopes, h_neglect, answers_2018=answers_2018, answer_date=answer_date ) ! Loop on cells to construct the cubic within each cell do k = 1,N @@ -72,7 +73,7 @@ end subroutine PQM_reconstruction !! !! It is assumed that the dimension of 'u' is equal to the number of cells !! defining 'grid' and 'ppoly'. No consistency check is performed. -subroutine PQM_limiter( N, h, u, edge_values, edge_slopes, h_neglect, answers_2018 ) +subroutine PQM_limiter( N, h, u, edge_values, edge_slopes, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] @@ -81,6 +82,7 @@ subroutine PQM_limiter( N, h, u, edge_values, edge_slopes, h_neglect, answers_20 real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! loop index @@ -102,7 +104,7 @@ subroutine PQM_limiter( N, h, u, edge_values, edge_slopes, h_neglect, answers_20 hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect ! Bound edge values - call bound_edge_values( N, h, u, edge_values, hNeglect, answers_2018 ) + call bound_edge_values( N, h, u, edge_values, hNeglect, answers_2018=answers_2018, answer_date=answer_date ) ! Make discontinuous edge values monotonic (thru averaging) call check_discontinuous_edge_values( N, u, edge_values ) diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index a972fc3444..08425fc92d 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -41,7 +41,7 @@ module regrid_edge_values !! Both boundary edge values are set equal to the boundary cell averages. !! Any extrapolation scheme is applied after this routine has been called. !! Therefore, boundary cells are treated as if they were local extrama. -subroutine bound_edge_values( N, h, u, edge_val, h_neglect, answers_2018 ) +subroutine bound_edge_values( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] @@ -49,6 +49,8 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect, answers_2018 ) !! second index is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use + ! Local variables real :: sigma_l, sigma_c, sigma_r ! left, center and right van Leer slopes [A H-1] or [A] real :: slope_x_h ! retained PLM slope times half grid step [A] @@ -57,6 +59,7 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect, answers_2018 ) integer :: k, km1, kp1 ! Loop index and the values to either side. use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 + if (present(answer_date)) use_2018_answers = (answer_date < 20190101) if (use_2018_answers) then hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect endif @@ -218,7 +221,7 @@ end subroutine edge_values_explicit_h2 !! available interpolant. !! !! For this fourth-order scheme, at least four cells must exist. -subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answers_2018 ) +subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] @@ -226,6 +229,7 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answers_2018 ) !! is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real :: h0, h1, h2, h3 ! temporary thicknesses [H] @@ -247,6 +251,7 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answers_2018 ) logical :: use_2018_answers ! If true use older, less acccurate expressions. use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 + if (present(answer_date)) use_2018_answers = (answer_date < 20190101) if (use_2018_answers) then hNeglect = hNeglect_edge_dflt ; if (present(h_neglect)) hNeglect = h_neglect else @@ -382,7 +387,7 @@ end subroutine edge_values_explicit_h4 !! !! There are N+1 unknowns and we are able to write N-1 equations. The !! boundary conditions close the system. -subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answers_2018 ) +subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] @@ -390,6 +395,7 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answers_2018 ) !! is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: i, j ! loop indexes @@ -418,6 +424,7 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answers_2018 ) logical :: use_2018_answers ! If true use older, less acccurate expressions. use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 + if (present(answer_date)) use_2018_answers = (answer_date < 20190101) if (use_2018_answers) then hNeglect = hNeglect_edge_dflt ; if (present(h_neglect)) hNeglect = h_neglect else @@ -690,7 +697,7 @@ end subroutine end_value_h4 !! !! There are N+1 unknowns and we are able to write N-1 equations. The !! boundary conditions close the system. -subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answers_2018 ) +subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] @@ -698,6 +705,8 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answers_201 !! second index is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use + ! Local variables integer :: i, j ! loop indexes real :: h0, h1 ! cell widths [H or nondim] @@ -729,6 +738,7 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answers_201 hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect hNeglect3 = hNeglect**3 use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 + if (present(answer_date)) use_2018_answers = (answer_date < 20190101) ! Loop on cells (except last one) do i = 1,N-1 @@ -859,7 +869,7 @@ end subroutine edge_slopes_implicit_h3 !------------------------------------------------------------------------------ !> Compute ih5 edge slopes (implicit fifth order accurate) -subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect, answers_2018 ) +subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] @@ -867,6 +877,8 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect, answers_201 !! second index is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use + ! ----------------------------------------------------------------------------- ! Fifth-order implicit estimates of edge slopes are based on a four-cell, ! three-edge stencil. A tridiagonal system is set up and is based on @@ -1129,7 +1141,7 @@ end subroutine edge_slopes_implicit_h5 !! become computationally expensive if regridding is carried out !! often. Figuring out closed-form expressions for these coefficients !! on nonuniform meshes turned out to be intractable. -subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect, answers_2018 ) +subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties (size N) in arbitrary units [A] @@ -1137,6 +1149,7 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect, answers_2018 ) !! is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real :: h0, h1, h2, h3 ! cell widths [H] diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index b7cc3b5402..022946a29d 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -16,12 +16,13 @@ module regrid_solvers !! This routine uses Gauss's algorithm to transform the system's original !! matrix into an upper triangular matrix. Back substitution yields the answer. !! The matrix A must be square, with the first index varing down the column. -subroutine solve_linear_system( A, R, X, N, answers_2018 ) +subroutine solve_linear_system( A, R, X, N, answers_2018, answer_date ) integer, intent(in) :: N !< The size of the system real, dimension(N,N), intent(inout) :: A !< The matrix being inverted [nondim] real, dimension(N), intent(inout) :: R !< system right-hand side [A] real, dimension(N), intent(inout) :: X !< solution vector [A] logical, optional, intent(in) :: answers_2018 !< If true or absent use older, less efficient expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real, parameter :: eps = 0.0 ! Minimum pivot magnitude allowed real :: factor ! The factor that eliminates the leading nonzero element in a row. @@ -32,6 +33,7 @@ subroutine solve_linear_system( A, R, X, N, answers_2018 ) integer :: i, j, k old_answers = .true. ; if (present(answers_2018)) old_answers = answers_2018 + if (present(answer_date)) old_answers = (answer_date < 20190101) ! Loop on rows to transform the problem into multiplication by an upper-right matrix. do i = 1,N-1 @@ -173,7 +175,7 @@ end subroutine linear_solver !! !! This routine uses Thomas's algorithm to solve the tridiagonal system AX = R. !! (A is made up of lower, middle and upper diagonals) -subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answers_2018 ) +subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answers_2018, answer_date ) integer, intent(in) :: N !< The size of the system real, dimension(N), intent(in) :: Ad !< Matrix center diagonal real, dimension(N), intent(in) :: Al !< Matrix lower diagonal @@ -181,6 +183,7 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answers_2018 ) real, dimension(N), intent(in) :: R !< system right-hand side real, dimension(N), intent(out) :: X !< solution vector logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real, dimension(N) :: pivot, Al_piv real, dimension(N) :: c1 ! Au / pivot for the backward sweep @@ -189,6 +192,7 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answers_2018 ) logical :: old_answers ! If true, use expressions that give the original (2008 through 2018) MOM6 answers old_answers = .true. ; if (present(answers_2018)) old_answers = answers_2018 + if (present(answer_date)) old_answers = (answer_date < 20190101) if (old_answers) then ! This version gives the same answers as the original (2008 through 2018) MOM6 code diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 05e3e393b6..bbb5ae0e15 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -81,7 +81,7 @@ end subroutine myStats !> Use ICE-9 algorithm to populate points (fill=1) with valid data (good=1). If no information !! is available, use a previous guess (prev). Optionally (smooth) blend the filled points to !! achieve a more desirable result. -subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, answers_2018) +subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, answer_date) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), & intent(inout) :: aout !< The array with missing values to fill [A] @@ -98,8 +98,9 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, integer, optional, intent(in) :: num_pass !< The maximum number of iterations real, optional, intent(in) :: relc !< A relaxation coefficient for Laplacian [nondim] logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. - logical, optional, intent(in) :: answers_2018 !< If true, use expressions that give the same - !! answers as the code did in late 2018. Otherwise + integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. + !! Dates before 20190101 give the same answers + !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. real, dimension(SZI_(G),SZJ_(G)) :: a_filled ! The aout with missing values filled in [A] @@ -135,7 +136,7 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, relax_coeff = relc_default if (PRESENT(relc)) relax_coeff = relc - ans_2018 = .true. ; if (PRESENT(answers_2018)) ans_2018 = answers_2018 + ans_2018 = .true. ; if (PRESENT(answer_date)) ans_2018 = (answer_date < 20190101) fill_pts(:,:) = fill(:,:) @@ -251,7 +252,7 @@ end subroutine fill_miss_2d !> Extrapolate and interpolate from a file record subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, & z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & - homogenize, m_to_Z, answers_2018, ongrid, tr_iter_tol) + homogenize, m_to_Z, answers_2018, ongrid, tr_iter_tol, answer_date) character(len=*), intent(in) :: filename !< Path to file containing tracer to be !! interpolated. @@ -287,6 +288,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, optional, intent(in) :: tr_iter_tol !< The tolerance for changes in tracer concentrations !! between smoothing iterations that determines when to !! stop iterating [CU ~> conc] + integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. + !! Dates before 20190101 give the same answers + !! as the code did in late 2018, while later versions + !! add parentheses for rotational symmetry. ! Local variables real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its @@ -313,6 +318,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real :: missing_val_in ! The missing value in the input field [conc] real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] real :: add_offset, scale_factor ! File-specific conversion factors. + integer :: ans_date ! The vintage of the expressions and order of arithmetic to use logical :: found_attr logical :: add_np logical :: is_ongrid @@ -356,6 +362,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, PI_180 = atan(1.0)/45. + ans_date = 20181231 + if (present(answers_2018)) then ; if (.not.answers_2018) ans_date = 20190101 ; endif + if (present(answer_date)) ans_date = answer_date + ! Open NetCDF file and if present, extract data and spatial coordinate information ! The convention adopted here requires that the data be written in (i,j,k) ordering. @@ -565,8 +575,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, good2(:,:) = good(:,:) fill2(:,:) = fill(:,:) - call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, dtr_iter_stop, & - answers_2018=answers_2018) + call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, dtr_iter_stop, answer_date=ans_date) if (debug) then call myStats(tr_outf, missing_value, is, ie, js, je, k, 'field from fill_miss_2d()', scale=I_scale) endif @@ -589,7 +598,8 @@ end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, & z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & - homogenize, spongeOngrid, m_to_Z, answers_2018, tr_iter_tol) + homogenize, spongeOngrid, m_to_Z, & + answers_2018, tr_iter_tol, answer_date) integer, intent(in) :: fms_id !< A unique id used by the FMS time interpolator type(time_type), intent(in) :: Time !< A FMS time type @@ -621,6 +631,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t real, optional, intent(in) :: tr_iter_tol !< The tolerance for changes in tracer concentrations !! between smoothing iterations that determines when to !! stop iterating [CU ~> conc] + integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. + !! Dates before 20190101 give the same answers + !! as the code did in late 2018, while later versions + !! add parentheses for rotational symmetry. ! Local variables real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its @@ -658,7 +672,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t integer, dimension(4) :: fld_sz logical :: debug=.false. logical :: is_ongrid - logical :: ans_2018 + integer :: ans_date ! The vintage of the expressions and order of arithmetic to use real :: I_scale ! The inverse of the conversion factor for diagnostic output [conc CU-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing ! iterations that determines when to stop iterating [CU ~> conc] @@ -692,7 +706,9 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t PI_180 = atan(1.0)/45. - ans_2018 = .true.;if (present(answers_2018)) ans_2018 = answers_2018 + ans_date = 20181231 + if (present(answers_2018)) then ; if (.not.answers_2018) ans_date = 20190101 ; endif + if (present(answer_date)) ans_date = answer_date ! Open NetCDF file and if present, extract data and spatial coordinate information ! The convention adopted here requires that the data be written in (i,j,k) ordering. @@ -872,8 +888,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t good2(:,:) = good(:,:) fill2(:,:) = fill(:,:) - call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, dtr_iter_stop, & - answers_2018=answers_2018) + call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, dtr_iter_stop, answer_date=ans_date) ! if (debug) then ! call hchksum(tr_outf, 'field from fill_miss_2d ', G%HI, scale=I_scale) @@ -895,7 +910,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do j=js,je do i=is,ie tr_z(i,j,k) = data_in(i,j,k) * conversion - if (.not. ans_2018) mask_z(i,j,k) = 1. + if (ans_date >= 20190101) mask_z(i,j,k) = 1. if (abs(tr_z(i,j,k)-missing_value) < abs(roundoff*missing_value)) mask_z(i,j,k) = 0. enddo enddo From ecb85cb8be6b4be7ecade8493c4962ac28591fba Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 29 Jul 2022 16:04:13 -0400 Subject: [PATCH 2/9] +Use answer_date to specify remapping in ALE Replace the answers_2018 arguments with answer_date arguments to specify the version of expressions in a number of calls from the upper-level ALE modules, while also adding new answer_date optional arguments to several of the publicly visible remapping routines, including ALE_remap_scalar, regrid_set_params and remapping_set_params. The routine interpolate_grid, which is not called from outside of the regrid_interp module, is no longer being made publicly visible. Some comments noting parameters that are not guaranteed to be externally set or that can not be reset were also added. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 60 +++++++++++++++++++---------- src/ALE/MOM_regridding.F90 | 36 ++++++++++++------ src/ALE/MOM_remapping.F90 | 69 +++++++++++++++++++-------------- src/ALE/regrid_interp.F90 | 78 +++++++++++++++++++------------------- 4 files changed, 143 insertions(+), 100 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 5240061c3f..1f675579c6 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -91,9 +91,11 @@ module MOM_ALE logical :: remap_after_initialization !< Indicates whether to regrid/remap after initializing the state. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions for remapping - !! that recover the answers from the end of 2018. Otherwise, use more - !! robust and accurate forms of mathematically equivalent expressions. + integer :: answer_date !< The vintage of the expressions and order of arithmetic to use for + !! remapping. Values below 20190101 result in the use of older, less + !! accurate expressions that were in use at the end of 2018. Higher + !! values result inthe use of more robust and accurate forms of + !! mathematically equivalent expressions. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: show_call_tree !< For debugging @@ -163,7 +165,11 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) character(len=40) :: mdl = "MOM_ALE" ! This module's name. character(len=80) :: string, vel_string ! Temporary strings real :: filter_shallow_depth, filter_deep_depth - 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 for remapping + ! that recover the answers from the end of 2018. Otherwise, use more + ! robust and accurate forms of mathematically equivalent expressions. logical :: check_reconstruction logical :: check_remapping logical :: force_bounds_in_subcell @@ -218,25 +224,33 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call get_param(param_file, mdl, "REMAP_BOUNDARY_EXTRAP", remap_boundary_extrap, & "If true, values at the interfaces of boundary cells are "//& "extrapolated instead of piecewise constant", default=.false.) + 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, do_not_log=.true.) 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, "REMAPPING_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (answers_2018) then + CS%answer_date = 20181231 + else + CS%answer_date = 20190101 + endif call initialize_remapping( CS%remapCS, string, & boundary_extrapolation=remap_boundary_extrap, & check_reconstruction=check_reconstruction, & check_remapping=check_remapping, & force_bounds_in_subcell=force_bounds_in_subcell, & - answers_2018=CS%answers_2018) + answer_date=CS%answer_date) call initialize_remapping( CS%vel_remapCS, vel_string, & boundary_extrapolation=remap_boundary_extrap, & check_reconstruction=check_reconstruction, & check_remapping=check_remapping, & force_bounds_in_subcell=force_bounds_in_subcell, & - answers_2018=CS%answers_2018) + answer_date=CS%answer_date) call get_param(param_file, mdl, "PARTIAL_CELL_VELOCITY_REMAP", CS%partial_cell_vel_remap, & "If true, use partial cell thicknesses at velocity points that are masked out "//& @@ -590,8 +604,8 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) endif enddo ; enddo - call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%T, h_new, tv%T, answers_2018=CS%answers_2018) - call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%S, h_new, tv%S, answers_2018=CS%answers_2018) + call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%T, h_new, tv%T, answer_date=CS%answer_date) + call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%S, h_new, tv%S, answer_date=CS%answer_date) if (debug) call MOM_tracer_chkinv("After ALE_offline_inputs", G, GV, h_new, Reg%Tr, Reg%ntr) @@ -742,7 +756,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d if (present(dt)) & call ALE_update_regrid_weights(dt, CS) - if (.not. CS%answers_2018) then + if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 @@ -843,7 +857,7 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & "and u/v are to be remapped") endif - if (.not.CS%answers_2018) then + if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -1092,7 +1106,8 @@ end subroutine mask_near_bottom_vel !> Remaps a single scalar between grids described by thicknesses h_src and h_dst. !! h_dst must be dimensioned as a model array with GV%ke layers while h_src can !! have an arbitrary number of layers specified by nk_src. -subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_cells, old_remap, answers_2018 ) +subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_cells, old_remap, & + answers_2018, answer_date ) type(remapping_CS), intent(in) :: CS !< Remapping control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -1112,6 +1127,8 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c !! and expressions that recover the answers for !! remapping from the end of 2018. Otherwise, !! use more robust forms of the same expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use + !! for remapping ! Local variables integer :: i, j, k, n_points real :: dx(GV%ke+1) @@ -1124,6 +1141,7 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c if (present(old_remap)) use_remapping_core_w = old_remap n_points = nk_src use_2018_remap = .true. ; if (present(answers_2018)) use_2018_remap = answers_2018 + if (present(answer_date)) use_2018_remap = (answer_date < 20190101) if (.not.use_2018_remap) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff @@ -1206,7 +1224,7 @@ subroutine ALE_PLM_edge_values( CS, G, GV, h, Q, bdry_extrap, Q_t, Q_b ) real :: mslp real :: h_neglect - if (.not.CS%answers_2018) then + if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 @@ -1275,7 +1293,7 @@ subroutine TS_PPM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap ppol_coefs ! Coefficients of polynomial, all in [degC] or [ppt] real :: h_neglect, h_neglect_edge ! Tiny thicknesses [H ~> m or kg m-2] - if (.not.CS%answers_2018) then + if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -1295,9 +1313,9 @@ subroutine TS_PPM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap ppol_E(:,:) = 0.0 ppol_coefs(:,:) = 0.0 call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=h_neglect_edge, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) call PPM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) if (bdry_extrap) & call PPM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) @@ -1310,15 +1328,15 @@ subroutine TS_PPM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap ppol_E(:,:) = 0.0 ppol_coefs(:,:) = 0.0 tmp(:) = tv%T(i,j,:) - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=1.0e-10*GV%m_to_H, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) else call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=GV%H_subroundoff, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) endif call PPM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) if (bdry_extrap) & call PPM_boundary_extrapolation(GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index f093efb8dc..2f28362fb1 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -117,9 +117,10 @@ module MOM_regridding !! If false, integrate from the bottom upward, as does the rest of the model. logical :: integrate_downward_for_e = .true. - !> If true, use the order of arithmetic and expressions that recover the remapping answers from 2018. - !! If false, use more robust forms of the same remapping expressions. - logical :: remap_answers_2018 = .true. + !> The vintage of the order of arithmetic and expressions to use for remapping. + !! Values below 20190101 recover the remapping answers from 2018. + !! Higher values use more robust forms of the same remapping expressions. + integer :: remap_answer_date = 20181231 !### Change to 99991231? logical :: use_hybgen_unmix = .false. !< If true, use the hybgen unmixing code before remapping @@ -204,7 +205,9 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m character(len=12) :: expected_units, alt_units ! Temporary strings logical :: tmpLogical, fix_haloclines, do_sum, main_parameters logical :: coord_is_state_dependent, ierr - logical :: default_2018_answers, remap_answers_2018 + 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 :: remap_answers_2018 real :: filt_len, strat_tol, tmpReal, P_Ref real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int @@ -264,9 +267,12 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m trim(regriddingInterpSchemeDoc), default=trim(string2)) call set_regrid_params(CS, interp_scheme=string) + 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, do_not_log=.true.) 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.) + default=(default_answer_date<20190101)) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& @@ -1381,7 +1387,7 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel #endif logical :: ice_shelf - if (.not.CS%remap_answers_2018) then + if (CS%remap_answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -1524,7 +1530,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she real :: z_top_col, totalThickness logical :: ice_shelf - if (.not.CS%remap_answers_2018) then + if (CS%remap_answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -1676,7 +1682,7 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) integer :: i, j, k, nz real :: h_neglect, h_neglect_edge - if (.not.CS%remap_answers_2018) then + if (CS%remap_answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -2352,8 +2358,8 @@ end function getCoordinateShortName subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_grid_weight, & interp_scheme, depth_of_time_filter_shallow, depth_of_time_filter_deep, & compress_fraction, ref_pressure, dz_min_surface, nz_fixed_surface, Rho_ML_avg_depth, & - nlay_ML_to_interior, fix_haloclines, halocline_filt_len, & - halocline_strat_tol, integrate_downward_for_e, remap_answers_2018, & + nlay_ML_to_interior, fix_haloclines, halocline_filt_len, halocline_strat_tol, & + integrate_downward_for_e, remap_answers_2018, remap_answer_date, & adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin, adaptDrho0) type(regridding_CS), intent(inout) :: CS !< Regridding control structure logical, optional, intent(in) :: boundary_extrapolation !< Extrapolate in boundary cells @@ -2383,6 +2389,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions !! that recover the remapping answers from 2018. Otherwise !! use more robust but mathematically equivalent expressions. + integer, optional, intent(in) :: remap_answer_date !< The vintage of the expressions to use for remapping real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale [nondim]. real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region [H ~> m or kg m-2]. real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity [nondim]. @@ -2413,7 +2420,14 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(compress_fraction)) CS%compressibility_fraction = compress_fraction if (present(ref_pressure)) CS%ref_pressure = ref_pressure if (present(integrate_downward_for_e)) CS%integrate_downward_for_e = integrate_downward_for_e - if (present(remap_answers_2018)) CS%remap_answers_2018 = remap_answers_2018 + if (present(remap_answers_2018)) then + if (remap_answers_2018) then + CS%remap_answer_date = 20181231 + else + CS%remap_answer_date = 20190101 + endif + endif + if (present(remap_answer_date)) CS%remap_answer_date = remap_answer_date select case (CS%regridding_scheme) case (REGRIDDING_ZSTAR) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 50e1085cf6..9979b5d39b 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -34,8 +34,9 @@ module MOM_remapping logical :: check_remapping = .false. !> If true, the intermediate values used in remapping are forced to be bounded. logical :: force_bounds_in_subcell = .false. - !> If true use older, less acccurate expressions. - logical :: answers_2018 = .true. + !> The vintage of the expressions to use for remapping. Values below 20190101 result + !! in the use of older, less accurate expressions. + integer :: answer_date = 20181231 !### Change to 99991231? end type ! The following routines are visible to the outside world @@ -93,7 +94,7 @@ module MOM_remapping !> Set parameters within remapping object subroutine remapping_set_param(CS, remapping_scheme, boundary_extrapolation, & - check_reconstruction, check_remapping, force_bounds_in_subcell, answers_2018) + check_reconstruction, check_remapping, force_bounds_in_subcell, answers_2018, answer_date) type(remapping_CS), intent(inout) :: CS !< Remapping control structure character(len=*), optional, intent(in) :: remapping_scheme !< Remapping scheme to use logical, optional, intent(in) :: boundary_extrapolation !< Indicate to extrapolate in boundary cells @@ -101,6 +102,7 @@ subroutine remapping_set_param(CS, remapping_scheme, boundary_extrapolation, & logical, optional, intent(in) :: check_remapping !< Indicate to check results of remapping logical, optional, intent(in) :: force_bounds_in_subcell !< Force subcells values to be bounded logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use if (present(remapping_scheme)) then call setReconstructionType( remapping_scheme, CS ) @@ -118,8 +120,16 @@ subroutine remapping_set_param(CS, remapping_scheme, boundary_extrapolation, & CS%force_bounds_in_subcell = force_bounds_in_subcell endif if (present(answers_2018)) then - CS%answers_2018 = answers_2018 + if (answers_2018) then + CS%answer_date = 20181231 + else + CS%answer_date = 20190101 + endif endif + if (present(answer_date)) then + CS%answer_date = answer_date + endif + end subroutine remapping_set_param subroutine extract_member_remapping_CS(CS, remapping_scheme, degree, boundary_extrapolation, check_reconstruction, & @@ -424,46 +434,46 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & call PLM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) iMethod = INTEGRATION_PLM case ( REMAPPING_PPM_H4 ) - call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answer_date=CS%answer_date ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=CS%answer_date ) if ( CS%boundary_extrapolation ) then call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) endif iMethod = INTEGRATION_PPM case ( REMAPPING_PPM_IH4 ) - call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answer_date=CS%answer_date ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=CS%answer_date ) if ( CS%boundary_extrapolation ) then call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) endif iMethod = INTEGRATION_PPM case ( REMAPPING_PPM_HYBGEN ) call hybgen_PPM_coefs(u0, h0, ppoly_r_E, n0, 1, h_neglect) - call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answers_2018=.false. ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=99991231 ) if ( CS%boundary_extrapolation ) & call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) iMethod = INTEGRATION_PPM case ( REMAPPING_WENO_HYBGEN ) call hybgen_weno_coefs(u0, h0, ppoly_r_E, n0, 1, h_neglect) - call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answers_2018=.false. ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=99991231 ) if ( CS%boundary_extrapolation ) & call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) iMethod = INTEGRATION_PPM case ( REMAPPING_PQM_IH4IH3 ) - call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call edge_slopes_implicit_h3( n0, h0, u0, ppoly_r_S, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answer_date=CS%answer_date ) + call edge_slopes_implicit_h3( n0, h0, u0, ppoly_r_S, h_neglect, answer_date=CS%answer_date ) call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefs, h_neglect, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) if ( CS%boundary_extrapolation ) then call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, & ppoly_r_coefs, h_neglect ) endif iMethod = INTEGRATION_PQM case ( REMAPPING_PQM_IH6IH5 ) - call edge_values_implicit_h6( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call edge_slopes_implicit_h5( n0, h0, u0, ppoly_r_S, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h6( n0, h0, u0, ppoly_r_E, h_neglect_edge, answer_date=CS%answer_date ) + call edge_slopes_implicit_h5( n0, h0, u0, ppoly_r_S, h_neglect, answer_date=CS%answer_date ) call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefs, h_neglect, & - answers_2018=CS%answers_2018 ) + answer_date=CS%answer_date ) if ( CS%boundary_extrapolation ) then call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, & ppoly_r_coefs, h_neglect ) @@ -1593,7 +1603,7 @@ end subroutine dzFromH1H2 !> Constructor for remapping control structure subroutine initialize_remapping( CS, remapping_scheme, boundary_extrapolation, & - check_reconstruction, check_remapping, force_bounds_in_subcell, answers_2018) + check_reconstruction, check_remapping, force_bounds_in_subcell, answers_2018, answer_date) ! Arguments type(remapping_CS), intent(inout) :: CS !< Remapping control structure character(len=*), intent(in) :: remapping_scheme !< Remapping scheme to use @@ -1602,11 +1612,12 @@ subroutine initialize_remapping( CS, remapping_scheme, boundary_extrapolation, & logical, optional, intent(in) :: check_remapping !< Indicate to check results of remapping logical, optional, intent(in) :: force_bounds_in_subcell !< Force subcells values to be bounded logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Note that remapping_scheme is mandatory for initialize_remapping() call remapping_set_param(CS, remapping_scheme=remapping_scheme, boundary_extrapolation=boundary_extrapolation, & check_reconstruction=check_reconstruction, check_remapping=check_remapping, & - force_bounds_in_subcell=force_bounds_in_subcell, answers_2018=answers_2018) + force_bounds_in_subcell=force_bounds_in_subcell, answers_2018=answers_2018, answer_date=answer_date) end subroutine initialize_remapping @@ -1681,15 +1692,15 @@ logical function remapping_unit_tests(verbose) data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 type(remapping_CS) :: CS !< Remapping control structure real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs - logical :: answers_2018 ! If true use older, less acccurate expressions. + integer :: answer_date ! The vintage of the expressions to test integer :: i real :: err, h_neglect, h_neglect_edge logical :: thisTest, v v = verbose - answers_2018 = .false. ! .true. + answer_date = 20190101 ! 20181231 h_neglect = hNeglect_dflt - h_neglect_edge = hNeglect_dflt ; if (answers_2018) h_neglect_edge = 1.0e-10 + h_neglect_edge = hNeglect_dflt ; if (answer_date < 20190101) h_neglect_edge = 1.0e-10 write(stdout,*) '==== MOM_remapping: remapping_unit_tests =================' remapping_unit_tests = .false. ! Normally return false @@ -1711,7 +1722,7 @@ logical function remapping_unit_tests(verbose) remapping_unit_tests = remapping_unit_tests .or. thisTest thisTest = .false. - call initialize_remapping(CS, 'PPM_H4', answers_2018=answers_2018) + call initialize_remapping(CS, 'PPM_H4', answer_date=answer_date) if (verbose) write(stdout,*) 'h0 (test data)' if (verbose) call dumpGrid(n0,h0,x0,u0) @@ -1735,8 +1746,8 @@ logical function remapping_unit_tests(verbose) ppoly0_S(:,:) = 0.0 ppoly0_coefs(:,:) = 0.0 - call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10, answers_2018=answers_2018 ) - call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=answers_2018 ) + call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10, answer_date=answer_date ) + call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=answer_date ) call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) u1(:) = 0. call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & @@ -1866,7 +1877,7 @@ logical function remapping_unit_tests(verbose) test_answer(v, 3, ppoly0_coefs(:,2), (/0.,4.,0./), 'Non-uniform line PLM: P1') call edge_values_explicit_h4( 5, (/1.,1.,1.,1.,1./), (/1.,3.,5.,7.,9./), ppoly0_E, & - h_neglect=1e-10, answers_2018=answers_2018 ) + h_neglect=1e-10, answer_date=answer_date ) ! The next two tests currently fail due to roundoff, but pass when given a reasonable tolerance. thisTest = test_answer(v, 5, ppoly0_E(:,1), (/0.,2.,4.,6.,8./), 'Line H4: left edges', tol=8.0e-15) remapping_unit_tests = remapping_unit_tests .or. thisTest @@ -1875,7 +1886,7 @@ logical function remapping_unit_tests(verbose) ppoly0_E(:,1) = (/0.,2.,4.,6.,8./) ppoly0_E(:,2) = (/2.,4.,6.,8.,10./) call PPM_reconstruction(5, (/1.,1.,1.,1.,1./), (/1.,3.,5.,7.,9./), ppoly0_E(1:5,:), & - ppoly0_coefs(1:5,:), h_neglect, answers_2018=answers_2018 ) + ppoly0_coefs(1:5,:), h_neglect, answer_date=answer_date ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_coefs(:,1), (/1.,2.,4.,6.,9./), 'Line PPM: P0') remapping_unit_tests = remapping_unit_tests .or. & @@ -1884,7 +1895,7 @@ logical function remapping_unit_tests(verbose) test_answer(v, 5, ppoly0_coefs(:,3), (/0.,0.,0.,0.,0./), 'Line PPM: P2') call edge_values_explicit_h4( 5, (/1.,1.,1.,1.,1./), (/1.,1.,7.,19.,37./), ppoly0_E, & - h_neglect=1e-10, answers_2018=answers_2018 ) + h_neglect=1e-10, answer_date=answer_date ) ! The next two tests are now passing when answers_2018 = .false., but otherwise only work to roundoff. thisTest = test_answer(v, 5, ppoly0_E(:,1), (/3.,0.,3.,12.,27./), 'Parabola H4: left edges', tol=2.7e-14) remapping_unit_tests = remapping_unit_tests .or. thisTest @@ -1893,7 +1904,7 @@ logical function remapping_unit_tests(verbose) ppoly0_E(:,1) = (/0.,0.,3.,12.,27./) ppoly0_E(:,2) = (/0.,3.,12.,27.,48./) call PPM_reconstruction(5, (/1.,1.,1.,1.,1./), (/0.,1.,7.,19.,37./), ppoly0_E(1:5,:), & - ppoly0_coefs(1:5,:), h_neglect, answers_2018=answers_2018 ) + ppoly0_coefs(1:5,:), h_neglect, answer_date=answer_date ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_E(:,1), (/0.,0.,3.,12.,37./), 'Parabola PPM: left edges') remapping_unit_tests = remapping_unit_tests .or. & @@ -1908,7 +1919,7 @@ logical function remapping_unit_tests(verbose) ppoly0_E(:,1) = (/0.,0.,6.,10.,15./) ppoly0_E(:,2) = (/0.,6.,12.,17.,15./) call PPM_reconstruction(5, (/1.,1.,1.,1.,1./), (/0.,5.,7.,16.,15./), ppoly0_E(1:5,:), & - ppoly0_coefs(1:5,:), h_neglect, answers_2018=answers_2018 ) + ppoly0_coefs(1:5,:), h_neglect, answer_date=answer_date ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_E(:,1), (/0.,3.,6.,16.,15./), 'Limits PPM: left edges') remapping_unit_tests = remapping_unit_tests .or. & diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 21773774f6..dbe364c969 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -31,12 +31,12 @@ module regrid_interp !! boundary cells logical :: boundary_extrapolation - !> If true use older, less acccurate expressions. - logical :: answers_2018 = .true. + !> The vintage of the expressions to use for remapping + integer :: answer_date = 20181231 !### Change to 99991231? + !### There is no point where the value of answer_date is reset. end type interp_CS_type -public regridding_set_ppolys, interpolate_grid -public build_and_interpolate_grid +public regridding_set_ppolys, build_and_interpolate_grid public set_interp_scheme, set_interp_extrap ! List of interpolation schemes @@ -107,7 +107,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_P1M_H2 ) degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -115,11 +115,11 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_P1M_H4 ) degree = DEGREE_1 if ( n0 >= 4 ) then - call edge_values_explicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) + call edge_values_explicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) else call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) endif - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -127,11 +127,11 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_P1M_IH4 ) degree = DEGREE_1 if ( n0 >= 4 ) then - call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) else call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) endif - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -146,8 +146,8 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_PPM_H4 ) if ( n0 >= 4 ) then degree = DEGREE_2 - call edge_values_explicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call PPM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_explicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) + call PPM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call PPM_boundary_extrapolation( n0, h0, densities, ppoly0_E, & ppoly0_coefs, h_neglect ) @@ -155,7 +155,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -164,8 +164,8 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_PPM_IH4 ) if ( n0 >= 4 ) then degree = DEGREE_2 - call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call PPM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) + call PPM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call PPM_boundary_extrapolation( n0, h0, densities, ppoly0_E, & ppoly0_coefs, h_neglect ) @@ -173,7 +173,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -182,10 +182,10 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_P3M_IH4IH3 ) if ( n0 >= 4 ) then degree = DEGREE_3 - call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call edge_slopes_implicit_h3( n0, h0, densities, ppoly0_S, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) + call edge_slopes_implicit_h3( n0, h0, densities, ppoly0_S, h_neglect, answer_date=CS%answer_date ) call P3M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_S, & - ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P3M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect, h_neglect_edge ) @@ -193,7 +193,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -202,10 +202,10 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_P3M_IH6IH5 ) if ( n0 >= 6 ) then degree = DEGREE_3 - call edge_values_implicit_h6( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call edge_slopes_implicit_h5( n0, h0, densities, ppoly0_S, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h6( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) + call edge_slopes_implicit_h5( n0, h0, densities, ppoly0_S, h_neglect, answer_date=CS%answer_date ) call P3M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_S, & - ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P3M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect, h_neglect_edge ) @@ -213,7 +213,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -222,10 +222,10 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_PQM_IH4IH3 ) if ( n0 >= 4 ) then degree = DEGREE_4 - call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call edge_slopes_implicit_h3( n0, h0, densities, ppoly0_S, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) + call edge_slopes_implicit_h3( n0, h0, densities, ppoly0_S, h_neglect, answer_date=CS%answer_date ) call PQM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_S, & - ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call PQM_boundary_extrapolation_v1( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect ) @@ -233,7 +233,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -242,10 +242,10 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & case ( INTERPOLATION_PQM_IH6IH5 ) if ( n0 >= 6 ) then degree = DEGREE_4 - call edge_values_implicit_h6( n0, h0, densities, ppoly0_E, h_neglect_edge, answers_2018=CS%answers_2018 ) - call edge_slopes_implicit_h5( n0, h0, densities, ppoly0_S, h_neglect, answers_2018=CS%answers_2018 ) + call edge_values_implicit_h6( n0, h0, densities, ppoly0_E, h_neglect_edge, answer_date=CS%answer_date ) + call edge_slopes_implicit_h5( n0, h0, densities, ppoly0_S, h_neglect, answer_date=CS%answer_date ) call PQM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_S, & - ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call PQM_boundary_extrapolation_v1( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect ) @@ -253,7 +253,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) - call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answers_2018=CS%answers_2018 ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) endif @@ -268,7 +268,7 @@ end subroutine regridding_set_ppolys !! 'ppoly0' (possibly discontinuous), the coordinates of the new grid 'grid1' !! are determined by finding the corresponding target interface densities. subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & - target_values, degree, n1, h1, x1, answers_2018 ) + target_values, degree, n1, h1, x1, answer_date ) integer, intent(in) :: n0 !< Number of points on source grid integer, intent(in) :: n1 !< Number of points on target grid real, dimension(n0), intent(in) :: h0 !< Thicknesses of source grid cells [H] @@ -280,7 +280,7 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & integer, intent(in) :: degree !< Degree of interpolating polynomials real, dimension(n1), intent(inout) :: h1 !< Thicknesses of target grid cells [H] real, dimension(n1+1), intent(inout) :: x1 !< Target interface positions [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables integer :: k ! loop index @@ -295,7 +295,7 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & do k = 2,n1 t = target_values(k) x1(k) = get_polynomial_coordinate ( n0, h0, x0, ppoly0_E, ppoly0_coefs, t, degree, & - answers_2018=answers_2018 ) + answer_date=answer_date ) h1(k-1) = x1(k) - x1(k-1) enddo h1(n1) = x1(n1+1) - x1(n1) @@ -329,7 +329,7 @@ subroutine build_and_interpolate_grid(CS, densities, n0, h0, x0, target_values, call regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, ppoly0_C, & degree, h_neglect, h_neglect_edge) call interpolate_grid(n0, h0, x0, ppoly0_E, ppoly0_C, target_values, degree, & - n1, h1, x1, answers_2018=CS%answers_2018) + n1, h1, x1, answer_date=CS%answer_date) end subroutine build_and_interpolate_grid !> Given a target value, find corresponding coordinate for given polynomial @@ -349,7 +349,7 @@ end subroutine build_and_interpolate_grid !! It is assumed that the number of cells defining 'grid' and 'ppoly' are the !! same. function get_polynomial_coordinate( N, h, x_g, edge_values, ppoly_coefs, & - target_value, degree, answers_2018 ) result ( x_tgt ) + target_value, degree, answer_date ) result ( x_tgt ) ! Arguments integer, intent(in) :: N !< Number of grid cells real, dimension(N), intent(in) :: h !< Grid cell thicknesses [H] @@ -358,7 +358,7 @@ function get_polynomial_coordinate( N, h, x_g, edge_values, ppoly_coefs, & real, dimension(N,DEGREE_MAX+1), intent(in) :: ppoly_coefs !< Coefficients of interpolating polynomials [A] real, intent(in) :: target_value !< Target value to find position for [A] integer, intent(in) :: degree !< Degree of the interpolating polynomials - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + integer, intent(in) :: answer_date !< The vintage of the expressions to use real :: x_tgt !< The position of x_g at which target_value is found [H] ! Local variables @@ -373,11 +373,11 @@ function get_polynomial_coordinate( N, h, x_g, edge_values, ppoly_coefs, & integer :: i, k, iter ! loop indices integer :: k_found ! index of target cell character(len=320) :: mesg - logical :: use_2018_answers ! If true use older, less acccurate expressions. + logical :: use_2018_answers ! If true use older, less accurate expressions. eps = NR_OFFSET k_found = -1 - use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 + use_2018_answers = (answer_date < 20190101) ! If the target value is outside the range of all values, we ! force the target coordinate to be equal to the lowest or From 7c7237734bb9909fc2fb07c3400824f768d39bc3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 29 Jul 2022 17:05:16 -0400 Subject: [PATCH 3/9] +Use answer_date to specify remapping Replace answers_2018 arguments with answer_date arguments to specify the version of expressions used in a number of vertical or horizontal regridding calls. In some cases, this also involves replacing one of the elements in an opaque type. It can also involve reading (but not yet logging) the new runtime parameter DEFAULT_ANSWER_DATE, but if it not set the results are unchanged from before. There is also a new optional argument, remap_answer_date, to wave_speed_init and wave_speed_set_param. Some comments were also added to describe real variables in VarMix_init. All answers are bitwise identical. --- src/core/MOM_open_boundary.F90 | 29 +++++--- src/diagnostics/MOM_diagnostics.F90 | 21 +++++- src/diagnostics/MOM_wave_speed.F90 | 35 +++++++--- src/framework/MOM_diag_mediator.F90 | 24 +++++-- src/framework/MOM_diag_remap.F90 | 25 +++---- .../MOM_state_initialization.F90 | 64 +++++++++++++----- .../MOM_tracer_initialization_from_Z.F90 | 34 ++++++++-- src/ocean_data_assim/MOM_oda_incupd.F90 | 3 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 33 +++++++--- .../vertical/MOM_ALE_sponge.F90 | 66 +++++++++++++------ .../vertical/MOM_tidal_mixing.F90 | 28 ++++++-- src/tracer/MOM_lateral_boundary_diffusion.F90 | 3 +- src/tracer/MOM_neutral_diffusion.F90 | 31 ++++++--- 13 files changed, 293 insertions(+), 103 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 63b9434269..5a011c9101 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -321,9 +321,10 @@ module MOM_open_boundary real :: ramp_value !< If ramp is True, where we are on the ramp from !! zero to one [nondim]. type(time_type) :: ramp_start_time !< Time when model was started. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions for remapping - !! that recover the answers from the end of 2018. Otherwise, use more - !! robust and accurate forms of mathematically equivalent expressions. + integer :: remap_answer_date !< The vintage of the order of arithmetic and expressions to use + !! for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. end type ocean_OBC_type !> Control structure for open boundaries that read from files. @@ -371,7 +372,11 @@ subroutine open_boundary_config(G, US, param_file, OBC) character(len=1024) :: segment_str ! The contents (rhs) for parameter "segment_param_str" character(len=200) :: config1 ! String for OBC_USER_CONFIG real :: Lscale_in, Lscale_out ! parameters controlling tracer values at the boundaries [L ~> m] - logical :: answers_2018, default_2018_answers + logical :: answers_2018 ! If true, use the order of arithmetic and expressions for remapping + ! that recover the answers from the end of 2018. Otherwise, use more + ! robust and accurate forms of mathematically equivalent expressions. + 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 :: check_reconstruction, check_remapping, force_bounds_in_subcell character(len=64) :: remappingScheme ! This include declares and sets the variable "version". @@ -618,18 +623,26 @@ subroutine open_boundary_config(G, US, param_file, OBC) "If true, the values on the intermediate grid used for remapping "//& "are forced to be bounded, which might not be the case due to "//& "round off.", default=.false.,do_not_log=.true.) + 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, do_not_log=.true.) 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, "REMAPPING_2018_ANSWERS", OBC%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (answers_2018) then + OBC%remap_answer_date = 20181231 + else + OBC%remap_answer_date = 20190101 + endif allocate(OBC%remap_CS) call initialize_remapping(OBC%remap_CS, remappingScheme, boundary_extrapolation = .false., & check_reconstruction=check_reconstruction, check_remapping=check_remapping, & - force_bounds_in_subcell=force_bounds_in_subcell, answers_2018=OBC%answers_2018) + force_bounds_in_subcell=force_bounds_in_subcell, answer_date=OBC%remap_answer_date) endif ! OBC%number_of_segments > 0 @@ -3718,7 +3731,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (OBC%add_tide_constituents) time_delta = US%s_to_T * time_type_to_real(Time - OBC%time_ref) - if (.not. OBC%answers_2018) then + if (OBC%remap_answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7390db2b92..d7d6b7afad 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1551,7 +1551,13 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. character(len=48) :: thickness_units, flux_units logical :: use_temperature, adiabatic - logical :: default_2018_answers, remap_answers_2018 + 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. + integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for remapping. Values below 20190101 recover the remapping + ! answers from 2018, while higher values use more robust + ! forms of the same remapping expressions. + logical :: remap_answers_2018 CS%initialized = .true. @@ -1579,13 +1585,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, & "If true, use a more robust estimate of the first mode wave speed as the "//& "starting point for iterations.", default=.true.) + 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, do_not_log=.true.) 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.) + default=(default_answer_date<20190101)) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (remap_answers_2018) then + remap_answer_date = 20181231 + else + remap_answer_date = 20190101 + endif + call get_param(param_file, mdl, "SPLIT", split, default=.true., do_not_log=.true.) if (GV%Boussinesq) then @@ -1813,7 +1828,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0) .or. & (CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then - call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018, & + call wave_speed_init(CS%wave_speed, remap_answer_date=remap_answer_date, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) endif diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 36a6d51e83..85f27d4249 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -46,9 +46,11 @@ module MOM_wave_speed !! speeds [nondim] type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic !! mode structure. - logical :: remap_answers_2018 = .true. !< If true, use the order of arithmetic and expressions that - !! recover the remapping answers from 2018. If false, use more - !! robust forms of the same remapping expressions. + integer :: remap_answer_date = 20181231 !< The vintage of the order of arithmetic and expressions to use + !! for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. + !### Change to 99991231? type(diag_ctrl), pointer :: diag !< Diagnostics control structure end type wave_speed_CS @@ -558,7 +560,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ do k = 1,kc Hc_H(k) = GV%Z_to_H * Hc(k) enddo - if (CS%remap_answers_2018) then + if (CS%remap_answer_date < 20190101) then call remapping_core_h(CS%remapping_CS, kc, Hc_H(:), mode_struct, & nz, h(i,j,:), modal_structure(i,j,:), & 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) @@ -1168,7 +1170,7 @@ end subroutine tridiag_det !> Initialize control structure for MOM_wave_speed subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & - better_speed_est, min_speed, wave_speed_tol) + remap_answer_date, better_speed_est, min_speed, wave_speed_tol) type(wave_speed_CS), intent(inout) :: CS !< Wave speed control struct logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. @@ -1181,6 +1183,10 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions !! that recover the remapping answers from 2018. Otherwise !! use more robust but mathematically equivalent expressions. + integer, optional, intent(in) :: remap_answer_date !< The vintage of the order of arithmetic and expressions + !! to use for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. logical, optional, intent(in) :: better_speed_est !< If true, use a more robust estimate of the first !! mode speed as the starting point for iterations. real, optional, intent(in) :: min_speed !< If present, set a floor in the first mode speed @@ -1199,15 +1205,17 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction, & better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol) + !### Uncomment this? remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date) + !### The remap_answers_2018 argument is irrelevant, because remapping is hard-coded to use PLM. call initialize_remapping(CS%remapping_CS, 'PLM', boundary_extrapolation=.false., & - answers_2018=CS%remap_answers_2018) + answer_date=CS%remap_answer_date) end subroutine wave_speed_init !> Sets internal parameters for MOM_wave_speed subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & - better_speed_est, min_speed, wave_speed_tol) + remap_answer_date, better_speed_est, min_speed, wave_speed_tol) type(wave_speed_CS), intent(inout) :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent @@ -1221,6 +1229,10 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions !! that recover the remapping answers from 2018. Otherwise !! use more robust but mathematically equivalent expressions. + integer, optional, intent(in) :: remap_answer_date !< The vintage of the order of arithmetic and expressions + !! to use for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. logical, optional, intent(in) :: better_speed_est !< If true, use a more robust estimate of the first !! mode speed as the starting point for iterations. real, optional, intent(in) :: min_speed !< If present, set a floor in the first mode speed @@ -1231,7 +1243,14 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth - if (present(remap_answers_2018)) CS%remap_answers_2018 = remap_answers_2018 + if (present(remap_answers_2018)) then + if (remap_answers_2018) then + CS%remap_answer_date = 20181231 + else + CS%remap_answer_date = 20190101 + endif + endif + if (present(remap_answer_date)) CS%remap_answer_date = remap_answer_date if (present(better_speed_est)) CS%better_cg1_est = better_speed_est if (present(min_speed)) CS%min_speed2 = min_speed**2 if (present(wave_speed_tol)) CS%wave_speed_tol = wave_speed_tol diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 677c268ab3..65725ca59c 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3144,7 +3144,15 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) ! Local variables integer :: ios, i, new_unit logical :: opened, new_file - logical :: answers_2018, default_2018_answers + logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. + integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for remapping. Values below 20190101 recover the remapping + ! answers from 2018, while higher values use more robust + ! forms of the same remapping expressions. + 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. character(len=8) :: this_pe character(len=240) :: doc_file, doc_file_dflt, doc_path character(len=240), allocatable :: diag_coords(:) @@ -3171,13 +3179,21 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) 'The number of diagnostic vertical coordinates to use. '//& 'For each coordinate, an entry in DIAG_COORDS must be provided.', & default=1) + 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, do_not_log=.true.) 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, "REMAPPING_2018_ANSWERS", answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (remap_answers_2018) then + remap_answer_date = 20181231 + else + remap_answer_date = 20190101 + endif call get_param(param_file, mdl, 'USE_GRID_SPACE_DIAGNOSTIC_AXES', diag_cs%grid_space_axes, & 'If true, use a grid index coordinate convention for diagnostic axes. ',& default=.false.) @@ -3200,7 +3216,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) allocate(diag_cs%diag_remap_cs(diag_cs%num_diag_coords)) ! Initialize each diagnostic vertical coordinate do i=1, diag_cs%num_diag_coords - call diag_remap_init(diag_cs%diag_remap_cs(i), diag_coords(i), answers_2018=answers_2018) + call diag_remap_init(diag_cs%diag_remap_cs(i), diag_coords(i), answer_date=remap_answer_date) enddo deallocate(diag_coords) endif diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 2f179a3825..1bdf13b41f 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -115,21 +115,24 @@ module MOM_diag_remap !! variables [H ~> m or kg m-2] integer :: interface_axes_id = 0 !< Vertical axes id for remapping at interfaces integer :: layer_axes_id = 0 !< Vertical axes id for remapping on layers - logical :: answers_2018 !< If true, use the order of arithmetic and expressions for remapping - !! that recover the answers from the end of 2018. Otherwise, use - !! updated more robust forms of the same expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions + !! to use for remapping. Values below 20190101 recover + !! the answers from 2018, while higher values use more + !! robust forms of the same remapping expressions. + end type diag_remap_ctrl contains !> Initialize a diagnostic remapping type with the given vertical coordinate. -subroutine diag_remap_init(remap_cs, coord_tuple, answers_2018) +subroutine diag_remap_init(remap_cs, coord_tuple, answer_date) type(diag_remap_ctrl), intent(inout) :: remap_cs !< Diag remapping control structure character(len=*), intent(in) :: coord_tuple !< A string in form of !! MODULE_SUFFIX PARAMETER_SUFFIX COORDINATE_NAME - logical, intent(in) :: answers_2018 !< If true, use the order of arithmetic and expressions - !! for remapping that recover the answers from the end of 2018. - !! Otherwise, use more robust forms of the same expressions. + integer, intent(in) :: answer_date !< The vintage of the order of arithmetic and expressions + !! to use for remapping. Values below 20190101 recover + !! the answers from 2018, while higher values use more + !! robust forms of the same remapping expressions. remap_cs%diag_module_suffix = trim(extractWord(coord_tuple, 1)) remap_cs%diag_coord_name = trim(extractWord(coord_tuple, 2)) @@ -138,7 +141,7 @@ subroutine diag_remap_init(remap_cs, coord_tuple, answers_2018) remap_cs%configured = .false. remap_cs%initialized = .false. remap_cs%used = .false. - remap_cs%answers_2018 = answers_2018 + remap_cs%answer_date = answer_date remap_cs%nz = 0 end subroutine diag_remap_init @@ -289,7 +292,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe return endif - if (.not.remap_cs%answers_2018) then + if (remap_cs%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -301,7 +304,7 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe if (.not. remap_cs%initialized) then ! Initialize remapping and regridding on the first call call initialize_remapping(remap_cs%remap_cs, 'PPM_IH4', boundary_extrapolation=.false., & - answers_2018=remap_cs%answers_2018) + answer_date=remap_cs%answer_date) remap_cs%initialized = .true. endif @@ -367,7 +370,7 @@ subroutine diag_remap_do_remap(remap_cs, G, GV, h, staggered_in_x, staggered_in_ call assert(size(field, 3) == size(h, 3), & 'diag_remap_do_remap: Remap field and thickness z-axes do not match.') - if (.not.remap_cs%answers_2018) then + if (remap_cs%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 257d25dad0..6aec256cc6 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1167,7 +1167,15 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) real :: scale_factor ! A file-dependent scaling factor for the input pressure. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. integer :: i, j, k - logical :: default_2018_answers, remap_answers_2018 + 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. + integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for remapping. Values below 20190101 recover the remapping + ! answers from 2018, while higher values use more robust + ! forms of the same remapping expressions. logical :: use_remapping ! If true, remap the initial conditions. type(remapping_CS), pointer :: remap_CS => NULL() @@ -1192,14 +1200,18 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) default=.false., do_not_log=just_read) remap_answers_2018 = .true. if (use_remapping) then + call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231, do_not_log=.true.) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=.false.) + default=(default_answer_date<20190101)) call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) endif + remap_answer_date = 20190101 ; if (remap_answers_2018) remap_answer_date = 20181231 if (just_read) return ! All run-time parameters have been read, so return. @@ -1226,7 +1238,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) call cut_off_column_top(GV%ke, tv, GV, US, GV%g_Earth, G%bathyT(i,j)+G%Z_ref, & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & - z_tol=1.0e-5*US%m_to_Z, remap_answers_2018=remap_answers_2018) + z_tol=1.0e-5*US%m_to_Z, remap_answer_date=remap_answer_date) enddo ; enddo end subroutine trim_for_ice @@ -1317,7 +1329,7 @@ end subroutine calc_sfc_displacement !> Adjust the layer thicknesses by removing the top of the water column above the !! depth where the hydrostatic pressure matches p_surf subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, T_t, T_b, & - S, S_t, S_b, p_surf, h, remap_CS, z_tol, remap_answers_2018) + S, S_t, S_b, p_surf, h, remap_CS, z_tol, remap_answer_date) integer, intent(in) :: nk !< Number of layers type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1337,10 +1349,10 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, !! if associated real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth !! matching the specified pressure [Z ~> m]. - logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic - !! and expressions that recover the answers for remapping - !! from the end of 2018. Otherwise, use more robust - !! forms of the same expressions. + integer, optional, intent(in) :: remap_answer_date !< The vintage of the order of arithmetic and + !! expressions to use for remapping. Values below 20190101 + !! recover the remapping answers from 2018, while higher + !! values use more robust forms of the same remapping expressions. ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions [Z ~> m] @@ -1350,7 +1362,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, logical :: answers_2018 integer :: k - answers_2018 = .true. ; if (present(remap_answers_2018)) answers_2018 = remap_answers_2018 + answers_2018 = .true. ; if (present(remap_answer_date)) answers_2018 = (remap_answer_date < 20190101) ! Calculate original interface positions e(nk+1) = -depth @@ -2458,7 +2470,20 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just type(remapping_CS) :: remapCS ! Remapping parameters and work arrays logical :: homogenize, useALEremapping, remap_full_column, remap_general, remap_old_alg - logical :: answers_2018, default_2018_answers, hor_regrid_answers_2018 + 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. + integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for remapping. Values below 20190101 recover the remapping + ! answers from 2018, while higher values use more robust + ! forms of the same remapping expressions. + logical :: hor_regrid_answers_2018 + integer :: hor_regrid_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for horizontal regridding. Values below 20190101 recover the + ! answers from 2018, while higher values use expressions that have + ! been rearranged for rotational invariance. logical :: pre_gridded logical :: separate_mixed_layer ! If true, handle the mixed layers differently. logical :: density_extrap_bug ! If true use an expression with a vertical indexing bug for @@ -2535,24 +2560,29 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If false, uses the preferred remapping algorithm for initialization. "//& "If true, use an older, less robust algorithm for remapping.", & default=.false., do_not_log=just_read) + call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231, do_not_log=.true.) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=.false.) + default=(default_answer_date<20190101)) call get_param(PF, mdl, "TEMP_SALT_INIT_VERTICAL_REMAP_ONLY", pre_gridded, & "If true, initial conditions are on the model horizontal grid. " //& "Extrapolation over missing ocean values is done using an ICE-9 "//& "procedure with vertical ALE remapping .", & default=.false.) if (useALEremapping) then - call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", answers_2018, & + call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + remap_answer_date = 20190101 ; if (remap_answers_2018) remap_answer_date = 20181231 endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizonal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) + hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) hor_regrid_answer_date = 20181231 if (.not.useALEremapping) then call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the "//& @@ -2618,12 +2648,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just call horiz_interp_and_extrap_tracer(tfilename, potemp_var, US%degC_to_C, 1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018, & + tripolar_n, homogenize, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date, & ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%degC_to_C) call horiz_interp_and_extrap_tracer(sfilename, salin_var, US%ppt_to_S, 1, & G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018, & + tripolar_n, homogenize, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date, & ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%ppt_to_S) kd = size(z_in,1) @@ -2701,7 +2731,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just endif ! Now remap from source grid to target grid, first setting reconstruction parameters - call initialize_remapping( remapCS, remappingScheme, boundary_extrapolation=.false., answers_2018=answers_2018 ) + call initialize_remapping( remapCS, remappingScheme, boundary_extrapolation=.false., answer_date=remap_answer_date ) if (remap_general) then call set_regrid_params( regridCS, min_thickness=0. ) tv_loc = tv @@ -2719,9 +2749,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just deallocate( dz_interface ) endif call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, & - old_remap=remap_old_alg, answers_2018=answers_2018 ) + old_remap=remap_old_alg, answer_date=remap_answer_date ) call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & - old_remap=remap_old_alg, answers_2018=answers_2018 ) + old_remap=remap_old_alg, answer_date=remap_answer_date ) deallocate( h1 ) deallocate( tmpT1dIn ) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 204a1e5f35..560a3ceef7 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -78,7 +78,20 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ real :: missing_value integer :: nPoints integer :: id_clock_routine, id_clock_ALE - logical :: answers_2018, default_2018_answers, hor_regrid_answers_2018 + 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. + integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for remapping. Values below 20190101 recover the remapping + ! answers from 2018, while higher values use more robust + ! forms of the same remapping expressions. + logical :: hor_regrid_answers_2018 + integer :: hor_regrid_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for horizontal regridding. Values below 20190101 recover the + ! answers from 2018, while higher values use expressions that have + ! been rearranged for rotational invariance. logical :: reentrant_x, tripolar_n id_clock_routine = cpu_clock_id('(Initialize tracer from Z)', grain=CLOCK_ROUTINE) @@ -100,19 +113,28 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ call get_param(PF, mdl, "Z_INIT_REMAPPING_SCHEME", remapScheme, & "The remapping scheme to use if using Z_INIT_ALE_REMAPPING is True.", & default="PLM") + call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231, do_not_log=.true.) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=.false.) + default=(default_answer_date<20190101)) if (useALE) then - call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", answers_2018, & + call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (remap_answers_2018) then + remap_answer_date = 20181231 + else + remap_answer_date = 20190101 + endif endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizonal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) + hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) hor_regrid_answer_date = 20181231 ! These are model grid properties, but being applied to the data grid for now. ! need to revisit this (mjh) @@ -129,7 +151,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & - homog, m_to_Z=US%m_to_Z, answers_2018=hor_regrid_answers_2018) + homog, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date) kd = size(z_edges_in,1)-1 call pass_var(tr_z,G%Domain) @@ -143,7 +165,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ allocate( h1(kd) ) allocate( hSrc(isd:ied,jsd:jed,kd) ) ! Set parameters for reconstructions - call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false., answers_2018=answers_2018 ) + call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false., answer_date=remap_answer_date ) ! Next we initialize the regridding package so that it knows about the target grid do j = js, je ; do i = is, ie @@ -168,7 +190,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ hSrc(i,j,:) = GV%Z_to_H * h1(:) enddo ; enddo - call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false., answers_2018=answers_2018 ) + call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false., answer_date=remap_answer_date ) deallocate( hSrc ) deallocate( h1 ) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index 77f20c4f66..be57bbe748 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -230,8 +230,9 @@ subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h, nz_data, re !### Doing a halo update here on CS%Ref_h%p would avoid needing halo updates each timestep. ! Call the constructor for remapping control structure + !### Revisit this hard-coded answer_date. call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & - answers_2018=.false.) + answer_date=20190101) end subroutine initialize_oda_incupd diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0871737d20..0dd590c2d7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1156,17 +1156,26 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients + ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when ! calculating the first-mode wave speed [Z ~> m] - real :: KhTr_passivity_coeff + real :: KhTr_passivity_coeff ! Coefficient setting the ratio between along-isopycnal tracer + ! mixing and interface height mixing [nondim] real :: absurdly_small_freq ! A miniscule frequency that is used to avoid division by 0 [T-1 ~> s-1]. The ! default value is roughly (pi / (the age of the universe)). logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use - logical :: default_2018_answers, remap_answers_2018 - real :: MLE_front_length - real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity + 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 :: remap_answers_2018 + integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use + ! for remapping. Values below 20190101 recover the remapping + ! answers from 2018, while higher values use more robust + ! forms of the same remapping expressions. + real :: MLE_front_length ! The frontal-length scale used to calculate the upscaling of + ! buoyancy gradients in boundary layer parameterizations [L ~> m] + real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity [nondim] real :: grid_sp_u2, grid_sp_v2 ! Intermediate quantities for Leith metrics [L2 ~> m2] real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] real :: wave_speed_min ! A floor in the first mode speed below which 0 is returned [L T-1 ~> m s-1] @@ -1175,7 +1184,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! scaled by the resolution function. logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. -! This include declares and sets the variable "version". + ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j @@ -1263,7 +1272,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) default=0., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (KhTr_passivity_coeff>0.) call get_param(param_file, mdl, "MLE_FRONT_LENGTH", MLE_front_length, & - default=0., do_not_log=.true.) + units="m", default=0.0, scale=US%m_to_L, do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (MLE_front_length>0.) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) @@ -1532,13 +1541,21 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_cg1) then in_use = .true. allocate(CS%cg1(isd:ied,jsd:jed), source=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, do_not_log=.true.) 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.) + default=(default_answer_date<20190101)) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (remap_answers_2018) then + remap_answer_date = 20181231 + else + remap_answer_date = 20190101 + endif call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, & "The fractional tolerance for finding the wave speeds.", & units="nondim", default=0.001) @@ -1550,7 +1567,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, use a more robust estimate of the first mode wave speed as the "//& "starting point for iterations.", default=.true.) call wave_speed_init(CS%wave_speed, use_ebt_mode=CS%Resoln_use_ebt, & - mono_N2_depth=N2_filter_depth, remap_answers_2018=remap_answers_2018, & + mono_N2_depth=N2_filter_depth, remap_answer_date=remap_answer_date, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) endif diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 9409a07fc1..59b46b61cf 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -118,12 +118,14 @@ module MOM_ALE_sponge !! timing of diagnostic output. type(remapping_cs) :: remap_cs !< Remapping parameters and work arrays - logical :: remap_answers_2018 !< If true, use the order of arithmetic and expressions that - !! recover the answers for remapping from the end of 2018. - !! Otherwise, use more robust forms of the same expressions. - logical :: hor_regrid_answers_2018 !< If true, use the order of arithmetic for horizontal regridding - !! that recovers the answers from the end of 2018. Otherwise, use - !! rotationally symmetric forms of the same expressions. + integer :: remap_answer_date !< The vintage of the order of arithmetic and expressions to use + !! for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. + integer :: hor_regrid_answer_date !< The vintage of the order of arithmetic and expressions to use + !! for horizontal regridding. Values below 20190101 recover the + !! answers from 2018, while higher values use expressions that have + !! been rearranged for rotational invariance. logical :: time_varying_sponges !< True if using newer sponge code logical :: spongeDataOngrid !< True if the sponge data are on the model horizontal grid @@ -173,7 +175,14 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, character(len=64) :: remapScheme logical :: use_sponge logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries - 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. + logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding + ! that recovers the answers from the end of 2018. Otherwise, use + ! rotationally symmetric forms of the same expressions. integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v if (associated(CS)) then @@ -208,17 +217,22 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "than PCM. E.g., if PPM is used for remapping, a "//& "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + 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, do_not_log=.true.) 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, "REMAPPING_2018_ANSWERS", CS%remap_answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", CS%hor_regrid_answers_2018, & + CS%remap_answer_date = 20190101 ; if (remap_answers_2018) CS%remap_answer_date = 20181231 + call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) + CS%hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) CS%hor_regrid_answer_date = 20181231 call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & "If true, the domain is zonally reentrant.", default=.true.) call get_param(param_file, mdl, "TRIPOLAR_N", CS%tripolar_N, & @@ -261,7 +275,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, ! Call the constructor for remapping control structure call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & - answers_2018=CS%remap_answers_2018) + answer_date=CS%remap_answer_date) call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & "The total number of columns where sponges are applied at h points.", like_default=.true.) @@ -434,7 +448,14 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest character(len=64) :: remapScheme logical :: use_sponge logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries - 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. + logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding + ! that recovers the answers from the end of 2018. Otherwise, use + ! rotationally symmetric forms of the same expressions. integer :: i, j, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v if (associated(CS)) then @@ -463,19 +484,24 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "than PCM. E.g., if PPM is used for remapping, a "//& "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + 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, do_not_log=.true.) 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, "REMAPPING_2018_ANSWERS", CS%remap_answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", CS%hor_regrid_answers_2018, & + CS%remap_answer_date = 20190101 ; if (remap_answers_2018) CS%remap_answer_date = 20181231 + call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018 and retain a bug in the 3-dimensional mask "//& "returned in certain cases. Otherwise, use rotationally symmetric "//& "forms of the same expressions and initialize the mask properly.", & default=default_2018_answers) + CS%hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) CS%hor_regrid_answer_date = 20181231 call get_param(param_file, mdl, "SPONGE_DATA_ONGRID", CS%spongeDataOngrid, & "When defined, the incoming sponge data are "//& "assumed to be on the model grid " , & @@ -514,7 +540,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest ! Call the constructor for remapping control structure call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & - answers_2018=CS%remap_answers_2018) + answer_date=CS%remap_answer_date) call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then @@ -868,7 +894,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) Idt = 1.0/dt - if (.not.CS%remap_answers_2018) then + if (CS%remap_answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -882,7 +908,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, CS%Ref_val(m)%scale, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & - answers_2018=CS%hor_regrid_answers_2018) + answer_date=CS%hor_regrid_answer_date) allocate( hsrc(nz_data) ) allocate( tmpT1d(nz_data) ) do c=1,CS%num_col @@ -966,7 +992,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, CS%Ref_val_u%scale, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answers_2018=CS%hor_regrid_answers_2018) + answer_date=CS%hor_regrid_answer_date) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc-1, G%jsc:G%jec, :) = 0. @@ -1015,7 +1041,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, CS%Ref_val_v%scale, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answers_2018=CS%hor_regrid_answers_2018) + answer_date=CS%hor_regrid_answer_date) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc:G%iec, G%jsc-1, :) = 0. mask_z(G%isc:G%iec, G%jec+1, :) = 0. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 85fc2abb7b..bd819a7a87 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -139,9 +139,11 @@ module MOM_tidal_mixing real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for !! tidal-energy-constituent data [Z ~> m]. type(remapping_CS) :: remap_CS !< The control structure for remapping - logical :: remap_answers_2018 = .true. !< If true, use the order of arithmetic and expressions that - !! recover the remapping answers from 2018. If false, use more - !! robust forms of the same remapping expressions. + integer :: remap_answer_date = 20181231 !< The vintage of the order of arithmetic and expressions to use + !! for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. + !### Change to 99991231? type(int_tide_CS), pointer :: int_tide_CSp=> NULL() !< Control structure for a child module @@ -222,7 +224,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di logical :: use_CVMix_tidal logical :: int_tide_dissipation logical :: read_tideamp - 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the remapping answers from 2018. If false, use more + ! robust forms of the same remapping expressions. character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file @@ -271,17 +277,25 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".",do_not_log=.true.) CS%inputdir = slasher(CS%inputdir) + 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, do_not_log=.true.) 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.) + default=(default_answer_date<20190101)) call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", CS%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", CS%remap_answers_2018, & + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (remap_answers_2018) then + CS%remap_answer_date = 20181231 + else + CS%remap_answer_date = 20190101 + endif if (CS%int_tide_dissipation) then @@ -1651,7 +1665,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) ! initialize input remapping: call initialize_remapping(CS%remap_cs, remapping_scheme="PLM", & boundary_extrapolation=.false., check_remapping=CS%debug, & - answers_2018=CS%remap_answers_2018) + answer_date=CS%remap_answer_date) deallocate(tc_m2) deallocate(tc_s2) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index d52e2cde4c..e7e47370e1 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -124,8 +124,9 @@ logical function lateral_boundary_diffusion_init(Time, G, GV, param_file, diag, "for vertical remapping for all variables. "//& "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default=remappingDefaultScheme) + !### Revisit this hard-coded answer_date. call initialize_remapping( CS%remap_CS, string, boundary_extrapolation = boundary_extrap ,& - check_reconstruction=.false., check_remapping=.false., answers_2018=.false.) + check_reconstruction=.false., check_remapping=.false., answer_date=20190101) call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg) call get_param(param_file, mdl, "LBD_DEBUG", CS%debug, & "If true, write out verbose debugging data in the LBD module.", & diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 3869610059..9cedfa8b57 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -100,9 +100,10 @@ module MOM_neutral_diffusion type(EOS_type), pointer :: EOS => NULL() !< Equation of state parameters type(remapping_CS) :: remap_CS !< Remapping control structure used to create sublayers - logical :: remap_answers_2018 !< If true, use the order of arithmetic and expressions that - !! recover the answers for remapping from the end of 2018. - !! Otherwise, use more robust forms of the same expressions. + integer :: remap_answer_date !< The vintage of the order of arithmetic and expressions to use + !! for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. type(KPP_CS), pointer :: KPP_CSp => NULL() !< KPP control structure needed to get BLD type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL()!< ePBL control structure needed to get MLD end type neutral_diffusion_CS @@ -127,7 +128,11 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, ! Local variables character(len=80) :: string ! Temporary strings - 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 :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that + ! recover the answers for remapping from the end of 2018. + ! Otherwise, use more robust forms of the same expressions. logical :: boundary_extrap if (associated(CS)) then @@ -183,15 +188,23 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, "for vertical remapping for all variables. "//& "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default=remappingDefaultScheme) + 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, do_not_log=.true.) 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, "REMAPPING_2018_ANSWERS", CS%remap_answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + if (remap_answers_2018) then + CS%remap_answer_date = 20181231 + else + CS%remap_answer_date = 20190101 + endif call initialize_remapping( CS%remap_CS, string, boundary_extrapolation=boundary_extrap, & - answers_2018=CS%remap_answers_2018 ) + answer_date=CS%remap_answer_date ) call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg) call get_param(param_file, mdl, "NEUTRAL_POS_METHOD", CS%neutral_pos_method, & "Method used to find the neutral position \n"// & @@ -333,7 +346,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff if (.not. CS%continuous_reconstruction) then - if (CS%remap_answers_2018) then + if (CS%remap_answer_date < 20190101) then if (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 else @@ -577,7 +590,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff if (.not. CS%continuous_reconstruction) then - if (CS%remap_answers_2018) then + if (CS%remap_answer_date < 20190101) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 endif endif From 7a9c8a8dcb6c3a5c6d3a9b0f22cd7103125e2acb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 Jul 2022 05:54:24 -0400 Subject: [PATCH 4/9] +Eliminate unused answers_2018 optional arguments Eliminated the now unused answers_2018 optional arguments in a variety of the ALE-related subroutines that are only called from code in the ALE directory. The functionality previously provided by answers_2018 is now provided by the more flexible answer_date arguments. A handful of spelling errors were also corrected in comments in the files that were edited. All answers are bitwise identical. --- src/ALE/MOM_remapping.F90 | 2 +- src/ALE/P1M_functions.F90 | 8 +++--- src/ALE/P3M_functions.F90 | 12 ++++----- src/ALE/PCM_functions.F90 | 2 +- src/ALE/PLM_functions.F90 | 4 +-- src/ALE/PPM_functions.F90 | 12 ++++----- src/ALE/PQM_functions.F90 | 14 +++++----- src/ALE/regrid_edge_values.F90 | 48 ++++++++++++++-------------------- src/ALE/regrid_solvers.F90 | 12 +++------ 9 files changed, 46 insertions(+), 68 deletions(-) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 9979b5d39b..faed4ac6be 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -1896,7 +1896,7 @@ logical function remapping_unit_tests(verbose) call edge_values_explicit_h4( 5, (/1.,1.,1.,1.,1./), (/1.,1.,7.,19.,37./), ppoly0_E, & h_neglect=1e-10, answer_date=answer_date ) - ! The next two tests are now passing when answers_2018 = .false., but otherwise only work to roundoff. + ! The next two tests are now passing when answer_date >= 20190101, but otherwise only work to roundoff. thisTest = test_answer(v, 5, ppoly0_E(:,1), (/3.,0.,3.,12.,27./), 'Parabola H4: left edges', tol=2.7e-14) remapping_unit_tests = remapping_unit_tests .or. thisTest thisTest = test_answer(v, 5, ppoly0_E(:,2), (/0.,3.,12.,27.,48./), 'Parabola H4: right edges', tol=4.8e-14) diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index 281971cca4..b17b35c85c 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -24,7 +24,7 @@ module P1M_functions !! !! It is assumed that the size of the array 'u' is equal to the number of cells !! defining 'grid' and 'ppoly'. No consistency check is performed here. -subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018, answer_date ) +subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] @@ -32,7 +32,6 @@ subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answe real, dimension(:,:), intent(inout) :: ppoly_coef !< Potentially modified !! piecewise polynomial coefficients, mainly [A] real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables @@ -40,8 +39,7 @@ subroutine P1M_interpolation( N, h, u, edge_values, ppoly_coef, h_neglect, answe real :: u0_l, u0_r ! edge values (left and right) ! Bound edge values (routine found in 'edge_values.F90') - call bound_edge_values( N, h, u, edge_values, h_neglect, & - answers_2018=answers_2018, answer_date=answer_date ) + call bound_edge_values( N, h, u, edge_values, h_neglect, answer_date=answer_date ) ! Systematically average discontinuous edge values (routine found in ! 'edge_values.F90') @@ -155,7 +153,7 @@ end subroutine P1M_boundary_extrapolation !! linearly interpolating between them. ! !! Once the edge values are estimated, the limiting process takes care of -!! ensuring that (1) edge values are bounded by neighoring cell averages +!! ensuring that (1) edge values are bounded by neighboring cell averages !! and (2) discontinuous edge values are averaged in order to provide a !! fully continuous interpolant throughout the domain. This last step is !! essential for the regridding problem to yield a unique solution. diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index 4d39542337..6039b197fb 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -25,7 +25,7 @@ module P3M_functions !! !! It is assumed that the size of the array 'u' is equal to the number of cells !! defining 'grid' and 'ppoly'. No consistency check is performed here. -subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018, answer_date ) +subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell averages (size N) in arbitrary units [A] @@ -34,7 +34,6 @@ subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_negle real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial [A] real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Call the limiter for p3m, which takes care of everything from @@ -43,7 +42,7 @@ subroutine P3M_interpolation( N, h, u, edge_values, ppoly_S, ppoly_coef, h_negle ! 'P3M_interpolation' first but we do that to provide an homogeneous ! interface. call P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, & - answers_2018=answers_2018, answer_date=answer_date ) + answer_date=answer_date ) end subroutine P3M_interpolation @@ -60,7 +59,7 @@ end subroutine P3M_interpolation !! c. If not, monotonize cubic curve and rebuild it !! !! Step 3 of the monotonization process leaves all edge values unchanged. -subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answers_2018, answer_date ) +subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell averages (size N) in arbitrary units [A] @@ -69,7 +68,6 @@ subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, an real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial [A] real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables @@ -89,7 +87,7 @@ subroutine P3M_limiter( N, h, u, edge_values, ppoly_S, ppoly_coef, h_neglect, an eps = 1e-10 ! 1. Bound edge values (boundary cells are assumed to be local extrema) - call bound_edge_values( N, h, u, edge_values, hNeglect, answers_2018=answers_2018, answer_date=answer_date ) + call bound_edge_values( N, h, u, edge_values, hNeglect, answer_date=answer_date ) ! 2. Systematically average discontinuous edge values call average_discontinuous_edge_values( N, edge_values ) @@ -386,7 +384,7 @@ end subroutine build_cubic_interpolant !! Hence, we check whether the roots (if any) lie inside this interval. If there !! is no root or if both roots lie outside this interval, the cubic is monotonic. logical function is_cubic_monotonic( ppoly_coef, k ) - real, dimension(:,:), intent(in) :: ppoly_coef !< Coefficients of cubic polynomial in arbitary units [A] + real, dimension(:,:), intent(in) :: ppoly_coef !< Coefficients of cubic polynomial in arbitrary units [A] integer, intent(in) :: k !< The index of the cell to work on ! Local variables real :: a, b, c ! Coefficients of the first derivative of the cubic [A] diff --git a/src/ALE/PCM_functions.F90 b/src/ALE/PCM_functions.F90 index 6608e85eda..4f64e4a96d 100644 --- a/src/ALE/PCM_functions.F90 +++ b/src/ALE/PCM_functions.F90 @@ -42,7 +42,7 @@ end subroutine PCM_reconstruction !! Date of creation: 2008.06.06 !! L. White !! -!! This module contains routines that handle one-dimensionnal finite volume +!! This module contains routines that handle one-dimensional finite volume !! reconstruction using the piecewise constant method (PCM). end module PCM_functions diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90 index 9defeb9215..bc7f100a04 100644 --- a/src/ALE/PLM_functions.F90 +++ b/src/ALE/PLM_functions.F90 @@ -156,7 +156,7 @@ real elemental pure function PLM_monotonized_slope(u_l, u_c, u_r, s_l, s_c, s_r) end function PLM_monotonized_slope !> Returns a PLM slope using h2 extrapolation from a cell to the left. -!! Use the negative to extrapolate from the a cell to the right. +!! Use the negative to extrapolate from the cell to the right. real elemental pure function PLM_extrapolate_slope(h_l, h_c, h_neglect, u_l, u_c) real, intent(in) :: h_l !< Thickness of left cell [units of grid thickness] real, intent(in) :: h_c !< Thickness of center cell [units of grid thickness] @@ -305,7 +305,7 @@ end subroutine PLM_boundary_extrapolation !! Date of creation: 2008.06.06 !! L. White !! -!! This module contains routines that handle one-dimensionnal finite volume +!! This module contains routines that handle one-dimensional finite volume !! reconstruction using the piecewise linear method (PLM). end module PLM_functions diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index 16441565ac..aa24806d68 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -25,14 +25,13 @@ module PPM_functions contains !> Builds quadratic polynomials coefficients from cell mean and edge values. -subroutine PPM_reconstruction( N, h, u, edge_values, ppoly_coef, h_neglect, answers_2018, answer_date) +subroutine PPM_reconstruction( N, h, u, edge_values, ppoly_coef, h_neglect, answer_date) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< Cell widths [H] real, dimension(N), intent(in) :: u !< Cell averages [A] real, dimension(N,2), intent(inout) :: edge_values !< Edge values [A] real, dimension(N,3), intent(inout) :: ppoly_coef !< Polynomial coefficients, mainly [A] real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables @@ -40,7 +39,7 @@ subroutine PPM_reconstruction( N, h, u, edge_values, ppoly_coef, h_neglect, answ real :: edge_l, edge_r ! Edge values (left and right) ! PPM limiter - call PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018=answers_2018, answer_date=answer_date ) + call PPM_limiter_standard( N, h, u, edge_values, h_neglect, answer_date=answer_date ) ! Loop over all cells do k = 1,N @@ -60,13 +59,12 @@ end subroutine PPM_reconstruction !> Adjusts edge values using the standard PPM limiter (Colella & Woodward, JCP 1984) !! after first checking that the edge values are bounded by neighbors cell averages !! and that the edge values are monotonic between cell averages. -subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018, answer_date ) +subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) [H] real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] real, dimension(:,:), intent(inout) :: edge_values !< Potentially modified edge values [A] real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables @@ -76,7 +74,7 @@ subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018, real :: expr1, expr2 ! Bound edge values - call bound_edge_values( N, h, u, edge_values, h_neglect, answers_2018=answers_2018, answer_date=answer_date ) + call bound_edge_values( N, h, u, edge_values, h_neglect, answer_date=answer_date ) ! Make discontinuous edge values monotonic call check_discontinuous_edge_values( N, u, edge_values ) @@ -112,7 +110,7 @@ subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answers_2018, endif ! This checks that the difference in edge values is representable ! and avoids overshoot problems due to round off. - !### The 1.e-60 needs to have units of [A], so this dimensionally inconsisent. + !### The 1.e-60 needs to have units of [A], so this dimensionally inconsistent. if ( abs( edge_r - edge_l ) Edge value estimation for high-order resconstruction +!> Edge value estimation for high-order reconstruction module regrid_edge_values ! This file is part of MOM6. See LICENSE.md for the license. @@ -40,26 +40,24 @@ module regrid_edge_values !! !! Both boundary edge values are set equal to the boundary cell averages. !! Any extrapolation scheme is applied after this routine has been called. -!! Therefore, boundary cells are treated as if they were local extrama. -subroutine bound_edge_values( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) +!! Therefore, boundary cells are treated as if they were local extrema. +subroutine bound_edge_values( N, h, u, edge_val, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] real, dimension(N,2), intent(inout) :: edge_val !< Potentially modified edge values [A]; the !! second index is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real :: sigma_l, sigma_c, sigma_r ! left, center and right van Leer slopes [A H-1] or [A] real :: slope_x_h ! retained PLM slope times half grid step [A] real :: hNeglect ! A negligible thickness [H]. - logical :: use_2018_answers ! If true use older, less acccurate expressions. + logical :: use_2018_answers ! If true use older, less accurate expressions. integer :: k, km1, kp1 ! Loop index and the values to either side. - use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 - if (present(answer_date)) use_2018_answers = (answer_date < 20190101) + use_2018_answers = .true. ; if (present(answer_date)) use_2018_answers = (answer_date < 20190101) if (use_2018_answers) then hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect endif @@ -221,23 +219,22 @@ end subroutine edge_values_explicit_h2 !! available interpolant. !! !! For this fourth-order scheme, at least four cells must exist. -subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) +subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] real, dimension(N,2), intent(inout) :: edge_val !< Returned edge values [A]; the second index !! is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real :: h0, h1, h2, h3 ! temporary thicknesses [H] real :: h_min ! A minimal cell width [H] real :: f1, f2, f3 ! auxiliary variables with various units - real :: et1, et2, et3 ! terms the expresson for edge values [A H] + real :: et1, et2, et3 ! terms the expression for edge values [A H] real :: I_h12 ! The inverse of the sum of the two central thicknesses [H-1] - real :: I_h012, I_h123 ! Inverses of sums of three succesive thicknesses [H-1] + real :: I_h012, I_h123 ! Inverses of sums of three successive thicknesses [H-1] real :: I_den_et2, I_den_et3 ! Inverses of denominators in edge value terms [H-2] real, dimension(5) :: x ! Coordinate system with 0 at edges [H] real, dimension(4) :: dz ! A temporary array of limited layer thicknesses [H] @@ -248,10 +245,9 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answers_2018, real, dimension(4) :: B, C real :: hNeglect ! A negligible thickness in the same units as h. integer :: i, j - logical :: use_2018_answers ! If true use older, less acccurate expressions. + logical :: use_2018_answers ! If true use older, less accurate expressions. - use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 - if (present(answer_date)) use_2018_answers = (answer_date < 20190101) + use_2018_answers = .true. ; if (present(answer_date)) use_2018_answers = (answer_date < 20190101) if (use_2018_answers) then hNeglect = hNeglect_edge_dflt ; if (present(h_neglect)) hNeglect = h_neglect else @@ -387,14 +383,13 @@ end subroutine edge_values_explicit_h4 !! !! There are N+1 unknowns and we are able to write N-1 equations. The !! boundary conditions close the system. -subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) +subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] real, dimension(N,2), intent(inout) :: edge_val !< Returned edge values [A]; the second index !! is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables @@ -421,10 +416,9 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect, answers_2018, tri_b, & ! tridiagonal system (right hand side) [A] tri_x ! tridiagonal system (solution vector) [A] real :: hNeglect ! A negligible thickness [H] - logical :: use_2018_answers ! If true use older, less acccurate expressions. + logical :: use_2018_answers ! If true use older, less accurate expressions. - use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 - if (present(answer_date)) use_2018_answers = (answer_date < 20190101) + use_2018_answers = .true. ; if (present(answer_date)) use_2018_answers = (answer_date < 20190101) if (use_2018_answers) then hNeglect = hNeglect_edge_dflt ; if (present(h_neglect)) hNeglect = h_neglect else @@ -590,7 +584,7 @@ subroutine end_value_h4(dz, u, Csys) ! Csys(4) = ((u(2)-u(1)) - 2.0 * (u(3)-u(2)) + (u(4)-u(3))) * (0.5*C1_3) ! else - ! Express the coefficients as sums of the differences between properties of succesive layers. + ! Express the coefficients as sums of the differences between properties of successive layers. h1 = dz(1) ; h2 = dz(2) ; h3 = dz(3) ; h4 = dz(4) ! Some of the weights used below are proportional to (h1/(h2+h3))**2 or (h1/(h2+h3))*(h2/(h3+h4)) @@ -697,14 +691,13 @@ end subroutine end_value_h4 !! !! There are N+1 unknowns and we are able to write N-1 equations. The !! boundary conditions close the system. -subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answers_2018, answer_date ) +subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] real, dimension(N,2), intent(inout) :: edge_slopes !< Returned edge slopes [A H-1]; the !! second index is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables @@ -733,12 +726,11 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect, answers_201 tri_x ! tridiagonal system (solution vector) [A H-1] real :: hNeglect ! A negligible thickness [H]. real :: hNeglect3 ! hNeglect^3 [H3]. - logical :: use_2018_answers ! If true use older, less acccurate expressions. + logical :: use_2018_answers ! If true use older, less accurate expressions. hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect hNeglect3 = hNeglect**3 - use_2018_answers = .true. ; if (present(answers_2018)) use_2018_answers = answers_2018 - if (present(answer_date)) use_2018_answers = (answer_date < 20190101) + use_2018_answers = .true. ; if (present(answer_date)) use_2018_answers = (answer_date < 20190101) ! Loop on cells (except last one) do i = 1,N-1 @@ -869,14 +861,13 @@ end subroutine edge_slopes_implicit_h3 !------------------------------------------------------------------------------ !> Compute ih5 edge slopes (implicit fifth order accurate) -subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect, answers_2018, answer_date ) +subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] real, dimension(N,2), intent(inout) :: edge_slopes !< Returned edge slopes [A H-1]; the !! second index is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! ----------------------------------------------------------------------------- @@ -1141,14 +1132,13 @@ end subroutine edge_slopes_implicit_h5 !! become computationally expensive if regridding is carried out !! often. Figuring out closed-form expressions for these coefficients !! on nonuniform meshes turned out to be intractable. -subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect, answers_2018, answer_date ) +subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect, answer_date ) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< cell widths [H] real, dimension(N), intent(in) :: u !< cell average properties (size N) in arbitrary units [A] real, dimension(N,2), intent(inout) :: edge_val !< Returned edge values [A]; the second index !! is for the two edges of each cell. real, optional, intent(in) :: h_neglect !< A negligibly small width [H] - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index 022946a29d..0655d31062 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -16,12 +16,11 @@ module regrid_solvers !! This routine uses Gauss's algorithm to transform the system's original !! matrix into an upper triangular matrix. Back substitution yields the answer. !! The matrix A must be square, with the first index varing down the column. -subroutine solve_linear_system( A, R, X, N, answers_2018, answer_date ) +subroutine solve_linear_system( A, R, X, N, answer_date ) integer, intent(in) :: N !< The size of the system real, dimension(N,N), intent(inout) :: A !< The matrix being inverted [nondim] real, dimension(N), intent(inout) :: R !< system right-hand side [A] real, dimension(N), intent(inout) :: X !< solution vector [A] - logical, optional, intent(in) :: answers_2018 !< If true or absent use older, less efficient expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real, parameter :: eps = 0.0 ! Minimum pivot magnitude allowed @@ -32,8 +31,7 @@ subroutine solve_linear_system( A, R, X, N, answers_2018, answer_date ) logical :: old_answers ! If true, use expressions that give the original (2008 through 2018) MOM6 answers integer :: i, j, k - old_answers = .true. ; if (present(answers_2018)) old_answers = answers_2018 - if (present(answer_date)) old_answers = (answer_date < 20190101) + old_answers = .true. ; if (present(answer_date)) old_answers = (answer_date < 20190101) ! Loop on rows to transform the problem into multiplication by an upper-right matrix. do i = 1,N-1 @@ -175,14 +173,13 @@ end subroutine linear_solver !! !! This routine uses Thomas's algorithm to solve the tridiagonal system AX = R. !! (A is made up of lower, middle and upper diagonals) -subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answers_2018, answer_date ) +subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answer_date ) integer, intent(in) :: N !< The size of the system real, dimension(N), intent(in) :: Ad !< Matrix center diagonal real, dimension(N), intent(in) :: Al !< Matrix lower diagonal real, dimension(N), intent(in) :: Au !< Matrix upper diagonal real, dimension(N), intent(in) :: R !< system right-hand side real, dimension(N), intent(out) :: X !< solution vector - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Local variables real, dimension(N) :: pivot, Al_piv @@ -191,8 +188,7 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, R, X, N, answers_2018, answer_d integer :: k ! Loop index logical :: old_answers ! If true, use expressions that give the original (2008 through 2018) MOM6 answers - old_answers = .true. ; if (present(answers_2018)) old_answers = answers_2018 - if (present(answer_date)) old_answers = (answer_date < 20190101) + old_answers = .true. ; if (present(answer_date)) old_answers = (answer_date < 20190101) if (old_answers) then ! This version gives the same answers as the original (2008 through 2018) MOM6 code From 92770139340973c8c97aa9a1b97658f4a3002a45 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 Jul 2022 09:18:07 -0400 Subject: [PATCH 5/9] +Add the runtime parameter REMAPPING_ANSWER_DATE Added the new runtime parameter REMAPPING_ANSWER_DATE, which takes precedence over the older parameter REMAPPING_2018_ANSWERS. There are 11 files with get_param calls for this new parameter. Also started logging the value of DEFAULT_ANSWER_DATE. All answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files. --- src/ALE/MOM_ALE.F90 | 20 +++++++----- src/ALE/MOM_regridding.F90 | 15 +++++++-- src/core/MOM_open_boundary.F90 | 17 ++++++---- src/diagnostics/MOM_diagnostics.F90 | 17 ++++++---- src/framework/MOM_diag_mediator.F90 | 17 ++++++---- .../MOM_state_initialization.F90 | 31 ++++++++++++++++--- .../MOM_tracer_initialization_from_Z.F90 | 19 ++++++++---- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 +++++++---- .../vertical/MOM_ALE_sponge.F90 | 30 +++++++++++++++--- .../vertical/MOM_tidal_mixing.F90 | 19 ++++++++---- src/tracer/MOM_neutral_diffusion.F90 | 17 ++++++---- 11 files changed, 160 insertions(+), 60 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 1f675579c6..78b3be54ec 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -94,7 +94,7 @@ module MOM_ALE integer :: answer_date !< The vintage of the expressions and order of arithmetic to use for !! remapping. Values below 20190101 result in the use of older, less !! accurate expressions that were in use at the end of 2018. Higher - !! values result inthe use of more robust and accurate forms of + !! values result in the use of more robust and accurate forms of !! mathematically equivalent expressions. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -226,7 +226,7 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) "extrapolated instead of piecewise constant", default=.false.) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -234,11 +234,17 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (answers_2018) then - CS%answer_date = 20181231 - else - CS%answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + 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, "REMAPPING_ANSWER_DATE", CS%answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) + call initialize_remapping( CS%remapCS, string, & boundary_extrapolation=remap_boundary_extrap, & check_reconstruction=check_reconstruction, & diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 2f28362fb1..e5ce4019ba 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -208,6 +208,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m 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 :: remap_answers_2018 + integer :: remap_answer_date ! The vintage of the remapping expressions to use. real :: filt_len, strat_tol, tmpReal, P_Ref real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int @@ -269,7 +270,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -277,7 +278,17 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - call set_regrid_params(CS, remap_answers_2018=remap_answers_2018) + ! Revise inconsistent default answer dates for remapping. + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) + call set_regrid_params(CS, remap_answer_date=remap_answer_date) endif if (main_parameters .and. coord_is_state_dependent) then diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5a011c9101..edaa2bc1d8 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -625,7 +625,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) "round off.", default=.false.,do_not_log=.true.) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -633,11 +633,16 @@ subroutine open_boundary_config(G, US, param_file, OBC) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (answers_2018) then - OBC%remap_answer_date = 20181231 - else - OBC%remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + 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, "REMAPPING_ANSWER_DATE", OBC%remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) allocate(OBC%remap_CS) call initialize_remapping(OBC%remap_CS, remappingScheme, boundary_extrapolation = .false., & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index d7d6b7afad..e2b1197d9a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1587,7 +1587,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag "starting point for iterations.", default=.true.) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -1595,11 +1595,16 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (remap_answers_2018) then - remap_answer_date = 20181231 - else - remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) call get_param(param_file, mdl, "SPLIT", split, default=.true., do_not_log=.true.) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 65725ca59c..fbfd4e3976 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3181,7 +3181,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) default=1) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -3189,11 +3189,16 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (remap_answers_2018) then - remap_answer_date = 20181231 - else - remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) call get_param(param_file, mdl, 'USE_GRID_SPACE_DIAGNOSTIC_AXES', diag_cs%grid_space_axes, & 'If true, use a grid index coordinate convention for diagnostic axes. ',& default=.false.) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6aec256cc6..3fb366b051 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1198,11 +1198,10 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) - remap_answers_2018 = .true. if (use_remapping) then call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & - default=99991231, do_not_log=.true.) + default=99991231) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=(default_answer_date<20190101)) @@ -1210,8 +1209,19 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + ! Revise inconsistent default answer dates for remapping. + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) + else + remap_answer_date = 20181231 endif - remap_answer_date = 20190101 ; if (remap_answers_2018) remap_answer_date = 20181231 if (just_read) return ! All run-time parameters have been read, so return. @@ -2475,6 +2485,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that ! recover the remapping answers from 2018. If false, use more ! robust forms of the same remapping expressions. + integer :: default_remap_ans_date ! The default setting for remap_answer_date integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use ! for remapping. Values below 20190101 recover the remapping ! answers from 2018, while higher values use more robust @@ -2562,7 +2573,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just default=.false., do_not_log=just_read) call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & - default=99991231, do_not_log=.true.) + default=99991231) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=(default_answer_date<20190101)) @@ -2576,7 +2587,17 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - remap_answer_date = 20190101 ; if (remap_answers_2018) remap_answer_date = 20181231 + ! Revise inconsistent default answer dates for remapping. + default_remap_ans_date = default_answer_date + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_remap_ans_date) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizonal regridding that recovers "//& diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 560a3ceef7..591c4db33c 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -83,6 +83,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that ! recover the remapping answers from 2018. If false, use more ! robust forms of the same remapping expressions. + integer :: default_remap_ans_date ! The default setting for remap_answer_date integer :: remap_answer_date ! The vintage of the order of arithmetic and expressions to use ! for remapping. Values below 20190101 recover the remapping ! answers from 2018, while higher values use more robust @@ -115,7 +116,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ default="PLM") call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & - default=99991231, do_not_log=.true.) + default=99991231) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=(default_answer_date<20190101)) @@ -124,11 +125,17 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (remap_answers_2018) then - remap_answer_date = 20181231 - else - remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + default_remap_ans_date = default_answer_date + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_remap_ans_date) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizonal regridding that recovers "//& diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0dd590c2d7..dc23042916 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1543,7 +1543,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%cg1(isd:ied,jsd:jed), source=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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -1551,11 +1551,17 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (remap_answers_2018) then - remap_answer_date = 20181231 - else - remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) + call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, & "The fractional tolerance for finding the wave speeds.", & units="nondim", default=0.001) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 59b46b61cf..8b35f3f1e1 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -180,6 +180,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that ! recover the remapping answers from 2018. If false, use more ! robust forms of the same remapping expressions. + integer :: default_remap_ans_date ! The default setting for remap_answer_date logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding ! that recovers the answers from the end of 2018. Otherwise, use ! rotationally symmetric forms of the same expressions. @@ -219,7 +220,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, default=.false., do_not_log=.true.) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -227,7 +228,17 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - CS%remap_answer_date = 20190101 ; if (remap_answers_2018) CS%remap_answer_date = 20181231 + ! Revise inconsistent default answer dates for remapping. + default_remap_ans_date = default_answer_date + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_remap_ans_date) call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& @@ -453,6 +464,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that ! recover the remapping answers from 2018. If false, use more ! robust forms of the same remapping expressions. + integer :: default_remap_ans_date ! The default setting for remap_answer_date logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding ! that recovers the answers from the end of 2018. Otherwise, use ! rotationally symmetric forms of the same expressions. @@ -486,7 +498,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest default=.false., do_not_log=.true.) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -494,7 +506,17 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - CS%remap_answer_date = 20190101 ; if (remap_answers_2018) CS%remap_answer_date = 20181231 + ! Revise inconsistent default answer dates for remapping. + default_remap_ans_date = default_answer_date + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_remap_ans_date) call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018 and retain a bug in the 3-dimensional mask "//& diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index bd819a7a87..1d74b104d7 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -229,6 +229,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di logical :: remap_answers_2018 ! If true, use the order of arithmetic and expressions that ! recover the remapping answers from 2018. If false, use more ! robust forms of the same remapping expressions. + integer :: default_remap_ans_date ! The default setting for remap_answer_date character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file @@ -279,7 +280,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -291,11 +292,17 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (remap_answers_2018) then - CS%remap_answer_date = 20181231 - else - CS%remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + default_remap_ans_date = default_answer_date + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_remap_ans_date) if (CS%int_tide_dissipation) then diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 9cedfa8b57..9ef59821e3 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -190,7 +190,7 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, trim(remappingSchemesDoc), default=remappingDefaultScheme) 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, do_not_log=.true.) + 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=(default_answer_date<20190101)) @@ -198,11 +198,16 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - if (remap_answers_2018) then - CS%remap_answer_date = 20181231 - else - CS%remap_answer_date = 20190101 - endif + ! Revise inconsistent default answer dates for remapping. + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, & + "The vintage of the expressions and order of arithmetic to use for remapping. "//& + "Values below 20190101 result in the use of older, less accurate expressions "//& + "that were in use at the end of 2018. Higher values result in the use of more "//& + "robust and accurate forms of mathematically equivalent expressions. "//& + "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) call initialize_remapping( CS%remap_CS, string, boundary_extrapolation=boundary_extrap, & answer_date=CS%remap_answer_date ) call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg) From ab1e5140c9f9f42064591a84e9e3dd33377d5926 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 Jul 2022 10:39:17 -0400 Subject: [PATCH 6/9] +Add the runtime parameter HOR_REGRID_ANSWER_DATE Added the new runtime parameter HOR_REGRID_ANSWER_DATE, which takes precedence over the older parameter HOR_REGRID_2018_ANSWERS. There are 3 files with get_param calls for this new parameter. All answers are bitwise identical, but there are new entries in the MOM_parameter_doc.all files. --- .../MOM_state_initialization.F90 | 13 +++++++++- .../MOM_tracer_initialization_from_Z.F90 | 12 +++++++++- .../vertical/MOM_ALE_sponge.F90 | 24 +++++++++++++++++-- 3 files changed, 45 insertions(+), 4 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 3fb366b051..4b189b539a 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2491,6 +2491,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! answers from 2018, while higher values use more robust ! forms of the same remapping expressions. logical :: hor_regrid_answers_2018 + integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date integer :: hor_regrid_answer_date ! The vintage of the order of arithmetic and expressions to use ! for horizontal regridding. Values below 20190101 recover the ! answers from 2018, while higher values use expressions that have @@ -2603,7 +2604,17 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If true, use the order of arithmetic for horizonal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) - hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) hor_regrid_answer_date = 20181231 + ! Revise inconsistent default answer dates for horizontal regridding. + default_hor_reg_ans_date = default_answer_date + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + call get_param(PF, mdl, "HOR_REGRID_ANSWER_DATE", hor_regrid_answer_date, & + "The vintage of the order of arithmetic for horizontal regridding. "//& + "Dates before 20190101 give the same answers as the code did in late 2018, "//& + "while later versions add parentheses for rotational symmetry. "//& + "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_hor_reg_ans_date) + if (.not.useALEremapping) then call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the "//& diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 591c4db33c..04c03a5b43 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -89,6 +89,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! answers from 2018, while higher values use more robust ! forms of the same remapping expressions. logical :: hor_regrid_answers_2018 + integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date integer :: hor_regrid_answer_date ! The vintage of the order of arithmetic and expressions to use ! for horizontal regridding. Values below 20190101 recover the ! answers from 2018, while higher values use expressions that have @@ -141,7 +142,16 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ "If true, use the order of arithmetic for horizonal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) - hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) hor_regrid_answer_date = 20181231 + ! Revise inconsistent default answer dates for horizontal regridding. + default_hor_reg_ans_date = default_answer_date + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + call get_param(PF, mdl, "HOR_REGRID_ANSWER_DATE", hor_regrid_answer_date, & + "The vintage of the order of arithmetic for horizontal regridding. "//& + "Dates before 20190101 give the same answers as the code did in late 2018, "//& + "while later versions add parentheses for rotational symmetry. "//& + "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_hor_reg_ans_date) ! These are model grid properties, but being applied to the data grid for now. ! need to revisit this (mjh) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 8b35f3f1e1..1631a76dd6 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -184,6 +184,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding ! that recovers the answers from the end of 2018. Otherwise, use ! rotationally symmetric forms of the same expressions. + integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v if (associated(CS)) then @@ -243,7 +244,16 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) - CS%hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) CS%hor_regrid_answer_date = 20181231 + ! Revise inconsistent default answer dates for horizontal regridding. + default_hor_reg_ans_date = default_answer_date + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + call get_param(param_file, mdl, "HOR_REGRID_ANSWER_DATE", CS%hor_regrid_answer_date, & + "The vintage of the order of arithmetic for horizontal regridding. "//& + "Dates before 20190101 give the same answers as the code did in late 2018, "//& + "while later versions add parentheses for rotational symmetry. "//& + "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_hor_reg_ans_date) call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & "If true, the domain is zonally reentrant.", default=.true.) call get_param(param_file, mdl, "TRIPOLAR_N", CS%tripolar_N, & @@ -468,6 +478,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest logical :: hor_regrid_answers_2018 ! If true, use the order of arithmetic for horizontal regridding ! that recovers the answers from the end of 2018. Otherwise, use ! rotationally symmetric forms of the same expressions. + integer :: default_hor_reg_ans_date ! The default setting for hor_regrid_answer_date integer :: i, j, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v if (associated(CS)) then @@ -523,7 +534,16 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "returned in certain cases. Otherwise, use rotationally symmetric "//& "forms of the same expressions and initialize the mask properly.", & default=default_2018_answers) - CS%hor_regrid_answer_date = 20190101 ; if (hor_regrid_answers_2018) CS%hor_regrid_answer_date = 20181231 + ! Revise inconsistent default answer dates for horizontal regridding. + default_hor_reg_ans_date = default_answer_date + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + call get_param(param_file, mdl, "HOR_REGRID_ANSWER_DATE", CS%hor_regrid_answer_date, & + "The vintage of the order of arithmetic for horizontal regridding. "//& + "Dates before 20190101 give the same answers as the code did in late 2018, "//& + "while later versions add parentheses for rotational symmetry. "//& + "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_hor_reg_ans_date) call get_param(param_file, mdl, "SPONGE_DATA_ONGRID", CS%spongeDataOngrid, & "When defined, the incoming sponge data are "//& "assumed to be on the model grid " , & From a32b840bd97e584ae0137a0e900d6beaeee6f486 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 Jul 2022 14:25:54 -0400 Subject: [PATCH 7/9] +Added 9 ..._ANSWER_DATE runtime parameters Added 9 ..._ANSWER_DATE runtime parameters controlling the expressions and order of arithmetic in the parameterizations modules, which take precedence over their older ..._ANSWERS_2018 counterparts. The new runtime parameters are HOR_VISC_ANSWER_DATE, MEKE_GEOMETRIC_ANSWER_DATE, EPBL_ANSWER_DATE, OPTICS_ANSWER_DATE, REGULARIZE_LAYERS_ANSWER_DATE, SET_DIFF_ANSWER_DATE, SET_VISC_ANSWER_DATE, TIDAL_MIXING_ANSWER_DATE and VERT_FRICTION_ANSWER_DATE. All answers are bitwise identical, but there are numerous new entries in the MOM_parameter_doc.all files. --- .../lateral/MOM_hor_visc.F90 | 32 +++++++++++--- .../lateral/MOM_thickness_diffuse.F90 | 29 ++++++++++--- .../vertical/MOM_energetic_PBL.F90 | 39 ++++++++++++----- .../vertical/MOM_opacity.F90 | 38 +++++++++++----- .../vertical/MOM_regularize_layers.F90 | 34 +++++++++++---- .../vertical/MOM_set_diffusivity.F90 | 35 +++++++++++---- .../vertical/MOM_set_viscosity.F90 | 29 ++++++++++--- .../vertical/MOM_tidal_mixing.F90 | 43 +++++++++++++------ .../vertical/MOM_vert_friction.F90 | 38 ++++++++++++---- 9 files changed, 237 insertions(+), 80 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f7235998a6..4339a699e5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -92,9 +92,10 @@ module MOM_hor_visc logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by !! the resolution function. logical :: use_GME !< If true, use GME backscatter scheme. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust - !! forms of the same expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the + !! horizontal viscosity calculations. Values below 20190101 recover + !! the answers from the end of 2018, while higher values use updated + !! and more robust forms of the same expressions. real :: GME_h0 !< The strength of GME tapers quadratically to zero when the bathymetric !! depth is shallower than GME_H0 [Z ~> m] real :: GME_efficiency !< The nondimensional prefactor multiplying the GME coefficient [nondim] @@ -1549,7 +1550,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Shear_mag_bc = sqrt(sh_xx(i,j) * sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) - if (CS%answers_2018) then + if (CS%answer_date > 20190101) then FatH = (US%s_to_T*FatH)**MEKE%backscatter_Ro_pow ! f^n ! Note the hard-coded dimensional constant in the following line that can not ! be rescaled for dimensional consistency. @@ -1724,7 +1725,11 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. logical :: use_MEKE ! If true, the MEKE parameterization is in use. - logical :: default_2018_answers + logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the + ! answers from the end of 2018. Otherwise, use updated and more robust + ! forms of the same expressions. + 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 character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine @@ -1748,13 +1753,26 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) call log_version(param_file, mdl, version, "") ! All parameters are read in all cases to enable parameter spelling checks. + 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, "HOR_VISC_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "HOR_VISC_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + ! Revise inconsistent default answer dates for horizontal viscosity. + 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, "HOR_VISC_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the horizontal "//& + "viscosity calculations. 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 HOR_VISC_2018_ANSWERS and HOR_VISC_ANSWER_DATE are "//& + "specified, the latter takes precedence.", default=default_answer_date) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index a058d536d3..3cab1030da 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -72,9 +72,10 @@ module MOM_thickness_diffuse !! the GEOMETRIC thickness diffusion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness !! diffusivity [T-1 ~> s-1]. - logical :: MEKE_GEOM_answers_2018 !< If true, use expressions in the MEKE_GEOMETRIC calculation - !! that recover the answers from the original implementation. - !! Otherwise, use expressions that satisfy rotational symmetry. + integer :: MEKE_GEOM_answer_date !< The vintage of the expressions in the MEKE_GEOMETRIC + !! calculation. Values below 20190101 recover the answers from the + !! original implementation, while higher values use expressions that + !! satisfy rotational symmetry. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. @@ -392,7 +393,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (allocated(MEKE%Kh)) then if (CS%MEKE_GEOMETRIC) then - if (CS%MEKE_GEOM_answers_2018) then + if (CS%MEKE_GEOM_answer_date < 20190101) then !$OMP do do j=js,je ; do I=is,ie ! This does not give bitwise rotational symmetry. @@ -1950,7 +1951,11 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) real :: strat_floor ! A floor for buoyancy frequency in the Ferrari et al. 2010, ! streamfunction formulation, expressed as a fraction of planetary ! rotation [nondim]. + 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 :: MEKE_GEOM_answers_2018 ! If true, use expressions in the MEKE_GEOMETRIC calculation + ! that recover the answers from the original implementation. + ! Otherwise, use expressions that satisfy rotational symmetry. integer :: i, j CS%initialized = .true. @@ -2068,13 +2073,25 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "The nondimensional coefficient governing the efficiency of the GEOMETRIC "//& "thickness diffusion.", units="nondim", default=0.05) + 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, "MEKE_GEOMETRIC_2018_ANSWERS", CS%MEKE_GEOM_answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "MEKE_GEOMETRIC_2018_ANSWERS", MEKE_GEOM_answers_2018, & "If true, use expressions in the MEKE_GEOMETRIC calculation that recover the "//& "answers from the original implementation. Otherwise, use expressions that "//& "satisfy rotational symmetry.", default=default_2018_answers) + ! Revise inconsistent default answer dates for MEKE_geometric. + if (MEKE_GEOM_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.MEKE_GEOM_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + call get_param(param_file, mdl, "MEKE_GEOMETRIC_ANSWER_DATE", CS%MEKE_GEOM_answer_date, & + "The vintage of the expressions in the MEKE_GEOMETRIC calculation. "//& + "Values below 20190101 recover the answers from the original implementation, "//& + "while higher values use expressions that satisfy rotational symmetry. "//& + "If both MEKE_GEOMETRIC_2018_ANSWERS and MEKE_GEOMETRIC_ANSWER_DATE are "//& + "specified, the latter takes precedence.", default=default_answer_date) endif call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index bb4b4a2f36..0e090b12e3 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -158,9 +158,10 @@ module MOM_energetic_PBL type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust - !! forms of the same expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the ePBL + !! calculations. Values below 20190101 recover the answers from the + !! end of 2018, while higher values use updated and more robust forms + !! of the same expressions. logical :: orig_PE_calc !< If true, the ePBL code uses the original form of the !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in @@ -828,7 +829,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs endif !/ Apply MStar to get mech_TKE - if ((CS%answers_2018) .and. (CS%mstar_scheme==Use_Fixed_MStar)) then + if ((CS%answer_date < 20190101) .and. (CS%mstar_scheme==Use_Fixed_MStar)) then mech_TKE = (dt*MSTAR_total*GV%Rho0) * u_star**3 else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) @@ -1760,7 +1761,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& !/ 1. Get mstar elseif (CS%mstar_scheme == MStar_from_Ekman) then - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) MStar_S = CS%MStar_coef*sqrt(max(0.0,Buoyancy_Flux) / UStar**2 / & (Abs_Coriolis + 1.e-10*US%T_to_s) ) @@ -1778,7 +1779,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& MStar = max(MStar_S, min(1.25, MStar_N)) if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) elseif ( CS%mstar_scheme == MStar_from_RH18 ) then - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) else @@ -1791,7 +1792,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& endif !/ 2. Adjust mstar to account for convective turbulence - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) / & ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) + & 2.0 *MStar * UStar**3 / BLD ) @@ -1851,7 +1852,7 @@ subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langm if (CS%LT_Enhance_Form /= No_Langmuir) then ! a. Get parameters for modified LA - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then iL_Ekman = Abs_Coriolis / Ustar iL_Obukhov = Buoyancy_Flux*CS%vonkar / Ustar**3 Ekman_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) @@ -1942,7 +1943,11 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) real :: omega_frac_dflt integer :: isd, ied, jsd, jed integer :: mstar_mode, LT_enhance, wT_mode - 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 updated and more robust + ! forms of the same expressions. logical :: use_temperature, use_omega logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -1977,13 +1982,25 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.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, "EPBL_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "EPBL_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + ! Revise inconsistent default answer dates for horizontal viscosity. + 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, "EPBL_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the energetic "//& + "PBL calculations. 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 EPBL_2018_ANSWERS and EPBL_ANSWER_DATE are "//& + "specified, the latter takes precedence.", default=default_answer_date) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 7f9f61a1dc..ccedb5c607 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -41,9 +41,10 @@ module MOM_opacity !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. real :: PenSW_absorb_Invlen !< The inverse of the thickness that is used to absorb the remaining !! shortwave heat flux when it drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust - !! forms of the same expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the optics + !! calculations. Values below 20190101 recover the answers from the + !! end of 2018, while higher values use updated and more robust + !! forms of the same expressions. end type optics_type @@ -631,7 +632,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l TKE_calc = (present(TKE) .and. present(dSV_dT)) - if (optics%answers_2018) then + if (optics%answer_date < 20190101) then g_Hconv2 = (US%L_to_Z**2*GV%g_Earth * GV%H_to_RZ) * GV%H_to_RZ else g_Hconv2 = US%L_to_Z**2*GV%g_Earth * GV%H_to_RZ**2 @@ -661,7 +662,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several ! thin layers without further penetration. - if (optics%answers_2018) then + if (optics%answer_date < 20190101) then if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then @@ -881,7 +882,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several ! thin layers without further penetration. - if (optics%answers_2018) then + if (optics%answer_date < 20190101) then if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then @@ -958,7 +959,11 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat ! flux when that flux drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2] real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] - logical :: default_2018_answers + logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the + ! answers from the end of 2018. Otherwise, use updated and more robust + ! forms of the same expressions. + 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 integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke @@ -1056,14 +1061,27 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "set_opacity: \Cannot use a single_exp opacity scheme with nbands!=1.") 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, "OPTICS_2018_ANSWERS", optics%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated expressions for "//& "handling the absorption of small remaining shortwave fluxes.", & default=default_2018_answers) + ! Revise inconsistent default answer dates for optics. + 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, "OPTICS_ANSWER_DATE", optics%answer_date, & + "The vintage of the order of arithmetic and expressions in the optics calculations. "//& + "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 OPTICS_2018_ANSWERS and OPTICS_ANSWER_DATE are "//& + "specified, the latter takes precedence.", default=default_answer_date) + call get_param(param_file, mdl, "PEN_SW_FLUX_ABSORB", optics%PenSW_flux_absorb, & "A minimum remaining shortwave heating rate that will be simply absorbed in "//& @@ -1072,7 +1090,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "or 0.08 degC m century-1, but 0 is also a valid value.", & default=2.5e-11, units="degC m s-1", scale=US%degC_to_C*GV%m_to_H*US%T_to_s) - if (optics%answers_2018) then ; PenSW_minthick_dflt = 0.001 ; else ; PenSW_minthick_dflt = 1.0 ; endif + if (optics%answer_date < 20190101) then ; PenSW_minthick_dflt = 0.001 ; else ; PenSW_minthick_dflt = 1.0 ; endif call get_param(param_file, mdl, "PEN_SW_ABSORB_MINTHICK", PenSW_absorb_minthick, & "A thickness that is used to absorb the remaining penetrating shortwave heat "//& "flux when it drops below PEN_SW_FLUX_ABSORB.", & diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 3791ad26aa..deb1c90ca9 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -50,9 +50,10 @@ module MOM_regularize_layers type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust - !! forms of the same expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in this module's + !! calculations. Values below 20190101 recover the answers from the + !! end of 2018, while higher values use updated and more robust forms + !! of the same expressions. logical :: debug !< If true, do more thorough checks for debugging purposes. integer :: id_def_rat = -1 !< A diagnostic ID @@ -303,7 +304,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) else h_add = e_2d(i,nkmb+1) - e_filt(i,nkmb+1) h_2d(i,k) = h_2d(i,k) - h_add - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then e_2d(i,nkmb+1) = e_2d(i,nkmb+1) - h_add else e_2d(i,nkmb+1) = e_filt(i,nkmb+1) @@ -709,9 +710,13 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) !! diagnostic output. type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control struct -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. - 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 updated and more robust + ! forms of the same expressions. logical :: just_read integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -741,13 +746,26 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) "densities during detrainment when regularizing the near-surface layers. The "//& "default of 0.6 gives 20% overlaps in density", & units="nondim", default=0.6, do_not_log=just_read) + 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, do_not_log=just_read) 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., do_not_log=just_read) - call get_param(param_file, mdl, "REGULARIZE_LAYERS_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101), do_not_log=just_read) + call get_param(param_file, mdl, "REGULARIZE_LAYERS_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the answers "//& "from the end of 2018. Otherwise, use updated and more robust forms of the "//& "same expressions.", default=default_2018_answers, do_not_log=just_read) + ! 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, "REGULARIZE_LAYERS_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the regularize "//& + "layers calculations. 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 REGULARIZE_LAYERS_2018_ANSWERS and "//& + "REGULARIZE_LAYERS_ANSWER_DATE are specified, the latter takes precedence.", & + default=default_answer_date) endif call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index eff9d7ff72..2e27877350 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -151,9 +151,10 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust - !! forms of the same expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in this module's + !! calculations. Values below 20190101 recover the answers from the + !! end of 2018, while higher values use updated and more robust forms + !! of the same expressions. character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module @@ -286,7 +287,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i if (.not.CS%initialized) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then ! These hard-coded dimensional parameters are being replaced. kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200. else @@ -719,7 +720,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & Omega2 = CS%omega**2 H_neglect = GV%H_subroundoff G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then I_Rho0 = 1.0 / (GV%Rho0) G_IRho0 = (US%L_to_Z**2 * GV%g_Earth) * I_Rho0 else @@ -801,7 +802,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & if (k == kb(i)) then maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) else maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) @@ -1981,7 +1982,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! Local variables real :: decay_length logical :: ML_use_omega - 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 updated and more robust + ! forms of the same expressions. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. @@ -2029,13 +2034,25 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", default=7.2921e-5, scale=US%T_to_s) + 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, "SET_DIFF_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", 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, "SET_DIFF_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the set diffusivity "//& + "calculations. 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 SET_DIFF_2018_ANSWERS and SET_DIFF_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 22d65110be..fbf03f1205 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -93,8 +93,9 @@ module MOM_set_visc real :: omega_frac !< When setting the decay scale for turbulence, use !! this fraction of the absolute rotation rate blended !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the set + !! viscosity calculations. Values below 20190101 recover the answers + !! from the end of 2018, while higher values use updated and more robust !! forms of the same expressions. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: BBL_use_tidal_bg !< If true, use a tidal background amplitude for the bottom velocity @@ -864,7 +865,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) use_L0 = .false. do_one_L_iter = .false. - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then curv_tol = GV%Angstrom_H*dV_dL2**2 & * (0.25 * dV_dL2 * GV%Angstrom_H - a * L0 * dVol) do_one_L_iter = (a * a * dVol**3) < curv_tol @@ -1961,7 +1962,11 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! representation in a restart file to the internal representation in this run. integer :: i, j, k, is, ie, js, je integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz - 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 updated and more robust + ! forms of the same expressions. logical :: adiabatic, use_omega, MLE_use_PBL_MLD logical :: use_KPP logical :: use_regridding ! If true, use the ALE algorithm rather than layered @@ -1987,13 +1992,25 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%RiNo_mix = .false. call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) + 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, "SET_VISC_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", 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, "SET_VISC_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the set viscosity "//& + "calculations. 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 SET_VISC_2018_ANSWERS and SET_VISC_ANSWER_DATE are specified, "//& + "the latter takes precedence.", default=default_answer_date) call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& "law of the form c_drag*|u|*u. The velocity magnitude "//& diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 1d74b104d7..645a6ef491 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -139,11 +139,14 @@ module MOM_tidal_mixing real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for !! tidal-energy-constituent data [Z ~> m]. type(remapping_CS) :: remap_CS !< The control structure for remapping - integer :: remap_answer_date = 20181231 !< The vintage of the order of arithmetic and expressions to use - !! for remapping. Values below 20190101 recover the remapping - !! answers from 2018, while higher values use more robust - !! forms of the same remapping expressions. - !### Change to 99991231? + integer :: remap_answer_date !< The vintage of the order of arithmetic and expressions to use + !! for remapping. Values below 20190101 recover the remapping + !! answers from 2018, while higher values use more robust + !! forms of the same remapping expressions. + integer :: tidal_answer_date !< The vintage of the order of arithmetic and expressions in the tidal + !! mixing calculations. Values below 20190101 recover the answers + !! from the end of 2018, while higher values use updated and more robust + !! forms of the same expressions. type(int_tide_CS), pointer :: int_tide_CSp=> NULL() !< Control structure for a child module @@ -163,9 +166,6 @@ module MOM_tidal_mixing !! TODO: make this E(x,y) only real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use updated and more robust - !! forms of the same expressions. ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing @@ -230,6 +230,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di ! recover the remapping answers from 2018. If false, use more ! robust forms of the same remapping expressions. integer :: default_remap_ans_date ! The default setting for remap_answer_date + integer :: default_tide_ans_date ! The default setting for tides_answer_date + logical :: tide_answers_2018 ! If true, use the order of arithmetic and expressions that recover the + ! answers from the end of 2018. Otherwise, use updated and more robust + ! forms of the same expressions. character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file @@ -284,10 +288,21 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=(default_answer_date<20190101)) - call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", CS%answers_2018, & + call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", tide_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) + ! Revise inconsistent default answer dates for the tidal mixing. + default_tide_ans_date = default_answer_date + if (tide_answers_2018 .and. (default_tide_ans_date >= 20190101)) default_tide_ans_date = 20181231 + if (.not.tide_answers_2018 .and. (default_tide_ans_date < 20190101)) default_tide_ans_date = 20190101 + call get_param(param_file, mdl, "TIDAL_MIXING_ANSWER_DATE", CS%tidal_answer_date, & + "The vintage of the order of arithmetic and expressions in the tidal mixing "//& + "calculations. 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 TIDAL_MIXING_2018_ANSWERS and TIDAL_MIXING_ANSWER_DATE are specified, "//& + "the latter takes precedence.", default=default_tide_ans_date) + call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& @@ -502,7 +517,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to a fraction (often 10 percent) of the column depth. - if (CS%answers_2018 .and. (max_frac_rough >= 0.0)) then + if ((CS%tidal_answer_date < 20190101) .and. (max_frac_rough >= 0.0)) then hamp = min(max_frac_rough*(G%bathyT(i,j)+G%Z_ref), sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp else @@ -1121,7 +1136,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - if (CS%answers_2018) then + if (CS%tidal_answer_date < 20190101) then if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & @@ -1166,7 +1181,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & if (allocated(CS%dd%N2_bot)) & CS%dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) - if (CS%answers_2018) then + if (CS%tidal_answer_date < 20190101) then ! These expressions use dimensional constants to avoid NaN values. if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & @@ -1199,7 +1214,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & z_from_bot(i) = GV%H_to_Z*h(i,j,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. - if (CS%answers_2018) then + if (CS%tidal_answer_date < 20190101) then if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif @@ -1331,7 +1346,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) - if (CS%answers_2018) then + if (CS%tidal_answer_date < 20190101) then if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then z_from_bot_WKB(i) = z_from_bot_WKB(i) & + GV%H_to_Z * h(i,j,k) * N2_lay(i,k) / N2_meanz(i) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 855d563efc..21ae10fef2 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -100,9 +100,10 @@ module MOM_vert_friction !! calculation, perhaps based on a bulk Richardson !! number criterion, to determine the mixed layer !! thickness for viscosity. - logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the - !! answers from the end of 2018. Otherwise, use expressions that do not - !! use an arbitrary and hard-coded maximum viscous coupling coefficient + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the viscous + !! calculations. Values below 20190101 recover the answers from the end + !! of 2018, while higher values use expressions that do not use an + !! arbitrary and hard-coded maximum viscous coupling coefficient !! between layers. logical :: debug !< If true, write verbose checksums for debugging purposes. integer :: nkml !< The number of layers in the mixed layer. @@ -1192,7 +1193,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, nz = GV%ke h_neglect = GV%H_subroundoff - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then ! The maximum coupling coefficient was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. @@ -1626,10 +1627,15 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & real :: Kv_dflt ! A default viscosity [m2 s-1]. real :: Hmix_m ! A boundary layer thickness [m]. - 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 expressions that do not + !! use an arbitrary and hard-coded maximum viscous coupling coefficient + !! between layers. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. character(len=40) :: thickness_units @@ -1652,14 +1658,28 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Default, read and log parameters call log_version(param_file, mdl, version, "", log_to_all=.true., debugging=.true.) + 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, "VERT_FRICTION_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "VERT_FRICTION_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 that do not use an arbitrary "//& "hard-coded maximum viscous coupling coefficient between layers.", & 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, "VERT_FRICTION_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the viscous "//& + "calculations. Values below 20190101 recover the answers from the end of 2018, "//& + "while higher values use expressions that do not use an arbitrary hard-coded "//& + "maximum viscous coupling coefficient between layers. "//& + "If both VERT_FRICTION_2018_ANSWERS and VERT_FRICTION_ANSWER_DATE are "//& + "specified, the latter takes precedence.", default=default_answer_date) + call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& "law of the form c_drag*|u|*u. The velocity magnitude "//& From 08a502fee2208006ba9a8b219441058ccac2868e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 31 Jul 2022 08:42:59 -0400 Subject: [PATCH 8/9] +Added 6 more ..._ANSWER_DATE runtime parameters 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. --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 40 ++++++++++++----- .../solo_driver/MOM_surface_forcing.F90 | 37 ++++++++++++---- src/core/MOM.F90 | 36 +++++++++++---- src/core/MOM_barotropic.F90 | 32 ++++++++++---- src/ocean_data_assim/MOM_oda_driver.F90 | 36 ++++++++++----- src/user/Idealized_Hurricane.F90 | 44 +++++++++++++------ 6 files changed, 165 insertions(+), 60 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index faa74a7fe0..5c18ce5c67 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -128,9 +128,10 @@ module MOM_surface_forcing_gfdl real :: max_delta_srestore !< Maximum delta salinity used for restoring real :: max_delta_trestore !< Maximum delta sst used for restoring 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 @@ -532,7 +533,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 @@ -1037,7 +1038,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 @@ -1059,7 +1060,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) @@ -1071,7 +1072,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) @@ -1092,7 +1093,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) @@ -1249,7 +1250,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". @@ -1530,13 +1535,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.) diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 6de59684b7..ddfd724f46 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -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 @@ -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) + & @@ -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. @@ -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, & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 29bef6bcd8..e57265f60c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -333,9 +333,10 @@ module MOM real :: bad_val_sst_min !< Minimum SST before triggering bad value message [degC] real :: bad_val_sss_max !< Maximum SSS before triggering bad value message [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. @@ -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 @@ -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.", & @@ -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) @@ -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 @@ -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 diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6c13fa8af0..5a02f64240 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -210,9 +210,9 @@ module MOM_barotropic !! the barotropic acclerations. Otherwise use the depth based on bathyT. real :: BT_Coriolis_scale !< A factor by which the barotropic Coriolis acceleration anomaly !! terms are scaled [nondim]. - logical :: answers_2018 !< If true, use expressions for the barotropic solver that recover - !! the answers from the end of 2018. Otherwise, use more efficient - !! or general expressions. + integer :: answer_date !< The vintage of the expressions in the barotropic solver. + !! Values below 20190101 recover the answers from the end of 2018, + !! while higher values use more efficient or general expressions. logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous !! ice shelf, for instance. @@ -1724,7 +1724,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, I_sum_wt_eta = 1.0 / sum_wt_eta ; I_sum_wt_trans = 1.0 / sum_wt_trans do n=1,nstep+nfilter wt_vel(n) = wt_vel(n) * I_sum_wt_vel - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then wt_accel2(n) = wt_accel(n) ! wt_trans(n) = wt_trans(n) * I_sum_wt_trans else @@ -2394,7 +2394,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Reset the time information in the diag type. if (do_hifreq_output) call enable_averaging(time_int_in, time_end_in, CS%diag) - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then I_sum_wt_vel = 1.0 / sum_wt_vel ; I_sum_wt_eta = 1.0 / sum_wt_eta I_sum_wt_accel = 1.0 / sum_wt_accel ; I_sum_wt_trans = 1.0 / sum_wt_trans else @@ -2462,7 +2462,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (id_clock_pass_post > 0) call cpu_clock_end(id_clock_pass_post) if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post) - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then do j=js,je ; do I=is-1,ie CS%ubtav(I,j) = ubt_sum(I,j) * I_sum_wt_trans uhbtav(I,j) = uhbt_sum(I,j) * I_sum_wt_trans @@ -4299,7 +4299,11 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor type(group_pass_type) :: pass_bt_hbt_btav, pass_a_polarity + 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 barotropic solver that recover + ! the answers from the end of 2018. Otherwise, use more efficient + ! or general expressions. logical :: use_BT_cont_type character(len=48) :: thickness_units, flux_units character*(40) :: hvel_str @@ -4439,13 +4443,25 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "BT_CORIOLIS_SCALE", CS%BT_Coriolis_scale, & "A factor by which the barotropic Coriolis anomaly terms are scaled.", & units="nondim", default=1.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, "BAROTROPIC_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "BAROTROPIC_2018_ANSWERS", answers_2018, & "If true, use expressions for the barotropic solver that recover the answers "//& "from the end of 2018. Otherwise, use more efficient or general expressions.", & 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, "BAROTROPIC_ANSWER_DATE", CS%answer_date, & + "The vintage of the expressions in the barotropic solver. "//& + "Values below 20190101 recover the answers from the end of 2018, "//& + "while higher values uuse more efficient or general expressions. "//& + "If both BAROTROPIC_2018_ANSWERS and BAROTROPIC_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 43a8416a10..fd49ec5a98 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -134,9 +134,10 @@ module MOM_oda_driver_mod type(INC_CS) :: INC_CS !< A Structure containing integer file handles for bias adjustment integer :: id_inc_t !< A diagnostic handle for the temperature climatological adjustment integer :: id_inc_s !< A diagnostic handle for the salinity climatological adjustment - logical :: answers_2018 !< If true, use the order of arithmetic and expressions for remapping - !! that recover the answers from the end of 2018. Otherwise, use more - !! robust and accurate forms of mathematically equivalent expressions. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the + !! remapping invoked by the ODA driver. Values below 20190101 recover + !! the answers from the end of 2018, while higher values use updated + !! and more robust forms of the same expressions. end type ODA_CS @@ -175,7 +176,11 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) character(len=200) :: inputdir, basin_file character(len=80) :: remap_scheme character(len=80) :: bias_correction_file, inc_file - logical :: default_2018_answers + logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the + ! answers from the end of 2018. Otherwise, use updated and more robust + ! forms of the same expressions. + 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. if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) @@ -232,14 +237,25 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) "for vertical remapping for all variables. "//& "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default="PPM_H4") + call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=.false., do_not_log=.true.) - call get_param(PF, mdl, "ODA_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(PF, mdl, "ODA_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from original version of the ODA driver. Otherwise, use updated and "//& - "more robust forms of the same expressions.", default=default_2018_answers, & - do_not_log=.true.) + "more robust forms of the same expressions.", 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(PF, mdl, "ODA_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions used by the ODA driver "//& + "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 ODA_2018_ANSWERS and ODA_ANSWER_DATE are specified, the "//& + "latter takes precedence.", default=default_answer_date) inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) @@ -408,7 +424,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) call set_PElist(CS%filter_pelist) !call MOM_mesg('Setting prior') - if (.not. CS%answers_2018) then + if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 @@ -676,7 +692,7 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) S = S + CS%tv_bc%S endif - if (.not. CS%answers_2018) then + if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H * 1.0e-30 ; h_neglect_edge = GV%m_to_H * 1.0e-10 diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index d067b76eff..0d2926798f 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -66,9 +66,10 @@ module Idealized_hurricane !! for the Holland prorfile calculation [R L2 T-2 ~> Pa] logical :: relative_tau !< A logical to take difference between wind !! and surface currents to compute the stress - logical :: answers_2018 !< If true, use expressions driving the idealized hurricane test - !! case that recover the answers from the end of 2018. Otherwise use - !! expressions that are rescalable and respect rotational symmetry. + integer :: answer_date !< The vintage of the expressions in the idealized hurricane + !! test case. Values below 20190101 recover the answers + !! from the end of 2018, while higher values use expressions + !! that are rescalable and respect rotational symmetry. ! Parameters used if in SCM (single column model) mode logical :: SCM_mode !< If true this being used in Single Column Model mode @@ -102,7 +103,11 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) ! Local variables real :: dP ! The pressure difference across the hurricane [R L2 T-2 ~> Pa] real :: C + 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 driving the idealized hurricane test + ! case that recover the answers from the end of 2018. Otherwise use + ! expressions that are rescalable and respect rotational symmetry. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -166,14 +171,27 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) call get_param(param_file, mdl, "IDL_HURR_SCM_LOCY", CS%dy_from_center, & "Y distance of station used in the SCM idealized hurricane "//& "wind profile.", units='m', default=50.e3, scale=US%m_to_L) + 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, "IDL_HURR_2018_ANSWERS", CS%answers_2018, & + default=(default_answer_date<20190101)) + call get_param(param_file, mdl, "IDL_HURR_2018_ANSWERS", answers_2018, & "If true, use expressions driving the idealized hurricane test case that recover "//& "the answers from the end of 2018. Otherwise use expressions that are rescalable "//& "and respect rotational symmetry.", 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, "IDL_HURR_ANSWER_DATE", CS%answer_date, & + "The vintage of the expressions in the idealized hurricane test case. "//& + "Values below 20190101 recover the answers from the end of 2018, while higher "//& + "values use expressions that are rescalable and respect rotational symmetry. "//& + "If both IDL_HURR_2018_ANSWERS and IDL_HURR_ANSWER_DATE are specified, "//& + "the latter takes precedence.", default=default_answer_date) + ! The following parameters are model run-time parameters which are used ! and logged elsewhere and so should not be logged here. The default ! value should be consistent with the rest of the model. @@ -191,7 +209,7 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) CS%rho_a = 1.2*US%kg_m3_to_R endif dP = CS%pressure_ambient - CS%pressure_central - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then C = CS%max_windspeed / sqrt( US%R_to_kg_m3 * dP ) CS%Holland_B = C**2 * US%R_to_kg_m3*CS%rho_a * exp(1.0) else @@ -261,7 +279,7 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) do j=js,je do I=is-1,Ieq Uocn = sfc_state%u(I,j) * REL_TAU_FAC - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then Vocn = 0.25*(sfc_state%v(i,J)+sfc_state%v(i+1,J-1)& +sfc_state%v(i+1,J)+sfc_state%v(i,J-1))*REL_TAU_FAC else @@ -284,7 +302,7 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) !> Computes tauy do J=js-1,Jeq do i=is,ie - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then Uocn = 0.25*(sfc_state%u(I,j)+sfc_state%u(I-1,j+1) + & sfc_state%u(I-1,j)+sfc_state%u(I,j+1))*REL_TAU_FAC else @@ -381,7 +399,7 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx !/ ! Calculate U10 in the interior (inside of 10x radius of maximum wind), ! while adjusting U10 to 0 outside of 12x radius of maximum wind. - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then if ( (radius > 0.001*CS%rad_max_wind) .and. (radius < 10.*CS%rad_max_wind) ) then U10 = sqrt(CS%Holland_AxBxDP*exp(-CS%Holland_A/radiusB) / (CS%rho_a*radiusB) + & 0.25*(radius_km*absf)**2) - 0.5*radius_km*absf @@ -449,7 +467,7 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx if (dU10 < 11.0*US%m_s_to_L_T) then Cd = 1.2e-3 elseif (dU10 < 20.0*US%m_s_to_L_T) then - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then Cd = (0.49 + 0.065*US%L_T_to_m_s*U10)*1.e-3 else Cd = (0.49 + 0.065*US%L_T_to_m_s*dU10)*1.e-3 @@ -514,7 +532,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C transdir = pie !translation direction (-x) | !------------------------------------------------------| dP = CS%pressure_ambient - CS%pressure_central - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then C = CS%max_windspeed / sqrt( US%R_to_kg_m3*dP ) B = C**2 * US%R_to_kg_m3*CS%rho_a * exp(1.0) if (BR_Bench) then ! rho_a reset to value used in generated wind for benchmark test @@ -617,7 +635,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C if (dU10 < 11.0*US%m_s_to_L_T) then Cd = 1.2e-3 elseif (dU10 < 20.0*US%m_s_to_L_T) then - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then Cd = (0.49 + 0.065 * US%L_T_to_m_s*U10 )*0.001 else Cd = (0.49 + 0.065 * US%L_T_to_m_s*dU10 )*0.001 @@ -639,7 +657,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C if (dU10 < 11.0*US%m_s_to_L_T) then Cd = 1.2e-3 elseif (dU10 < 20.0*US%m_s_to_L_T) then - if (CS%answers_2018) then + if (CS%answer_date < 20190101) then Cd = (0.49 + 0.065 * US%L_T_to_m_s*U10 )*0.001 else Cd = (0.49 + 0.065 * US%L_T_to_m_s*dU10 )*0.001 From ecbb8d5c99e302002c94511a4e9c9b97aae69dd6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 31 Jul 2022 08:50:21 -0400 Subject: [PATCH 9/9] +Add do_not_log=just_read args in get_param calls Added do_not_log=just_read arguments to get_param calls where other calls in the same initialization routines already had them, so that the logging of the parameters is consistent. All answers are bitwise identical, but this could lead to changes in the MOM_parameter_doc files. --- .../MOM_state_initialization.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4b189b539a..3918163197 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1194,21 +1194,21 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3, do_not_log=just_read, scale=US%m_to_Z) + units='m', default=1.e-3, scale=US%m_to_Z, do_not_log=just_read) call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) if (use_remapping) then call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & - default=99991231) + default=99991231, do_not_log=just_read) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=just_read) call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) ! Revise inconsistent default answer dates for remapping. if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 @@ -1218,7 +1218,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=just_read) else remap_answer_date = 20181231 endif @@ -2574,20 +2574,20 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just default=.false., do_not_log=just_read) call get_param(PF, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & - default=99991231) + default=99991231, do_not_log=just_read) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=just_read) call get_param(PF, mdl, "TEMP_SALT_INIT_VERTICAL_REMAP_ONLY", pre_gridded, & "If true, initial conditions are on the model horizontal grid. " //& "Extrapolation over missing ocean values is done using an ICE-9 "//& "procedure with vertical ALE remapping .", & - default=.false.) + default=.false., do_not_log=just_read) if (useALEremapping) then call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) ! Revise inconsistent default answer dates for remapping. default_remap_ans_date = default_answer_date if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 @@ -2598,12 +2598,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_remap_ans_date) + "latter takes precedence.", default=default_remap_ans_date, do_not_log=just_read) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizonal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) ! Revise inconsistent default answer dates for horizontal regridding. default_hor_reg_ans_date = default_answer_date if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 @@ -2613,7 +2613,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_hor_reg_ans_date) + "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=just_read) if (.not.useALEremapping) then call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, &