Skip to content

Commit 174105e

Browse files
uramirez8707uramirez8707
authored
fix: make define_blocks warning a note (#1588)
1 parent 644cbd3 commit 174105e

File tree

7 files changed

+168
-7
lines changed

7 files changed

+168
-7
lines changed

‎block_control/block_control.F90‎

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,9 @@
2323

2424
module block_control_mod
2525

26-
use mpp_mod, only: mpp_error, NOTE, WARNING, FATAL
26+
use mpp_mod, only: mpp_error, NOTE, WARNING, FATAL, mpp_sum, mpp_npes
2727
use mpp_domains_mod, only: mpp_compute_extent
28+
use fms_string_utils_mod, only: string
2829
implicit none
2930

3031
public block_control_type
@@ -104,15 +105,19 @@ subroutine define_blocks (component, Block, isc, iec, jsc, jec, kpts, &
104105
integer, dimension(ny_block) :: j1, j2
105106
character(len=256) :: text
106107
integer :: i, j, nblks, ix, ii, jj
108+
integer :: non_uniform_blocks !< Number of non uniform blocks
107109

108110
if (message) then
111+
non_uniform_blocks = 0
109112
if ((mod(iec-isc+1,nx_block) .ne. 0) .or. (mod(jec-jsc+1,ny_block) .ne. 0)) then
110-
write( text,'(a,a,2i4,a,2i4,a)' ) trim(component),'define_blocks: domain (',&
111-
(iec-isc+1), (jec-jsc+1),') is not an even divisor with definition (',&
112-
nx_block, ny_block,') - blocks will not be uniform'
113-
call mpp_error (WARNING, trim(text))
113+
non_uniform_blocks = 1
114+
endif
115+
call mpp_sum(non_uniform_blocks)
116+
if (non_uniform_blocks > 0 ) then
117+
call mpp_error(NOTE, string(non_uniform_blocks)//" out of "//string(mpp_npes())//" total domains "//&
118+
"have non-uniform blocks for block size ("//string(nx_block)//","//string(ny_block)//")")
119+
message = .false.
114120
endif
115-
message = .false.
116121
endif
117122

118123
!--- set up blocks

‎configure.ac‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -533,6 +533,7 @@ AC_CONFIG_FILES([
533533
test_fms/random_numbers/Makefile
534534
test_fms/topography/Makefile
535535
test_fms/column_diagnostics/Makefile
536+
test_fms/block_control/Makefile
536537
FMS.pc
537538
])
538539

‎test_fms/Makefile.am‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ ACLOCAL_AMFLAGS = -I m4
2727
SUBDIRS = astronomy coupler diag_manager data_override exchange monin_obukhov drifters \
2828
mosaic2 interpolator fms mpp mpp_io time_interp time_manager horiz_interp topography \
2929
field_manager axis_utils affinity fms2_io parser string_utils sat_vapor_pres tracer_manager \
30-
random_numbers diag_integral column_diagnostics tridiagonal
30+
random_numbers diag_integral column_diagnostics tridiagonal block_control
3131

3232
# testing utility scripts to distribute
3333
EXTRA_DIST = test-lib.sh.in intel_coverage.sh.in tap-driver.sh

‎test_fms/block_control/Makefile.am‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
#***********************************************************************
2+
#* GNU Lesser General Public License
3+
#*
4+
#* This file is part of the GFDL Flexible Modeling System (FMS).
5+
#*
6+
#* FMS is free software: you can redistribute it and/or modify it under
7+
#* the terms of the GNU Lesser General Public License as published by
8+
#* the Free Software Foundation, either version 3 of the License, or (at
9+
#* your option) any later version.
10+
#*
11+
#* FMS is distributed in the hope that it will be useful, but WITHOUT
12+
#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13+
#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14+
#* for more details.
15+
#*
16+
#* You should have received a copy of the GNU Lesser General Public
17+
#* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18+
#***********************************************************************
19+
20+
# This is an automake file for the test_fms/block_control directory of the
21+
# FMS package.
22+
23+
# Find the fms and mpp mod files.
24+
AM_CPPFLAGS = -I$(top_srcdir)/include -I$(MODDIR)
25+
26+
# Link to the FMS library.
27+
LDADD = $(top_builddir)/libFMS/libFMS.la
28+
29+
# Build this test program.
30+
check_PROGRAMS = \
31+
test_block_control
32+
33+
# This is the source code for the test.
34+
test_block_control_SOURCES = test_block_control.F90
35+
36+
# Run the test program.
37+
TESTS = test_block_control.sh
38+
39+
# Copy over other needed files to the srcdir
40+
EXTRA_DIST = test_block_control.sh
41+
42+
TEST_EXTENSIONS = .sh
43+
SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
44+
$(abs_top_srcdir)/test_fms/tap-driver.sh
45+
46+
# Clean up
47+
CLEANFILES = input.nml *.out* *.dpi *.spi *.dyn *.spl

‎test_fms/block_control/test_block_control.F90‎

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
!***********************************************************************
2+
!* GNU Lesser General Public License
3+
!*
4+
!* This file is part of the GFDL Flexible Modeling System (FMS).
5+
!*
6+
!* FMS is free software: you can redistribute it and/or modify it under
7+
!* the terms of the GNU Lesser General Public License as published by
8+
!* the Free Software Foundation, either version 3 of the License, or (at
9+
!* your option) any later version.
10+
!*
11+
!* FMS is distributed in the hope that it will be useful, but WITHOUT
12+
!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13+
!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14+
!* for more details.
15+
!*
16+
!* You should have received a copy of the GNU Lesser General Public
17+
!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18+
!***********************************************************************
19+
20+
program test_block_control
21+
use fms_mod, only: fms_init, fms_end
22+
use mpp_domains_mod, only: domain2d, mpp_define_domains, mpp_get_compute_domain
23+
use block_control_mod, only: block_control_type, define_blocks
24+
use mpp_mod, only: mpp_pe, mpp_root_pe, mpp_error, FATAL
25+
use fms_string_utils_mod, only: string
26+
27+
implicit none
28+
29+
integer, parameter :: nx=96 !< Size of the x grid
30+
integer, parameter :: ny=96 !< Size of the y grid
31+
type(domain2d) :: Domain !< 2D domain
32+
integer :: layout(2) = (/2, 3/) !< Layout of the domain
33+
type(block_control_type) :: my_block !< Block control type
34+
integer :: isc, iec, jsc, jec !< Starting and ending index for the commute domain
35+
integer :: expected_startingy !< Expected starting y index for the current block
36+
integer :: expected_endingy !< Expected ending y index for the current block
37+
integer :: ncy(3) !< Size of the y for each block
38+
logical :: message !< Set to .True., to output the warning message
39+
integer :: i !< For do loops
40+
41+
call fms_init()
42+
message = .True. !< Needs to be .true. so that the error message can be printed
43+
call mpp_define_domains( (/1,nx,1,ny/), layout, Domain)
44+
call mpp_get_compute_domain(Domain, isc, iec, jsc, jec)
45+
call define_blocks ('testing_model', my_block, isc, iec, jsc, jec, kpts=0, &
46+
nx_block=1, ny_block=3, message=message)
47+
48+
!< Message will be set to .false. if the blocks are not uniform
49+
if (message) &
50+
call mpp_error(FATAL, "test_block_control::define_blocks did not output the warning message"//&
51+
" about uneven blocks")
52+
53+
!Expected size of each block for every PE
54+
ncy = (/11, 10, 11/)
55+
expected_endingy = jsc-1
56+
do i = 1, 3
57+
! Check the starting and ending "x" indices for each block
58+
if (my_block%ibs(i) .ne. isc .or. my_block%ibe(i) .ne. iec) &
59+
call mpp_error(FATAL, "The starting and ending 'x' index for the "//string(i)//" block is not expected value!")
60+
61+
! Check the starting and ending "y" indices for each block
62+
expected_startingy = expected_endingy + 1
63+
expected_endingy = expected_startingy + ncy(i) - 1
64+
if (my_block%jbs(i) .ne. expected_startingy .or. my_block%jbe(i) .ne. expected_endingy) &
65+
call mpp_error(FATAL, "The starting and ending 'y' index for the "//string(i)//" block is not expected value!")
66+
enddo
67+
68+
call fms_end()
69+
end program

‎test_fms/block_control/test_block_control.sh‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
#!/bin/sh
2+
3+
#***********************************************************************
4+
#* GNU Lesser General Public License
5+
#*
6+
#* This file is part of the GFDL Flexible Modeling System (FMS).
7+
#*
8+
#* FMS is free software: you can redistribute it and/or modify it under
9+
#* the terms of the GNU Lesser General Public License as published by
10+
#* the Free Software Foundation, either version 3 of the License, or (at
11+
#* your option) any later version.
12+
#*
13+
#* FMS is distributed in the hope that it will be useful, but WITHOUT
14+
#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15+
#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16+
#* for more details.
17+
#*
18+
#* You should have received a copy of the GNU Lesser General Public
19+
#* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
20+
#***********************************************************************
21+
22+
# This is part of the GFDL FMS package. This is a shell script to
23+
# execute tests in the test_fms/block_control directory.
24+
25+
# Set common test settings.
26+
. ../test-lib.sh
27+
28+
# Prepare the directory to run the tests.
29+
cat <<EOF > input.nml
30+
EOF
31+
32+
# Run the test.
33+
34+
test_expect_success "Test block_control" '
35+
mpirun -n 6 ./test_block_control
36+
'
37+
38+
test_done

‎test_fms/diag_manager/test_reduction_methods.F90‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,7 @@ program test_reduction_methods
135135
ddata = allocate_buffer(isd, ied, jsd, jed, nz, nw)
136136
call init_buffer(ddata, isc, iec, jsc, jec, 2) !< The halos never get set
137137
case (test_openmp)
138+
message = .true.
138139
if (mpp_pe() .eq. mpp_root_pe()) print *, "Testing the send_data calls with openmp blocks"
139140
call define_blocks ('testing_model', my_block, isc, iec, jsc, jec, kpts=0, &
140141
nx_block=1, ny_block=4, message=message)

0 commit comments

Comments
 (0)