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
|
! This file created from f77/coll/alltoallwf.f with f77tof90
! -*- Mode: Fortran; -*-
!
! (C) 2003 by Argonne National Laboratory.
! See COPYRIGHT in top-level directory.
!
program main
use mpi
integer ierr, errs
integer i, intsize, ans, size, rank, color, comm, newcomm
integer maxSize
parameter (maxSize=32)
integer scounts(maxSize), sdispls(maxSize), stypes(maxSize)
integer rcounts(maxSize), rdispls(maxSize), rtypes(maxSize)
integer sbuf(maxSize), rbuf(maxSize)
errs = 0
call mtest_init( ierr )
call mpi_type_size( MPI_INTEGER, intsize, ierr )
! Get a comm
call mpi_comm_dup( MPI_COMM_WORLD, comm, ierr )
call mpi_comm_size( comm, size, ierr )
if (size .gt. maxSize) then
call mpi_comm_rank( comm, rank, ierr )
color = 1
if (rank .lt. maxSize) color = 0
call mpi_comm_split( comm, color, rank, newcomm, ierr )
call mpi_comm_free( comm, ierr )
comm = newcomm
call mpi_comm_size( comm, size, ierr )
endif
call mpi_comm_rank( comm, rank, ierr )
if (size .le. maxSize) then
! Initialize the data. Just use this as an all to all
do i=1, size
scounts(i) = 1
sdispls(i) = (i-1)*intsize
stypes(i) = MPI_INTEGER
sbuf(i) = rank * size + i
rcounts(i) = 1
rdispls(i) = (i-1)*intsize
rtypes(i) = MPI_INTEGER
rbuf(i) = -1
enddo
call mpi_alltoallw( sbuf, scounts, sdispls, stypes, &
& rbuf, rcounts, rdispls, rtypes, comm, ierr )
!
! check rbuf(i) = data from the ith location of the ith send buf, or
! rbuf(i) = (i-1) * size + i
do i=1, size
ans = (i-1) * size + rank + 1
if (rbuf(i) .ne. ans) then
errs = errs + 1
print *, rank, ' rbuf(', i, ') = ', rbuf(i), &
& ' expected ', ans
endif
enddo
endif
call mpi_comm_free( comm, ierr )
call mtest_finalize( errs )
end
|
