teshsuite/smpi/mpich3-test/f90/coll/allredopttf90.f90

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