+Rename rotated_mpp_chksum to rotated_field_chksum

  Renamed rotated_mpp_chksum to rotated_field_chksum and moved the routines
wrapped by this overloaded interface from MOM_transform_FMS.F90 to
MOM_checksums.F90.  Also provided access to mpp_chksum as field_chksum via
MOM_coms.F90.  Both of these are steps to clean up the MOM6 framework code and
reduce the direct use of mpp routines in the rest of the MOM6 code.  All answers
are bitwise identical, but there are effectively new interfaces, and one
existing interface was renamed.

src/diagnostics/MOM_sum_output.F90

@@ -4,7 +4,7 @@ module MOM_sum_output
 ! This file is part of MOM6. See LICENSE.md for the license.
 
 use iso_fortran_env, only : int64
-use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs
+use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum
 use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP
 use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs
 use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg
@@ -25,7 +25,6 @@ module MOM_sum_output
 use MOM_unit_scaling, only : unit_scale_type
 use MOM_variables, only : surface, thermo_var_ptrs
 use MOM_verticalGrid, only : verticalGrid_type
-use mpp_mod, only : mpp_chksum
 
 use netcdf
 
@@ -1511,13 +1510,13 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum)
   do j=G%jsc,G%jec ; do i=G%isc,G%iec
     field(i,j) = G%bathyT(i,j)
   enddo ; enddo
-  write(depth_chksum, '(Z16)') mpp_chksum(field(:,:))
+  write(depth_chksum, '(Z16)') field_chksum(field(:,:))
 
   ! Area checksum
   do j=G%jsc,G%jec ; do i=G%isc,G%iec
     field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j)
   enddo ; enddo
-  write(area_chksum, '(Z16)') mpp_chksum(field(:,:))
+  write(area_chksum, '(Z16)') field_chksum(field(:,:))
 
   deallocate(field)
 end subroutine get_depth_list_checksums

src/framework/MOM_checksums.F90

@@ -3,10 +3,11 @@ module MOM_checksums
 
 ! This file is part of MOM6. See LICENSE.md for the license.
 
-use MOM_array_transform, only: rotate_array, rotate_array_pair, rotate_vector
+use MOM_array_transform, only : rotate_array, rotate_array_pair, rotate_vector
+use MOM_array_transform, only : allocate_rotated_array
 use MOM_coms, only : PE_here, root_PE, num_PEs, sum_across_PEs
 use MOM_coms, only : min_across_PEs, max_across_PEs
-use MOM_coms, only : reproducing_sum
+use MOM_coms, only : reproducing_sum, field_chksum
 use MOM_error_handler, only : MOM_error, FATAL, is_root_pe
 use MOM_file_parser, only : log_version, param_file_type
 use MOM_hor_index, only : hor_index_type, rotate_hor_index
@@ -15,7 +16,7 @@ module MOM_checksums
 
 implicit none ; private
 
-public :: chksum0, zchksum
+public :: chksum0, zchksum, rotated_field_chksum
 public :: hchksum, Bchksum, uchksum, vchksum, qchksum, is_NaN, chksum
 public :: hchksum_pair, uvchksum, Bchksum_pair
 public :: MOM_checksums_init
@@ -75,6 +76,15 @@ module MOM_checksums
   module procedure is_NaN_0d, is_NaN_1d, is_NaN_2d, is_NaN_3d
 end interface
 
+!> Rotate and compute the checksum of a field
+interface rotated_field_chksum
+  module procedure rotated_field_chksum_real_0d
+  module procedure rotated_field_chksum_real_1d
+  module procedure rotated_field_chksum_real_2d
+  module procedure rotated_field_chksum_real_3d
+  module procedure rotated_field_chksum_real_4d
+end interface rotated_field_chksum
+
 integer, parameter :: bc_modulus = 1000000000 !< Modulus of checksum bitcount
 integer, parameter :: default_shift=0 !< The default array shift
 logical :: calculateStatistics=.true. !< If true, report min, max and mean.
@@ -2021,16 +2031,16 @@ function is_NaN_1d(x, skip_mpp)
   logical :: is_NaN_1d
 
   integer :: i, n
-  logical :: call_mpp
+  logical :: global_check
 
   n = 0
   do i = LBOUND(x,1), UBOUND(x,1)
     if (is_NaN_0d(x(i))) n = n + 1
   enddo
-  call_mpp = .true.
-  if (present(skip_mpp)) call_mpp = .not.skip_mpp
+  global_check = .true.
+  if (present(skip_mpp)) global_check = .not.skip_mpp
 
-  if (call_mpp) call sum_across_PEs(n)
+  if (global_check) call sum_across_PEs(n)
   is_NaN_1d = .false.
   if (n>0) is_NaN_1d = .true.
 
@@ -2072,6 +2082,121 @@ function is_NaN_3d(x)
 
 end function is_NaN_3d
 
