[mpich2-commits] r7823 - mpich2/trunk/test/mpi/f77/topo
chan at mcs.anl.gov
chan at mcs.anl.gov
Mon Jan 24 18:52:45 CST 2011
Author: chan
Date: 2011-01-24 18:52:45 -0600 (Mon, 24 Jan 2011)
New Revision: 7823
Added:
mpich2/trunk/test/mpi/f77/topo/dgraph_unwgtf.f
Modified:
mpich2/trunk/test/mpi/f77/topo/Makefile.sm
mpich2/trunk/test/mpi/f77/topo/testlist
Log:
A Fortran version of dgraph_unwgt.c that checks MPI_UNWEIGHTED in distributed graph functions.
Modified: mpich2/trunk/test/mpi/f77/topo/Makefile.sm
===================================================================
--- mpich2/trunk/test/mpi/f77/topo/Makefile.sm 2011-01-25 00:50:07 UTC (rev 7822)
+++ mpich2/trunk/test/mpi/f77/topo/Makefile.sm 2011-01-25 00:52:45 UTC (rev 7823)
@@ -3,6 +3,7 @@
smvar_do_sharedlibs = 0
cartcrf_SOURCES = cartcrf.f
+dgraph_unwgtf_SOURCES = dgraph_unwgtf.f
testing:
../../runtests -srcdir=$(srcdir) -tests=testlist \
Added: mpich2/trunk/test/mpi/f77/topo/dgraph_unwgtf.f
===================================================================
--- mpich2/trunk/test/mpi/f77/topo/dgraph_unwgtf.f (rev 0)
+++ mpich2/trunk/test/mpi/f77/topo/dgraph_unwgtf.f 2011-01-25 00:52:45 UTC (rev 7823)
@@ -0,0 +1,179 @@
+! This program is Fortran version of dgraph_unwgt.c
+! Specify a distributed graph of a bidirectional ring of the MPI_COMM_WORLD,
+! i.e. everyone only talks to left and right neighbors.
+
+ logical function validate_dgraph(dgraph_comm)
+ implicit none
+ include 'mpif.h'
+
+ integer dgraph_comm
+ integer comm_topo
+ integer src_sz, dest_sz
+ integer ierr;
+ logical wgt_flag;
+ integer srcs(2), dests(2)
+
+ integer world_rank, world_size;
+ integer idx, nbr_sep
+
+ comm_topo = MPI_UNDEFINED
+ call MPI_Topo_test(dgraph_comm, comm_topo, ierr);
+ if (comm_topo .ne. MPI_DIST_GRAPH) then
+ validate_dgraph = .false.
+ write(6,*) "dgraph_comm is NOT of type MPI_DIST_GRAPH."
+ return
+ endif
+
+ call MPI_Dist_graph_neighbors_count(dgraph_comm,
+ & src_sz, dest_sz, wgt_flag,
+ & ierr)
+ if (ierr .ne. MPI_SUCCESS) then
+ validate_dgraph = .false.
+ write(6,*) "MPI_Dist_graph_neighbors_count() fails!"
+ return
+ endif
+ if (wgt_flag) then
+ validate_dgraph = .false.
+ write(6,*) "dgraph_comm is NOT created with MPI_UNWEIGHTED."
+ return
+ endif
+
+ if (src_sz .ne. 2 .or. dest_sz .ne. 2) then
+ validate_dgraph = .false.
+ write(6,*) "source or destination edge array is not size 2."
+ write(6,"('src_sz = ',I3,', dest_sz = ',I3)") src_sz, dest_sz
+ return
+ endif
+
+ call MPI_Dist_graph_neighbors(dgraph_comm,
+ & src_sz, srcs, MPI_UNWEIGHTED,
+ & dest_sz, dests, MPI_UNWEIGHTED,
+ & ierr)
+ if (ierr .ne. MPI_SUCCESS) then
+ validate_dgraph = .false.
+ write(6,*) "MPI_Dist_graph_neighbors() fails!"
+ return
+ endif
+
+! Check if the neighbors returned from MPI are really
+! the nearest neighbors that within a ring.
+ call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)
+ call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr)
+
+ do idx = 1, src_sz
+ nbr_sep = abs(srcs(idx) - world_rank)
+ if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then
+ validate_dgraph = .false.
+ write(6,"('srcs[',I3,']=',I3,
+ & ' is NOT a neighbor of my rank',I3)")
+ & idx, srcs(idx), world_rank
+ return
+ endif
+ enddo
+ do idx = 1, dest_sz
+ nbr_sep = abs(dests(idx) - world_rank)
+ if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then
+ validate_dgraph = .false.
+ write(6,"('dests[',I3,']=',I3,
+ & ' is NOT a neighbor of my rank',I3)")
+ & idx, dests(idx), world_rank
+ return
+ endif
+ enddo
+
+ validate_dgraph = .true.
+ return
+ end
+
+ integer function ring_rank(world_size, in_rank)
+ implicit none
+ integer world_size, in_rank
+ if (in_rank .ge. 0 .and. in_rank .lt. world_size) then
+ ring_rank = in_rank
+ return
+ endif
+ if (in_rank .lt. 0 ) then
+ ring_rank = in_rank + world_size
+ return
+ endif
+ if (in_rank .ge. world_size) then
+ ring_rank = in_rank - world_size
+ return
+ endif
+ ring_rank = -99999
+ return
+ end
+
+
+
+ program dgraph_unwgt
+ implicit none
+ include 'mpif.h'
+
+ integer ring_rank
+ external ring_rank
+ logical validate_dgraph
+ external validate_dgraph
+ integer errs, ierr
+
+ integer dgraph_comm
+ integer world_size, world_rank
+ integer src_sz, dest_sz
+ integer degs(1)
+ integer srcs(2), dests(2)
+
+ errs = 0
+ call MTEST_Init(ierr)
+ call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)
+ call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr)
+
+ srcs(1) = world_rank
+ degs(1) = 2;
+ dests(1) = ring_rank(world_size, world_rank-1)
+ dests(2) = ring_rank(world_size, world_rank+1)
+ call MPI_Dist_graph_create(MPI_COMM_WORLD, 1, srcs, degs, dests,
+ & MPI_UNWEIGHTED, MPI_INFO_NULL,
+ & .true., dgraph_comm, ierr)
+ if (ierr .ne. MPI_SUCCESS) then
+ write(6,*) "MPI_Dist_graph_create() fails!"
+ call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
+ stop
+ endif
+ if (.not. validate_dgraph(dgraph_comm)) then
+ write(6,*) "MPI_Dist_graph_create() does not create"
+ & //"a bidirectional ring graph!"
+ call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
+ stop
+ endif
+ call MPI_Comm_free(dgraph_comm, ierr)
+
+ src_sz = 2
+ srcs(1) = ring_rank(world_size, world_rank-1)
+ srcs(2) = ring_rank(world_size, world_rank+1)
+ dest_sz = 2
+ dests(1) = ring_rank(world_size, world_rank-1)
+ dests(2) = ring_rank(world_size, world_rank+1)
+ call MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD,
+ & src_sz, srcs,
+ & MPI_UNWEIGHTED,
+ & dest_sz, dests,
+ & MPI_UNWEIGHTED,
+ & MPI_INFO_NULL, .true.,
+ & dgraph_comm, ierr)
+ if (ierr .ne. MPI_SUCCESS) then
+ write(6,*) "MPI_Dist_graph_create_adjacent() fails!"
+ call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
+ stop
+ endif
+ if (.not. validate_dgraph(dgraph_comm)) then
+ write(6,*) "MPI_Dist_graph_create_adjacent() does not create"
+ & //"a bidirectional ring graph!"
+ call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
+ stop
+ endif
+ call MPI_Comm_free(dgraph_comm, ierr)
+
+ call MTEST_Finalize(errs)
+ call MPI_Finalize(ierr)
+ stop
+ end
Modified: mpich2/trunk/test/mpi/f77/topo/testlist
===================================================================
--- mpich2/trunk/test/mpi/f77/topo/testlist 2011-01-25 00:50:07 UTC (rev 7822)
+++ mpich2/trunk/test/mpi/f77/topo/testlist 2011-01-25 00:52:45 UTC (rev 7823)
@@ -1 +1,2 @@
cartcrf 4
+dgraph_unwgtf 4 mpiversion=2.2
More information about the mpich2-commits
mailing list