C -*- Mode: Fortran; -*- C C (C) 2011 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. C C This program is Fortran version of dgraph_unwgt.c C Specify a distributed graph of a bidirectional ring of the MPI_COMM_WORLD, C 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 C Check if the neighbors returned from MPI are really C 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 = iabs(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 = iabs(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) C now create one with MPI_WEIGHTS_EMPTY C NOTE that MPI_WEIGHTS_EMPTY was added in MPI-3 and does not C appear before then. Incluing this test means that this test cannot C be compiled if the MPI version is less than 3 (see the testlist file) degs(1) = 0; call MPI_Dist_graph_create(MPI_COMM_WORLD, 1, srcs, degs, dests, & MPI_WEIGHTS_EMPTY, 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 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) C now create one with MPI_WEIGHTS_EMPTY src_sz = 0 dest_sz = 0 call MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, & src_sz, srcs, & MPI_WEIGHTS_EMPTY, & dest_sz, dests, & MPI_WEIGHTS_EMPTY, & 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 call MPI_Comm_free(dgraph_comm, ierr) call MTEST_Finalize(errs) call MPI_Finalize(ierr) end