Merge pull request #1283 from Hallberg-NOAA/revise_framework

Revise framework

src/core/MOM.F90

@@ -23,8 +23,8 @@ module MOM
 use MOM_diag_mediator,        only : diag_grid_storage, diag_grid_storage_init
 use MOM_diag_mediator,        only : diag_save_grids, diag_restore_grids
 use MOM_diag_mediator,        only : diag_copy_storage_to_diag, diag_copy_diag_to_storage
-use MOM_domains,              only : MOM_domains_init, clone_MOM_domain
-use MOM_domains,              only : sum_across_PEs, pass_var, pass_vector
+use MOM_domain_init,          only : MOM_domains_init
+use MOM_domains,              only : sum_across_PEs, pass_var, pass_vector, clone_MOM_domain
 use MOM_domains,              only : To_North, To_East, To_South, To_West
 use MOM_domains,              only : To_All, Omit_corners, CGRID_NE, SCALAR_PAIR
 use MOM_domains,              only : create_group_pass, do_group_pass, group_pass_type

src/core/MOM_dynamics_split_RK2.F90

@@ -16,7 +16,6 @@ module MOM_dynamics_split_RK2
 use MOM_diag_mediator,     only : disable_averaging, post_data, safe_alloc_ptr
 use MOM_diag_mediator,     only : register_diag_field, register_static_field
 use MOM_diag_mediator,     only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids
-use MOM_domains,           only : MOM_domains_init
 use MOM_domains,           only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR
 use MOM_domains,           only : To_North, To_East, Omit_Corners
 use MOM_domains,           only : create_group_pass, do_group_pass, group_pass_type

src/core/MOM_dynamics_unsplit.F90

@@ -61,9 +61,8 @@ module MOM_dynamics_unsplit
 use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr
 use MOM_diag_mediator, only : register_diag_field, register_static_field
 use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids
-use MOM_domains, only : MOM_domains_init, pass_var, pass_vector
-use MOM_domains, only : pass_var_start, pass_var_complete
-use MOM_domains, only : pass_vector_start, pass_vector_complete
+use MOM_domains, only : pass_var, pass_var_start, pass_var_complete
+use MOM_domains, only : pass_vector, pass_vector_start, pass_vector_complete
 use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
 use MOM_file_parser, only : get_param, log_version, param_file_type

src/core/MOM_dynamics_unsplit_RK2.F90

@@ -59,9 +59,8 @@ module MOM_dynamics_unsplit_RK2
 use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr
 use MOM_diag_mediator, only : register_diag_field, register_static_field
 use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl
-use MOM_domains, only : MOM_domains_init, pass_var, pass_vector
-use MOM_domains, only : pass_var_start, pass_var_complete
-use MOM_domains, only : pass_vector_start, pass_vector_complete
+use MOM_domains, only : pass_var, pass_var_start, pass_var_complete
+use MOM_domains, only : pass_vector, pass_vector_start, pass_vector_complete
 use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
 use MOM_error_handler, only : MOM_set_verbosity

src/core/MOM_grid.F90

@@ -5,7 +5,7 @@ module MOM_grid
 
 use MOM_hor_index, only : hor_index_type, hor_index_init
 use MOM_domains, only : MOM_domain_type, get_domain_extent, compute_block_extent
-use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2
+use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2, deallocate_MOM_domain
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL
 use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
 use MOM_unit_scaling, only : unit_scale_type
@@ -630,8 +630,9 @@ subroutine MOM_grid_end(G)
   deallocate(G%gridLonT) ; deallocate(G%gridLatT)
   deallocate(G%gridLonB) ; deallocate(G%gridLatB)
 
-  deallocate(G%Domain%mpp_domain)
-  deallocate(G%Domain)
+  ! The cursory flag avoids doing any deallocation of memory in the underlying
+  ! infrastructure to avoid problems due to shared pointers.
+  call deallocate_MOM_domain(G%Domain, cursory=.true.)
 
 end subroutine MOM_grid_end
 

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(=)