From 3c08cef2f7a6ca8abc0bd36cd40ceb07c377c15e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 16 Mar 2020 17:23:32 -0400 Subject: [PATCH] +Corrected doc_param_time Rewrote the subroutine doc_param_time to work like the other doc_param routines, including making the units argument optional, removing the argument layout_param, and adding the new internally visible routine time_string. Because time variables are currently logged as real values using the timeunit argument to log_param_time, these changes do not have a widespread impact. All answers are bitwise identical, but there are some limited interface changes. --- src/framework/MOM_document.F90 | 83 ++++++++++++++++++++----------- src/framework/MOM_file_parser.F90 | 3 +- 2 files changed, 54 insertions(+), 32 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 75496544db..6c4c1f1ebb 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -4,7 +4,7 @@ module MOM_document ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_time_manager, only : time_type +use MOM_time_manager, only : time_type, operator(==), get_time, get_ticks_per_second use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe implicit none ; private @@ -104,9 +104,9 @@ subroutine doc_param_logical(doc, varname, desc, units, val, default, & if (doc%filesAreOpen) then if (val) then - mesg = define_string(doc,varname,STRING_TRUE,units) + mesg = define_string(doc, varname, STRING_TRUE, units) else - mesg = undef_string(doc,varname,units) + mesg = undef_string(doc, varname, units) endif equalsDefault = .false. @@ -156,7 +156,7 @@ subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & endif enddo - mesg = define_string(doc,varname,valstring,units) + mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. if (present(default)) then @@ -197,7 +197,7 @@ subroutine doc_param_int(doc, varname, desc, units, val, default, & if (doc%filesAreOpen) then valstring = int_string(val) - mesg = define_string(doc,varname,valstring,units) + mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. if (present(default)) then @@ -238,7 +238,7 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & valstring = trim(valstring)//", "//trim(int_string(vals(i))) enddo - mesg = define_string(doc,varname,valstring,units) + mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. if (present(default)) then @@ -274,7 +274,7 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara if (doc%filesAreOpen) then valstring = real_string(val) - mesg = define_string(doc,varname,valstring,units) + mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. if (present(default)) then @@ -283,8 +283,7 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates - call writeMessageAndDesc(doc, mesg, desc, equalsDefault, & - debuggingParam=debuggingParam) + call writeMessageAndDesc(doc, mesg, desc, equalsDefault, debuggingParam=debuggingParam) endif end subroutine doc_param_real @@ -310,7 +309,7 @@ subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debugg if (doc%filesAreOpen) then valstring = trim(real_array_string(vals(:))) - mesg = define_string(doc,varname,valstring,units) + mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. if (present(default)) then @@ -320,8 +319,7 @@ subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debugg endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates - call writeMessageAndDesc(doc, mesg, desc, equalsDefault, & - debuggingParam=debuggingParam) + call writeMessageAndDesc(doc, mesg, desc, equalsDefault, debuggingParam=debuggingParam) endif end subroutine doc_param_real_array @@ -347,7 +345,7 @@ subroutine doc_param_char(doc, varname, desc, units, val, default, & call open_doc_file(doc) if (doc%filesAreOpen) then - mesg = define_string(doc,varname,'"'//trim(val)//'"',units) + mesg = define_string(doc, varname, '"'//trim(val)//'"', units) equalsDefault = .false. if (present(default)) then @@ -414,35 +412,40 @@ subroutine doc_closeBlock(doc, blockName) end subroutine doc_closeBlock !> This subroutine handles parameter documentation for time-type variables. -subroutine doc_param_time(doc, varname, desc, units, val, default, & - layoutParam, debuggingParam) +subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingParam) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented character(len=*), intent(in) :: desc !< A description of the parameter being documented - character(len=*), intent(in) :: units !< The units of the parameter being documented type(time_type), intent(in) :: val !< The value of the parameter type(time_type), optional, intent(in) :: default !< The default value of this parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + character(len=*), optional, intent(in) :: units !< The units of the parameter being documented logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. -! This subroutine handles parameter documentation for time-type variables. -! ### This needs to be written properly! - integer :: numspc - character(len=mLen) :: mesg - logical :: equalsDefault + + ! Local varables + character(len=mLen) :: mesg ! The output message + character(len=doc%commentColumn) :: valstring ! A string with the formatted value. + logical :: equalsDefault ! True if val = default. if (.not. (is_root_pe() .and. associated(doc))) return call open_doc_file(doc) - equalsDefault = .false. if (doc%filesAreOpen) then - numspc = max(1,doc%commentColumn-18-len_trim(varname)) - mesg = "#define "//trim(varname)//" Time-type"//repeat(" ",numspc)//"!" - if (len_trim(units) > 0) mesg = trim(mesg)//" ["//trim(units)//"]" + valstring = time_string(val) + if (present(units)) then + mesg = define_string(doc, varname, valstring, units) + else + mesg = define_string(doc, varname, valstring, "[days : seconds]") + endif + + equalsDefault = .false. + if (present(default)) then + if (val == default) equalsDefault = .true. + mesg = trim(mesg)//" default = "//trim(time_string(default)) + endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates - call writeMessageAndDesc(doc, mesg, desc, equalsDefault, & - layoutParam=layoutParam, debuggingParam=debuggingParam) + call writeMessageAndDesc(doc, mesg, desc, equalsDefault, debuggingParam=debuggingParam) endif end subroutine doc_param_time @@ -545,6 +548,26 @@ end subroutine writeMessageAndDesc ! ---------------------------------------------------------------------- +!> This function returns a string with a time type formatted as seconds (perhaps including a +!! fractional number of seconds) and days +function time_string(time) + type(time_type), intent(in) :: time !< The time type being translated + character(len=40) :: time_string + + ! Local variables + integer :: secs, days, ticks, ticks_per_sec + + call get_time(Time, secs, days, ticks) + + time_string = trim(adjustl(int_string(days))) // ":" // trim(adjustl(int_string(secs))) + if (ticks /= 0) then + ticks_per_sec = get_ticks_per_second() + time_string = trim(time_string) // ":" // & + trim(adjustl(int_string(ticks)))//"/"//trim(adjustl(int_string(ticks_per_sec))) + endif + +end function time_string + !> This function returns a string with a real formatted like '(G)' function real_string(val) real, intent(in) :: val !< The value being written into a string @@ -675,7 +698,7 @@ function logical_string(val) end function logical_string !> This function returns a string for formatted parameter assignment -function define_string(doc,varName,valString,units) +function define_string(doc, varName, valString, units) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varName !< The name of the parameter being documented @@ -696,7 +719,7 @@ function define_string(doc,varName,valString,units) end function define_string !> This function returns a string for formatted false logicals -function undef_string(doc,varName,units) +function undef_string(doc, varName, units) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varName !< The name of the parameter being documented diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 00ed8152c9..8109890736 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1556,8 +1556,7 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & call doc_param(CS%doc, varname, desc, myunits, real_time) endif else - myunits='not defined'; if (present(units)) write(myunits(1:240),'(A)') trim(units) - call doc_param(CS%doc, varname, desc, myunits, value, default) + call doc_param(CS%doc, varname, desc, value, default, units=units) endif endif