diff --git a/block_control/block_control.F90 b/block_control/block_control.F90
index fd385e8266..f78e8659f3 100644
--- a/block_control/block_control.F90
+++ b/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
diff --git a/configure.ac b/configure.ac
index e7dc02506e..0bc6cb557d 100644
--- a/configure.ac
+++ b/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
])
diff --git a/test_fms/Makefile.am b/test_fms/Makefile.am
index 230ad1b164..409cde9765 100644
--- a/test_fms/Makefile.am
+++ b/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
diff --git a/test_fms/block_control/Makefile.am b/test_fms/block_control/Makefile.am
new file mode 100644
index 0000000000..4fc64f93b0
--- /dev/null
+++ b/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 .
+#***********************************************************************
+
+# 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
diff --git a/test_fms/block_control/test_block_control.F90 b/test_fms/block_control/test_block_control.F90
new file mode 100644
index 0000000000..97ff4aa7f6
--- /dev/null
+++ b/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 .
+!***********************************************************************
+
+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
diff --git a/test_fms/block_control/test_block_control.sh b/test_fms/block_control/test_block_control.sh
new file mode 100755
index 0000000000..a5e76f68c3
--- /dev/null
+++ b/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 .
+#***********************************************************************
+
+# 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 < input.nml
+EOF
+
+# Run the test.
+
+test_expect_success "Test block_control" '
+ mpirun -n 6 ./test_block_control
+'
+
+test_done
diff --git a/test_fms/diag_manager/test_reduction_methods.F90 b/test_fms/diag_manager/test_reduction_methods.F90
index 0b09fc69ca..7a0bb8efc6 100644
--- a/test_fms/diag_manager/test_reduction_methods.F90
+++ b/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)