From ed3da3d0030374425089d6600b296f1ce54b8215 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 1 Jan 2025 05:48:05 -0500 Subject: [PATCH] +Add a vector of defaults to get_param_array_int The `default=` optional argument to get_param() only provides a uniform value to initialize an array of integers. This commit adds an optional `defaults=` argument to get_param_int_array(), doc_param_int_array() and log_param_int_array() to allow for the specification of an array of default values. These additions are analogous to what had previously been added for real arrays in github.com/NOAA-GFDL/MOM6/pull/760. This commit also adds the new internal function int_array_string(), analogous to real_array_string(), in MOM_document. This differs slightly from its real array counterpart in that it only uses the syntax like `3*75` for lists of integers that are longer than we would use to specify dates and times or pairs of layout parameters, because "(0, 0)" seems more readily interpretable than "(2*0)". The new defaults argument is now used in the get_param calls for LAYOUT and IO_LAYOUT, and in setting the tidal reference dates. Several spelling errors in comments were also corrected in the files that were being edited. All answers are bitwise identical, but there are minor changes in many MOM_parameter_doc.layout files and some MOM_parameter_doc.all files. --- src/core/MOM_open_boundary.F90 | 6 +- src/framework/MOM_document.F90 | 63 +++++++++++++++++-- src/framework/MOM_domains.F90 | 4 +- src/framework/MOM_file_parser.F90 | 36 +++++++---- .../lateral/MOM_tidal_forcing.F90 | 10 +-- 5 files changed, 92 insertions(+), 27 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2f2709ed75..c15b6bd54b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1188,7 +1188,7 @@ subroutine initialize_obc_tides(OBC, US, param_file) call get_param(param_file, mdl, "OBC_TIDE_NODAL_REF_DATE", nodal_ref_date, & "Fixed reference date to use for nodal modulation of boundary tides.", & - fail_if_missing=.false., default=0) + fail_if_missing=.false., defaults=(/0, 0, 0/)) if (.not. OBC%add_eq_phase) then ! If equilibrium phase argument is not added, the input phases @@ -1200,7 +1200,7 @@ subroutine initialize_obc_tides(OBC, US, param_file) read(tide_constituent_str, *) OBC%tide_names ! Set reference time (t = 0) for boundary tidal forcing. - OBC%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3)) + OBC%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3), 0, 0, 0) ! Find relevant lunar and solar longitudes at the reference time if (OBC%add_eq_phase) call astro_longitudes_init(OBC%time_ref, OBC%tidal_longitudes) @@ -1210,7 +1210,7 @@ subroutine initialize_obc_tides(OBC, US, param_file) if (OBC%add_nodal_terms) then if (sum(nodal_ref_date) /= 0) then ! A reference date was provided for the nodal correction - nodal_time = set_date(nodal_ref_date(1), nodal_ref_date(2), nodal_ref_date(3)) + nodal_time = set_date(nodal_ref_date(1), nodal_ref_date(2), nodal_ref_date(3), 0, 0, 0) call astro_longitudes_init(nodal_time, nodal_longitudes) elseif (OBC%add_eq_phase) then ! Astronomical longitudes were already calculated for use in equilibrium phases, diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index eceb87d7d4..d999e1e680 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -221,7 +221,7 @@ subroutine doc_param_int(doc, varname, desc, units, val, default, & end subroutine doc_param_int !> This subroutine handles parameter documentation for arrays of integers. -subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & +subroutine doc_param_int_array(doc, varname, desc, units, vals, default, defaults, & layoutParam, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting @@ -229,7 +229,8 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & character(len=*), intent(in) :: desc !< A description of the parameter being documented character(len=*), intent(in) :: units !< The units of the parameter being documented integer, intent(in) :: vals(:) !< The array of values to record - integer, optional, intent(in) :: default !< The default value of this parameter + integer, optional, intent(in) :: default !< The uniform default value of this parameter + integer, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though @@ -257,6 +258,11 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & do i=1,size(vals) ; if (vals(i) /= default) equalsDefault = .false. ; enddo mesg = trim(mesg)//" default = "//(trim(int_string(default))) endif + if (present(defaults)) then + equalsDefault = .true. + do i=1,size(vals) ; if (vals(i) /= defaults(i)) equalsDefault = .false. ; enddo + mesg = trim(mesg)//" default = "//trim(int_array_string(defaults)) + endif if (present(like_default)) then ; if (like_default) equalsDefault = .true. ; endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates @@ -479,7 +485,7 @@ subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingPara end subroutine doc_param_time -!> This subroutine writes out the message and description to the documetation files. +!> This subroutine writes out the message and description to the documentation files. subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & layoutParam, debuggingParam) type(doc_type), intent(in) :: doc !< A pointer to a structure that controls where the @@ -719,6 +725,55 @@ function real_array_string(vals, sep) enddo end function real_array_string + +!> Returns a character string of a comma-separated, compact formatted, integers +!> e.g. "1, 2, 7*3, 500", that give the list of values. +function int_array_string(vals, sep) + character(len=:), allocatable :: int_array_string !< The output string listing vals + integer, intent(in) :: vals(:) !< The array of values to record + character(len=*), & + optional, intent(in) :: sep !< The separator between successive values, + !! by default it is ', '. + + ! Local variables + integer :: j, m, n, ns + logical :: doWrite + character(len=10) :: separator + n = 1 ; doWrite = .true. ; int_array_string = '' + if (present(sep)) then + separator = sep ; ns = len(sep) + else + separator = ', ' ; ns = 2 + endif + do j=1,size(vals) + doWrite = .true. + if (j < size(vals)) then + if (vals(j) == vals(j+1)) then + n = n+1 + doWrite = .false. + endif + endif + if (doWrite) then + if (len(int_array_string) > 0) then ! Write separator if a number has already been written + int_array_string = int_array_string // separator(1:ns) + endif + if (n>1) then + if (size(vals) > 6) then ! The n*val syntax is convenient in long lists of integers. + int_array_string = int_array_string // trim(int_string(n)) // "*" // trim(int_string(vals(j))) + else ! For short lists of integers, do not use the n*val syntax as it is less convenient. + do m=1,n-1 + int_array_string = int_array_string // trim(int_string(vals(j))) // separator(1:ns) + enddo + int_array_string = int_array_string // trim(int_string(vals(j))) + endif + else + int_array_string = int_array_string // trim(int_string(vals(j))) + endif + n=1 + endif + enddo +end function int_array_string + !> This function tests whether a real value is encoded in a string. function testFormattedFloatIsReal(str, val) character(len=*), intent(in) :: str !< The string that match val @@ -1007,7 +1062,7 @@ function find_unused_unit_number() "doc_init failed to find an unused unit number.") end function find_unused_unit_number -!> This subroutine closes the the files controlled by doc, and sets flags in +!> This subroutine closes the files controlled by doc, and sets flags in !! doc to indicate that parameterization is no longer permitted. subroutine doc_end(doc) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 81e4425be3..6ed3eb23fe 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -350,7 +350,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & else call get_param(param_file, mdl, trim(layout_nm), layout, & "The processor layout to be used, or 0, 0 to automatically set the layout "//& - "based on the number of processors.", default=0, do_not_log=.true.) + "based on the number of processors.", defaults=(/0, 0/), do_not_log=.true.) call get_param(param_file, mdl, trim(niproc_nm), nip_parsed, & "The number of processors in the x-direction.", default=-1, do_not_log=.true.) call get_param(param_file, mdl, trim(njproc_nm), njp_parsed, & @@ -436,7 +436,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & else call get_param(param_file, mdl, trim(io_layout_nm), io_layout, & "The processor layout to be used, or 0,0 to automatically set the io_layout "//& - "to be the same as the layout.", default=1, layoutParam=.true.) + "to be the same as the layout.", defaults=(/1, 1/), layoutParam=.true.) endif call create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, layout, & diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index fc496ac1b5..7d3337ea24 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -125,7 +125,7 @@ module MOM_file_parser contains -!> Make the contents of a parameter input file availalble in a param_file_type +!> Make the contents of a parameter input file available in a param_file_type subroutine open_param_file(filename, CS, checkable, component, doc_file_dir, ensemble_num) character(len=*), intent(in) :: filename !< An input file name, optionally with the full path type(param_file_type), intent(inout) :: CS !< The control structure for the file_parser module, @@ -562,10 +562,10 @@ function removeComments(string) removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string end function removeComments -!> Constructs a string with all repeated whitespace replaced with single blanks +!> Constructs a string with all repeated white space replaced with single blanks !! and insert white space where it helps delineate tokens (e.g. around =) function simplifyWhiteSpace(string) - character(len=*), intent(in) :: string !< A string to modify to simpify white space + character(len=*), intent(in) :: string !< A string to modify to simplify white space character(len=len(string)+16) :: simplifyWhiteSpace ! Local variables @@ -583,7 +583,7 @@ function simplifyWhiteSpace(string) if (string(j:j)==quoteChar) insideString=.false. ! End of string else ! The following is outside of string delimiters if (string(j:j)==" " .or. string(j:j)==achar(9)) then ! Space or tab - if (nonBlank) then ! Only copy a blank if the preceeding character was non-blank + if (nonBlank) then ! Only copy a blank if the preceding character was non-blank i=i+1 simplifyWhiteSpace(i:i)=" " ! Not string(j:j) so that tabs are replace by blanks nonBlank=.false. @@ -989,7 +989,7 @@ function max_input_line_length(CS, pf_num) result(max_len) end function max_input_line_length !> This subroutine extracts the contents of lines in the param_file_type that refer to -!! a named parameter. The value_string that is returned must be interepreted in a way +!! a named parameter. The value_string that is returned must be interpreted in a way !! that depends on the type of this variable. subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsLogical) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, @@ -1391,7 +1391,7 @@ end subroutine log_param_int !> Log the name and values of an array of integer model parameter in documentation files. subroutine log_param_int_array(CS, modulename, varname, value, desc, & - units, default, layoutParam, debuggingParam, like_default) + units, default, defaults, layoutParam, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the module using this parameter @@ -1400,7 +1400,8 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter - integer, optional, intent(in) :: default !< The default value of the parameter + integer, optional, intent(in) :: default !< The uniform default value of this parameter + integer, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is @@ -1419,7 +1420,7 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & myunits=" "; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default, & + call doc_param(CS%doc, varname, desc, myunits, value, default, defaults, & layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_int_array @@ -1745,7 +1746,7 @@ end subroutine get_param_int !> This subroutine reads the values of an array of integer model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, & + default, defaults, fail_if_missing, do_not_read, do_not_log, & layoutParam, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters @@ -1756,7 +1757,8 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter - integer, optional, intent(in) :: default !< The default value of the parameter + integer, optional, intent(in) :: default !< The uniform default value of this parameter + integer, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1773,14 +1775,22 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log + if (present(defaults)) then + if (present(default)) call MOM_error(FATAL, & + "get_param_int_array: Only one of default and defaults can be specified at a time.") + if (size(defaults) /= size(value)) call MOM_error(FATAL, & + "get_param_int_array: The size of defaults and value are not the same.") + endif + if (do_read) then if (present(default)) value(:) = default + if (present(defaults)) value(:) = defaults(:) call read_param_int_array(CS, varname, value, fail_if_missing) endif if (do_log) then - call log_param_int_array(CS, modulename, varname, value, desc, & - units, default, layoutParam, debuggingParam) + call log_param_int_array(CS, modulename, varname, value, desc, units, & + default, defaults, layoutParam, debuggingParam) endif end subroutine get_param_int_array @@ -1871,7 +1881,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & if (present(default)) call MOM_error(FATAL, & "get_param_real_array: Only one of default and defaults can be specified at a time.") if (size(defaults) /= size(value)) call MOM_error(FATAL, & - "get_param_real_array: The size of defaults nad value are not the same.") + "get_param_real_array: The size of defaults and value are not the same.") endif if (do_read) then diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 43885cccc3..85c9b1ee81 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -95,8 +95,8 @@ subroutine astro_longitudes_init(time_ref, longitudes) real :: T !> Time in Julian centuries [centuries] real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] - ! Find date at time_ref in days since 1900-01-01 - D = time_type_to_real(time_ref - set_date(1900, 1, 1)) / (24.0 * 3600.0) + ! Find date at time_ref in days since midnight at the start of 1900-01-01 + D = time_type_to_real(time_ref - set_date(1900, 1, 1, 0, 0, 0)) / (24.0 * 3600.0) ! Time since 1900-01-01 in Julian centuries ! Kowalik and Luick use 36526, but Schureman uses 36525 which I think is correct. T = D / 36525.0 @@ -385,14 +385,14 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS, HA_CS) call get_param(param_file, mdl, "TIDE_REF_DATE", tide_ref_date, & "Year,month,day to use as reference date for tidal forcing. "//& "If not specified, defaults to 0.", & - default=0) + defaults=(/0, 0, 0/)) call get_param(param_file, mdl, "TIDE_USE_EQ_PHASE", CS%use_eq_phase, & "Correct phases by calculating equilibrium phase arguments for TIDE_REF_DATE. ", & default=.false., fail_if_missing=.false.) if (sum(tide_ref_date) == 0) then ! tide_ref_date defaults to 0. - CS%time_ref = set_date(1, 1, 1) + CS%time_ref = set_date(1, 1, 1, 0, 0, 0) else if (.not. CS%use_eq_phase) then ! Using a reference date but not using phase relative to equilibrium. @@ -400,7 +400,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS, HA_CS) ! correctly simulating tidal phases is not desired. call MOM_mesg('Tidal phases will *not* be corrected with equilibrium arguments.') endif - CS%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3)) + CS%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3), 0, 0, 0) endif ! Initialize reference time for tides and find relevant lunar and solar