diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index ca058089e1..648abd81dd 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -373,11 +373,12 @@ subroutine doc_closeBlock(doc, blockName) endif end subroutine doc_closeBlock -subroutine doc_param_time(doc, varname, desc, units, val, default) +subroutine doc_param_time(doc, varname, desc, units, val, default, layoutParam) type(doc_type), pointer :: doc character(len=*), intent(in) :: varname, desc, units type(time_type), intent(in) :: val type(time_type), optional, intent(in) :: default + logical, optional, intent(in) :: layoutParam ! This subroutine handles parameter documentation for time-type variables. ! ### This needs to be written properly! integer :: numspc @@ -394,7 +395,7 @@ subroutine doc_param_time(doc, varname, desc, units, val, default) if (len_trim(units) > 0) mesg = trim(mesg)//" ["//trim(units)//"]" if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates - call writeMessageAndDesc(doc, mesg, desc, equalsDefault) + call writeMessageAndDesc(doc, mesg, desc, equalsDefault, layoutParam=layoutParam) endif end subroutine doc_param_time diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 9c4411976b..7fd47a781f 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -49,6 +49,7 @@ module MOM_file_parser use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout use MOM_time_manager, only : set_time, get_time, time_type, get_ticks_per_second +use MOM_time_manager, only : set_date, get_date use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type use MOM_document, only : doc_openBlock, doc_closeBlock use MOM_string_functions, only : left_int, left_ints, slasher @@ -781,30 +782,60 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing) end subroutine read_param_logical -subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing) +subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format) type(param_file_type), intent(in) :: CS character(len=*), intent(in) :: varname type(time_type), intent(inout) :: value real, optional, intent(in) :: timeunit logical, optional, intent(in) :: fail_if_missing -! This subroutine determines the value of an integer model parameter + logical, optional, intent(out) :: date_format +! This subroutine determines the value of an time-type model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable ! where the value is to be stored, and (optionally) a flag indicating ! whether to fail if this parameter can not be found. The unique argument ! to read time is the number of seconds to use as the unit of time being read. character(len=INPUT_STR_LENGTH) :: value_string(1) + character(len=240) :: err_msg logical :: found, defined real :: real_time, time_unit - integer :: days, secs + integer :: days, secs, vals(7) + + if (present(date_format)) date_format = .false. call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then - time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit - read( value_string(1), *) real_time - days = int(real_time*(time_unit/86400.0)) - secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) - value = set_time(secs, days) + ! Determine whether value string should be parsed for a real number + ! or a date, in either a string format or a comma-delimited list of values. + if ((INDEX(value_string(1),'-') > 0) .and. & + (INDEX(value_string(1),'-',back=.true.) > INDEX(value_string(1),'-'))) then + ! There are two dashes, so this must be a date format. + value = set_date(value_string(1), err_msg=err_msg) + if (LEN_TRIM(err_msg) > 0) call MOM_error(FATAL,'read_param_time: '//& + trim(err_msg)//' in integer list read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') + if (present(date_format)) date_format = .true. + elseif (INDEX(value_string(1),',') > 0) then + ! Initialize vals with an invalid date. + vals(:) = (/ -999, -999, -999, 0, 0, 0, 0 /) + read(value_string(1),*,end=995,err=1005) vals + 995 continue + if ((vals(1) < 0) .or. (vals(2) < 0) .or. (vals(3) < 0)) & + call MOM_error(FATAL,'read_param_time: integer list read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') + value = set_date(vals(1), vals(2), vals(3), vals(4), vals(5), vals(6), & + vals(7), err_msg=err_msg) + if (LEN_TRIM(err_msg) > 0) call MOM_error(FATAL,'read_param_time: '//& + trim(err_msg)//' in integer list read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') + if (present(date_format)) date_format = .true. + else + time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit + read( value_string(1), *) real_time + days = int(real_time*(time_unit/86400.0)) + secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) + value = set_time(secs, days) + endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -816,6 +847,9 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing) endif endif ; endif endif + return + 1005 call MOM_error(FATAL,'read_param_time: read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_time function strip_quotes(val_str) @@ -1382,8 +1416,10 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & end subroutine log_param_char +!> This subroutine writes the value of a time-type parameter to a log file, +!! along with its name and the module it came from. subroutine log_param_time(CS, modulename, varname, value, desc, units, & - default, timeunit) + default, timeunit, layoutParam, log_date) type(param_file_type), intent(in) :: CS character(len=*), intent(in) :: modulename character(len=*), intent(in) :: varname @@ -1391,12 +1427,17 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & character(len=*), optional, intent(in) :: desc, units type(time_type), optional, intent(in) :: default real, optional, intent(in) :: timeunit -! This subroutine writes the value of a time-type parameter to a log file, -! along with its name and the module it came from. + logical, optional, intent(in) :: log_date !< If true, log the time_type in date format. + logical, optional, intent(in) :: layoutParam + real :: real_time, real_default - logical :: use_timeunit = .false. + logical :: use_timeunit, date_format character(len=240) :: mesg, myunits - integer :: days, secs, ticks + character(len=80) :: date_string, default_string + integer :: days, secs, ticks, ticks_per_sec + + use_timeunit = .false. + date_format = .false. ; if (present(log_date)) date_format = log_date call get_time(value, secs, days, ticks) @@ -1414,7 +1455,19 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & if (present(desc)) then if (present(timeunit)) use_timeunit = (timeunit > 0.0) - if (use_timeunit) then + if (date_format) then + myunits='[date]' + + date_string = convert_date_to_string(value) + if (present(default)) then + default_string = convert_date_to_string(default) + call doc_param(CS%doc, varname, desc, myunits, date_string, & + default=default_string, layoutParam=layoutParam) + else + call doc_param(CS%doc, varname, desc, myunits, date_string, & + layoutParam=layoutParam) + endif + elseif (use_timeunit) then if (present(units)) then write(myunits(1:240),'(A)') trim(units) else @@ -1444,6 +1497,34 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & end subroutine log_param_time +!> This function converts a date into a string, valid with ticks and for dates up to year 99,999,999 +function convert_date_to_string(date) result(date_string) + type(time_type), intent(in) :: date !< The date to be translated into a string. + character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss + + character(len=40) :: sub_string + real :: real_secs + integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec + + call get_date(date, yrs, mons, days, hours, mins, secs, ticks) + write (date_string, '(i8.4)') yrs + write (sub_string, '("-", i2.2, "-", I2.2, " ", i2.2, ":", i2.2, ":")') & + mons, days, hours, mins + date_string = trim(adjustl(date_string)) // trim(sub_string) + if (ticks > 0) then + ticks_per_sec = get_ticks_per_second() + real_secs = secs + ticks/ticks_per_sec + if (ticks_per_sec <= 100) then + write (sub_string, '(F7.3)') real_secs + else + write (sub_string, '(F10.6)') real_secs + endif + else + write (sub_string, '(i2.2)') secs + endif + date_string = trim(date_string) // trim(adjustl(sub_string)) + +end function convert_date_to_string subroutine get_param_int(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & @@ -1675,7 +1756,7 @@ end subroutine get_param_logical subroutine get_param_time(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - timeunit, static_value) + timeunit, static_value, layoutParam, log_as_date) type(param_file_type), intent(in) :: CS character(len=*), intent(in) :: modulename character(len=*), intent(in) :: varname @@ -1685,22 +1766,26 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & logical, optional, intent(in) :: fail_if_missing logical, optional, intent(in) :: do_not_read, do_not_log real, optional, intent(in) :: timeunit + logical, optional, intent(in) :: layoutParam + logical, optional, intent(in) :: log_as_date ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. - logical :: do_read, do_log + logical :: do_read, do_log, date_format, log_date 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 + log_date = .false. if (do_read) then if (present(default)) value = default if (present(static_value)) value = static_value - call read_param_time(CS, varname, value, timeunit, fail_if_missing) + call read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format=log_date) endif if (do_log) then - call log_param_time(CS, modulename, varname, value, desc, & - units, default, timeunit) + if (present(log_as_date)) log_date = log_as_date + call log_param_time(CS, modulename, varname, value, desc, units, default, & + timeunit, layoutParam=layoutParam, log_date=log_date) endif end subroutine get_param_time