/*
* Synopsis
*
* int BigMPI_Create_graph_comm(MPI_Comm comm_old, int root, MPI_Comm * graph_comm)
*
* Input Parameter
*
* comm_old MPI communicator from which to create a graph comm
* root integer id of root. if -1, create fully connected graph,
* which is appropriate for the all___ collectives.
*
* Output Parameters
*
* graph_comm MPI topology communicator associated with input communicator
* rc returns the rc from the MPI graph comm create function.
*
*/
int BigMPI_Create_graph_comm(MPI_Comm comm_old, int root, MPI_Comm * comm_dist_graph)
{
int rank, size;
MPI_Comm_rank(comm_old, &rank);
MPI_Comm_size(comm_old, &size);
/* in the all case (root == -1), every rank is a destination for every other rank;
* otherwise, only the root is a destination. */
int indegree = (root == -1 || root==rank) ? size : 0;
/* in the all case (root == -1), every rank is a source for every other rank;
* otherwise, all non-root processes are the source for only one rank (the root). */
int outdegree = (root == -1 || root==rank) ? size : 1;
int * sources = malloc(indegree*sizeof(int)); assert(sources!=NULL);
int * destinations = malloc(outdegree*sizeof(int)); assert(destinations!=NULL);
for (int i=0; i<indegree; i++) {
sources[i] = i;
}
for (int i=0; i<outdegree; i++) {
destinations[i] = (root == -1 || root==rank) ? i : root;
}
int rc = MPI_Dist_graph_create_adjacent(comm_old,
indegree, sources, indegree==0 ? MPI_WEIGHTS_EMPTY : MPI_UNWEIGHTED,
outdegree, destinations, outdegree==0 ? MPI_WEIGHTS_EMPTY : MPI_UNWEIGHTED,
MPI_INFO_NULL, 0 /* reorder */, comm_dist_graph);
free(sources);
free(destinations);
return rc;
}
CommPtr Comm::graph_adjacent(Read<I32> srcs, Read<I32> dsts) const {
#ifdef OMEGA_H_USE_MPI
MPI_Comm impl2;
HostRead<I32> sources(srcs);
HostRead<I32> destinations(dsts);
int reorder = 0;
CALL(MPI_Dist_graph_create_adjacent(impl_, sources.size(), sources.data(),
OMEGA_H_MPI_UNWEIGHTED, destinations.size(), destinations.data(),
OMEGA_H_MPI_UNWEIGHTED, MPI_INFO_NULL, reorder, &impl2));
return CommPtr(new Comm(impl2));
#else
CHECK(srcs == dsts);
return CommPtr(new Comm(true, dsts.size() == 1));
#endif
}
MPI_Comm create_dist_graph(P& presyns, int ncells){
MPI_Comm neighborhood;
int size;
int rank;
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
//passed in as argument but not used
environment::presyn dummy_input;
//create a temporary buffer for sending
std::vector<int> sendbuf;
std::vector<int> outNeighbors;
std::vector<int> inNeighbors;
//Every rank takes a turn to broadcast their output presyns
//If receiver has a corresponding input presyn, add as inNeighbor
int start = 0;
for(int i = 0; i < size; ++i){
if(rank == i){
start = rank * ncells;
for(int j = 0; j < ncells; ++j){
sendbuf.push_back(start + j);
}
}
else{
sendbuf.resize(ncells);
}
MPI_Bcast(&sendbuf[0], ncells, MPI_INT, i, MPI_COMM_WORLD);
//add sender to inNeighbors if there is matching input presyn
if(rank != i){
for(int j = 0; j < ncells; ++j){
if(presyns.find_input(sendbuf[j])){
inNeighbors.push_back(i);
break;
}
}
}
sendbuf.clear();
}
int send_size;
//Now every rank broadcasts their inNeighbors
//If receiver is an inNeighbor, add sender as outNeighbor
for(int i = 0; i < size; ++i){
//Broadcast the send size
if(rank == i){
send_size = inNeighbors.size();
}
MPI_Bcast(&send_size, 1, MPI_INT, i, MPI_COMM_WORLD);
//send inNeighbors
if(rank == i){
for(int i = 0; i < inNeighbors.size(); ++i){
sendbuf.push_back(inNeighbors[i]);
}
}
else{
sendbuf.resize(send_size);
}
MPI_Bcast(&sendbuf[0], send_size, MPI_INT, i, MPI_COMM_WORLD);
//add sender to outNeighbors if receiver is an inNeighbor
if(rank != i){
for(int j = 0; j < send_size; ++j){
if(sendbuf[j] == rank){
outNeighbors.push_back(i);
break;
}
}
}
sendbuf.clear();
}
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, inNeighbors.size(),
&inNeighbors[0], (int*)MPI_UNWEIGHTED, outNeighbors.size(),
&outNeighbors[0], (int*)MPI_UNWEIGHTED, MPI_INFO_NULL,
false, &neighborhood);
return neighborhood;
}
int main(int argc, char *argv[])
{
int errs = 0;
int i, j, k, p;
int indegree, outdegree, reorder;
int check_indegree, check_outdegree, check_weighted;
int *sources, *sweights, *destinations, *dweights, *degrees;
MPI_Comm comm;
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
layout = (int **) malloc(size * sizeof(int *));
assert(layout);
for (i = 0; i < size; i++) {
layout[i] = (int *) malloc(size * sizeof(int));
assert(layout[i]);
}
/* alloc size*size ints to handle the all-on-one-process case */
sources = (int *) malloc(size * size * sizeof(int));
sweights = (int *) malloc(size * size * sizeof(int));
destinations = (int *) malloc(size * size * sizeof(int));
dweights = (int *) malloc(size * size * sizeof(int));
degrees = (int *) malloc(size * size * sizeof(int));
for (i = 0; i < NUM_GRAPHS; i++) {
create_graph_layout(i);
if (rank == 0) {
MTestPrintfMsg( 1, "using graph layout '%s'\n", graph_layout_name );
}
/* MPI_Dist_graph_create_adjacent */
if (rank == 0) {
MTestPrintfMsg( 1, "testing MPI_Dist_graph_create_adjacent\n" );
}
indegree = 0;
k = 0;
for (j = 0; j < size; j++) {
if (layout[j][rank]) {
indegree++;
sources[k] = j;
sweights[k++] = layout[j][rank];
}
}
outdegree = 0;
k = 0;
for (j = 0; j < size; j++) {
if (layout[rank][j]) {
outdegree++;
destinations[k] = j;
dweights[k++] = layout[rank][j];
}
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, indegree, sources, sweights,
outdegree, destinations, dweights, MPI_INFO_NULL,
reorder, &comm);
MPI_Barrier(comm);
errs += verify_comm(comm);
MPI_Comm_free(&comm);
}
/* a weak check that passing MPI_UNWEIGHTED doesn't cause
* create_adjacent to explode */
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, indegree, sources, MPI_UNWEIGHTED,
outdegree, destinations, MPI_UNWEIGHTED, MPI_INFO_NULL,
reorder, &comm);
MPI_Barrier(comm);
/* intentionally no verify here, weights won't match */
MPI_Comm_free(&comm);
/* MPI_Dist_graph_create() where each process specifies its
* outgoing edges */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create w/ outgoing only\n" );
}
sources[0] = rank;
k = 0;
for (j = 0; j < size; j++) {
if (layout[rank][j]) {
destinations[k] = j;
dweights[k++] = layout[rank][j];
}
}
degrees[0] = k;
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, 1, sources, degrees, destinations, dweights,
MPI_INFO_NULL, reorder, &comm);
MPI_Barrier(comm);
errs += verify_comm(comm);
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create() where each process specifies its
* incoming edges */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create w/ incoming only\n" );
}
k = 0;
for (j = 0; j < size; j++) {
if (layout[j][rank]) {
sources[k] = j;
sweights[k] = layout[j][rank];
degrees[k] = 1;
destinations[k++] = rank;
}
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, k, sources, degrees, destinations, sweights,
MPI_INFO_NULL, reorder, &comm);
MPI_Barrier(comm);
errs += verify_comm(comm);
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create() where rank 0 specifies the entire
* graph */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create w/ rank 0 specifies only\n" );
}
p = 0;
for (j = 0; j < size; j++) {
for (k = 0; k < size; k++) {
if (layout[j][k]) {
sources[p] = j;
sweights[p] = layout[j][k];
degrees[p] = 1;
destinations[p++] = k;
}
}
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, (rank == 0) ? p : 0, sources, degrees,
destinations, sweights, MPI_INFO_NULL, reorder, &comm);
MPI_Barrier(comm);
errs += verify_comm(comm);
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create() where rank 0 specifies the entire
* graph and all other ranks pass NULL. Can catch implementation
* problems when MPI_UNWEIGHTED==NULL. */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create w/ rank 0 specifies only -- NULLs\n");
}
p = 0;
for (j = 0; j < size; j++) {
for (k = 0; k < size; k++) {
if (layout[j][k]) {
sources[p] = j;
sweights[p] = layout[j][k];
degrees[p] = 1;
destinations[p++] = k;
}
}
}
for (reorder = 0; reorder <= 1; reorder++) {
if (rank == 0) {
MPI_Dist_graph_create(MPI_COMM_WORLD, p, sources, degrees,
destinations, sweights, MPI_INFO_NULL, reorder, &comm);
}
else {
MPI_Dist_graph_create(MPI_COMM_WORLD, 0, NULL, NULL,
NULL, NULL, MPI_INFO_NULL, reorder, &comm);
}
MPI_Barrier(comm);
errs += verify_comm(comm);
MPI_Comm_free(&comm);
}
}
/* now tests that don't depend on the layout[][] array */
/* The MPI-2.2 standard recommends implementations set
* MPI_UNWEIGHTED==NULL, but this leads to an ambiguity. The draft
* MPI-3.0 standard specifically recommends _not_ setting it equal
* to NULL. */
if (MPI_UNWEIGHTED == NULL) {
fprintf(stderr, "MPI_UNWEIGHTED should not be NULL\n");
++errs;
}
/* MPI_Dist_graph_create() with no graph */
if (rank == 0) {
MTestPrintfMsg( 1, "testing MPI_Dist_graph_create w/ no graph\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, 0, sources, degrees,
destinations, sweights, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
if (!check_weighted) {
fprintf(stderr, "expected weighted == TRUE for the \"no graph\" case\n");
++errs;
}
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create() with no graph -- passing MPI_WEIGHTS_EMPTY
instead */
/* NOTE that MPI_WEIGHTS_EMPTY was added in MPI-3 and does not
appear before then. This part of the test thus requires a check
on the MPI major version */
#if MPI_VERSION >= 3
if (rank == 0) {
MTestPrintfMsg( 1, "testing MPI_Dist_graph_create w/ no graph\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, 0, sources, degrees,
destinations, MPI_WEIGHTS_EMPTY, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
if (!check_weighted) {
fprintf(stderr, "expected weighted == TRUE for the \"no graph -- MPI_WEIGHTS_EMPTY\" case\n");
++errs;
}
MPI_Comm_free(&comm);
}
#endif
/* MPI_Dist_graph_create() with no graph -- passing NULLs instead */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create w/ no graph -- NULLs\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, 0, NULL, NULL,
NULL, NULL, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
/* ambiguous if they are equal, only check when they are distinct values. */
if (MPI_UNWEIGHTED != NULL) {
if (!check_weighted) {
fprintf(stderr, "expected weighted == TRUE for the \"no graph -- NULLs\" case\n");
++errs;
}
}
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create() with no graph -- passing NULLs+MPI_UNWEIGHTED instead */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create w/ no graph -- NULLs+MPI_UNWEIGHTED\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create(MPI_COMM_WORLD, 0, NULL, NULL,
NULL, MPI_UNWEIGHTED, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
/* ambiguous if they are equal, only check when they are distinct values. */
if (MPI_UNWEIGHTED != NULL) {
if (check_weighted) {
fprintf(stderr, "expected weighted == FALSE for the \"no graph -- NULLs+MPI_UNWEIGHTED\" case\n");
++errs;
}
}
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create_adjacent() with no graph */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create_adjacent w/ no graph\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, 0, sources, sweights,
0, destinations, dweights, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
if (!check_weighted) {
fprintf(stderr, "expected weighted == TRUE for the \"no graph\" case\n");
++errs;
}
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create_adjacent() with no graph -- passing MPI_WEIGHTS_EMPTY instead */
/* NOTE that MPI_WEIGHTS_EMPTY was added in MPI-3 and does not
appear before then. This part of the test thus requires a check
on the MPI major version */
#if MPI_VERSION >= 3
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create_adjacent w/ no graph -- MPI_WEIGHTS_EMPTY\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, 0, sources, MPI_WEIGHTS_EMPTY,
0, destinations, MPI_WEIGHTS_EMPTY, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
if (!check_weighted) {
fprintf(stderr, "expected weighted == TRUE for the \"no graph -- MPI_WEIGHTS_EMPTY\" case\n");
++errs;
}
MPI_Comm_free(&comm);
}
#endif
/* MPI_Dist_graph_create_adjacent() with no graph -- passing NULLs instead */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create_adjacent w/ no graph -- NULLs\n" );
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, 0, NULL, NULL,
0, NULL, NULL, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
/* ambiguous if they are equal, only check when they are distinct values. */
if (MPI_UNWEIGHTED != NULL) {
if (!check_weighted) {
fprintf(stderr, "expected weighted == TRUE for the \"no graph -- NULLs\" case\n");
++errs;
}
}
MPI_Comm_free(&comm);
}
/* MPI_Dist_graph_create_adjacent() with no graph -- passing NULLs+MPI_UNWEIGHTED instead */
if (rank == 0) {
MTestPrintfMsg( 1,
"testing MPI_Dist_graph_create_adjacent w/ no graph -- NULLs+MPI_UNWEIGHTED\n");
}
for (reorder = 0; reorder <= 1; reorder++) {
MPI_Dist_graph_create_adjacent(MPI_COMM_WORLD, 0, NULL, MPI_UNWEIGHTED,
0, NULL, MPI_UNWEIGHTED, MPI_INFO_NULL, reorder, &comm);
MPI_Dist_graph_neighbors_count(comm, &check_indegree, &check_outdegree, &check_weighted);
/* ambiguous if they are equal, only check when they are distinct values. */
if (MPI_UNWEIGHTED != NULL) {
if (check_weighted) {
fprintf(stderr, "expected weighted == FALSE for the \"no graph -- NULLs+MPI_UNWEIGHTED\" case\n");
++errs;
}
}
MPI_Comm_free(&comm);
}
for (i = 0; i < size; i++)
free(layout[i]);
free(layout);
#endif
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
void ompi_dist_graph_create_adjacent_f(MPI_Fint *comm_old, MPI_Fint *indegree,
MPI_Fint *sources, MPI_Fint *sourceweights,
MPI_Fint *outdegree,
MPI_Fint *destinations, MPI_Fint *destweights, MPI_Fint *info,
ompi_fortran_logical_t *reorder, MPI_Fint *comm_graph,
MPI_Fint *ierr)
{
MPI_Info c_info;
MPI_Comm c_comm_old, c_comm_graph;
const int *c_destweights, *c_sourceweights;
OMPI_ARRAY_NAME_DECL(sources);
OMPI_ARRAY_NAME_DECL(sourceweights);
OMPI_ARRAY_NAME_DECL(destinations);
OMPI_ARRAY_NAME_DECL(destweights);
c_comm_old = MPI_Comm_f2c(*comm_old);
c_info = MPI_Info_f2c(*info);
OMPI_ARRAY_FINT_2_INT(sources, *indegree);
if (OMPI_IS_FORTRAN_UNWEIGHTED(sourceweights)) {
c_sourceweights = MPI_UNWEIGHTED;
} else if (OMPI_IS_FORTRAN_WEIGHTS_EMPTY(sourceweights)) {
c_sourceweights = MPI_WEIGHTS_EMPTY;
} else {
OMPI_ARRAY_FINT_2_INT(sourceweights, *indegree);
c_sourceweights = OMPI_ARRAY_NAME_CONVERT(sourceweights);
}
OMPI_ARRAY_FINT_2_INT(destinations, *outdegree);
if (OMPI_IS_FORTRAN_UNWEIGHTED(destweights)) {
c_destweights = MPI_UNWEIGHTED;
} else if (OMPI_IS_FORTRAN_WEIGHTS_EMPTY(destweights)) {
c_destweights = MPI_WEIGHTS_EMPTY;
} else {
OMPI_ARRAY_FINT_2_INT(destweights, *indegree);
c_destweights = OMPI_ARRAY_NAME_CONVERT(destweights);
}
*ierr = OMPI_INT_2_FINT(MPI_Dist_graph_create_adjacent(c_comm_old, OMPI_FINT_2_INT(*indegree),
OMPI_ARRAY_NAME_CONVERT(sources),
c_sourceweights,
OMPI_FINT_2_INT(*outdegree),
OMPI_ARRAY_NAME_CONVERT(destinations),
c_destweights,
c_info,
OMPI_LOGICAL_2_INT(*reorder),
&c_comm_graph));
if (OMPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*comm_graph = MPI_Comm_c2f(c_comm_graph);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(sources);
if( MPI_UNWEIGHTED != c_sourceweights && MPI_WEIGHTS_EMPTY != c_sourceweights ) {
OMPI_ARRAY_FINT_2_INT_CLEANUP(sourceweights);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(destinations);
if( MPI_UNWEIGHTED != c_destweights && MPI_WEIGHTS_EMPTY != c_destweights ) {
OMPI_ARRAY_FINT_2_INT_CLEANUP(destweights);
}
}
