Skip to content

Commit 25b08dc

Browse files
WeiqunZhangWeiqunZhang
authored
Workaround argument mismatch in MPI reduce for gfortran >= 10 (#2042)
In #2040, we added -fallow-argument-mismatch as a workaround. This commit reverts the change and implements an alternative approach that does not require that compiler compiler. We just need to make sure that there are no argument mismatches in the same file.
1 parent 2255a3c commit 25b08dc

File tree

9 files changed

+167
-59
lines changed

9 files changed

+167
-59
lines changed

‎Src/F_Interfaces/Base/AMReX_fi_mpi_mod.F90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module amrex_fi_mpi
2+
use mpi
3+
implicit none
4+
end module amrex_fi_mpi

‎Src/F_Interfaces/Base/AMReX_mpi_reduce_int.F90

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
! Starting from gfortran 10, mismatches between actual and dummy argument
2+
! lists in a single file have been rejected with an error. This causes
3+
! issues for mpich. https://lists.mpich.org/pipermail/discuss/2020-January/005863.html
4+
! This is a workaroung by splitting calls to int and real into two files.
5+
6+
module amrex_mpi_reduce_int_module
7+
use amrex_fi_mpi
8+
implicit none
9+
private
10+
public :: amrex_mpi_reduce_int, amrex_mpi_allreduce_int
11+
12+
interface amrex_mpi_reduce_int
13+
module procedure amrex_mpi_reduce_int_s
14+
module procedure amrex_mpi_reduce_int_v
15+
end interface amrex_mpi_reduce_int
16+
17+
interface amrex_mpi_allreduce_int
18+
module procedure amrex_mpi_allreduce_int_s
19+
module procedure amrex_mpi_allreduce_int_v
20+
end interface amrex_mpi_allreduce_int
21+
22+
contains
23+
24+
subroutine amrex_mpi_reduce_int_s (sendbuf, recvbuf, count, datatype, op, root, comm, ierror)
25+
integer, intent(in) :: sendbuf
26+
integer, intent(out) :: recvbuf
27+
integer, intent(in) :: count, datatype, op, root, comm
28+
integer, intent(out) :: ierror
29+
integer :: src(1), dst(1)
30+
src(1) = sendbuf
31+
call MPI_Reduce(src, dst, 1, datatype, op, root, comm, ierror)
32+
recvbuf = dst(1)
33+
end subroutine amrex_mpi_reduce_int_s
34+
35+
subroutine amrex_mpi_reduce_int_v (sendbuf, recvbuf, count, datatype, op, root, comm, ierror)
36+
integer, intent(in) :: sendbuf(*)
37+
integer :: recvbuf(*)
38+
integer, intent(in) :: count, datatype, op, root, comm
39+
integer, intent(out) :: ierror
40+
call MPI_Reduce(sendbuf, recvbuf, count, datatype, op, root, comm, ierror)
41+
end subroutine amrex_mpi_reduce_int_v
42+
43+
subroutine amrex_mpi_allreduce_int_s (sendbuf, recvbuf, count, datatype, op, comm, ierror)
44+
integer, intent(in) :: sendbuf
45+
integer, intent(out) :: recvbuf
46+
integer, intent(in) :: count, datatype, op, comm
47+
integer, intent(out) :: ierror
48+
integer :: src(1), dst(1)
49+
src(1) = sendbuf
50+
call MPI_Allreduce(src, dst, 1, datatype, op, comm, ierror)
51+
recvbuf = dst(1)
52+
end subroutine amrex_mpi_allreduce_int_s
53+
54+
subroutine amrex_mpi_allreduce_int_v (sendbuf, recvbuf, count, datatype, op, comm, ierror)
55+
integer, intent(in) :: sendbuf(*)
56+
integer :: recvbuf(*)
57+
integer, intent(in) :: count, datatype, op, comm
58+
integer, intent(out) :: ierror
59+
call MPI_Allreduce(sendbuf, recvbuf, count, datatype, op, comm, ierror)
60+
end subroutine amrex_mpi_allreduce_int_v
61+
62+
end module amrex_mpi_reduce_int_module

‎Src/F_Interfaces/Base/AMReX_mpi_reduce_real.F90

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
! Starting from gfortran 10, mismatches between actual and dummy argument
2+
! lists in a single file have been rejected with an error. This causes
3+
! issues for mpich. https://lists.mpich.org/pipermail/discuss/2020-January/005863.html
4+
! This is a workaroung by splitting calls to int and real into two files.
5+
6+
module amrex_mpi_reduce_real_module
7+
use amrex_fi_mpi
8+
use amrex_fort_module, only : amrex_real
9+
implicit none
10+
private
11+
public :: amrex_mpi_reduce_real, amrex_mpi_allreduce_real
12+
13+
interface amrex_mpi_reduce_real
14+
module procedure amrex_mpi_reduce_real_s
15+
module procedure amrex_mpi_reduce_real_v
16+
end interface amrex_mpi_reduce_real
17+
18+
interface amrex_mpi_allreduce_real
19+
module procedure amrex_mpi_allreduce_real_s
20+
module procedure amrex_mpi_allreduce_real_v
21+
end interface amrex_mpi_allreduce_real
22+
23+
contains
24+
25+
subroutine amrex_mpi_reduce_real_s (sendbuf, recvbuf, count, datatype, op, root, comm, ierror)
26+
real(amrex_real), intent(in) :: sendbuf
27+
real(amrex_real), intent(out) :: recvbuf
28+
integer, intent(in) :: count, datatype, op, root, comm
29+
integer, intent(out) :: ierror
30+
real(amrex_real) :: src(1), dst(1)
31+
src(1) = sendbuf
32+
call MPI_Reduce(src, dst, 1, datatype, op, root, comm, ierror)
33+
recvbuf = dst(1)
34+
end subroutine amrex_mpi_reduce_real_s
35+
36+
subroutine amrex_mpi_reduce_real_v (sendbuf, recvbuf, count, datatype, op, root, comm, ierror)
37+
real(amrex_real), intent(in) :: sendbuf(*)
38+
real(amrex_real) :: recvbuf(*)
39+
integer, intent(in) :: count, datatype, op, root, comm
40+
integer, intent(out) :: ierror
41+
call MPI_Reduce(sendbuf, recvbuf, count, datatype, op, root, comm, ierror)
42+
end subroutine amrex_mpi_reduce_real_v
43+
44+
subroutine amrex_mpi_allreduce_real_s (sendbuf, recvbuf, count, datatype, op, comm, ierror)
45+
real(amrex_real), intent(in) :: sendbuf
46+
real(amrex_real), intent(out) :: recvbuf
47+
integer, intent(in) :: count, datatype, op, comm
48+
integer, intent(out) :: ierror
49+
real(amrex_real) :: src(1), dst(1)
50+
src(1) = sendbuf
51+
call MPI_Allreduce(src, dst, 1, datatype, op, comm, ierror)
52+
recvbuf = dst(1)
53+
end subroutine amrex_mpi_allreduce_real_s
54+
55+
subroutine amrex_mpi_allreduce_real_v (sendbuf, recvbuf, count, datatype, op, comm, ierror)
56+
real(amrex_real), intent(in) :: sendbuf(*)
57+
real(amrex_real) :: recvbuf(*)
58+
integer, intent(in) :: count, datatype, op, comm
59+
integer, intent(out) :: ierror
60+
call MPI_Allreduce(sendbuf, recvbuf, count, datatype, op, comm, ierror)
61+
end subroutine amrex_mpi_allreduce_real_v
62+
63+
end module amrex_mpi_reduce_real_module

‎Src/F_Interfaces/Base/AMReX_parallel_mod.F90

Lines changed: 26 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,10 @@
1-
2-
#ifdef BL_USE_MPI
3-
module amrex_fi_mpi
4-
use mpi
5-
implicit none
6-
end module amrex_fi_mpi
7-
#endif
8-
91
module amrex_parallel_module
102

113
use iso_c_binding
124
#ifdef BL_USE_MPI
135
use amrex_fi_mpi
6+
use amrex_mpi_reduce_int_module, only : amrex_mpi_reduce_int, amrex_mpi_allreduce_int
7+
use amrex_mpi_reduce_real_module, only : amrex_mpi_reduce_real, amrex_mpi_allreduce_real
148
#endif
159

1610
use amrex_error_module
@@ -141,9 +135,9 @@ subroutine amrex_parallel_reduce_sum_is (i, rank)
141135
integer :: tmp, ierr
142136
tmp = i
143137
if (present(rank)) then
144-
call MPI_Reduce(tmp, i, 1, MPI_INTEGER, MPI_SUM, rank, m_comm, ierr)
138+
call amrex_mpi_reduce_int(tmp, i, 1, MPI_INTEGER, MPI_SUM, rank, m_comm, ierr)
145139
else
146-
call MPI_Allreduce(tmp, i, 1, MPI_INTEGER, MPI_SUM, m_comm, ierr)
140+
call amrex_mpi_allreduce_int(tmp, i, 1, MPI_INTEGER, MPI_SUM, m_comm, ierr)
147141
end if
148142
#endif
149143
end subroutine amrex_parallel_reduce_sum_is
@@ -156,9 +150,9 @@ subroutine amrex_parallel_reduce_sum_iv (i, n, rank)
156150
integer :: tmp(n), ierr
157151
tmp = i(1:n)
158152
if (present(rank)) then
159-
call MPI_Reduce(tmp, i, n, MPI_INTEGER, MPI_SUM, rank, m_comm, ierr)
153+
call amrex_mpi_reduce_int(tmp, i, n, MPI_INTEGER, MPI_SUM, rank, m_comm, ierr)
160154
else
161-
call MPI_Allreduce(tmp, i, n, MPI_INTEGER, MPI_SUM, m_comm, ierr)
155+
call amrex_mpi_allreduce_int(tmp, i, n, MPI_INTEGER, MPI_SUM, m_comm, ierr)
162156
end if
163157
#endif
164158
end subroutine amrex_parallel_reduce_sum_iv
@@ -171,9 +165,9 @@ subroutine amrex_parallel_reduce_sum_rs (r, rank)
171165
integer :: ierr
172166
tmp = r
173167
if (present(rank)) then
174-
call MPI_Reduce(tmp, r, 1, amrex_mpi_real, MPI_SUM, rank, m_comm, ierr)
168+
call amrex_mpi_reduce_real(tmp, r, 1, amrex_mpi_real, MPI_SUM, rank, m_comm, ierr)
175169
else
176-
call MPI_Allreduce(tmp, r, 1, amrex_mpi_real, MPI_SUM, m_comm, ierr)
170+
call amrex_mpi_allreduce_real(tmp, r, 1, amrex_mpi_real, MPI_SUM, m_comm, ierr)
177171
end if
178172
#endif
179173
end subroutine amrex_parallel_reduce_sum_rs
@@ -187,9 +181,9 @@ subroutine amrex_parallel_reduce_sum_rv (r, n, rank)
187181
integer :: ierr
188182
tmp = r(1:n)
189183
if (present(rank)) then
190-
call MPI_Reduce(tmp, r, n, amrex_mpi_real, MPI_SUM, rank, m_comm, ierr)
184+
call amrex_mpi_reduce_real(tmp, r, n, amrex_mpi_real, MPI_SUM, rank, m_comm, ierr)
191185
else
192-
call MPI_Allreduce(tmp, r, n, amrex_mpi_real, MPI_SUM, m_comm, ierr)
186+
call amrex_mpi_allreduce_real(tmp, r, n, amrex_mpi_real, MPI_SUM, m_comm, ierr)
193187
end if
194188
#endif
195189
end subroutine amrex_parallel_reduce_sum_rv
@@ -201,9 +195,9 @@ subroutine amrex_parallel_reduce_max_is (i, rank)
201195
integer :: tmp, ierr
202196
tmp = i
203197
if (present(rank)) then
204-
call MPI_Reduce(tmp, i, 1, MPI_INTEGER, MPI_MAX, rank, m_comm, ierr)
198+
call amrex_mpi_reduce_int(tmp, i, 1, MPI_INTEGER, MPI_MAX, rank, m_comm, ierr)
205199
else
206-
call MPI_Allreduce(tmp, i, 1, MPI_INTEGER, MPI_MAX, m_comm, ierr)
200+
call amrex_mpi_allreduce_int(tmp, i, 1, MPI_INTEGER, MPI_MAX, m_comm, ierr)
207201
end if
208202
#endif
209203
end subroutine amrex_parallel_reduce_max_is
@@ -216,9 +210,9 @@ subroutine amrex_parallel_reduce_max_iv (i, n, rank)
216210
integer :: tmp(n), ierr
217211
tmp = i(1:n)
218212
if (present(rank)) then
219-
call MPI_Reduce(tmp, i, n, MPI_INTEGER, MPI_MAX, rank, m_comm, ierr)
213+
call amrex_mpi_reduce_int(tmp, i, n, MPI_INTEGER, MPI_MAX, rank, m_comm, ierr)
220214
else
221-
call MPI_Allreduce(tmp, i, n, MPI_INTEGER, MPI_MAX, m_comm, ierr)
215+
call amrex_mpi_allreduce_int(tmp, i, n, MPI_INTEGER, MPI_MAX, m_comm, ierr)
222216
end if
223217
#endif
224218
end subroutine amrex_parallel_reduce_max_iv
@@ -231,9 +225,9 @@ subroutine amrex_parallel_reduce_max_rs (r, rank)
231225
integer :: ierr
232226
tmp = r
233227
if (present(rank)) then
234-
call MPI_Reduce(tmp, r, 1, amrex_mpi_real, MPI_MAX, rank, m_comm, ierr)
228+
call amrex_mpi_reduce_real(tmp, r, 1, amrex_mpi_real, MPI_MAX, rank, m_comm, ierr)
235229
else
236-
call MPI_Allreduce(tmp, r, 1, amrex_mpi_real, MPI_MAX, m_comm, ierr)
230+
call amrex_mpi_allreduce_real(tmp, r, 1, amrex_mpi_real, MPI_MAX, m_comm, ierr)
237231
end if
238232
#endif
239233
end subroutine amrex_parallel_reduce_max_rs
@@ -247,9 +241,9 @@ subroutine amrex_parallel_reduce_max_rv (r, n, rank)
247241
integer :: ierr
248242
tmp = r(1:n)
249243
if (present(rank)) then
250-
call MPI_Reduce(tmp, r, n, amrex_mpi_real, MPI_MAX, rank, m_comm, ierr)
244+
call amrex_mpi_reduce_real(tmp, r, n, amrex_mpi_real, MPI_MAX, rank, m_comm, ierr)
251245
else
252-
call MPI_Allreduce(tmp, r, n, amrex_mpi_real, MPI_MAX, m_comm, ierr)
246+
call amrex_mpi_allreduce_real(tmp, r, n, amrex_mpi_real, MPI_MAX, m_comm, ierr)
253247
end if
254248
#endif
255249
end subroutine amrex_parallel_reduce_max_rv
@@ -261,9 +255,9 @@ subroutine amrex_parallel_reduce_min_is (i, rank)
261255
integer :: tmp, ierr
262256
tmp = i
263257
if (present(rank)) then
264-
call MPI_Reduce(tmp, i, 1, MPI_INTEGER, MPI_MIN, rank, m_comm, ierr)
258+
call amrex_mpi_reduce_int(tmp, i, 1, MPI_INTEGER, MPI_MIN, rank, m_comm, ierr)
265259
else
266-
call MPI_Allreduce(tmp, i, 1, MPI_INTEGER, MPI_MIN, m_comm, ierr)
260+
call amrex_mpi_allreduce_int(tmp, i, 1, MPI_INTEGER, MPI_MIN, m_comm, ierr)
267261
end if
268262
#endif
269263
end subroutine amrex_parallel_reduce_min_is
@@ -276,9 +270,9 @@ subroutine amrex_parallel_reduce_min_iv (i, n, rank)
276270
integer :: tmp(n), ierr
277271
tmp = i(1:n)
278272
if (present(rank)) then
279-
call MPI_Reduce(tmp, i, n, MPI_INTEGER, MPI_MIN, rank, m_comm, ierr)
273+
call amrex_mpi_reduce_int(tmp, i, n, MPI_INTEGER, MPI_MIN, rank, m_comm, ierr)
280274
else
281-
call MPI_Allreduce(tmp, i, n, MPI_INTEGER, MPI_MIN, m_comm, ierr)
275+
call amrex_mpi_allreduce_int(tmp, i, n, MPI_INTEGER, MPI_MIN, m_comm, ierr)
282276
end if
283277
#endif
284278
end subroutine amrex_parallel_reduce_min_iv
@@ -291,9 +285,9 @@ subroutine amrex_parallel_reduce_min_rs (r, rank)
291285
integer :: ierr
292286
tmp = r
293287
if (present(rank)) then
294-
call MPI_Reduce(tmp, r, 1, amrex_mpi_real, MPI_MIN, rank, m_comm, ierr)
288+
call amrex_mpi_reduce_real(tmp, r, 1, amrex_mpi_real, MPI_MIN, rank, m_comm, ierr)
295289
else
296-
call MPI_Allreduce(tmp, r, 1, amrex_mpi_real, MPI_MIN, m_comm, ierr)
290+
call amrex_mpi_allreduce_real(tmp, r, 1, amrex_mpi_real, MPI_MIN, m_comm, ierr)
297291
end if
298292
#endif
299293
end subroutine amrex_parallel_reduce_min_rs
@@ -307,9 +301,9 @@ subroutine amrex_parallel_reduce_min_rv (r, n, rank)
307301
integer :: ierr
308302
tmp = r(1:n)
309303
if (present(rank)) then
310-
call MPI_Reduce(tmp, r, n, amrex_mpi_real, MPI_MIN, rank, m_comm, ierr)
304+
call amrex_mpi_reduce_real(tmp, r, n, amrex_mpi_real, MPI_MIN, rank, m_comm, ierr)
311305
else
312-
call MPI_Allreduce(tmp, r, n, amrex_mpi_real, MPI_MIN, m_comm, ierr)
306+
call amrex_mpi_allreduce_real(tmp, r, n, amrex_mpi_real, MPI_MIN, m_comm, ierr)
313307
end if
314308
#endif
315309
end subroutine amrex_parallel_reduce_min_rv

‎Src/F_Interfaces/Base/Make.package

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,5 +17,9 @@ CEXE_sources += AMReX_multifabutil_fi.cpp AMReX_physbc_fi.cpp
1717
CEXE_headers += AMReX_FPhysBC.H
1818
CEXE_sources += AMReX_FPhysBC.cpp
1919

20+
ifeq ($(USE_MPI),TRUE)
21+
F90EXE_sources += AMReX_fi_mpi_mod.F90 AMReX_mpi_reduce_int.F90 AMReX_mpi_reduce_real.F90
22+
endif
23+
2024
VPATH_LOCATIONS += $(AMREX_HOME)/Src/F_Interfaces/Base
2125
INCLUDE_LOCATIONS += $(AMREX_HOME)/Src/F_Interfaces/Base

‎Src/F_Interfaces/CMakeLists.txt

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,14 @@ target_sources( amrex PRIVATE
3838
Base/AMReX_FPhysBC.cpp
3939
)
4040

41+
if (AMReX_MPI)
42+
target_sources( amrex PRIVATE
43+
Base/AMReX_fi_mpi_mod.F90
44+
Base/AMReX_mpi_reduce_int.F90
45+
Base/AMReX_mpi_reduce_real.F90
46+
)
47+
endif ()
48+
4149
#
4250
# AMRCORE subdir
4351
#

‎Tools/GNUMake/comps/gnu.mak

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -212,15 +212,6 @@ F90FLAGS += -ffree-line-length-none -fno-range-check -fno-second-underscore -fim
212212

213213
FMODULES = -J$(fmoddir) -I $(fmoddir)
214214

215-
# gcc 10 has treated mismatches between actuall and dummy argument lists
216-
# in a single file as errors. This is a workaround.
217-
ifeq ($(USE_MPI),TRUE)
218-
ifeq ($(gcc_major_ge_10),1)
219-
F90FLAGS += -fallow-argument-mismatch
220-
FFLAGS += -fallow-argument-mismatch
221-
endif
222-
endif
223-
224215
########################################################################
225216

226217
ifneq ($(BL_NO_FORT),TRUE)

‎Tools/GNUMake/comps/hip.mak

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -29,15 +29,6 @@ F90FLAGS := -ffree-line-length-none -fno-range-check -fno-second-underscore -fim
2929

3030
FMODULES = -J$(fmoddir) -I $(fmoddir)
3131

32-
ifeq ($(USE_MPI),TRUE)
33-
gfortran_major_version = $(shell gfortran -dumpfullversion -dumpversion | head -1 | sed -e 's;.* *;;' | sed -e 's;\..*;;')
34-
gfortran_major_ge_10 = $(shell expr $(gfortran_major_version) \>= 10)
35-
ifeq ($(gfortran_major_ge_10),1)
36-
F90FLAGS += -fallow-argument-mismatch
37-
FFLAGS += -fallow-argument-mismatch
38-
endif
39-
endif
40-
4132
# rdc support
4233
CXXFLAGS += -fgpu-rdc
4334
HIPCC_FLAGS += -fgpu-rdc # This will be added to link flags

‎Tools/GNUMake/comps/llvm.mak

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -78,15 +78,6 @@ F90FLAGS += -ffree-line-length-none -fno-range-check -fno-second-underscore -fim
7878

7979
FMODULES = -J$(fmoddir) -I $(fmoddir)
8080

81-
ifeq ($(USE_MPI),TRUE)
82-
gfortran_major_version = $(shell gfortran -dumpfullversion -dumpversion | head -1 | sed -e 's;.* *;;' | sed -e 's;\..*;;')
83-
gfortran_major_ge_10 = $(shell expr $(gfortran_major_version) \>= 10)
84-
ifeq ($(gfortran_major_ge_10),1)
85-
F90FLAGS += -fallow-argument-mismatch
86-
FFLAGS += -fallow-argument-mismatch
87-
endif
88-
endif
89-
9081
########################################################################
9182

9283
GENERIC_COMP_FLAGS =

0 commit comments

Comments
 (0)