change target to pointer and check for association

.github/workflows/perfmon.yml

@@ -40,14 +40,36 @@ jobs:
         sudo sysctl -w kernel.perf_event_paranoid=2
         make perf DO_REGRESSION_TESTS=true
 
+    # This job assumes that build/target_codebase was cloned above
+    - name: Compile timing tests for reference code
+      if: ${{ github.event_name == 'pull_request' }}
+      run: >-
+        make -j build.timing_target
+        MOM_TARGET_SLUG=$GITHUB_REPOSITORY
+        MOM_TARGET_LOCAL_BRANCH=$GITHUB_BASE_REF
+        DO_REGRESSION_TESTS=true
+
     - name: Compile timing tests
       run: |
         make -j build.timing
 
+    # DO_REGERESSION_TESTS=true is needed here to set the internal macro TARGET_CODEBASE
+    - name: Run timing tests for reference code
+      if: ${{ github.event_name == 'pull_request' }}
+      run: >-
+        make -j run.timing_target
+        DO_REGRESSION_TESTS=true
+
     - name: Run timing tests
       run: |
         make -j run.timing
 
     - name: Display timing results
       run: |
         make -j show.timing
+
+    - name: Display comparison of timing results
+      if: ${{ github.event_name == 'pull_request' }}
+      run: >-
+        make -j compare.timing
+        DO_REGRESSION_TESTS=true

.testing/Makefile

@@ -217,7 +217,6 @@ endif
 
 FMS_SOURCE = $(call SOURCE,deps/fms/src)
 
-
 #---
 # Rules
 
@@ -684,6 +683,24 @@ show.timing: $(foreach f, $(TIMING_EXECS), work/timing/$(f).show)
 $(WORKSPACE)/work/timing/%.show:
 	./tools/disp_timing.py $(@:.show=.out)
 
