1 ! This file created from test/mpi/f77/coll/inplacef.f with f77tof90
2 ! -*- Mode: Fortran; -*-
4 ! (C) 2005 by Argonne National Laboratory.
5 ! See COPYRIGHT in top-level directory.
7 ! This is a simple test that Fortran support the MPI_IN_PLACE value
16 parameter (MAX_SIZE=1024)
17 integer rbuf(MAX_SIZE), rdispls(MAX_SIZE), rcount(MAX_SIZE), &
21 call mtest_init( ierr )
24 call mpi_comm_rank( comm, rank, ierr )
25 call mpi_comm_size( comm, size, ierr )
33 if (rank .eq. root) then
34 call mpi_gather( MPI_IN_PLACE, 1, MPI_INTEGER, rbuf, 1, &
35 & MPI_INTEGER, root, comm, ierr )
37 if (rbuf(i) .ne. i-1) then
39 print *, '[',rank,'] rbuf(', i, ') = ', rbuf(i), &
44 call mpi_gather( rank, 1, MPI_INTEGER, rbuf, 1, MPI_INTEGER, &
48 ! Gatherv with inplace
55 if (rank .eq. root) then
56 call mpi_gatherv( MPI_IN_PLACE, 1, MPI_INTEGER, rbuf, rcount, &
57 & rdispls, MPI_INTEGER, root, comm, ierr )
59 if (rbuf(i) .ne. i-1) then
61 print *, '[', rank, '] rbuf(', i, ') = ', rbuf(i), &
66 call mpi_gatherv( rank, 1, MPI_INTEGER, rbuf, rcount, rdispls, &
67 & MPI_INTEGER, root, comm, ierr )
70 ! Scatter with inplace
75 if (rank .eq. root) then
76 call mpi_scatter( sbuf, 1, MPI_INTEGER, MPI_IN_PLACE, 1, &
77 & MPI_INTEGER, root, comm, ierr )
79 call mpi_scatter( sbuf, 1, MPI_INTEGER, rbuf, 1, &
80 & MPI_INTEGER, root, comm, ierr )
81 if (rbuf(1) .ne. rank+1) then
83 print *, '[', rank, '] rbuf = ', rbuf(1), &
88 call mtest_finalize( errs )
89 call mpi_finalize( ierr )