EXTERN_C_BEGIN
/* ----------------------------------------------------------------------------*/
/*
MatGetColoring_SL_Minpack - Uses the smallest-last (SL) coloring of minpack
*/
#undef __FUNCT__
#define __FUNCT__ "MatGetColoring_SL_Minpack"
PetscErrorCode MatGetColoring_SL_Minpack(Mat mat,MatColoringType name,ISColoring *iscoloring)
{
PetscErrorCode ierr;
PetscInt *list,*work,clique,*seq,*coloring,n;
const PetscInt *ria,*rja,*cia,*cja;
PetscInt ncolors,i;
PetscBool done;
Mat mat_seq = mat;
PetscMPIInt size;
MPI_Comm comm;
ISColoring iscoloring_seq;
PetscInt bs = 1,rstart,rend,N_loc,nc;
ISColoringValue *colors_loc;
PetscBool flg1,flg2;
PetscFunctionBegin;
/* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
ierr = PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
}
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1){
/* create a sequential iscoloring on all processors */
ierr = MatGetSeqNonzeroStructure(mat,&mat_seq);CHKERRQ(ierr);
}
ierr = MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");
ierr = MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);CHKERRQ(ierr);
ierr = PetscMalloc2(n,PetscInt,&list,4*n,PetscInt,&work);CHKERRQ(ierr);
MINPACKslo(&n,cja,cia,rja,ria,seq,list,&clique,work,work+n,work+2*n,work+3*n);
ierr = PetscMalloc(n*sizeof(PetscInt),&coloring);CHKERRQ(ierr);
MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
ierr = PetscFree2(list,work);CHKERRQ(ierr);
ierr = PetscFree(seq);CHKERRQ(ierr);
ierr = MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);CHKERRQ(ierr);
/* shift coloring numbers to start at zero and shorten */
if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
{
ISColoringValue *s = (ISColoringValue*) coloring;
for (i=0; i<n; i++) {
s[i] = (ISColoringValue) (coloring[i]-1);
}
ierr = MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);CHKERRQ(ierr);
}
if (size > 1) {
ierr = MatDestroySeqNonzeroStructure(&mat_seq);CHKERRQ(ierr);
/* convert iscoloring_seq to a parallel iscoloring */
iscoloring_seq = *iscoloring;
rstart = mat->rmap->rstart/bs;
rend = mat->rmap->rend/bs;
N_loc = rend - rstart; /* number of local nodes */
/* get local colors for each local node */
ierr = PetscMalloc((N_loc+1)*sizeof(ISColoringValue),&colors_loc);CHKERRQ(ierr);
for (i=rstart; i<rend; i++){
colors_loc[i-rstart] = iscoloring_seq->colors[i];
}
/* create a parallel iscoloring */
nc=iscoloring_seq->n;
ierr = ISColoringCreate(comm,nc,N_loc,colors_loc,iscoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring_seq);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatColoringApply_LF(MatColoring mc,ISColoring *iscoloring)
{
PetscErrorCode ierr;
PetscInt *list,*work,*seq,*coloring,n;
const PetscInt *ria,*rja,*cia,*cja;
PetscInt n1, none,ncolors,i;
PetscBool done;
Mat mat = mc->mat;
Mat mat_seq = mat;
PetscMPIInt size;
MPI_Comm comm;
ISColoring iscoloring_seq;
PetscInt bs = 1,rstart,rend,N_loc,nc;
ISColoringValue *colors_loc;
PetscBool flg1,flg2;
PetscFunctionBegin;
if (mc->dist != 2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LF may only do distance 2 coloring");
/* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
ierr = PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
}
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1) {
/* create a sequential iscoloring on all processors */
ierr = MatGetSeqNonzeroStructure(mat,&mat_seq);CHKERRQ(ierr);
}
ierr = MatGetRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatGetColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,&n,&cia,&cja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Ordering requires IJ");
ierr = MatFDColoringDegreeSequence_Minpack(n,cja,cia,rja,ria,&seq);CHKERRQ(ierr);
ierr = PetscMalloc2(n,&list,4*n,&work);CHKERRQ(ierr);
n1 = n - 1;
none = -1;
MINPACKnumsrt(&n,&n1,seq,&none,list,work+2*n,work+n);
ierr = PetscMalloc1(n,&coloring);CHKERRQ(ierr);
MINPACKseq(&n,cja,cia,rja,ria,list,coloring,&ncolors,work);
ierr = PetscFree2(list,work);CHKERRQ(ierr);
ierr = PetscFree(seq);CHKERRQ(ierr);
ierr = MatRestoreRowIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&ria,&rja,&done);CHKERRQ(ierr);
ierr = MatRestoreColumnIJ(mat_seq,1,PETSC_FALSE,PETSC_TRUE,NULL,&cia,&cja,&done);CHKERRQ(ierr);
/* shift coloring numbers to start at zero and shorten */
if (ncolors > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
{
ISColoringValue *s = (ISColoringValue*) coloring;
for (i=0; i<n; i++) s[i] = (ISColoringValue) (coloring[i]-1);
ierr = MatColoringPatch(mat_seq,ncolors,n,s,iscoloring);CHKERRQ(ierr);
}
if (size > 1) {
ierr = MatDestroySeqNonzeroStructure(&mat_seq);CHKERRQ(ierr);
/* convert iscoloring_seq to a parallel iscoloring */
iscoloring_seq = *iscoloring;
rstart = mat->rmap->rstart/bs;
rend = mat->rmap->rend/bs;
N_loc = rend - rstart; /* number of local nodes */
/* get local colors for each local node */
ierr = PetscMalloc1((N_loc+1),&colors_loc);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) colors_loc[i-rstart] = iscoloring_seq->colors[i];
/* create a parallel iscoloring */
nc = iscoloring_seq->n;
ierr = ISColoringCreate(comm,nc,N_loc,colors_loc,iscoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring_seq);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}