Merge branch 'dev/gfdl' into fix_ALE_sponge_diagnostic

Author: marshallward

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,

src/framework/MOM_coms.F90

@@ -412,6 +412,7 @@ function reproducing_sum_3d(array, isr, ier, jsr, jer, sums, EFP_sum, EFP_lay_su
 
   do_sum_across_PEs = .true. ; if (present(only_on_PE)) do_sum_across_PEs = .not.only_on_PE
   do_unscale = .false. ; if (present(unscale)) do_unscale = (unscale /= 1.0)
+  descale = 1.0 ; if (do_unscale) descale = unscale
 
   if (present(sums) .or. present(EFP_lay_sums)) then
     if (present(sums)) then ; if (size(sums) < ke) then

src/framework/MOM_document.F90

@@ -221,15 +221,16 @@ 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
   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
   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

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, &

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

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,22 +385,22 @@ 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.
       ! This makes sense as long as either phases are overridden, or
       ! 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