FORT_DLL_SPEC void FORT_CALL mpi_dist_graph_create_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint v3[], MPI_Fint v4[], MPI_Fint v5[], MPI_Fint v6[], MPI_Fint *v7, MPI_Fint *v8, MPI_Fint *v9, MPI_Fint *ierr ){ int l8; #ifndef HAVE_MPI_F_INIT_WORKS_WITH_C if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; } #endif if (v6 == MPIR_F_MPI_UNWEIGHTED) v6 = MPI_UNWEIGHTED; else if (v6 == MPIR_F_MPI_WEIGHTS_EMPTY) v6 = MPI_WEIGHTS_EMPTY; l8 = MPIR_FROM_FLOG(*v8); *ierr = MPI_Dist_graph_create( (MPI_Comm)(*v1), (int)*v2, v3, v4, v5, v6, (MPI_Info)(*v7), l8, (MPI_Comm *)(v9) ); }
CommPtr Comm::graph(Read<I32> dsts) const { #ifdef OMEGA_H_USE_MPI MPI_Comm impl2; int n = 1; int sources[1] = {rank()}; int degrees[1] = {dsts.size()}; HostRead<I32> destinations(dsts); int reorder = 0; CALL(MPI_Dist_graph_create(impl_, n, sources, degrees, destinations.data(), OMEGA_H_MPI_UNWEIGHTED, MPI_INFO_NULL, reorder, &impl2)); return CommPtr(new Comm(impl2)); #else return CommPtr(new Comm(true, dsts.size() == 1)); #endif }
void ompi_dist_graph_create_f(MPI_Fint *comm_old, MPI_Fint *n, MPI_Fint *sources, MPI_Fint *degrees, MPI_Fint *destinations, MPI_Fint *weights, MPI_Fint *info, ompi_fortran_logical_t *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr) { MPI_Comm c_comm_old, c_comm_graph; int count = 0, i; MPI_Info c_info; OMPI_ARRAY_NAME_DECL(sources); OMPI_ARRAY_NAME_DECL(degrees); OMPI_ARRAY_NAME_DECL(destinations); OMPI_ARRAY_NAME_DECL(weights); c_comm_old = MPI_Comm_f2c(*comm_old); c_info = MPI_Info_f2c(*info); OMPI_ARRAY_FINT_2_INT(sources, *n); OMPI_ARRAY_FINT_2_INT(degrees, *n); for( i = 0; i < OMPI_FINT_2_INT(*n); i++ ) count += OMPI_ARRAY_NAME_CONVERT(degrees)[i]; OMPI_ARRAY_FINT_2_INT(destinations, count); if( !OMPI_IS_FORTRAN_UNWEIGHTED(weights) ) { OMPI_ARRAY_FINT_2_INT(weights, count); } *ierr = OMPI_INT_2_FINT(MPI_Dist_graph_create(c_comm_old, OMPI_FINT_2_INT(*n), OMPI_ARRAY_NAME_CONVERT(sources), OMPI_ARRAY_NAME_CONVERT(degrees), OMPI_ARRAY_NAME_CONVERT(destinations), OMPI_IS_FORTRAN_UNWEIGHTED(weights) ? MPI_UNWEIGHTED : OMPI_ARRAY_NAME_CONVERT(weights), 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); OMPI_ARRAY_FINT_2_INT_CLEANUP(degrees); OMPI_ARRAY_FINT_2_INT_CLEANUP(destinations); if( !OMPI_IS_FORTRAN_UNWEIGHTED(weights) ) { OMPI_ARRAY_FINT_2_INT_CLEANUP(weights); } }
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; }