+# Invoke the above unit/timing rules for a "target" code
+# Invoke with appropriate macros defines, i.e.
+#   make build.timing_target MOM_TARGET_URL=... MOM_TARGET_BRANCH=... TARGET_CODEBASE=build/target_codebase
+#   make run.timing_target TARGET_CODEBASE=build/target_codebase
+
+TIMING_TARGET_EXECS ?= $(basename $(notdir $(wildcard $(TARGET_CODEBASE)/config_src/drivers/timing_tests/*.F90) ) )
+
+.PHONY: build.timing_target
+build.timing_target: $(foreach f, $(TIMING_TARGET_EXECS), $(TARGET_CODEBASE)/.testing/build/timing/$(f))
+.PHONY: run.timing_target
+run.timing_target: $(foreach f, $(TIMING_TARGET_EXECS), $(TARGET_CODEBASE)/.testing/work/timing/$(f).out)
+.PHONY: compare.timing
+compare.timing: $(foreach f, $(filter $(TIMING_EXECS),$(TIMING_TARGET_EXECS)), work/timing/$(f).compare)
+$(WORKSPACE)/work/timing/%.compare: $(TARGET_CODEBASE)
+	./tools/disp_timing.py -r $(TARGET_CODEBASE)/.testing/$(@:.compare=.out) $(@:.compare=.out)
+$(TARGET_CODEBASE)/.testing/%: | $(TARGET_CODEBASE)
+	cd $(TARGET_CODEBASE)/.testing && make $*
+
 # General rule to run a unit test executable
 # Pattern is to run build/unit/executable and direct output to executable.out
 $(WORKSPACE)/work/unit/%.out: build/unit/%

src/core/MOM_open_boundary.F90

@@ -854,7 +854,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF)
 !       if (siz(4) == 1) segment%values_needed = .false.
         if (segment%on_pe) then
           if (OBC%brushcutter_mode .and. (modulo(siz(1),2) == 0 .or. modulo(siz(2),2) == 0)) then
-            write(mesg,'("Brushcutter mode sizes ", I6, I6))') siz(1), siz(2)
+            write(mesg,'("Brushcutter mode sizes ", I6, I6)') siz(1), siz(2)
             call MOM_error(WARNING, mesg // " " // trim(filename) // " " // trim(fieldname))
             call MOM_error(FATAL,'segment data are not on the supergrid')
           endif

src/parameterizations/vertical/MOM_set_diffusivity.F90

@@ -2052,7 +2052,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
   type(diag_ctrl), target,  intent(inout) :: diag !< A structure used to regulate diagnostic output.
   type(set_diffusivity_CS), pointer       :: CS   !< pointer set to point to the module control
                                                   !! structure.
-  type(int_tide_CS),        intent(in), target :: int_tide_CSp !< Internal tide control structure
+  type(int_tide_CS),        pointer       :: int_tide_CSp !< Internal tide control structure
   integer,                  intent(out)   :: halo_TS !< The halo size of tracer points that must be
                                                   !! valid for the calculations in set_diffusivity.
   logical,                  intent(out)   :: double_diffuse !< This indicates whether some version
@@ -2097,7 +2097,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_
   isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
 
   CS%diag => diag
-  CS%int_tide_CSp  => int_tide_CSp
+  if (associated(int_tide_CSp)) CS%int_tide_CSp  => int_tide_CSp
 
   ! These default values always need to be set.
   CS%BBL_mixing_as_max = .true.

src/parameterizations/vertical/MOM_tidal_mixing.F90

@@ -221,7 +221,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
   type(verticalGrid_type),  intent(in)    :: GV         !< Vertical grid structure.
   type(unit_scale_type),    intent(in)    :: US         !< A dimensional unit scaling type
   type(param_file_type),    intent(in)    :: param_file !< Run-time parameter file handle
-  type(int_tide_CS),target, intent(in)    :: int_tide_CSp !< A pointer to the internal tides control structure
+  type(int_tide_CS),        pointer       :: int_tide_CSp !< A pointer to the internal tides control structure
   type(diag_ctrl), target,  intent(inout) :: diag       !< Diagnostics control structure.
   type(tidal_mixing_cs),    intent(inout) :: CS         !< This module's control structure.
 
@@ -276,7 +276,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
 
   CS%debug = CS%debug.and.is_root_pe()
   CS%diag => diag
-  CS%int_tide_CSp  => int_tide_CSp
+  if (associated(int_tide_CSp)) CS%int_tide_CSp  => int_tide_CSp
   CS%use_CVmix_tidal = use_CVmix_tidal
   CS%int_tide_dissipation = int_tide_dissipation
 

src/tracer/MOM_hor_bnd_diffusion.F90

@@ -32,7 +32,7 @@ module MOM_hor_bnd_diffusion
 public boundary_k_range, hor_bnd_diffusion_end
 
 ! Private parameters to avoid doing string comparisons for bottom or top boundary layer
-integer, public, parameter :: SURFACE = -1 !< Set a value that corresponds to the surface bopundary
+integer, public, parameter :: SURFACE = -1 !< Set a value that corresponds to the surface boundary
 integer, public, parameter :: BOTTOM  = 1  !< Set a value that corresponds to the bottom boundary
 #include <MOM_memory.h>
 
@@ -53,7 +53,7 @@ module MOM_hor_bnd_diffusion
                              !! Angstrom or larger without changing it at the bit level [H ~> m or kg m-2].
                              !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m.
   ! HBD dynamic grids
-  real,    allocatable, dimension(:,:,:) :: hbd_grd_u   !< HBD thicknesses at t-points adjecent to
+  real,    allocatable, dimension(:,:,:) :: hbd_grd_u   !< HBD thicknesses at t-points adjacent to
                                                           !! u-points                     [H ~> m or kg m-2]
   real,    allocatable, dimension(:,:,:) :: hbd_grd_v   !< HBD thicknesses at t-points adjacent to
                                                           !! v-points (left and right)    [H ~> m or kg m-2]
@@ -182,11 +182,19 @@ subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS)
                                                             !! [conc H L2 ~> conc m3 or conc kg]
   real, dimension(SZI_(G),SZJB_(G))          :: vwork_2d    !< Layer summed v-flux transport
                                                             !! [conc H L2 ~> conc m3 or conc kg]
-  real, dimension(SZI_(G),SZJ_(G),SZK_(GV))  :: tendency    !< tendency array for diagnostic [conc T-1 ~> conc s-1]
-  real, dimension(SZI_(G),SZJ_(G))           :: tendency_2d !< depth integrated content tendency for diagn
-  type(tracer_type), pointer                 :: tracer => NULL() !< Pointer to the current tracer
+  real, dimension(SZI_(G),SZJ_(G),SZK_(GV))  :: tendency    !< tendency array for diagnostics at first in
+                                                            !! [H conc T-1 ~> m conc s-1 or kg m-2 conc s-1],
+                                                            !! then converted to [conc T-1 ~> conc s-1].
+                                                            ! For temperature these units are
+                                                            ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] and
+                                                            ! then [C T-1 ~> degC s-1].
+  real, dimension(SZI_(G),SZJ_(G))           :: tendency_2d !< depth integrated content tendency for diagnostics in
+                                                            !! [H conc T-1 ~> m conc s-1 or kg m-2 conc s-1].
+                                                            !! For temperature these units are
+                                                            !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1].
+  type(tracer_type), pointer                 :: tracer => NULL() !< Pointer to the current tracer [conc]
   real, dimension(SZI_(G),SZJ_(G),SZK_(GV))  :: tracer_old  !< local copy of the initial tracer concentration,
-                                                            !! only used to compute tendencies.
+                                                            !! only used to compute tendencies [conc].
   real :: tracer_int_prev !< Globally integrated tracer before HBD is applied, in mks units [conc kg]
   real :: tracer_int_end  !< Integrated tracer after HBD is applied, in mks units [conc kg]
   real    :: Idt          !< inverse of the time step [T-1 ~> s-1]
@@ -323,7 +331,7 @@ subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS)
 
 end subroutine hor_bnd_diffusion
 
-!> Build the HBD grid where tracers will be rammaped to.
+!> Build the HBD grid where tracers will be remapped to.
 subroutine hbd_grid(boundary, G, GV, hbl, h, CS)
   integer,                 intent(in   ) :: boundary !< Which boundary layer SURFACE or BOTTOM       [nondim]
   type(ocean_grid_type),   intent(inout) :: G    !< Grid type
@@ -393,8 +401,8 @@ end subroutine hbd_grid
 !> Calculate the harmonic mean of two quantities
 !! See \ref section_harmonic_mean.
 real function harmonic_mean(h1,h2)
-  real :: h1 !< Scalar quantity
-  real :: h2 !< Scalar quantity
+  real :: h1 !< Scalar quantity [arbitrary]
+  real :: h2 !< Scalar quantity [arbitrary]
   if (h1 + h2 == 0.) then
     harmonic_mean = 0.
   else
@@ -407,10 +415,10 @@ end function harmonic_mean
 integer function  find_minimum(x, s, e)
   integer, intent(in) :: s              !< start index
   integer, intent(in) :: e              !< end index
-  real, dimension(e), intent(in) :: x   !< 1D array to be checked
+  real, dimension(e), intent(in) :: x   !< 1D array to be checked [arbitrary]
 
   ! local variables
-  real :: minimum
+  real :: minimum ! Minimum value in the same units as x [arbitrary]
   integer :: location
   integer :: i
 
@@ -427,11 +435,11 @@ end function  find_minimum
 
 !> Swaps the values of its two formal arguments.
 subroutine swap(a, b)
-  real, intent(inout) :: a  !< First value to be swaped
-  real, intent(inout) :: b  !< Second value to be swaped
+  real, intent(inout) :: a  !< First value to be swapped [arbitrary]
+  real, intent(inout) :: b  !< Second value to be swapped [arbitrary]
 
   ! local variables
-  real :: tmp
+  real :: tmp ! A temporary copy of a [arbitrary]
 
   tmp = a
   a = b
@@ -440,8 +448,8 @@ end subroutine swap
 
 !> Receives a 1D array x and sorts it into ascending order.
 subroutine sort(x, n)
-  integer,             intent(in   ) :: n        !< # of pts in the array
-  real, dimension(n),  intent(inout) :: x        !< 1D array to be sorted
+  integer,             intent(in   ) :: n        !< Number of points in the array
+  real, dimension(n),  intent(inout) :: x        !< 1D array to be sorted [arbitrary]
 
   ! local variables
   integer :: i, location
@@ -454,15 +462,15 @@ end subroutine sort
 
 !> Returns the unique values in a 1D array.
 subroutine unique(val, n, val_unique, val_max)
-  integer,                         intent(in   ) :: n          !< # of pts in the array.
-  real, dimension(n),              intent(in   ) :: val        !< 1D array to be checked.
-  real, dimension(:), allocatable, intent(inout) :: val_unique !< Returned 1D array with unique values.
+  integer,                         intent(in   ) :: n          !< Number of points in the array.
+  real, dimension(n),              intent(in   ) :: val        !< 1D array to be checked [arbitrary]
+  real, dimension(:), allocatable, intent(inout) :: val_unique !< Returned 1D array with unique values [arbitrary]
   real,                  optional, intent(in   ) :: val_max    !< sets the maximum value in val_unique to
-                                                               !! this value.
+                                                               !! this value [arbitrary]
   ! local variables
-  real, dimension(n) :: tmp
+  real, dimension(n) :: tmp ! The list of unique values [arbitrary]
   integer :: i, j, ii
-  real :: min_val, max_val
+  real :: min_val, max_val ! The minimum and maximum values in the list [arbitrary]
   logical :: limit
 
   limit = .false.
@@ -510,12 +518,14 @@ subroutine merge_interfaces(nk, h_L, h_R, hbl_L, hbl_R, H_subroundoff, h)
 
   ! Local variables
   integer                         :: n           !< Number of layers in eta_all
-  real, dimension(nk+1)           :: eta_L, eta_R!< Interfaces in the left and right coloumns
-  real, dimension(:), allocatable :: eta_all     !< Combined interfaces in the left/right columns + hbl_L and hbl_R
-  real, dimension(:), allocatable :: eta_unique  !< Combined interfaces (eta_L, eta_R), possibly hbl_L and hbl_R
-  real                            :: min_depth   !< Minimum depth
-  real                            :: max_depth   !< Maximum depth
-  real                            :: max_bld     !< Deepest BLD
+  real, dimension(nk+1)           :: eta_L, eta_R!< Interfaces in the left and right columns [H ~> m or kg m-2]
+  real, dimension(:), allocatable :: eta_all     !< Combined list of interfaces in the left and right columns
+                                                 !! plus hbl_L and hbl_R [H ~> m or kg m-2]
+  real, dimension(:), allocatable :: eta_unique  !< Combined list of unique interfaces (eta_L, eta_R), possibly
+                                                 !! hbl_L and hbl_R [H ~> m or kg m-2]
+  real                            :: min_depth   !< Minimum depth [H ~> m or kg m-2]
+  real                            :: max_depth   !< Maximum depth [H ~> m or kg m-2]
+  real                            :: max_bld     !< Deepest BLD [H ~> m or kg m-2]
   integer :: k, kk, nk1                          !< loop indices (k and kk) and array size (nk1)
 
   n = (2*nk)+3
@@ -564,7 +574,7 @@ subroutine flux_limiter(F_layer, area_L, area_R, phi_L, phi_R, h_L, h_R)
   real, intent(in) :: phi_R      !< Tracer concentration in the right cell [conc]
 
   ! local variables
-  real :: F_max !< maximum flux allowed
+  real :: F_max !< maximum flux allowed [conc H L2 ~> conc m3 or conc kg]
   ! limit the flux to 0.2 of the tracer *gradient*
   ! Why 0.2?
   !  t=0         t=inf
@@ -723,7 +733,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_
   ! thicknesses at velocity points & khtr_u at layer centers
   do k = 1,ke
     h_vel(k)   = harmonic_mean(h_L(k), h_R(k))
-    ! GMM, writting 0.5 * (A(k) + A(k+1)) as A(k) + 0.5 * (A(k+1) - A(k)) to recover
+    ! GMM, writing 0.5 * (A(k) + A(k+1)) as A(k) + 0.5 * (A(k+1) - A(k)) to recover
     ! answers with depth-independent khtr
     khtr_ul(k) = khtr_u(k) + 0.5 * (khtr_u(k+1) - khtr_u(k))
   enddo
@@ -741,7 +751,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_
     k_bot_max = MAX(k_bot_L, k_bot_R)
     k_bot_diff = (k_bot_max - k_bot_min)
 
-    ! tracer flux where the minimum BLD intersets layer
+    ! tracer flux where the minimum BLD intersects layer
     if ((CS%linear) .and. (k_bot_diff > 1)) then
       ! apply linear decay at the base of hbl
       do k = k_bot_min,1,-1
@@ -815,17 +825,17 @@ logical function near_boundary_unit_tests( verbose )
   ! Local variables
   integer, parameter    :: nk = 2               ! Number of layers
   real, dimension(nk+1) :: eta1                 ! Updated interfaces with one extra value           [m]
-  real, dimension(:), allocatable :: h1         ! Upates layer thicknesses                          [m]
+  real, dimension(:), allocatable :: h1         ! Updated list of layer thicknesses or other field  [m] or [arbitrary]
   real, dimension(nk)   :: phi_L, phi_R         ! Tracer values (left and right column)             [conc]
   real, dimension(nk)   :: h_L, h_R             ! Layer thickness (left and right)                  [m]
   real, dimension(nk+1) :: khtr_u               ! Horizontal diffusivities at U-point and interfaces[m2 s-1]
   real                  :: hbl_L, hbl_R         ! Depth of the boundary layer (left and right)      [m]
   real, dimension(nk)   :: F_layer              ! Diffusive flux within each layer at U-point       [conc m3 s-1]
   character(len=120)    :: test_name            ! Title of the unit test
   integer               :: k_top                ! Index of cell containing top of boundary
-  real                  :: zeta_top             ! Nondimension position                             [nondim]
+  real                  :: zeta_top             ! Fractional position in the cell of the top        [nondim]
   integer               :: k_bot                ! Index of cell containing bottom of boundary
-  real                  :: zeta_bot             ! Nondimension position                             [nondim]
+  real                  :: zeta_bot             ! Fractional position in the cell of the bottom     [nondim]
   type(hbd_CS), pointer :: CS
 
   allocate(CS)
@@ -1058,8 +1068,8 @@ logical function test_layer_fluxes(verbose, nk, test_name, F_calc, F_ans)
   logical,                    intent(in) :: verbose   !< If true, write results to stdout
   character(len=80),          intent(in) :: test_name !< Brief description of the unit test
   integer,                    intent(in) :: nk        !< Number of layers
-  real, dimension(nk),        intent(in) :: F_calc    !< Fluxes of the unitless tracer from the algorithm [s^-1]
-  real, dimension(nk),        intent(in) :: F_ans     !< Fluxes of the unitless tracer calculated by hand [s^-1]
+  real, dimension(nk),        intent(in) :: F_calc    !< Fluxes or other quantity from the algorithm [arbitrary]
+  real, dimension(nk),        intent(in) :: F_ans     !< Expected value calculated by hand [arbitrary]
   ! Local variables
   integer :: k
 
@@ -1081,13 +1091,13 @@ end function test_layer_fluxes
 logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_ans, zeta_top_ans,&
                                        k_bot_ans, zeta_bot_ans, test_name, verbose)
   integer :: k_top               !< Index of cell containing top of boundary
-  real    :: zeta_top            !< Nondimension position
+  real    :: zeta_top            !< Fractional position in the cell of the top boundary [nondim]
   integer :: k_bot               !< Index of cell containing bottom of boundary
-  real    :: zeta_bot            !< Nondimension position
-  integer :: k_top_ans           !< Index of cell containing top of boundary
-  real    :: zeta_top_ans        !< Nondimension position
-  integer :: k_bot_ans           !< Index of cell containing bottom of boundary
-  real    :: zeta_bot_ans        !< Nondimension position
+  real    :: zeta_bot            !< Fractional position in the cell of the bottom boundary [nondim]
+  integer :: k_top_ans           !< Expected index of cell containing top of boundary
+  real    :: zeta_top_ans        !< Expected fractional position of the top boundary [nondim]
+  integer :: k_bot_ans           !< Expected index of cell containing bottom of boundary
+  real    :: zeta_bot_ans        !< Expected fractional position of the bottom boundary [nondim]
   character(len=80) :: test_name !< Name of the unit test
   logical :: verbose             !< If true always print output