int main ( int argc, char * argv[]) { SCOTCH_Strat bipastrat; /* Bipartitioning strategy */ SCOTCH_Arch archdat; /* Target (terminal) architecture */ SCOTCH_Graph grafdat; /* Source graph to turn into architecture */ SCOTCH_Num vertnbr; /* Number of vertices in graph */ SCOTCH_Num * vlbltab; /* Pointer to vertex label array, if present */ SCOTCH_Num listnbr; /* Size of list array */ SCOTCH_Num * listtab; /* Pointer to list array */ C_VertSort * sorttab; /* Vertex label sort area */ SCOTCH_Num baseval; int flagval; /* Process flags */ int i; errorProg ("amk_grf"); if ((argc >= 2) && (argv[1][0] == '?')) { /* If need for help */ usagePrint (stdout, C_usageList); return (0); } flagval = C_FLAGNONE; SCOTCH_stratInit (&bipastrat); fileBlockInit (C_fileTab, C_FILENBR); /* Set default stream pointers */ for (i = 1; i < argc; i ++) { /* Loop for all option codes */ if ((argv[i][0] != '-') || (argv[i][1] == '\0') || (argv[i][1] == '.')) { /* If found a file name */ if (C_fileNum < C_FILEARGNBR) /* File name has been given */ fileBlockName (C_fileTab, C_fileNum ++) = argv[i]; else { errorPrint ("main: too many file names given"); return (1); } } else { /* If found an option name */ switch (argv[i][1]) { case 'B' : /* Bipartitioning strategy */ case 'b' : SCOTCH_stratExit (&bipastrat); SCOTCH_stratInit (&bipastrat); if ((SCOTCH_stratGraphBipart (&bipastrat, &argv[i][2])) != 0) { errorPrint ("main: invalid bipartitioning strategy"); return (1); } break; case 'H' : /* Give the usage message */ case 'h' : usagePrint (stdout, C_usageList); return (0); case 'L' : /* Input vertex list */ case 'l' : flagval |= C_FLAGVRTINP; if (argv[i][2] != '\0') C_filenamevrtinp = &argv[i][2]; break; case 'V' : fprintf (stderr, "amk_grf, version " SCOTCH_VERSION_STRING "\n"); fprintf (stderr, "Copyright 2004,2007,2008,2010-2012,2014 IPB, Universite de Bordeaux, INRIA & CNRS, France\n"); fprintf (stderr, "This software is libre/free software under CeCILL-C -- see the user's manual for more information\n"); return (0); default : errorPrint ("main: unprocessed option '%s'", argv[i]); return (1); } } } fileBlockOpen (C_fileTab, C_FILENBR); /* Open all files */ SCOTCH_graphInit (&grafdat); /* Create graph structure */ SCOTCH_graphLoad (&grafdat, C_filepntrgrfinp, -1, 0); /* Load source graph */ SCOTCH_graphData (&grafdat, &baseval, &vertnbr, NULL, NULL, NULL, /* Get graph data */ &vlbltab, NULL, NULL, NULL); listnbr = 0; /* Initialize vertex list */ listtab = NULL; if (flagval & C_FLAGVRTINP) { /* If list of vertices provided */ SCOTCH_Num listnum; if ((intLoad (C_filepntrvrtinp, &listnbr) != 1) || /* Read list size */ (listnbr < 0) || (listnbr > vertnbr)) { errorPrint ("main: bad list input (1)"); return (1); } if ((listtab = (SCOTCH_Num *) memAlloc (listnbr * sizeof (SCOTCH_Num) + 1)) == NULL) { errorPrint ("main: out of memory (1)"); return (1); } for (listnum = 0; listnum < listnbr; listnum ++) { /* Read list data */ if (intLoad (C_filepntrvrtinp, &listtab[listnum]) != 1) { errorPrint ("main: bad list input (2)"); return (1); } } intSort1asc1 (listtab, listnbr); for (listnum = 0; listnum < listnbr - 1; listnum ++) { /* Search for duplicates */ if (listtab[listnum] == listtab[listnum + 1]) { errorPrint ("main: duplicate list labels"); memFree (listtab); return (1); } } if (vlbltab != NULL) { /* If graph has vertex labels */ SCOTCH_Num vertnum; if ((sorttab = (C_VertSort *) memAlloc (vertnbr * sizeof (C_VertSort))) == NULL) { errorPrint ("main: out of memory (2)"); memFree (listtab); return (1); } for (vertnum = 0; vertnum < vertnbr; vertnum ++) { /* Initialize sort area */ sorttab[vertnum].vlblnum = vlbltab[vertnum]; sorttab[vertnum].vertnum = vertnum; } intSort2asc1 (sorttab, vertnbr); /* Sort by ascending labels */ for (listnum = 0, vertnum = 0; listnum < listnbr; listnum ++) { /* For all labels in list */ while ((vertnum < vertnbr) && (sorttab[vertnum].vlblnum < listtab[listnum])) vertnum ++; /* Search vertex graph with corresponding label */ if ((vertnum >= vertnbr) || /* If label not found */ (sorttab[vertnum].vlblnum > listtab[listnum])) { errorPrint ("main: list label '" SCOTCH_NUMSTRING "' not in graph", (SCOTCH_Num) listtab[listnum]); memFree (sorttab); memFree (listtab); return (1); } listtab[listnum] = sorttab[vertnum ++].vertnum; /* Replace label by number */ } memFree (sorttab); /* Free sort area */ } } SCOTCH_archInit (&archdat); /* Initialize target architecture */ SCOTCH_archBuild (&archdat, &grafdat, listnbr, listtab, &bipastrat); /* Compute architecture */ SCOTCH_archSave (&archdat, C_filepntrtgtout); /* Write target architecture */ fileBlockClose (C_fileTab, C_FILENBR); /* Always close explicitely to end potential (un)compression tasks */ SCOTCH_graphExit (&grafdat); /* Free target graph */ SCOTCH_archExit (&archdat); /* Free target architecture */ SCOTCH_stratExit (&bipastrat); /* Free strategy string */ if (listtab != NULL) /* If vertex list provided */ memFree (listtab); /* Free it */ #ifdef COMMON_PTHREAD pthread_exit ((void *) 0); /* Allow potential (un)compression tasks to complete */ #endif /* COMMON_PTHREAD */ return (0); }
static PetscErrorCode MatPartitioningApply_Scotch(MatPartitioning part, IS * partitioning) { PetscErrorCode ierr; int *parttab, *locals = PETSC_NULL, rank, i, size; size_t j; Mat mat = part->adj, matMPI, matSeq; int nb_locals = mat->rmap->n; Mat_MPIAdj *adj = (Mat_MPIAdj *) mat->data; MatPartitioning_Scotch *scotch = (MatPartitioning_Scotch *) part->data; PetscTruth flg; #ifdef PETSC_HAVE_UNISTD_H int fd_stdout, fd_pipe[2], count,err; #endif PetscFunctionBegin; /* check if the matrix is sequential, use MatGetSubMatrices if necessary */ ierr = MPI_Comm_size(((PetscObject)mat)->comm, &size);CHKERRQ(ierr); ierr = PetscTypeCompare((PetscObject) mat, MATMPIADJ, &flg);CHKERRQ(ierr); if (size > 1) { int M, N; IS isrow, iscol; Mat *A; if (flg) { SETERRQ(0, "Distributed matrix format MPIAdj is not supported for sequential partitioners"); } PetscPrintf(((PetscObject)part)->comm, "Converting distributed matrix to sequential: this could be a performance loss\n");CHKERRQ(ierr); ierr = MatGetSize(mat, &M, &N);CHKERRQ(ierr); ierr = ISCreateStride(PETSC_COMM_SELF, M, 0, 1, &isrow);CHKERRQ(ierr); ierr = ISCreateStride(PETSC_COMM_SELF, N, 0, 1, &iscol);CHKERRQ(ierr); ierr = MatGetSubMatrices(mat, 1, &isrow, &iscol, MAT_INITIAL_MATRIX, &A);CHKERRQ(ierr); matSeq = *A; ierr = PetscFree(A);CHKERRQ(ierr); ierr = ISDestroy(isrow);CHKERRQ(ierr); ierr = ISDestroy(iscol);CHKERRQ(ierr); } else matSeq = mat; /* convert the the matrix to MPIADJ type if necessary */ if (!flg) { ierr = MatConvert(matSeq, MATMPIADJ, MAT_INITIAL_MATRIX, &matMPI);CHKERRQ(ierr); } else { matMPI = matSeq; } adj = (Mat_MPIAdj *) matMPI->data; /* finaly adj contains adjacency graph */ ierr = MPI_Comm_rank(((PetscObject)part)->comm, &rank);CHKERRQ(ierr); { /* definition of Scotch library arguments */ SCOTCH_Strat stratptr; /* scotch strategy */ SCOTCH_Graph grafptr; /* scotch graph */ #if defined(DOES_NOT_COMPILE_DUE_TO_BROKEN_INTERFACE) int vertnbr = mat->rmap->N; /* number of vertices in full graph */ int *verttab = adj->i; /* start of edge list for each vertex */ int *edgetab = adj->j; /* edge list data */ int edgenbr = adj->nz; /* number of edges */ int *velotab = NULL; /* not used by petsc interface */ int *vlbltab = NULL; int *edlotab = NULL; int flagval = 3; /* (cf doc scotch no weight edge & vertices) */ #endif int baseval = 0; /* 0 for C array indexing */ char strategy[256]; ierr = PetscMalloc((mat->rmap->N) * sizeof(int), &parttab);CHKERRQ(ierr); /* redirect output to buffer scotch -> mesg_log */ #ifdef PETSC_HAVE_UNISTD_H fd_stdout = dup(1); pipe(fd_pipe); close(1); dup2(fd_pipe[1], 1); ierr = PetscMalloc(SIZE_LOG * sizeof(char), &(scotch->mesg_log));CHKERRQ(ierr); #endif /* library call */ /* Construction of the scotch graph object */ ierr = SCOTCH_graphInit(&grafptr); #if defined(DOES_NOT_COMPILE_DUE_TO_BROKEN_INTERFACE) ierr = SCOTCH_graphBuild((SCOTCH_Graph *) &grafptr, (const SCOTCH_Num) vertnbr, (const SCOTCH_Num) verttab, (const SCOTCH_Num *)velotab, (const SCOTCH_Num *)vlbltab, (const SCOTCH_Num *)edgenbr, (const SCOTCH_Num *)edgetab, (const SCOTCH_Num) edlotab, (const SCOTCH_Num *)baseval, (const SCOTCH_Num *)flagval);CHKERRQ(ierr); #else SETERRQ(PETSC_ERR_SUP,"Scotch interface currently broken"); #endif ierr = SCOTCH_graphCheck(&grafptr);CHKERRQ(ierr); /* Construction of the strategy */ if (scotch->strategy[0] != 0) { ierr = PetscStrcpy(strategy, scotch->strategy);CHKERRQ(ierr); } else { PetscStrcpy(strategy, "b{strat="); if (scotch->multilevel) { /* PetscStrcat(strategy,"m{vert="); sprintf(strategy+strlen(strategy),"%d",scotch->nbvtxcoarsed); PetscStrcat(strategy,",asc="); */ sprintf(strategy, "b{strat=m{vert=%d,asc=", scotch->nbvtxcoarsed); } else PetscStrcpy(strategy, "b{strat="); switch (scotch->global_method) { case MP_SCOTCH_GREEDY: PetscStrcat(strategy, "h"); break; case MP_SCOTCH_GPS: PetscStrcat(strategy, "g"); break; case MP_SCOTCH_GR_GPS: PetscStrcat(strategy, "g|h"); } switch (scotch->local_method) { case MP_SCOTCH_KERNIGHAN_LIN: if (scotch->multilevel) PetscStrcat(strategy, ",low=f}"); else PetscStrcat(strategy, " f"); break; case MP_SCOTCH_NONE: if (scotch->multilevel) PetscStrcat(strategy, ",asc=x}"); default: break; } PetscStrcat(strategy, " x}"); } PetscPrintf(((PetscObject)part)->comm, "strategy=[%s]\n", strategy); ierr = SCOTCH_stratInit(&stratptr);CHKERRQ(ierr); /* TODO: Correct this part Commented because this doesn't exists anymore ierr = SCOTCH_stratMap(&stratptr, strategy);CHKERRQ(ierr); */ /* check for option mapping */ if (!scotch->map) { /* ******************************************** * * * TODO: Correct this part * * * * Won't work with this tmp SCOTCH_Strat... * * * * I just modified it to make scotch compile, * * to be able to use PaStiX... * * * **********************************************/ #if defined (DOES_NOT_COMPILE_DUE_TO_BROKEN_INTERFACE) SCOTCH_Strat tmp; ierr = SCOTCH_graphPart((const SCOTCH_Graph *)&grafptr, (const SCOTCH_Num) &stratptr, (const SCOTCH_Strat *)&tmp, /* The Argument changed from scotch 3.04 it was part->n, */ (SCOTCH_Num *) parttab);CHKERRQ(ierr); #else SETERRQ(PETSC_ERR_SUP,"Scotch interface currently broken"); #endif ierr = PetscPrintf(PETSC_COMM_SELF, "Partition simple without mapping\n"); } else { SCOTCH_Graph grafarch; SCOTCH_Num *listtab; SCOTCH_Num listnbr = 0; SCOTCH_Arch archptr; /* file in scotch architecture format */ SCOTCH_Strat archstrat; int arch_total_size, *parttab_tmp,err; int cpt; char buf[256]; FILE *file1, *file2; char host_buf[256]; /* generate the graph that represents the arch */ file1 = fopen(scotch->arch, "r"); if (!file1) SETERRQ1(PETSC_ERR_FILE_OPEN, "Scotch: unable to open architecture file %s", scotch->arch); ierr = SCOTCH_graphInit(&grafarch);CHKERRQ(ierr); ierr = SCOTCH_graphLoad(&grafarch, file1, baseval, 3);CHKERRQ(ierr); ierr = SCOTCH_graphCheck(&grafarch);CHKERRQ(ierr); SCOTCH_graphSize(&grafarch, &arch_total_size, &cpt); err = fclose(file1); if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file"); printf("total size = %d\n", arch_total_size); /* generate the list of nodes currently working */ ierr = PetscGetHostName(host_buf, 256);CHKERRQ(ierr); ierr = PetscStrlen(host_buf, &j);CHKERRQ(ierr); file2 = fopen(scotch->host_list, "r"); if (!file2) SETERRQ1(PETSC_ERR_FILE_OPEN, "Scotch: unable to open host list file %s", scotch->host_list); i = -1; flg = PETSC_FALSE; while (!feof(file2) && !flg) { i++; fgets(buf, 256, file2); PetscStrncmp(buf, host_buf, j, &flg); } err = fclose(file2); if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file"); if (!flg) SETERRQ1(PETSC_ERR_LIB, "Scotch: unable to find '%s' in host list file", host_buf); listnbr = size; ierr = PetscMalloc(sizeof(SCOTCH_Num) * listnbr, &listtab);CHKERRQ(ierr); ierr = MPI_Allgather(&i, 1, MPI_INT, listtab, 1, MPI_INT, ((PetscObject)part)->comm);CHKERRQ(ierr); printf("listnbr = %d, listtab = ", listnbr); for (i = 0; i < listnbr; i++) printf("%d ", listtab[i]); printf("\n"); err = fflush(stdout); if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on file"); ierr = SCOTCH_stratInit(&archstrat);CHKERRQ(ierr); /************************************************************** * * * TODO: Correct this part * * * * Commented because this doesn't exists anymore * * * * ierr = SCOTCH_stratBipart(&archstrat, "fx");CHKERRQ(ierr); * **************************************************************/ ierr = SCOTCH_archInit(&archptr);CHKERRQ(ierr); ierr = SCOTCH_archBuild(&archptr, &grafarch, listnbr, listtab, &archstrat);CHKERRQ(ierr); ierr = PetscMalloc((mat->rmap->N) * sizeof(int), &parttab_tmp);CHKERRQ(ierr); /************************************************************************************ * * * TODO: Correct this part * * * * Commented because this doesn't exists anymore * * * * ierr = SCOTCH_mapInit(&mappptr, &grafptr, &archptr, parttab_tmp);CHKERRQ(ierr); * * * * ierr = SCOTCH_mapCompute(&mappptr, &stratptr);CHKERRQ(ierr); * * * * ierr = SCOTCH_mapView(&mappptr, stdout);CHKERRQ(ierr); * ************************************************************************************/ /* now we have to set in the real parttab at the good place */ /* because the ranks order are different than position in */ /* the arch graph */ for (i = 0; i < mat->rmap->N; i++) { parttab[i] = parttab_tmp[i]; } ierr = PetscFree(listtab);CHKERRQ(ierr); SCOTCH_archExit(&archptr); /************************************************* * TODO: Correct this part * * * * Commented because this doesn't exists anymore * * SCOTCH_mapExit(&mappptr); * *************************************************/ SCOTCH_stratExit(&archstrat); } /* dump to mesg_log... */ #ifdef PETSC_HAVE_UNISTD_H err = fflush(stdout); if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on stdout"); count = read(fd_pipe[0], scotch->mesg_log, (SIZE_LOG - 1) * sizeof(char)); if (count < 0) count = 0; scotch->mesg_log[count] = 0; close(1); dup2(fd_stdout, 1); close(fd_stdout); close(fd_pipe[0]); close(fd_pipe[1]); #endif SCOTCH_graphExit(&grafptr); SCOTCH_stratExit(&stratptr); } if (ierr) SETERRQ(PETSC_ERR_LIB, scotch->mesg_log); /* Creation of the index set */ ierr = MPI_Comm_rank(((PetscObject)part)->comm, &rank);CHKERRQ(ierr); ierr = MPI_Comm_size(((PetscObject)part)->comm, &size);CHKERRQ(ierr); nb_locals = mat->rmap->N / size; locals = parttab + rank * nb_locals; if (rank < mat->rmap->N % size) { nb_locals++; locals += rank; } else locals += mat->rmap->N % size; ierr = ISCreateGeneral(((PetscObject)part)->comm, nb_locals, locals, partitioning);CHKERRQ(ierr); /* destroying old objects */ ierr = PetscFree(parttab);CHKERRQ(ierr); if (matSeq != mat) { ierr = MatDestroy(matSeq);CHKERRQ(ierr); } if (matMPI != mat) { ierr = MatDestroy(matMPI);CHKERRQ(ierr); } PetscFunctionReturn(0); }