+! The following set of routines do a checksum across the computational domain of
+! a field, with the potential for rotation of this field and masking.
+
+!> Compute the field checksum of a scalar.
+function rotated_field_chksum_real_0d(field, pelist, mask_val, turns) &
+    result(chksum)
+  real,              intent(in) :: field      !< Input scalar
+  integer, optional, intent(in) :: pelist(:)  !< PE list of ranks to checksum
+  real,    optional, intent(in) :: mask_val   !< FMS mask value
+  integer, optional, intent(in) :: turns      !< Number of quarter turns
+  integer :: chksum                           !< checksum of scalar
+
+  if (present(turns)) call MOM_error(FATAL, "Rotation not supported for 0d fields.")
+
+  chksum = field_chksum(field, pelist=pelist, mask_val=mask_val)
+end function rotated_field_chksum_real_0d
+
+
+!> Compute the field checksum of a 1d field.
+function rotated_field_chksum_real_1d(field, pelist, mask_val, turns) &
+    result(chksum)
+  real, dimension(:), intent(in) :: field     !< Input array
+  integer,  optional, intent(in) :: pelist(:) !< PE list of ranks to checksum
+  real,     optional, intent(in) :: mask_val  !< FMS mask value
+  integer,  optional, intent(in) :: turns     !< Number of quarter turns
+  integer :: chksum                           !< checksum of array
+
+  if (present(turns)) call MOM_error(FATAL, "Rotation not supported for 1d fields.")
+
+  chksum = field_chksum(field, pelist=pelist, mask_val=mask_val)
+end function rotated_field_chksum_real_1d
+
+
+!> Compute the field checksum of a rotated 2d field.
+function rotated_field_chksum_real_2d(field, pelist, mask_val, turns) &
+    result(chksum)
+  real, dimension(:,:),     intent(in) :: field     !< Unrotated input field
+  integer,        optional, intent(in) :: pelist(:) !< PE list of ranks to checksum
+  real,           optional, intent(in) :: mask_val  !< FMS mask value
+  integer,        optional, intent(in) :: turns     !< Number of quarter turns
+  integer :: chksum                                 !< checksum of array
+
+  ! Local variables
+  real, allocatable :: field_rot(:,:)  ! A rotated version of field, with the same units
+  integer :: qturns ! The number of quarter turns through which to rotate field
+
+  qturns = 0
+  if (present(turns)) &
+    qturns = modulo(turns, 4)
+
+  if (qturns == 0) then
+    chksum = field_chksum(field, pelist=pelist, mask_val=mask_val)
+  else
+    call allocate_rotated_array(field, [1,1], qturns, field_rot)
+    call rotate_array(field, qturns, field_rot)
+    chksum = field_chksum(field_rot, pelist=pelist, mask_val=mask_val)
+    deallocate(field_rot)
+  endif
+end function rotated_field_chksum_real_2d
+
+!> Compute the field checksum of a rotated 3d field.
+function rotated_field_chksum_real_3d(field, pelist, mask_val, turns) &
+    result(chksum)
+  real, dimension(:,:,:),   intent(in) :: field     !< Unrotated input field
+  integer,        optional, intent(in) :: pelist(:) !< PE list of ranks to checksum
+  real,           optional, intent(in) :: mask_val  !< FMS mask value
+  integer,        optional, intent(in) :: turns     !< Number of quarter turns
+  integer :: chksum                                 !< checksum of array
+
+  ! Local variables
+  real, allocatable :: field_rot(:,:,:)  ! A rotated version of field, with the same units
+  integer :: qturns ! The number of quarter turns through which to rotate field
+
+  qturns = 0
+  if (present(turns)) &
+    qturns = modulo(turns, 4)
+
+  if (qturns == 0) then
+    chksum = field_chksum(field, pelist=pelist, mask_val=mask_val)
+  else
+    call allocate_rotated_array(field, [1,1,1], qturns, field_rot)
+    call rotate_array(field, qturns, field_rot)
+    chksum = field_chksum(field_rot, pelist=pelist, mask_val=mask_val)
+    deallocate(field_rot)
+  endif
+end function rotated_field_chksum_real_3d
+
+!> Compute the field checksum of a rotated 4d field.
+function rotated_field_chksum_real_4d(field, pelist, mask_val, turns) &
+    result(chksum)
+  real, dimension(:,:,:,:), intent(in) :: field     !< Unrotated input field
+  integer,        optional, intent(in) :: pelist(:) !< PE list of ranks to checksum
+  real,           optional, intent(in) :: mask_val  !< FMS mask value
+  integer,        optional, intent(in) :: turns     !< Number of quarter turns
+  integer :: chksum                                 !< checksum of array
+
+  ! Local variables
+  real, allocatable :: field_rot(:,:,:,:)  ! A rotated version of field, with the same units
+  integer :: qturns ! The number of quarter turns through which to rotate field
+
+  qturns = 0
+  if (present(turns)) &
+    qturns = modulo(turns, 4)
+
+  if (qturns == 0) then
+    chksum = field_chksum(field, pelist=pelist, mask_val=mask_val)
+  else
+    call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot)
+    call rotate_array(field, qturns, field_rot)
+    chksum = field_chksum(field_rot, pelist=pelist, mask_val=mask_val)
+    deallocate(field_rot)
+  endif
+end function rotated_field_chksum_real_4d
+
+
 !> Write a message including the checksum of the non-shifted array
 subroutine chk_sum_msg1(fmsg, bc0, mesg, iounit)
   character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble

src/framework/MOM_coms.F90

@@ -9,13 +9,13 @@ module MOM_coms
 use memutils_mod, only : print_memuse_stats
 use mpp_mod, only : PE_here => mpp_pe, root_PE => mpp_root_pe, num_PEs => mpp_npes
 use mpp_mod, only : Set_PElist => mpp_set_current_pelist, Get_PElist => mpp_get_current_pelist
-use mpp_mod, only : broadcast => mpp_broadcast
+use mpp_mod, only : broadcast => mpp_broadcast, field_chksum => mpp_chksum
 use mpp_mod, only : sum_across_PEs => mpp_sum, max_across_PEs => mpp_max, min_across_PEs => mpp_min
 
 implicit none ; private
 
 public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end
-public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs
+public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum
 public :: reproducing_sum, reproducing_sum_EFP, EFP_sum_across_PEs, EFP_list_sum_across_PEs
 public :: EFP_plus, EFP_minus, EFP_to_real, real_to_EFP, EFP_real_diff
 public :: operator(+), operator(-), assignment(=)