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)
16 integer comm, rank, size, req
17 integer sumval, ierr, errs
18 integer iexpected, igot
22 call mtest_init( ierr )
25 call mpi_comm_rank( comm, rank, ierr )
26 call mpi_comm_size( comm, size, ierr )
27 call mpi_type_size( MPI_INTEGER, SIZEOFINT, ierr )
33 rbuf(i) = (i-1) * size + rank
35 call mpi_ialltoall( MPI_IN_PLACE, -1, MPI_DATATYPE_NULL,
36 . rbuf, 1, MPI_INTEGER, comm, req, ierr )
37 call mpi_wait( req, MPI_STATUS_IGNORE, ierr )
39 if (rbuf(i) .ne. (rank*size + i - 1)) then
41 print *, '[', rank, ']: IALLTOALL rbuf(', i, ') = ',
42 . rbuf(i), ', should be', rank * size + i - 1
50 rcounts(i) = i-1 + rank
51 rdispls(i) = (i-1) * (2*size)
53 rbuf(rdispls(i)+j+1) = 100 * rank + 10 * (i-1) + j
56 call mpi_ialltoallv( MPI_IN_PLACE, 0, 0, MPI_DATATYPE_NULL,
57 . rbuf, rcounts, rdispls, MPI_INTEGER,
59 call mpi_wait( req, MPI_STATUS_IGNORE, ierr )
62 iexpected = 100 * (i-1) + 10 * rank + j
63 igot = rbuf(rdispls(i)+j+1)
64 if ( igot .ne. iexpected ) then
66 print *, '[', rank, ']: IALLTOALLV got ', igot,
67 . ',but expected ', iexpected,
68 . ' for block=', i-1, ' element=', j
77 rcounts(i) = i-1 + rank
78 rdispls(i) = (i-1) * (2*size) * SIZEOFINT
79 rtypes(i) = MPI_INTEGER
81 rbuf(rdispls(i)/SIZEOFINT+j+1) = 100 * rank
85 call mpi_ialltoallw( MPI_IN_PLACE, 0, 0, MPI_DATATYPE_NULL,
86 . rbuf, rcounts, rdispls, rtypes,
88 call mpi_wait( req, MPI_STATUS_IGNORE, ierr )
91 iexpected = 100 * (i-1) + 10 * rank + j
92 igot = rbuf(rdispls(i)/SIZEOFINT+j+1)
93 if ( igot .ne. iexpected ) then
95 print *, '[', rank, ']: IALLTOALLW got ', igot,
96 . ',but expected ', iexpected,
97 . ' for block=', i-1, ' element=', j
106 rbuf(i) = rank + (i-1)
108 call mpi_ireduce_scatter_block( MPI_IN_PLACE, rbuf, 1,
109 . MPI_INTEGER, MPI_SUM, comm,
111 call mpi_wait( req, MPI_STATUS_IGNORE, ierr )
113 sumval = size * rank + ((size-1) * size)/2
114 if ( rbuf(1) .ne. sumval ) then
116 print *, 'Ireduce_scatter_block does not get expected value.'
117 print *, '[', rank, ']:', 'Got ', rbuf(1), ' but expected ',
121 call mtest_finalize( errs )
122 call mpi_finalize( ierr )