1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
! This file created from f77/coll/allredopttf.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi
integer*8 inbuf, outbuf
double complex zinbuf, zoutbuf
integer wsize
integer errs, ierr
errs = 0
call mtest_init( ierr )
call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
!
! A simple test of allreduce for the optional integer*8 type
inbuf = 1
outbuf = 0
call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM, &
& MPI_COMM_WORLD, ierr)
if (outbuf .ne. wsize ) then
errs = errs + 1
print *, "result wrong for sum with integer*8 = got ", outbuf, &
& " but should have ", wsize
endif
zinbuf = (1,1)
zoutbuf = (0,0)
call mpi_allreduce(zinbuf, zoutbuf, 1, MPI_DOUBLE_COMPLEX, &
& MPI_SUM, MPI_COMM_WORLD, ierr)
if (dreal(zoutbuf) .ne. wsize ) then
errs = errs + 1
print *, "result wrong for sum with double complex = got ", &
& outbuf, " but should have ", wsize
endif
if (dimag(zoutbuf) .ne. wsize ) then
errs = errs + 1
print *, "result wrong for sum with double complex = got ", &
& outbuf, " but should have ", wsize
endif
call mtest_finalize( errs )
end
|
