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