|
Packit |
0848f5 |
C -*- Mode: Fortran; -*-
|
|
Packit |
0848f5 |
C
|
|
Packit |
0848f5 |
C (C) 2007 by Argonne National Laboratory.
|
|
Packit |
0848f5 |
C See COPYRIGHT in top-level directory.
|
|
Packit |
0848f5 |
C
|
|
Packit |
0848f5 |
program main
|
|
Packit |
0848f5 |
implicit none
|
|
Packit |
0848f5 |
include 'mpif.h'
|
|
Packit |
0848f5 |
integer*8 inbuf, outbuf
|
|
Packit |
0848f5 |
double complex zinbuf, zoutbuf
|
|
Packit |
0848f5 |
integer wsize
|
|
Packit |
0848f5 |
integer errs, ierr
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
errs = 0
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call mtest_init( ierr )
|
|
Packit |
0848f5 |
call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
|
|
Packit |
0848f5 |
C
|
|
Packit |
0848f5 |
C A simple test of allreduce for the optional integer*8 type
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
inbuf = 1
|
|
Packit |
0848f5 |
outbuf = 0
|
|
Packit |
0848f5 |
call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM,
|
|
Packit |
0848f5 |
& MPI_COMM_WORLD, ierr)
|
|
Packit |
0848f5 |
if (outbuf .ne. wsize ) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, "result wrong for sum with integer*8 = got ", outbuf,
|
|
Packit |
0848f5 |
& " but should have ", wsize
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
zinbuf = (1,1)
|
|
Packit |
0848f5 |
zoutbuf = (0,0)
|
|
Packit |
0848f5 |
call mpi_allreduce(zinbuf, zoutbuf, 1, MPI_DOUBLE_COMPLEX,
|
|
Packit |
0848f5 |
& MPI_SUM, MPI_COMM_WORLD, ierr)
|
|
Packit |
0848f5 |
if (dreal(zoutbuf) .ne. wsize ) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, "result wrong for sum with double complex = got ",
|
|
Packit |
0848f5 |
& outbuf, " but should have ", wsize
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
if (dimag(zoutbuf) .ne. wsize ) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, "result wrong for sum with double complex = got ",
|
|
Packit |
0848f5 |
& outbuf, " but should have ", wsize
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
call mtest_finalize( errs )
|
|
Packit |
0848f5 |
call mpi_finalize( ierr )
|
|
Packit |
0848f5 |
end
|