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
|
! This file created from f77/topo/cartcrf.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
! Test various combinations of periodic and non-periodic Cartesian
! communicators
!
program main
use mpi
integer errs, ierr
integer ndims, nperiods, i, size
integer comm, source, dest, newcomm
integer maxdims
parameter (maxdims=7)
logical periods(maxdims), outperiods(maxdims)
integer dims(maxdims), outdims(maxdims)
integer outcoords(maxdims)
errs = 0
call mtest_init( ierr )
!
! For upto 6 dimensions, test with periodicity in 0 through all
! dimensions. The test is computed by both:
! get info about the created communicator
! apply cart shift
! Note that a dimension can have size one, so that these tests
! can work with small numbers (even 1) of processes
!
comm = MPI_COMM_WORLD
call mpi_comm_size( comm, size, ierr )
do ndims = 1, 6
do nperiods = 0, ndims
do i=1,ndims
periods(i) = .false.
dims(i) = 0
enddo
do i=1,nperiods
periods(i) = .true.
enddo
call mpi_dims_create( size, ndims, dims, ierr )
call mpi_cart_create( comm, ndims, dims, periods, .false., &
& newcomm, ierr )
if (newcomm .ne. MPI_COMM_NULL) then
call mpi_cart_get( newcomm, maxdims, outdims, outperiods, &
& outcoords, ierr )
! print *, 'Coords = '
do i=1, ndims
! print *, i, '(', outcoords(i), ')'
if (periods(i) .neqv. outperiods(i)) then
errs = errs + 1
print *, ' Wrong value for periods ', i
print *, ' ndims = ', ndims
endif
enddo
do i=1, ndims
call mpi_cart_shift( newcomm, i-1, 1, source, dest, &
& ierr )
if (outcoords(i) .eq. outdims(i)-1) then
if (periods(i)) then
if (dest .eq. MPI_PROC_NULL) then
errs = errs + 1
print *, 'Expected rank, got proc_null'
endif
else
if (dest .ne. MPI_PROC_NULL) then
errs = errs + 1
print *, 'Expected procnull, got ', dest
endif
endif
endif
call mpi_cart_shift( newcomm, i-1, -1, source, dest, &
& ierr )
if (outcoords(i) .eq. 0) then
if (periods(i)) then
if (dest .eq. MPI_PROC_NULL) then
errs = errs + 1
print *, 'Expected rank, got proc_null'
endif
else
if (dest .ne. MPI_PROC_NULL) then
errs = errs + 1
print *, 'Expected procnull, got ', dest
endif
endif
endif
enddo
call mpi_comm_free( newcomm, ierr )
endif
enddo
enddo
call mtest_finalize( errs )
end
|
