1 C -*- Mode: Fortran; -*-
3 C (C) 2011 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
6 C This program is Fortran version of dgraph_unwgt.c
7 C Specify a distributed graph of a bidirectional ring of the MPI_COMM_WORLD,
8 C i.e. everyone only talks to left and right neighbors.
10 logical function validate_dgraph(dgraph_comm)
16 integer src_sz, dest_sz
19 integer srcs(2), dests(2)
21 integer world_rank, world_size;
24 comm_topo = MPI_UNDEFINED
25 call MPI_Topo_test(dgraph_comm, comm_topo, ierr);
26 if (comm_topo .ne. MPI_DIST_GRAPH) then
27 validate_dgraph = .false.
28 write(6,*) "dgraph_comm is NOT of type MPI_DIST_GRAPH."
32 call MPI_Dist_graph_neighbors_count(dgraph_comm,
33 & src_sz, dest_sz, wgt_flag,
35 if (ierr .ne. MPI_SUCCESS) then
36 validate_dgraph = .false.
37 write(6,*) "MPI_Dist_graph_neighbors_count() fails!"
41 validate_dgraph = .false.
42 write(6,*) "dgraph_comm is NOT created with MPI_UNWEIGHTED."
46 if (src_sz .ne. 2 .or. dest_sz .ne. 2) then
47 validate_dgraph = .false.
48 write(6,*) "source or destination edge array is not size 2."
49 write(6,"('src_sz = ',I3,', dest_sz = ',I3)") src_sz, dest_sz
53 call MPI_Dist_graph_neighbors(dgraph_comm,
54 & src_sz, srcs, MPI_UNWEIGHTED,
55 & dest_sz, dests, MPI_UNWEIGHTED,
57 if (ierr .ne. MPI_SUCCESS) then
58 validate_dgraph = .false.
59 write(6,*) "MPI_Dist_graph_neighbors() fails!"
63 C Check if the neighbors returned from MPI are really
64 C the nearest neighbors that within a ring.
65 call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)
66 call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr)
69 nbr_sep = iabs(srcs(idx) - world_rank)
70 if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then
71 validate_dgraph = .false.
72 write(6,"('srcs[',I3,']=',I3,
73 & ' is NOT a neighbor of my rank',I3)")
74 & idx, srcs(idx), world_rank
79 nbr_sep = iabs(dests(idx) - world_rank)
80 if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then
81 validate_dgraph = .false.
82 write(6,"('dests[',I3,']=',I3,
83 & ' is NOT a neighbor of my rank',I3)")
84 & idx, dests(idx), world_rank
89 validate_dgraph = .true.
93 integer function ring_rank(world_size, in_rank)
95 integer world_size, in_rank
96 if (in_rank .ge. 0 .and. in_rank .lt. world_size) then
100 if (in_rank .lt. 0 ) then
101 ring_rank = in_rank + world_size
104 if (in_rank .ge. world_size) then
105 ring_rank = in_rank - world_size
120 logical validate_dgraph
121 external validate_dgraph
125 integer world_size, world_rank
126 integer src_sz, dest_sz
128 integer srcs(2), dests(2)
131 call MTEST_Init(ierr)
132 call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)
133 call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr)
137 dests(1) = ring_rank(world_size, world_rank-1)
138 dests(2) = ring_rank(world_size, world_rank+1)
139 call MPI_Dist_graph_create(MPI_COMM_WORLD, 1, srcs, degs, dests,
140 & MPI_UNWEIGHTED, MPI_INFO_NULL,
141 & .true., dgraph_comm, ierr)
142 if (ierr .ne. MPI_SUCCESS) then
143 write(6,*) "MPI_Dist_graph_create() fails!"
144 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
147 if (.not. validate_dgraph(dgraph_comm)) then
148 write(6,*) "MPI_Dist_graph_create() does not create"
149 & //"a bidirectional ring graph!"
150 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
153 call MPI_Comm_free(dgraph_comm, ierr)
155 C now create one with MPI_WEIGHTS_EMPTY
156 C NOTE that MPI_WEIGHTS_EMPTY was added in MPI-3 and does not
157 C appear before then. Incluing this test means that this test cannot
158 C be compiled if the MPI version is less than 3 (see the testlist file)
161 call MPI_Dist_graph_create(MPI_COMM_WORLD, 1, srcs, degs, dests,
162 & MPI_WEIGHTS_EMPTY, MPI_INFO_NULL,
163 & .true., dgraph_comm, ierr)
164 if (ierr .ne. MPI_SUCCESS) then
165 write(6,*) "MPI_Dist_graph_create() fails!"
166 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
169 call MPI_Comm_free(dgraph_comm, ierr)
172 srcs(1) = ring_rank(world_size, world_rank-1)
173 srcs(2) = ring_rank(world_size, world_rank+1)
175 dests(1) = ring_rank(world_size, world_rank-1)
176 dests(2) = ring_rank(world_size, world_rank+1)
177 call MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD,
182 & MPI_INFO_NULL, .true.,
184 if (ierr .ne. MPI_SUCCESS) then
185 write(6,*) "MPI_Dist_graph_create_adjacent() fails!"
186 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
189 if (.not. validate_dgraph(dgraph_comm)) then
190 write(6,*) "MPI_Dist_graph_create_adjacent() does not create"
191 & //"a bidirectional ring graph!"
192 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
195 call MPI_Comm_free(dgraph_comm, ierr)
197 C now create one with MPI_WEIGHTS_EMPTY
200 call MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD,
205 & MPI_INFO_NULL, .true.,
207 if (ierr .ne. MPI_SUCCESS) then
208 write(6,*) "MPI_Dist_graph_create_adjacent() fails!"
209 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
212 call MPI_Comm_free(dgraph_comm, ierr)
214 call MTEST_Finalize(errs)
215 call MPI_Finalize(ierr)