fix: make define_blocks warning a note (#1588)

block_control/block_control.F90

@@ -23,8 +23,9 @@
 
 module block_control_mod
 
-use mpp_mod,         only: mpp_error, NOTE, WARNING, FATAL
+use mpp_mod,         only: mpp_error, NOTE, WARNING, FATAL, mpp_sum, mpp_npes
 use mpp_domains_mod, only: mpp_compute_extent
+use fms_string_utils_mod, only: string
 implicit none
 
 public block_control_type
@@ -104,15 +105,19 @@ subroutine define_blocks (component, Block, isc, iec, jsc, jec, kpts, &
     integer, dimension(ny_block) :: j1, j2
     character(len=256) :: text
     integer :: i, j, nblks, ix, ii, jj
+    integer :: non_uniform_blocks !< Number of non uniform blocks
 
     if (message) then
+      non_uniform_blocks = 0
       if ((mod(iec-isc+1,nx_block) .ne. 0) .or. (mod(jec-jsc+1,ny_block) .ne. 0)) then
-        write( text,'(a,a,2i4,a,2i4,a)' ) trim(component),'define_blocks: domain (',&
-             (iec-isc+1), (jec-jsc+1),') is not an even divisor with definition (',&
-             nx_block, ny_block,') - blocks will not be uniform'
-        call mpp_error (WARNING, trim(text))
+        non_uniform_blocks = 1
+      endif
+      call mpp_sum(non_uniform_blocks)
+      if (non_uniform_blocks > 0 ) then
+        call mpp_error(NOTE, string(non_uniform_blocks)//" out of "//string(mpp_npes())//" total domains "//&
+                       "have non-uniform blocks for block size ("//string(nx_block)//","//string(ny_block)//")")
+        message = .false.
       endif
-      message = .false.
     endif
 
 !--- set up blocks

configure.ac

@@ -533,6 +533,7 @@ AC_CONFIG_FILES([
   test_fms/random_numbers/Makefile
   test_fms/topography/Makefile
   test_fms/column_diagnostics/Makefile
+  test_fms/block_control/Makefile
   FMS.pc
   ])
 

test_fms/Makefile.am

@@ -27,7 +27,7 @@ ACLOCAL_AMFLAGS = -I m4
 SUBDIRS = astronomy coupler diag_manager data_override exchange monin_obukhov drifters \
 mosaic2 interpolator fms mpp mpp_io time_interp time_manager horiz_interp topography \
 field_manager axis_utils affinity fms2_io parser string_utils sat_vapor_pres tracer_manager \
-random_numbers diag_integral column_diagnostics tridiagonal
+random_numbers diag_integral column_diagnostics tridiagonal block_control
 
 # testing utility scripts to distribute
 EXTRA_DIST = test-lib.sh.in intel_coverage.sh.in tap-driver.sh

test_fms/block_control/Makefile.am

@@ -0,0 +1,47 @@
+#***********************************************************************
+#*                   GNU Lesser General Public License
+#*
+#* This file is part of the GFDL Flexible Modeling System (FMS).
+#*
+#* FMS is free software: you can redistribute it and/or modify it under
+#* the terms of the GNU Lesser General Public License as published by
+#* the Free Software Foundation, either version 3 of the License, or (at
+#* your option) any later version.
+#*
+#* FMS is distributed in the hope that it will be useful, but WITHOUT
+#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#* for more details.
+#*
+#* You should have received a copy of the GNU Lesser General Public
+#* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+#***********************************************************************
+
+# This is an automake file for the test_fms/block_control directory of the
+# FMS package.
+
+# Find the fms and mpp mod files.
+AM_CPPFLAGS = -I$(top_srcdir)/include -I$(MODDIR)
+
+# Link to the FMS library.
+LDADD = $(top_builddir)/libFMS/libFMS.la
+
+# Build this test program.
+check_PROGRAMS = \
+  test_block_control
+
+# This is the source code for the test.
+test_block_control_SOURCES = test_block_control.F90
+
+# Run the test program.
+TESTS = test_block_control.sh
+
+# Copy over other needed files to the srcdir
+EXTRA_DIST = test_block_control.sh
+
+TEST_EXTENSIONS = .sh
+SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
+                  $(abs_top_srcdir)/test_fms/tap-driver.sh
+
+# Clean up
+CLEANFILES = input.nml *.out* *.dpi *.spi *.dyn *.spl

test_fms/block_control/test_block_control.F90

@@ -0,0 +1,69 @@
+!***********************************************************************
+!*                   GNU Lesser General Public License
+!*
+!* This file is part of the GFDL Flexible Modeling System (FMS).
+!*
+!* FMS is free software: you can redistribute it and/or modify it under
+!* the terms of the GNU Lesser General Public License as published by
+!* the Free Software Foundation, either version 3 of the License, or (at
+!* your option) any later version.
+!*
+!* FMS is distributed in the hope that it will be useful, but WITHOUT
+!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+!* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+!* for more details.
+!*
+!* You should have received a copy of the GNU Lesser General Public
+!* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+!***********************************************************************
+
+program test_block_control
+  use fms_mod,              only: fms_init, fms_end
+  use mpp_domains_mod,      only: domain2d, mpp_define_domains, mpp_get_compute_domain
+  use block_control_mod,    only: block_control_type, define_blocks
+  use mpp_mod,              only: mpp_pe, mpp_root_pe, mpp_error, FATAL
+  use fms_string_utils_mod, only: string
+
+  implicit none
+
+  integer, parameter :: nx=96                !< Size of the x grid
+  integer, parameter :: ny=96                !< Size of the y grid
+  type(domain2d)     :: Domain               !< 2D domain
+  integer            :: layout(2) = (/2, 3/) !< Layout of the domain
+  type(block_control_type) :: my_block       !< Block control type
+  integer            :: isc, iec, jsc, jec   !< Starting and ending index for the commute domain
+  integer            :: expected_startingy   !< Expected starting y index for the current block
+  integer            :: expected_endingy     !< Expected ending y index for the current block
+  integer            :: ncy(3)               !< Size of the y for each block
+  logical            :: message              !< Set to .True., to output the warning message
+  integer            :: i                    !< For do loops
+
+  call fms_init()
+  message = .True. !< Needs to be .true. so that the error message can be printed
+  call mpp_define_domains( (/1,nx,1,ny/), layout, Domain)
+  call mpp_get_compute_domain(Domain, isc, iec, jsc, jec)
+  call define_blocks ('testing_model', my_block, isc, iec, jsc, jec, kpts=0, &
+                         nx_block=1, ny_block=3, message=message)
+
+  !< Message will be set to .false. if the blocks are not uniform
+  if (message) &
+    call mpp_error(FATAL, "test_block_control::define_blocks did not output the warning message"//&
+                          " about uneven blocks")
+
+  !Expected size of each block for every PE
+  ncy = (/11, 10, 11/)
+  expected_endingy = jsc-1
+  do i = 1, 3
+    ! Check the starting and ending "x" indices for each block
+    if (my_block%ibs(i) .ne. isc .or. my_block%ibe(i) .ne. iec) &
+      call mpp_error(FATAL, "The starting and ending 'x' index for the "//string(i)//" block is not expected value!")
+
+    ! Check the starting and ending "y" indices for each block
+    expected_startingy = expected_endingy + 1
+    expected_endingy = expected_startingy + ncy(i) - 1
+    if (my_block%jbs(i) .ne. expected_startingy .or. my_block%jbe(i) .ne. expected_endingy) &
+    call mpp_error(FATAL, "The starting and ending 'y' index for the "//string(i)//" block is not expected value!")
+  enddo
+
+  call fms_end()
+end program

test_fms/block_control/test_block_control.sh

@@ -0,0 +1,38 @@
+#!/bin/sh
+
+#***********************************************************************
+#*                   GNU Lesser General Public License
+#*
+#* This file is part of the GFDL Flexible Modeling System (FMS).
+#*
+#* FMS is free software: you can redistribute it and/or modify it under
+#* the terms of the GNU Lesser General Public License as published by
+#* the Free Software Foundation, either version 3 of the License, or (at
+#* your option) any later version.
+#*
+#* FMS is distributed in the hope that it will be useful, but WITHOUT
+#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#* for more details.
+#*
+#* You should have received a copy of the GNU Lesser General Public
+#* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+#***********************************************************************
+
+# This is part of the GFDL FMS package. This is a shell script to
+# execute tests in the test_fms/block_control directory.
+
+# Set common test settings.
+. ../test-lib.sh
+
+# Prepare the directory to run the tests.
+cat <<EOF > input.nml
+EOF
+
+# Run the test.
+
+test_expect_success "Test block_control" '
+  mpirun -n 6 ./test_block_control
+'
+
+test_done

test_fms/diag_manager/test_reduction_methods.F90

@@ -135,6 +135,7 @@ program test_reduction_methods
     ddata = allocate_buffer(isd, ied, jsd, jed, nz, nw)
     call init_buffer(ddata, isc, iec, jsc, jec, 2) !< The halos never get set
   case (test_openmp)
+    message = .true.
     if (mpp_pe() .eq. mpp_root_pe()) print *, "Testing the send_data calls with openmp blocks"
      call define_blocks ('testing_model', my_block, isc, iec, jsc, jec, kpts=0, &
                          nx_block=1, ny_block=4, message=message)