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)
20 integer src_wgts(2), dest_wgts(2)
22 integer world_rank, world_size;
25 comm_topo = MPI_UNDEFINED
26 call MPI_Topo_test(dgraph_comm, comm_topo, ierr);
27 if (comm_topo .ne. MPI_DIST_GRAPH) then
28 validate_dgraph = .false.
29 write(6,*) "dgraph_comm is NOT of type MPI_DIST_GRAPH."
33 call MPI_Dist_graph_neighbors_count(dgraph_comm,
34 & src_sz, dest_sz, wgt_flag,
36 if (ierr .ne. MPI_SUCCESS) then
37 validate_dgraph = .false.
38 write(6,*) "MPI_Dist_graph_neighbors_count() fails!"
41 if (.not. wgt_flag) then
42 validate_dgraph = .false.
43 write(6,*) "dgraph_comm is created with MPI_UNWEIGHTED!"
47 if (src_sz .ne. 2 .or. dest_sz .ne. 2) then
48 validate_dgraph = .false.
49 write(6,*) "source or destination edge array is not size 2."
50 write(6,"('src_sz = ',I3,', dest_sz = ',I3)") src_sz, dest_sz
54 call MPI_Dist_graph_neighbors(dgraph_comm,
55 & src_sz, srcs, src_wgts,
56 & dest_sz, dests, dest_wgts,
58 if (ierr .ne. MPI_SUCCESS) then
59 validate_dgraph = .false.
60 write(6,*) "MPI_Dist_graph_neighbors() fails!"
64 C Check if the neighbors returned from MPI are really
65 C the nearest neighbors that within a ring.
66 call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)
67 call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr)
70 nbr_sep = iabs(srcs(idx) - world_rank)
71 if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then
72 validate_dgraph = .false.
73 write(6,"('srcs[',I3,']=',I3,
74 & ' is NOT a neighbor of my rank',I3)")
75 & idx, srcs(idx), world_rank
79 if (src_wgts(1) .ne. src_wgts(2)) then
80 validate_dgraph = .false.
81 write(6,"('src_wgts = [',I3,',',I3,']')")
82 & src_wgts(1), src_wgts(2)
86 nbr_sep = iabs(dests(idx) - world_rank)
87 if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then
88 validate_dgraph = .false.
89 write(6,"('dests[',I3,']=',I3,
90 & ' is NOT a neighbor of my rank',I3)")
91 & idx, dests(idx), world_rank
95 if (dest_wgts(1) .ne. dest_wgts(2)) then
96 validate_dgraph = .false.
97 write(6,"('dest_wgts = [',I3,',',I3,']')")
98 & dest_wgts(1), dest_wgts(2)
102 validate_dgraph = .true.
106 integer function ring_rank(world_size, in_rank)
108 integer world_size, in_rank
109 if (in_rank .ge. 0 .and. in_rank .lt. world_size) then
113 if (in_rank .lt. 0 ) then
114 ring_rank = in_rank + world_size
117 if (in_rank .ge. world_size) then
118 ring_rank = in_rank - world_size
133 logical validate_dgraph
134 external validate_dgraph
138 integer world_size, world_rank
139 integer src_sz, dest_sz
141 integer srcs(2), dests(2)
142 integer src_wgts(2), dest_wgts(2)
145 call MTEST_Init(ierr)
146 call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)
147 call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr)
151 dests(1) = ring_rank(world_size, world_rank-1)
152 dests(2) = ring_rank(world_size, world_rank+1)
155 call MPI_Dist_graph_create(MPI_COMM_WORLD, 1, srcs, degs, dests,
156 & dest_wgts, MPI_INFO_NULL,
157 & .true., dgraph_comm, ierr)
158 if (ierr .ne. MPI_SUCCESS) then
159 write(6,*) "MPI_Dist_graph_create() fails!"
160 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
163 if (.not. validate_dgraph(dgraph_comm)) then
164 write(6,*) "MPI_Dist_graph_create() does not create "
165 & //"a bidirectional ring graph!"
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)
177 dests(1) = ring_rank(world_size, world_rank-1)
178 dests(2) = ring_rank(world_size, world_rank+1)
181 call MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD,
182 & src_sz, srcs, src_wgts,
183 & dest_sz, dests, dest_wgts,
184 & MPI_INFO_NULL, .true.,
186 if (ierr .ne. MPI_SUCCESS) then
187 write(6,*) "MPI_Dist_graph_create_adjacent() fails!"
188 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
191 if (.not. validate_dgraph(dgraph_comm)) then
192 write(6,*) "MPI_Dist_graph_create_adjacent() does not create "
193 & //"a bidirectional ring graph!"
194 call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
197 call MPI_Comm_free(dgraph_comm, ierr)
199 call MTEST_Finalize(errs)
200 call MPI_Finalize(ierr)