1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
C
C Copyright (C) by Argonne National Laboratory
C See COPYRIGHT in top-level directory
C
C A simple test for Fortran support of the MPI_IN_PLACE value in Alltoall[vw].
C
program main
implicit none
include 'mpif.h'
integer SIZEOFINT
integer MAX_SIZE
parameter (MAX_SIZE=1024)
integer rbuf(MAX_SIZE)
integer scounts(1), sdispls(1), stypes(1)
integer rdispls(MAX_SIZE), rcounts(MAX_SIZE), rtypes(MAX_SIZE)
integer ierr, errs
integer comm, root
integer rank, size
integer iexpected, igot
integer i, j
errs = 0
call mtest_init( ierr )
comm = MPI_COMM_WORLD
call mpi_comm_rank( comm, rank, ierr )
call mpi_comm_size( comm, size, ierr )
call mpi_type_size( MPI_INTEGER, SIZEOFINT, ierr )
if (size .gt. MAX_SIZE) then
print *, ' At most ', MAX_SIZE, ' processes allowed'
call mpi_abort( MPI_COMM_WORLD, 1, ierr )
endif
C
do i=1,MAX_SIZE
rbuf(i) = -1
enddo
do i=1,size
rbuf(i) = (i-1) * size + rank
enddo
call mpi_alltoall( MPI_IN_PLACE, -1, MPI_DATATYPE_NULL,
$ rbuf, 1, MPI_INTEGER, comm, ierr )
do i=1,size
if (rbuf(i) .ne. (rank*size + i - 1)) then
errs = errs + 1
print *, '[', rank, '] rbuf(', i, ') = ', rbuf(i),
$ ', should be', rank * size + i - 1
endif
enddo
scounts(1) = 0
sdispls(1) = 0
stypes(1) = MPI_DATATYPE_NULL
do i=1,MAX_SIZE
rbuf(i) = -1
enddo
do i=1,size
rcounts(i) = (i-1) + rank
rdispls(i) = (i-1) * (2*size)
do j=0,rcounts(i)-1
rbuf(rdispls(i)+j+1) = 100 * rank + 10 * (i-1) + j
enddo
enddo
call mpi_alltoallv( MPI_IN_PLACE, scounts, sdispls, stypes(1),
$ rbuf, rcounts, rdispls, MPI_INTEGER,
$ comm, ierr )
do i=1,size
do j=0,rcounts(i)-1
iexpected = 100 * (i-1) + 10 * rank + j
igot = rbuf(rdispls(i)+j+1)
if ( igot .ne. iexpected ) then
errs = errs + 1
print *, '[', rank, '] ALLTOALLV got ', igot,
$ ',but expected ', iexpected,
$ ' for block=', i-1, ' element=', j
endif
enddo
enddo
do i=1,MAX_SIZE
rbuf(i) = -1
enddo
C Alltoallw's displs[] are in bytes not in type extents.
do i=1,size
rcounts(i) = (i-1) + rank
rdispls(i) = (i-1) * (2*size) * SIZEOFINT
rtypes(i) = MPI_INTEGER
do j=0,rcounts(i)-1
rbuf(rdispls(i)/SIZEOFINT+j+1) = 100 * rank
$ + 10 * (i-1) + j
enddo
enddo
call mpi_alltoallw( MPI_IN_PLACE, scounts, sdispls, stypes,
$ rbuf, rcounts, rdispls, rtypes,
$ comm, ierr )
do i=1,size
do j=0,rcounts(i)-1
iexpected = 100 * (i-1) + 10 * rank + j
igot = rbuf(rdispls(i)/SIZEOFINT+j+1)
if ( igot .ne. iexpected ) then
errs = errs + 1
print *, '[', rank, '] ALLTOALLW got ', igot,
$ ',but expected ', iexpected,
$ ' for block=', i-1, ' element=', j
endif
enddo
enddo
call mtest_finalize( errs )
end
|
