1 C -*- Mode: Fortran; -*-
3 C (C) 2012 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
6 C A simple test for Fortran support of the MPI_IN_PLACE value in Alltoall[vw].
13 parameter (MAX_SIZE=1024)
14 integer rbuf(MAX_SIZE)
15 integer rdispls(MAX_SIZE), rcounts(MAX_SIZE), rtypes(MAX_SIZE)
19 integer iexpected, igot
23 call mtest_init( ierr )
26 call mpi_comm_rank( comm, rank, ierr )
27 call mpi_comm_size( comm, size, ierr )
28 call mpi_type_size( MPI_INTEGER, SIZEOFINT, ierr )
30 if (size .gt. MAX_SIZE) then
31 print *, ' At most ', MAX_SIZE, ' processes allowed'
32 call mpi_abort( MPI_COMM_WORLD, 1, ierr )
39 rbuf(i) = (i-1) * size + rank
41 call mpi_alltoall( MPI_IN_PLACE, -1, MPI_DATATYPE_NULL,
42 $ rbuf, 1, MPI_INTEGER, comm, ierr )
44 if (rbuf(i) .ne. (rank*size + i - 1)) then
46 print *, '[', rank, '] rbuf(', i, ') = ', rbuf(i),
47 $ ', should be', rank * size + i - 1
55 rcounts(i) = (i-1) + rank
56 rdispls(i) = (i-1) * (2*size)
58 rbuf(rdispls(i)+j+1) = 100 * rank + 10 * (i-1) + j
61 call mpi_alltoallv( MPI_IN_PLACE, 0, 0, MPI_DATATYPE_NULL,
62 $ rbuf, rcounts, rdispls, MPI_INTEGER,
66 iexpected = 100 * (i-1) + 10 * rank + j
67 igot = rbuf(rdispls(i)+j+1)
68 if ( igot .ne. iexpected ) then
70 print *, '[', rank, '] ALLTOALLV got ', igot,
71 $ ',but expected ', iexpected,
72 $ ' for block=', i-1, ' element=', j
80 C Alltoallw's displs[] are in bytes not in type extents.
82 rcounts(i) = (i-1) + rank
83 rdispls(i) = (i-1) * (2*size) * SIZEOFINT
84 rtypes(i) = MPI_INTEGER
86 rbuf(rdispls(i)/SIZEOFINT+j+1) = 100 * rank
90 call mpi_alltoallw( MPI_IN_PLACE, 0, 0, MPI_DATATYPE_NULL,
91 $ rbuf, rcounts, rdispls, rtypes,
95 iexpected = 100 * (i-1) + 10 * rank + j
96 igot = rbuf(rdispls(i)/SIZEOFINT+j+1)
97 if ( igot .ne. iexpected ) then
99 print *, '[', rank, '] ALLTOALLW got ', igot,
100 $ ',but expected ', iexpected,
101 $ ' for block=', i-1, ' element=', j
106 call mtest_finalize( errs )
107 call mpi_finalize( ierr )