Merge branch 'dev/gfdl' into solo_forcing_timelevels

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_diag_remap.F90

@@ -820,9 +820,11 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
   logical, dimension(:),   intent(out) :: averaged_mask  !< Mask for horizontally averaged field [nondim]
 
   ! Local variables
-  real :: volume(G%isc:G%iec, G%jsc:G%jec, size(field,3)) ! The area [m2], volume [m3] or mass [kg] of each cell.
+  real :: volume(G%isc:G%iec, G%jsc:G%jec, size(field,3)) ! The area [L2 ~> m2], volume [L2 m ~> m3]
+                                             ! or mass [L2 kg m-2 ~> kg] of each cell.
   real :: stuff(G%isc:G%iec, G%jsc:G%jec, size(field,3))  ! The area, volume or mass-weighted integral of the
-                                             ! field being averaged in each cell, in [m2 A], [m3 A] or [kg A],
+                                             ! field being averaged in each cell, in [L2 a ~> m2 A],
+                                             ! [L2 m a ~> m3 A] or [L2 kg m-2 A ~> kg A],
                                              ! depending on the weighting for the averages and whether the
                                              ! model makes the Boussinesq approximation.
   real, dimension(size(field, 3)) :: vol_sum   ! The global sum of the areas [m2], volumes [m3] or mass [kg]
@@ -847,22 +849,21 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
         stuff_sum(k) = 0.
         if (is_extensive) then
           do j=G%jsc, G%jec ; do I=G%isc, G%iec
-            volume(I,j,k) = (G%US%L_to_m**2 * G%areaCu(I,j)) * G%mask2dCu(I,j)
+            volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j)
             stuff(I,j,k) = volume(I,j,k) * field(I,j,k)
           enddo ; enddo
         else ! Intensive
           do j=G%jsc, G%jec ; do I=G%isc, G%iec
             height = 0.5 * (h(i,j,k) + h(i+1,j,k))
-            volume(I,j,k) = (G%US%L_to_m**2 * G%areaCu(I,j)) &
-                * (GV%H_to_MKS * height) * G%mask2dCu(I,j)
+            volume(I,j,k) = G%areaCu(I,j)  * (GV%H_to_MKS * height) * G%mask2dCu(I,j)
             stuff(I,j,k) = volume(I,j,k) * field(I,j,k)
           enddo ; enddo
         endif
       enddo
     else ! Interface
       do k=1,nz
         do j=G%jsc, G%jec ; do I=G%isc, G%iec
-          volume(I,j,k) = (G%US%L_to_m**2 * G%areaCu(I,j)) * G%mask2dCu(I,j)
+          volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j)
           stuff(I,j,k) = volume(I,j,k) * field(I,j,k)
         enddo ; enddo
       enddo
@@ -873,22 +874,21 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
       do k=1,nz
         if (is_extensive) then
           do J=G%jsc, G%jec ; do i=G%isc, G%iec
-            volume(i,J,k) = (G%US%L_to_m**2 * G%areaCv(i,J)) * G%mask2dCv(i,J)
+            volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J)
             stuff(i,J,k) = volume(i,J,k) * field(i,J,k)
           enddo ; enddo
         else ! Intensive
           do J=G%jsc, G%jec ; do i=G%isc, G%iec
             height = 0.5 * (h(i,j,k) + h(i,j+1,k))
-            volume(i,J,k) = (G%US%L_to_m**2 * G%areaCv(i,J)) &
-                * (GV%H_to_MKS * height) * G%mask2dCv(i,J)
+            volume(i,J,k) = G%areaCv(i,J) * (GV%H_to_MKS * height) * G%mask2dCv(i,J)
             stuff(i,J,k) = volume(i,J,k) * field(i,J,k)
           enddo ; enddo
         endif
       enddo
     else ! Interface
       do k=1,nz
         do J=G%jsc, G%jec ; do i=G%isc, G%iec
-          volume(i,J,k) = (G%US%L_to_m**2 * G%areaCv(i,J)) * G%mask2dCv(i,J)
+          volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J)
           stuff(i,J,k) = volume(i,J,k) * field(i,J,k)
         enddo ; enddo
       enddo
@@ -900,7 +900,7 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
         if (is_extensive) then
           do j=G%jsc, G%jec ; do i=G%isc, G%iec
             if (h(i,j,k) > 0.) then
-              volume(i,j,k) = (G%US%L_to_m**2 * G%areaT(i,j)) * G%mask2dT(i,j)
+              volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j)
               stuff(i,j,k) = volume(i,j,k) * field(i,j,k)
             else
               volume(i,j,k) = 0.
@@ -909,16 +909,15 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
           enddo ; enddo
         else ! Intensive
           do j=G%jsc, G%jec ; do i=G%isc, G%iec
-            volume(i,j,k) = (G%US%L_to_m**2 * G%areaT(i,j)) &
-                * (GV%H_to_MKS * h(i,j,k)) * G%mask2dT(i,j)
+            volume(i,j,k) = G%areaT(i,j) * (GV%H_to_MKS * h(i,j,k)) * G%mask2dT(i,j)
             stuff(i,j,k) = volume(i,j,k) * field(i,j,k)
           enddo ; enddo
         endif
       enddo
     else ! Interface
       do k=1,nz
         do j=G%jsc, G%jec ; do i=G%isc, G%iec
-          volume(i,j,k) = (G%US%L_to_m**2 * G%areaT(i,j)) * G%mask2dT(i,j)
+          volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j)
           stuff(i,j,k) = volume(i,j,k) * field(i,j,k)
         enddo ; enddo
       enddo
@@ -930,8 +929,8 @@ subroutine horizontally_average_field(G, GV, isdf, jsdf, h, staggered_in_x, stag
   ! Packing the sums into a single array with a single call to sum across PEs saves reduces
   ! the costs of communication.
   do k=1,nz
-    sums_EFP(2*k-1) = reproducing_sum_EFP(volume(:,:,k), only_on_PE=.true.)
-    sums_EFP(2*k)   = reproducing_sum_EFP(stuff(:,:,k), only_on_PE=.true.)
+    sums_EFP(2*k-1) = reproducing_sum_EFP(volume(:,:,k), only_on_PE=.true., unscale=G%US%L_to_m**2)
+    sums_EFP(2*k)   = reproducing_sum_EFP(stuff(:,:,k), only_on_PE=.true., unscale=G%US%L_to_m**2)
   enddo
   call EFP_sum_across_PEs(sums_EFP, 2*nz)
   do k=1,nz

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