PetscErrorCode MatColoringCreateWeights(MatColoring mc,PetscReal **weights,PetscInt **lperm)
{
PetscErrorCode ierr;
PetscInt i,s,e,n;
PetscReal *wts;
PetscFunctionBegin;
/* create weights of the specified type */
ierr = MatGetOwnershipRange(mc->mat,&s,&e);CHKERRQ(ierr);
n=e-s;
ierr = PetscMalloc1(n,&wts);CHKERRQ(ierr);
switch(mc->weight_type) {
case MAT_COLORING_WEIGHT_RANDOM:
ierr = MatColoringCreateRandomWeights(mc,wts);CHKERRQ(ierr);
break;
case MAT_COLORING_WEIGHT_LEXICAL:
ierr = MatColoringCreateLexicalWeights(mc,wts);CHKERRQ(ierr);
break;
case MAT_COLORING_WEIGHT_LF:
ierr = MatColoringCreateLargestFirstWeights(mc,wts);CHKERRQ(ierr);
break;
case MAT_COLORING_WEIGHT_SL:
ierr = MatColoringCreateSmallestLastWeights(mc,wts);CHKERRQ(ierr);
break;
}
if (lperm) {
ierr = PetscMalloc1(n,lperm);CHKERRQ(ierr);
for (i=0;i<n;i++) {
(*lperm)[i] = i;
}
ierr = PetscSortRealWithPermutation(n,wts,*lperm);CHKERRQ(ierr);
for (i=0;i<n/2;i++) {
PetscInt swp;
swp = (*lperm)[i];
(*lperm)[i] = (*lperm)[n-1-i];
(*lperm)[n-1-i] = swp;
}
}
if (weights) *weights = wts;
PetscFunctionReturn(0);
}
/*@
PetscDrawBarDraw - Redraws a bar graph.
Collective on PetscDrawBar
Input Parameter:
. bar - The bar graph context
Level: intermediate
.seealso: PetscDrawBar, PetscDrawBarCreate(), PetscDrawBarSetData()
@*/
PetscErrorCode PetscDrawBarDraw(PetscDrawBar bar)
{
PetscDraw draw;
PetscBool isnull;
PetscReal xmin,xmax,ymin,ymax,*values,binLeft,binRight;
PetscInt numValues,i,bcolor,color,idx,*perm,nplot;
PetscMPIInt rank;
PetscErrorCode ierr;
char **labels;
PetscFunctionBegin;
PetscValidHeaderSpecific(bar,PETSC_DRAWBAR_CLASSID,1);
ierr = PetscDrawIsNull(bar->win,&isnull);CHKERRQ(ierr);
if (isnull) PetscFunctionReturn(0);
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)bar),&rank);CHKERRQ(ierr);
if (bar->numBins < 1) PetscFunctionReturn(0);
color = bar->color;
if (color == PETSC_DRAW_ROTATE) bcolor = PETSC_DRAW_BLACK+1;
else bcolor = color;
numValues = bar->numBins;
values = bar->values;
if (bar->ymin == bar->ymax) {
/* user has not set bounds on bars so set them based on the data */
ymin = PETSC_MAX_REAL;
ymax = PETSC_MIN_REAL;
for (i=0; i<numValues; i++) {
ymin = PetscMin(ymin,values[i]);
ymax = PetscMax(ymax,values[i]);
}
} else {
ymin = bar->ymin;
ymax = bar->ymax;
}
nplot = numValues; /* number of points to actually plot; if some are lower than requested tolerance */
xmin = 0.0;
xmax = nplot;
labels = bar->labels;
if (bar->sort) {
ierr = PetscMalloc1(numValues,&perm);CHKERRQ(ierr);
for (i=0; i<numValues;i++) perm[i] = i;
ierr = PetscSortRealWithPermutation(numValues,values,perm);CHKERRQ(ierr);
if (bar->sorttolerance) {
for (i=0; i<numValues;i++) {
if (values[perm[numValues - i - 1]] < bar->sorttolerance) {
nplot = i;
break;
}
}
}
}
draw = bar->win;
ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr);
ierr = PetscDrawClear(draw);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLimits(bar->axis,xmin,xmax,ymin,ymax);CHKERRQ(ierr);
ierr = PetscDrawAxisDraw(bar->axis);CHKERRQ(ierr);
ierr = PetscDrawCollectiveBegin(draw);CHKERRQ(ierr);
if (!rank) { /* Draw bins */
for (i=0; i<nplot; i++) {
idx = (bar->sort ? perm[numValues - i - 1] : i);
binLeft = xmin + i;
binRight = xmin + i + 1;
ierr = PetscDrawRectangle(draw,binLeft,ymin,binRight,values[idx],bcolor,bcolor,bcolor,bcolor);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,binLeft,ymin,binLeft,values[idx],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,binRight,ymin,binRight,values[idx],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,binLeft,values[idx],binRight,values[idx],PETSC_DRAW_BLACK);CHKERRQ(ierr);
if (labels) {
PetscReal h;
ierr = PetscDrawStringGetSize(draw,NULL,&h);CHKERRQ(ierr);
ierr = PetscDrawStringCentered(draw,.5*(binLeft+binRight),ymin - 1.5*h,bcolor,labels[idx]);CHKERRQ(ierr);
}
if (color == PETSC_DRAW_ROTATE) bcolor++;
if (bcolor > PETSC_DRAW_BASIC_COLORS-1) bcolor = PETSC_DRAW_BLACK+1;
}
}
ierr = PetscDrawCollectiveEnd(draw);CHKERRQ(ierr);
if (bar->sort) {ierr = PetscFree(perm);CHKERRQ(ierr);}
ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
ierr = PetscDrawPause(draw);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatColoringLocalColor(MatColoring mc,PetscSF etoc,PetscSF etor,PetscReal *wts,ISColoringValue *color, ISColoringValue *maxcolor)
{
PetscInt nrows,ncols,ncolentries,nrowentries,idx,neighoffset;
PetscInt i,j,k;
PetscInt dist = mc->dist;
PetscInt totalcolors;
PetscBool *colormask;
PetscErrorCode ierr;
PetscBool *rowseen,*colseen;
const PetscInt *rowdegrees;
PetscInt *rowoffsets;
const PetscInt *coldegrees;
PetscInt *coloffsets;
PetscInt offset;
PetscInt *ll_ptr;
PetscInt *ll_idx;
PetscReal *swts;
PetscInt *sidx;
PetscInt unused;
PetscInt rowlist,collist;
PetscInt swp;
PetscMPIInt rank;
const PetscSFNode *colentries,*rowentries;
PetscFunctionBegin;
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mc),&rank);CHKERRQ(ierr);
ierr = PetscSFGetGraph(etoc,&ncols,&ncolentries,NULL,&colentries);CHKERRQ(ierr);
ierr = PetscSFGetGraph(etor,&nrows,&nrowentries,NULL,&rowentries);CHKERRQ(ierr);
ierr = PetscMalloc6(nrows,&rowseen,ncols,&colseen,ncols,&coloffsets,nrows,&rowoffsets,2*ncols,&ll_ptr,2*ncols,&ll_idx);CHKERRQ(ierr);
ierr = PetscMalloc2(ncols,&sidx,ncols,&swts);CHKERRQ(ierr);
ierr = PetscSFComputeDegreeBegin(etoc,&rowdegrees);CHKERRQ(ierr);
ierr = PetscSFComputeDegreeEnd(etoc,&rowdegrees);CHKERRQ(ierr);
ierr = PetscSFComputeDegreeBegin(etor,&coldegrees);CHKERRQ(ierr);
ierr = PetscSFComputeDegreeEnd(etor,&coldegrees);CHKERRQ(ierr);
/* sort by weight */
for (i=0;i<ncols;i++) {
sidx[i] = i;
swts[i] = wts[i];
}
ierr = PetscSortRealWithPermutation(ncols,swts,sidx);CHKERRQ(ierr);
for (i=0;i<ncols/2;i++) {
swp = sidx[i];
sidx[i] = sidx[ncols-1-i];
sidx[ncols-1-i] = swp;
}
/* set up the "unused" linked list */
unused = 0;
ll_ptr[2*ncols-1] = -1;
for (i=0;i<2*ncols-1;i++) {
ll_ptr[i] = i+1;
}
/* initialize the offsets */
offset=0;
for (i=0;i<ncols;i++) {
coloffsets[i] = offset;
offset+=coldegrees[i];
colseen[i] = PETSC_FALSE;
}
offset=0;
for (i=0;i<nrows;i++) {
rowoffsets[i] = offset;
offset+=rowdegrees[i];
rowseen[i] = PETSC_FALSE;
}
/* discover the maximum current color */
totalcolors = 1;
for (i=0;i<ncols;i++) {
if (color[i] > totalcolors-1 && color[i] != IS_COLORING_MAX) totalcolors = color[i]+1;
}
if (totalcolors < 10) totalcolors=10;
ierr = PetscMalloc(sizeof(PetscBool)*totalcolors,&colormask);CHKERRQ(ierr);
/* alternate between rows and columns to get the distance k minimum coloring */
for (i=0;i<ncols;i++) {
collist = -1;
rowlist = -1;
if (color[sidx[i]] == IS_COLORING_MAX) {
for (j=0;j<totalcolors;j++) colormask[j] = PETSC_FALSE;
swp = unused;
unused = ll_ptr[unused];
ll_ptr[swp] = collist;
ll_idx[swp] = sidx[i];
collist = swp;
colseen[sidx[i]] = PETSC_TRUE;
for (k=0;k<=dist;k++) {
if (k % 2 == 0) {
while (collist >= 0) {
if (k != dist) {
for (j=0;j<coldegrees[ll_idx[collist]];j++) {
neighoffset = coloffsets[ll_idx[collist]]+j;
idx = colentries[neighoffset].index;
if (colentries[neighoffset].rank == rank && !rowseen[idx]) {
swp = unused;
unused = ll_ptr[unused];
ll_ptr[swp] = rowlist;
ll_idx[swp] = idx;
rowlist = swp;
rowseen[idx] = PETSC_TRUE;
}
}
}
if (color[ll_idx[collist]] != IS_COLORING_MAX) colormask[color[ll_idx[collist]]] = PETSC_TRUE;
colseen[ll_idx[collist]] = PETSC_FALSE;
swp = collist;
collist = ll_ptr[collist];
ll_ptr[swp] = unused;
unused = swp;
}
} else {
while (rowlist >= 0) {
if (k != dist) {
for (j=0;j<rowdegrees[ll_idx[rowlist]];j++) {
neighoffset = rowoffsets[ll_idx[rowlist]]+j;
idx = rowentries[neighoffset].index;
if (rowentries[neighoffset].rank == rank && !colseen[idx]) {
swp = unused;
unused = ll_ptr[unused];
ll_ptr[swp] = collist;
ll_idx[swp] = idx;
collist = swp;
colseen[idx] = PETSC_TRUE;
}
}
}
if (color[ll_idx[rowlist]] != IS_COLORING_MAX) colormask[color[ll_idx[rowlist]]] = PETSC_TRUE;
rowseen[ll_idx[rowlist]] = PETSC_FALSE;
swp = rowlist;
rowlist = ll_ptr[rowlist];
ll_ptr[swp] = unused;
unused = swp;
}
}
}
color[sidx[i]] = totalcolors;
for (k=0;k<totalcolors;k++) {
if (!colormask[k]) {color[sidx[i]] = k; break;}
}
if (color[sidx[i]] >= mc->maxcolors && mc->maxcolors > 0) color[sidx[i]] = mc->maxcolors;
if (color[sidx[i]] > *maxcolor) *maxcolor = color[sidx[i]];
if (color[sidx[i]] > totalcolors-1) {
totalcolors *= 2;
ierr = PetscFree(colormask);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscBool)*totalcolors,&colormask);CHKERRQ(ierr);
}
}
if (collist != -1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_NOT_CONVERGED,"Likely error in local coloring BFS -- column queue still has %d\n",collist);
if (rowlist != -1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_NOT_CONVERGED,"Likely error in local coloring BFS -- row queue still has %d\n",rowlist);
}
for (i=0;i<ncols;i++) {
if (colseen[i]) {SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_NOT_CONVERGED,"Likely error in local coloring BFS -- column %d still seen\n",i);}
}
for (i=0;i<nrows;i++) {
if (rowseen[i]) {SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_NOT_CONVERGED,"Likely error in local coloring BFS -- row %d still seen\n",i);}
}
ierr = PetscFree6(rowseen,colseen,coloffsets,rowoffsets,ll_ptr,ll_idx);CHKERRQ(ierr);
ierr = PetscFree2(sidx,swts);CHKERRQ(ierr);
ierr = PetscFree(colormask);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
KSPComputeEigenvaluesExplicitly - Computes all of the eigenvalues of the
preconditioned operator using LAPACK.
Collective on KSP
Input Parameter:
+ ksp - iterative context obtained from KSPCreate()
- n - size of arrays r and c
Output Parameters:
+ r - real part of computed eigenvalues
- c - complex part of computed eigenvalues
Notes:
This approach is very slow but will generally provide accurate eigenvalue
estimates. This routine explicitly forms a dense matrix representing
the preconditioned operator, and thus will run only for relatively small
problems, say n < 500.
Many users may just want to use the monitoring routine
KSPMonitorSingularValue() (which can be set with option -ksp_monitor_singular_value)
to print the singular values at each iteration of the linear solve.
The preconditoner operator, rhs vector, solution vectors should be
set before this routine is called. i.e use KSPSetOperators(),KSPSolve() or
KSPSetOperators()
Level: advanced
.keywords: KSP, compute, eigenvalues, explicitly
.seealso: KSPComputeEigenvalues(), KSPMonitorSingularValue(), KSPComputeExtremeSingularValues(), KSPSetOperators(), KSPSolve()
@*/
PetscErrorCode KSPComputeEigenvaluesExplicitly(KSP ksp,PetscInt nmax,PetscReal *r,PetscReal *c)
{
Mat BA;
PetscErrorCode ierr;
PetscMPIInt size,rank;
MPI_Comm comm = ((PetscObject)ksp)->comm;
PetscScalar *array;
Mat A;
PetscInt m,row,nz,i,n,dummy;
const PetscInt *cols;
const PetscScalar *vals;
PetscFunctionBegin;
ierr = KSPComputeExplicitOperator(ksp,&BA);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MatGetSize(BA,&n,&n);CHKERRQ(ierr);
if (size > 1) { /* assemble matrix on first processor */
ierr = MatCreate(((PetscObject)ksp)->comm,&A);CHKERRQ(ierr);
if (!rank) {
ierr = MatSetSizes(A,n,n,n,n);CHKERRQ(ierr);
} else {
ierr = MatSetSizes(A,0,0,n,n);CHKERRQ(ierr);
}
ierr = MatSetType(A,MATMPIDENSE);CHKERRQ(ierr);
ierr = MatMPIDenseSetPreallocation(A,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParent(BA,A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(BA,&row,&dummy);CHKERRQ(ierr);
ierr = MatGetLocalSize(BA,&m,&dummy);CHKERRQ(ierr);
for (i=0; i<m; i++) {
ierr = MatGetRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&row,nz,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
row++;
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatDenseGetArray(A,&array);CHKERRQ(ierr);
} else {
ierr = MatDenseGetArray(BA,&array);CHKERRQ(ierr);
}
#if defined(PETSC_HAVE_ESSL)
/* ESSL has a different calling sequence for dgeev() and zgeev() than standard LAPACK */
if (!rank) {
PetscScalar sdummy,*cwork;
PetscReal *work,*realpart;
PetscBLASInt clen,idummy,lwork,bn,zero = 0;
PetscInt *perm;
#if !defined(PETSC_USE_COMPLEX)
clen = n;
#else
clen = 2*n;
#endif
ierr = PetscMalloc(clen*sizeof(PetscScalar),&cwork);CHKERRQ(ierr);
idummy = -1; /* unused */
bn = PetscBLASIntCast(n);
lwork = 5*n;
ierr = PetscMalloc(lwork*sizeof(PetscReal),&work);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&realpart);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeev_(&zero,array,&bn,cwork,&sdummy,&idummy,&idummy,&bn,work,&lwork);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
/* For now we stick with the convention of storing the real and imaginary
components of evalues separately. But is this what we really want? */
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) {
realpart[i] = cwork[2*i];
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = cwork[2*perm[i]];
c[i] = cwork[2*perm[i]+1];
}
#else
for (i=0; i<n; i++) {
realpart[i] = PetscRealPart(cwork[i]);
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(cwork[perm[i]]);
c[i] = PetscImaginaryPart(cwork[perm[i]]);
}
#endif
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(realpart);CHKERRQ(ierr);
ierr = PetscFree(cwork);CHKERRQ(ierr);
}
#elif !defined(PETSC_USE_COMPLEX)
if (!rank) {
PetscScalar *work;
PetscReal *realpart,*imagpart;
PetscBLASInt idummy,lwork;
PetscInt *perm;
idummy = n;
lwork = 5*n;
ierr = PetscMalloc(2*n*sizeof(PetscReal),&realpart);CHKERRQ(ierr);
imagpart = realpart + n;
ierr = PetscMalloc(5*n*sizeof(PetscReal),&work);CHKERRQ(ierr);
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#else
{
PetscBLASInt lierr;
PetscScalar sdummy;
PetscBLASInt bn = PetscBLASIntCast(n);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeev_("N","N",&bn,array,&bn,realpart,imagpart,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,&lierr);
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
for (i=0; i<n; i++) { perm[i] = i;}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = realpart[perm[i]];
c[i] = imagpart[perm[i]];
}
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(realpart);CHKERRQ(ierr);
}
#else
if (!rank) {
PetscScalar *work,*eigs;
PetscReal *rwork;
PetscBLASInt idummy,lwork;
PetscInt *perm;
idummy = n;
lwork = 5*n;
ierr = PetscMalloc(5*n*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = PetscMalloc(2*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscScalar),&eigs);CHKERRQ(ierr);
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#else
{
PetscBLASInt lierr;
PetscScalar sdummy;
PetscBLASInt nb = PetscBLASIntCast(n);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeev_("N","N",&nb,array,&nb,eigs,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,rwork,&lierr);
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(rwork);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
for (i=0; i<n; i++) { perm[i] = i;}
for (i=0; i<n; i++) { r[i] = PetscRealPart(eigs[i]);}
ierr = PetscSortRealWithPermutation(n,r,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(eigs[perm[i]]);
c[i] = PetscImaginaryPart(eigs[perm[i]]);
}
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(eigs);CHKERRQ(ierr);
}
#endif
if (size > 1) {
ierr = MatDenseRestoreArray(A,&array);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
} else {
ierr = MatDenseRestoreArray(BA,&array);CHKERRQ(ierr);
}
ierr = MatDestroy(&BA);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPComputeEigenvalues_GMRES(KSP ksp,PetscInt nmax,PetscReal *r,PetscReal *c,PetscInt *neig)
{
#if defined(PETSC_HAVE_ESSL)
KSP_GMRES *gmres = (KSP_GMRES*)ksp->data;
PetscErrorCode ierr;
PetscInt n = gmres->it + 1,N = gmres->max_k + 1;
PetscInt i,*perm;
PetscScalar *R = gmres->Rsvd;
PetscScalar *cwork = R + N*N,sdummy;
PetscReal *work,*realpart = gmres->Dsvd ;
PetscBLASInt zero = 0,bn,bN,idummy,lwork;
PetscFunctionBegin;
bn = PetscBLASIntCast(n);
bN = PetscBLASIntCast(N);
idummy = -1; /* unused */
lwork = PetscBLASIntCast(5*N);
if (nmax < n) SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_ARG_SIZ,"Not enough room in work space r and c for eigenvalues");
*neig = n;
if (!n) {
PetscFunctionReturn(0);
}
/* copy R matrix to work space */
ierr = PetscMemcpy(R,gmres->hes_origin,N*N*sizeof(PetscScalar));
CHKERRQ(ierr);
/* compute eigenvalues */
/* for ESSL version need really cwork of length N (complex), 2N
(real); already at least 5N of space has been allocated */
ierr = PetscMalloc(lwork*sizeof(PetscReal),&work);
CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);
CHKERRQ(ierr);
LAPACKgeev_(&zero,R,&bN,cwork,&sdummy,&idummy,&idummy,&bn,work,&lwork);
ierr = PetscFPTrapPop();
CHKERRQ(ierr);
ierr = PetscFree(work);
CHKERRQ(ierr);
/* For now we stick with the convention of storing the real and imaginary
components of evalues separately. But is this what we really want? */
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);
CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) {
realpart[i] = cwork[2*i];
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = cwork[2*perm[i]];
c[i] = cwork[2*perm[i]+1];
}
#else
for (i=0; i<n; i++) {
realpart[i] = PetscRealPart(cwork[i]);
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(cwork[perm[i]]);
c[i] = PetscImaginaryPart(cwork[perm[i]]);
}
#endif
ierr = PetscFree(perm);
CHKERRQ(ierr);
#elif defined(PETSC_MISSING_LAPACK_GEEV)
PetscFunctionBegin;
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#elif !defined(PETSC_USE_COMPLEX)
KSP_GMRES *gmres = (KSP_GMRES*)ksp->data;
PetscErrorCode ierr;
PetscInt n = gmres->it + 1,N = gmres->max_k + 1,i,*perm;
PetscBLASInt bn, bN, lwork, idummy, lierr;
PetscScalar *R = gmres->Rsvd,*work = R + N*N;
PetscScalar *realpart = gmres->Dsvd,*imagpart = realpart + N,sdummy;
PetscFunctionBegin;
bn = PetscBLASIntCast(n);
bN = PetscBLASIntCast(N);
lwork = PetscBLASIntCast(5*N);
idummy = PetscBLASIntCast(N);
if (nmax < n) SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_ARG_SIZ,"Not enough room in work space r and c for eigenvalues");
*neig = n;
if (!n) {
PetscFunctionReturn(0);
}
/* copy R matrix to work space */
ierr = PetscMemcpy(R,gmres->hes_origin,N*N*sizeof(PetscScalar));
CHKERRQ(ierr);
/* compute eigenvalues */
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);
CHKERRQ(ierr);
LAPACKgeev_("N","N",&bn,R,&bN,realpart,imagpart,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,&lierr);
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();
CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = realpart[perm[i]];
c[i] = imagpart[perm[i]];
}
ierr = PetscFree(perm);
CHKERRQ(ierr);
#else
KSP_GMRES *gmres = (KSP_GMRES*)ksp->data;
PetscErrorCode ierr;
PetscInt n = gmres->it + 1,N = gmres->max_k + 1,i,*perm;
PetscScalar *R = gmres->Rsvd,*work = R + N*N,*eigs = work + 5*N,sdummy;
PetscBLASInt bn,bN,lwork,idummy,lierr;
PetscFunctionBegin;
bn = PetscBLASIntCast(n);
bN = PetscBLASIntCast(N);
lwork = PetscBLASIntCast(5*N);
idummy = PetscBLASIntCast(N);
if (nmax < n) SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_ARG_SIZ,"Not enough room in work space r and c for eigenvalues");
*neig = n;
if (!n) {
PetscFunctionReturn(0);
}
/* copy R matrix to work space */
ierr = PetscMemcpy(R,gmres->hes_origin,N*N*sizeof(PetscScalar));
CHKERRQ(ierr);
/* compute eigenvalues */
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);
CHKERRQ(ierr);
LAPACKgeev_("N","N",&bn,R,&bN,eigs,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,gmres->Dsvd,&lierr);
if (lierr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine");
ierr = PetscFPTrapPop();
CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
perm[i] = i;
}
for (i=0; i<n; i++) {
r[i] = PetscRealPart(eigs[i]);
}
ierr = PetscSortRealWithPermutation(n,r,perm);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(eigs[perm[i]]);
c[i] = PetscImaginaryPart(eigs[perm[i]]);
}
ierr = PetscFree(perm);
CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
void array_sort_d(unsigned int NRows, unsigned int NCols, double *A, unsigned int *Indices, const char ordering,
const char trans)
{
unsigned int i, count, swap,
row, col, *colMs, *colMe, SortLen, rowM, rowS,
*Indicestmp, *IndicesInter;
double *Atmp;
if ((ordering == 'R' && trans == 'T') || (ordering == 'C' && trans == 'N')) {
mkl_dimatcopy(ordering,trans,NRows,NCols,1.,A,NCols,NRows);
swap = NRows; NRows = NCols; NCols = swap;
} else if ((ordering == 'R' && trans == 'N') || (ordering == 'C' && trans == 'T')) {
// Don't do anything.
} else {
printf("Error: Invalid ordering/trans input.\n"), EXIT_MSG;
}
// array_print_d(NRows,NCols,A,'R');
colMs = malloc(NRows * sizeof *colMs); // free
colMe = malloc(NRows * sizeof *colMe); // free
for (row = 0; row < NRows; row++) {
if (row == 0) {
colMs[row] = 0;
colMe[row] = NCols-1;
SortLen = colMe[row] - colMs[row] + 1;
IndicesInter = malloc(SortLen * sizeof *IndicesInter); // free
Indicestmp = malloc(SortLen * sizeof *Indicestmp); // free
for (i = 0; i < SortLen; i++)
Indicestmp[i] = i;
PetscSortRealWithPermutation(SortLen,&A[row*NCols],(int *)Indicestmp);
for (i = 0; i < SortLen; i++) IndicesInter[i] = Indices[Indicestmp[i]];
for (i = 0; i < SortLen; i++) Indices[i] = IndicesInter[i];
free(IndicesInter);
Atmp = malloc(NCols * sizeof *Atmp); // free
// Rearrange rows (including the current row) accordingly
for (rowM = row; rowM < NRows; rowM++) {
for (col = 0; col < NCols; col++) Atmp[col] = A[rowM*NCols+col];
for (col = 0; col < NCols; col++) A[rowM*NCols+col] = Atmp[Indicestmp[col]];
}
free(Indicestmp);
free(Atmp);
} else {
colMs[0] = colMe[row-1] = 0;
while (colMe[row-1] < NCols-1) {
for (rowM = 0; rowM < row; rowM++) {
if (rowM > 0)
colMs[rowM] = colMs[rowM-1];
col = colMs[rowM]+1;
while (col < NCols && A[rowM*NCols+col] == A[rowM*NCols+colMs[rowM]])
col++;
colMe[rowM] = col-1;
}
rowM -= 1;
SortLen = colMe[rowM] - colMs[rowM]+1;
// printf("%d %d %d %d %d %d %d \n",row,rowM,colMs[0],colMe[0],colMs[rowM],colMe[rowM],SortLen);
IndicesInter = malloc(SortLen * sizeof *IndicesInter); // free
Indicestmp = malloc(SortLen * sizeof *Indicestmp); // free
for (i = 0; i < SortLen; i++)
Indicestmp[i] = i;
PetscSortRealWithPermutation(SortLen,&A[row*NCols+colMs[rowM]],(int *)Indicestmp);
for (i = 0; i < SortLen; i++) IndicesInter[i] = Indices[Indicestmp[i]+colMs[rowM]];
for (i = 0; i < SortLen; i++) Indices[i+colMs[rowM]] = IndicesInter[i];
free(IndicesInter);
Atmp = malloc(SortLen * sizeof *Atmp); // free
// Rearrange rows (including the current row) accordingly
for (rowS = row; rowS < NRows; rowS++) {
for (count = 0, col = colMs[rowM]; col <= colMe[rowM]; col++) {
Atmp[count] = A[rowS*NCols+col];
count++;
}
for (count = 0, col = colMs[rowM]; col <= colMe[rowM]; col++) {
A[rowS*NCols+col] = Atmp[Indicestmp[count]];
count++;
}
}
free(Indicestmp);
free(Atmp);
colMs[0] = colMe[row-1]+1;
}
}
// printf("row: %d: \n",row);
// array_print_d(NRows,NCols,A,'R');
// array_print_i(1,NCols,Indices,'R');
}
free(colMs);
free(colMe);
// array_print_d(NRows,NCols,A,'R');
if ((ordering == 'R' && trans == 'T') || (ordering == 'C' && trans == 'N')) {
mkl_dimatcopy(ordering,trans,NRows,NCols,1.,A,NCols,NRows);
swap = NRows; NRows = NCols; NCols = swap;
} else if ((ordering == 'R' && trans == 'N') || (ordering == 'C' && trans == 'T')) {
// Don't do anything.
}
// array_print_d(NRows,NCols,A,'R');
}
static PetscErrorCode ComputeSpectral(DM dm, Vec u, PetscInt numPlanes, const PetscInt planeDir[], const PetscReal planeCoord[], AppCtx *user)
{
MPI_Comm comm;
PetscSection coordSection, section;
Vec coordinates, uloc;
const PetscScalar *coords, *array;
PetscInt p;
PetscMPIInt size, rank;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm, &uloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm, u, INSERT_VALUES, uloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm, u, INSERT_VALUES, uloc);CHKERRQ(ierr);
ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, uloc, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
ierr = VecViewFromOptions(uloc, NULL, "-sol_view");CHKERRQ(ierr);
ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr);
ierr = VecGetArrayRead(uloc, &array);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
for (p = 0; p < numPlanes; ++p) {
DMLabel label;
char name[PETSC_MAX_PATH_LEN];
Mat F;
Vec x, y;
IS stratum;
PetscReal *ray, *gray;
PetscScalar *rvals, *svals, *gsvals;
PetscInt *perm, *nperm;
PetscInt n, N, i, j, off, offu;
const PetscInt *points;
ierr = PetscSNPrintf(name, PETSC_MAX_PATH_LEN, "spectral_plane_%D", p);CHKERRQ(ierr);
ierr = DMGetLabel(dm, name, &label);CHKERRQ(ierr);
ierr = DMLabelGetStratumIS(label, 1, &stratum);CHKERRQ(ierr);
ierr = ISGetLocalSize(stratum, &n);CHKERRQ(ierr);
ierr = ISGetIndices(stratum, &points);CHKERRQ(ierr);
ierr = PetscMalloc2(n, &ray, n, &svals);CHKERRQ(ierr);
for (i = 0; i < n; ++i) {
ierr = PetscSectionGetOffset(coordSection, points[i], &off);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(section, points[i], &offu);CHKERRQ(ierr);
ray[i] = PetscRealPart(coords[off+((planeDir[p]+1)%2)]);
svals[i] = array[offu];
}
/* Gather the ray data to proc 0 */
if (size > 1) {
PetscMPIInt *cnt, *displs, p;
ierr = PetscCalloc2(size, &cnt, size, &displs);CHKERRQ(ierr);
ierr = MPI_Gather(&n, 1, MPIU_INT, cnt, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
for (p = 1; p < size; ++p) displs[p] = displs[p-1] + cnt[p-1];
N = displs[size-1] + cnt[size-1];
ierr = PetscMalloc2(N, &gray, N, &gsvals);CHKERRQ(ierr);
ierr = MPI_Gatherv(ray, n, MPIU_REAL, gray, cnt, displs, MPIU_REAL, 0, comm);CHKERRQ(ierr);
ierr = MPI_Gatherv(svals, n, MPIU_SCALAR, gsvals, cnt, displs, MPIU_SCALAR, 0, comm);CHKERRQ(ierr);
ierr = PetscFree2(cnt, displs);CHKERRQ(ierr);
} else {
N = n;
gray = ray;
gsvals = svals;
}
if (!rank) {
/* Sort point along ray */
ierr = PetscMalloc2(N, &perm, N, &nperm);CHKERRQ(ierr);
for (i = 0; i < N; ++i) {perm[i] = i;}
ierr = PetscSortRealWithPermutation(N, gray, perm);CHKERRQ(ierr);
/* Count duplicates and squish mapping */
nperm[0] = perm[0];
for (i = 1, j = 1; i < N; ++i) {
if (PetscAbsReal(gray[perm[i]] - gray[perm[i-1]]) > PETSC_SMALL) nperm[j++] = perm[i];
}
/* Create FFT structs */
ierr = MatCreateFFT(PETSC_COMM_SELF, 1, &j, MATFFTW, &F);CHKERRQ(ierr);
ierr = MatCreateVecs(F, &x, &y);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) y, name);CHKERRQ(ierr);
ierr = VecGetArray(x, &rvals);CHKERRQ(ierr);
for (i = 0, j = 0; i < N; ++i) {
if (i > 0 && PetscAbsReal(gray[perm[i]] - gray[perm[i-1]]) < PETSC_SMALL) continue;
rvals[j] = gsvals[nperm[j]];
++j;
}
ierr = PetscFree2(perm, nperm);CHKERRQ(ierr);
if (size > 1) {ierr = PetscFree2(gray, gsvals);CHKERRQ(ierr);}
ierr = VecRestoreArray(x, &rvals);CHKERRQ(ierr);
/* Do FFT along the ray */
ierr = MatMult(F, x, y);CHKERRQ(ierr);
/* Chop FFT */
ierr = VecChop(y, PETSC_SMALL);CHKERRQ(ierr);
ierr = VecViewFromOptions(x, NULL, "-real_view");CHKERRQ(ierr);
ierr = VecViewFromOptions(y, NULL, "-fft_view");CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = MatDestroy(&F);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(stratum, &points);CHKERRQ(ierr);
ierr = ISDestroy(&stratum);CHKERRQ(ierr);
ierr = PetscFree2(ray, svals);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(uloc, &array);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm, &uloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc, char **args)
{
Mat A, L;
AppCtx ctx;
PetscViewer viewer;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc, &args, (char *) 0, help);CHKERRQ(ierr);
ierr = ProcessOptions(&ctx);CHKERRQ(ierr);
/* Load matrix */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD, ctx.matFilename, FILE_MODE_READ, &viewer);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD, &A);CHKERRQ(ierr);
ierr = MatLoad(A, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
/* Make graph Laplacian from matrix */
ierr = MatLaplacian(A, 1.0e-12, &L);CHKERRQ(ierr);
/* Check Laplacian */
PetscReal norm;
Vec x, y;
ierr = MatGetVecs(L, &x, NULL);CHKERRQ(ierr);
ierr = VecDuplicate(x, &y);CHKERRQ(ierr);
ierr = VecSet(x, 1.0);CHKERRQ(ierr);
ierr = MatMult(L, x, y);CHKERRQ(ierr);
ierr = VecNorm(y, NORM_INFINITY, &norm);CHKERRQ(ierr);
if (norm > 1.0e-10) SETERRQ(PetscObjectComm((PetscObject) y), PETSC_ERR_PLIB, "Invalid graph Laplacian");
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
/* Compute Fiedler vector, and perhaps more vectors */
Mat LD;
PetscScalar *a, *realpart, *imagpart, *eigvec, *work, sdummy;
PetscBLASInt bn, bN, lwork, lierr, idummy;
PetscInt n, i;
ierr = MatConvert(L, MATDENSE, MAT_INITIAL_MATRIX, &LD);CHKERRQ(ierr);
ierr = MatGetLocalSize(LD, &n, NULL);CHKERRQ(ierr);
ierr = MatDenseGetArray(LD, &a);CHKERRQ(ierr);
ierr = PetscBLASIntCast(n, &bn);CHKERRQ(ierr);
ierr = PetscBLASIntCast(n, &bN);CHKERRQ(ierr);
ierr = PetscBLASIntCast(5*n,&lwork);CHKERRQ(ierr);
ierr = PetscBLASIntCast(1,&idummy);CHKERRQ(ierr);
ierr = PetscMalloc4(n,PetscScalar,&realpart,n,PetscScalar,&imagpart,n*n,PetscScalar,&eigvec,lwork,PetscScalar,&work);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCall("LAPACKgeev", LAPACKgeev_("N","V",&bn,a,&bN,realpart,imagpart,&sdummy,&idummy,eigvec,&bN,work,&lwork,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in LAPACK routine %d", (int) lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
PetscReal *r, *c;
PetscInt *perm;
ierr = PetscMalloc3(n,PetscInt,&perm,n,PetscReal,&r,n,PetscReal,&c);CHKERRQ(ierr);
for (i = 0; i < n; ++i) perm[i] = i;
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i = 0; i < n; ++i) {
r[i] = realpart[perm[i]];
c[i] = imagpart[perm[i]];
}
for (i = 0; i < n; ++i) {
realpart[i] = r[i];
imagpart[i] = c[i];
}
/* Output spectrum */
if (ctx.showSpectrum) {
ierr = PetscPrintf(PETSC_COMM_SELF, "Spectrum\n");CHKERRQ(ierr);
for (i = 0; i < n; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, "%d: Real %g Imag %g\n", i, realpart[i], imagpart[i]);CHKERRQ(ierr);}
}
/* Check lowest eigenvalue and eigenvector */
PetscInt evInd = perm[0];
if ((realpart[0] > 1.0e-12) || (imagpart[0] > 1.0e-12)) SETERRQ(PetscObjectComm((PetscObject) L), PETSC_ERR_PLIB, "Graph Laplacian must have lowest eigenvalue 0");
for (i = 0; i < n; ++i) {
if (fabs(eigvec[evInd*n+i] - eigvec[evInd*n+0]) > 1.0e-10) SETERRQ3(PetscObjectComm((PetscObject) L), PETSC_ERR_PLIB, "Graph Laplacian must have constant lowest eigenvector ev_%d %g != ev_0 %g", i, eigvec[evInd*n+i], eigvec[evInd*n+0]);
}
/* Output Fiedler vector */
evInd = perm[1];
if (ctx.showFiedler) {
ierr = PetscPrintf(PETSC_COMM_SELF, "Fiedler vector, Re{ev} %g\n", realpart[1]);CHKERRQ(ierr);
for (i = 0; i < n; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, "%d: %g\n", i, eigvec[evInd*n+i]);CHKERRQ(ierr);}
}
/* Construct Fiedler partition */
IS fIS, fIS2;
PetscInt *fperm, *fperm2, pos, neg, posSize = 0;
ierr = PetscMalloc(n * sizeof(PetscInt), &fperm);CHKERRQ(ierr);
for (i = 0; i < n; ++i) {
if (eigvec[evInd*n+i] > 0.0) ++posSize;
}
ierr = PetscMalloc(n * sizeof(PetscInt), &fperm2);CHKERRQ(ierr);
for (i = 0; i < n; ++i) fperm[i] = i;
ierr = PetscSortRealWithPermutation(n, &eigvec[evInd*n], fperm);CHKERRQ(ierr);
for (i = 0; i < n; ++i) fperm2[n-1-i] = fperm[i];
for (i = 0, pos = 0, neg = posSize; i < n; ++i) {
if (eigvec[evInd*n+i] > 0.0) fperm[pos++] = i;
else fperm[neg++] = i;
}
ierr = ISCreateGeneral(PetscObjectComm((PetscObject) L), n, fperm, PETSC_OWN_POINTER, &fIS);CHKERRQ(ierr);
ierr = ISSetPermutation(fIS);CHKERRQ(ierr);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject) L), n, fperm2, PETSC_OWN_POINTER, &fIS2);CHKERRQ(ierr);
ierr = ISSetPermutation(fIS2);CHKERRQ(ierr);
ierr = PetscFree3(perm,r,c);CHKERRQ(ierr);
ierr = PetscFree4(realpart,imagpart,eigvec,work);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(LD, &a);CHKERRQ(ierr);
ierr = MatDestroy(&LD);CHKERRQ(ierr);
ierr = MatDestroy(&L);CHKERRQ(ierr);
/* Permute matrix */
Mat AR, AR2;
ierr = MatPermute(A, fIS, fIS, &AR);CHKERRQ(ierr);
ierr = MatView(A, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = MatView(AR, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = ISDestroy(&fIS);CHKERRQ(ierr);
ierr = MatPermute(A, fIS2, fIS2, &AR2);CHKERRQ(ierr);
ierr = MatView(AR2, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = ISDestroy(&fIS2);CHKERRQ(ierr);
ierr = MatDestroy(&AR);CHKERRQ(ierr);
AR = AR2;
/* Extract blocks and reorder */
Mat AP, AN, APR, ANR;
IS ispos, isneg, rpermpos, cpermpos, rpermneg, cpermneg;
PetscInt bw, bwr;
ierr = ISCreateStride(PETSC_COMM_SELF, posSize, 0, 1, &ispos);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF, n - posSize, posSize, 1, &isneg);CHKERRQ(ierr);
ierr = MatGetSubMatrix(AR, ispos, ispos, MAT_INITIAL_MATRIX, &AP);CHKERRQ(ierr);
ierr = MatGetSubMatrix(AR, isneg, isneg, MAT_INITIAL_MATRIX, &AN);CHKERRQ(ierr);
ierr = ISDestroy(&ispos);CHKERRQ(ierr);
ierr = ISDestroy(&isneg);CHKERRQ(ierr);
ierr = MatGetOrdering(AP, ctx.matOrdtype, &rpermpos, &cpermpos);CHKERRQ(ierr);
ierr = MatGetOrdering(AN, ctx.matOrdtype, &rpermneg, &cpermneg);CHKERRQ(ierr);
ierr = MatPermute(AP, rpermpos, cpermpos, &APR);CHKERRQ(ierr);
ierr = MatComputeBandwidth(AP, 0.0, &bw);CHKERRQ(ierr);
ierr = MatComputeBandwidth(APR, 0.0, &bwr);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "Reduced positive bandwidth from %d to %d\n", bw, bwr);CHKERRQ(ierr);
ierr = MatPermute(AN, rpermneg, cpermneg, &ANR);CHKERRQ(ierr);
ierr = MatComputeBandwidth(AN, 0.0, &bw);CHKERRQ(ierr);
ierr = MatComputeBandwidth(ANR, 0.0, &bwr);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "Reduced negative bandwidth from %d to %d\n", bw, bwr);CHKERRQ(ierr);
ierr = MatView(AP, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = MatView(APR, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = MatView(AN, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = MatView(ANR, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
/* Reorder original matrix */
Mat ARR;
IS rperm, cperm;
PetscInt *idx;
const PetscInt *cidx;
ierr = PetscMalloc(n * sizeof(PetscInt), &idx);CHKERRQ(ierr);
ierr = ISGetIndices(rpermpos, &cidx);CHKERRQ(ierr);
for (i = 0; i < posSize; ++i) idx[i] = cidx[i];
ierr = ISRestoreIndices(rpermpos, &cidx);CHKERRQ(ierr);
ierr = ISGetIndices(rpermneg, &cidx);CHKERRQ(ierr);
for (i = posSize; i < n; ++i) idx[i] = cidx[i-posSize] + posSize;
ierr = ISRestoreIndices(rpermneg, &cidx);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF, n, idx, PETSC_OWN_POINTER, &rperm);CHKERRQ(ierr);
ierr = ISSetPermutation(rperm);CHKERRQ(ierr);
ierr = PetscMalloc(n * sizeof(PetscInt), &idx);CHKERRQ(ierr);
ierr = ISGetIndices(cpermpos, &cidx);CHKERRQ(ierr);
for (i = 0; i < posSize; ++i) idx[i] = cidx[i];
ierr = ISRestoreIndices(cpermpos, &cidx);CHKERRQ(ierr);
ierr = ISGetIndices(cpermneg, &cidx);CHKERRQ(ierr);
for (i = posSize; i < n; ++i) idx[i] = cidx[i-posSize] + posSize;
ierr = ISRestoreIndices(cpermneg, &cidx);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF, n, idx, PETSC_OWN_POINTER, &cperm);CHKERRQ(ierr);
ierr = ISSetPermutation(cperm);CHKERRQ(ierr);
ierr = MatPermute(AR, rperm, cperm, &ARR);CHKERRQ(ierr);
ierr = MatView(ARR, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = ISDestroy(&rperm);CHKERRQ(ierr);
ierr = ISDestroy(&cperm);CHKERRQ(ierr);
ierr = ISDestroy(&rpermpos);CHKERRQ(ierr);
ierr = ISDestroy(&cpermpos);CHKERRQ(ierr);
ierr = ISDestroy(&rpermneg);CHKERRQ(ierr);
ierr = ISDestroy(&cpermneg);CHKERRQ(ierr);
ierr = MatDestroy(&AP);CHKERRQ(ierr);
ierr = MatDestroy(&AN);CHKERRQ(ierr);
ierr = MatDestroy(&APR);CHKERRQ(ierr);
ierr = MatDestroy(&ANR);CHKERRQ(ierr);
/* Compare bands */
Mat B, BR;
ierr = MatCreateSubMatrixBanded(A, 50, 0.95, &B);CHKERRQ(ierr);
ierr = MatCreateSubMatrixBanded(ARR, 50, 0.95, &BR);CHKERRQ(ierr);
ierr = MatView(B, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = MatView(BR, PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&BR);CHKERRQ(ierr);
/* Cleanup */
ierr = MatDestroy(&ARR);CHKERRQ(ierr);
ierr = MatDestroy(&AR);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode MatColoringCreateSmallestLastWeights(MatColoring mc,PetscReal *weights)
{
PetscInt *degrees,*degb,*llprev,*llnext;
PetscInt j,i,s,e,n,nin,ln,lm,degree,maxdegree=0,bidx,idx,dist,distance=mc->dist;
Mat lG,*lGs;
IS ris;
PetscErrorCode ierr;
PetscInt *seen;
const PetscInt *gidx;
PetscInt *idxbuf;
PetscInt *distbuf;
PetscInt ncols,nxt,prv,cur;
const PetscInt *cols;
PetscBool isSEQAIJ;
Mat_SeqAIJ *aij;
PetscInt *Gi,*Gj,*rperm;
Mat G = mc->mat;
PetscReal *lweights,r;
PetscRandom rand;
PetscFunctionBegin;
ierr = MatGetOwnershipRange(G,&s,&e);CHKERRQ(ierr);
n=e-s;
ierr = ISCreateStride(PetscObjectComm((PetscObject)G),n,s,1,&ris);CHKERRQ(ierr);
ierr = MatIncreaseOverlap(G,1,&ris,distance+1);CHKERRQ(ierr);
ierr = ISSort(ris);CHKERRQ(ierr);
ierr = MatGetSubMatrices(G,1,&ris,&ris,MAT_INITIAL_MATRIX,&lGs);CHKERRQ(ierr);
lG = lGs[0];
ierr = PetscObjectTypeCompare((PetscObject)lG,MATSEQAIJ,&isSEQAIJ);CHKERRQ(ierr);
if (!isSEQAIJ) SETERRQ(PetscObjectComm((PetscObject)G),PETSC_ERR_ARG_WRONGSTATE,"Requires an MPI/SEQAIJ Matrix");
ierr = MatGetSize(lG,&ln,&lm);CHKERRQ(ierr);
aij = (Mat_SeqAIJ*)lG->data;
Gi = aij->i;
Gj = aij->j;
ierr = PetscMalloc3(lm,&seen,lm,&idxbuf,lm,&distbuf);CHKERRQ(ierr);
ierr = PetscMalloc1(lm,°rees);CHKERRQ(ierr);
ierr = PetscMalloc1(lm,&lweights);CHKERRQ(ierr);
for (i=0;i<ln;i++) {
seen[i]=-1;
lweights[i] = 1.;
}
ierr = ISGetIndices(ris,&gidx);CHKERRQ(ierr);
for (i=0;i<ln;i++) {
bidx=-1;
ncols = Gi[i+1]-Gi[i];
cols = &(Gj[Gi[i]]);
degree = 0;
/* place the distance-one neighbors on the queue */
for (j=0;j<ncols;j++) {
bidx++;
seen[cols[j]] = i;
distbuf[bidx] = 1;
idxbuf[bidx] = cols[j];
}
while (bidx >= 0) {
/* pop */
idx = idxbuf[bidx];
dist = distbuf[bidx];
bidx--;
degree++;
if (dist < distance) {
ncols = Gi[idx+1]-Gi[idx];
cols = &(Gj[Gi[idx]]);
for (j=0;j<ncols;j++) {
if (seen[cols[j]] != i) {
bidx++;
seen[cols[j]] = i;
idxbuf[bidx] = cols[j];
distbuf[bidx] = dist+1;
}
}
}
}
degrees[i] = degree;
if (degree > maxdegree) maxdegree = degree;
}
/* bucket by degree by some random permutation */
ierr = PetscRandomCreate(PetscObjectComm((PetscObject)mc),&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = PetscMalloc1(ln,&rperm);CHKERRQ(ierr);
for (i=0;i<ln;i++) {
ierr = PetscRandomGetValueReal(rand,&r);CHKERRQ(ierr);
lweights[i] = r;
rperm[i]=i;
}
ierr = PetscSortRealWithPermutation(lm,lweights,rperm);CHKERRQ(ierr);
ierr = PetscMalloc1(maxdegree+1,°b);CHKERRQ(ierr);
ierr = PetscMalloc2(ln,&llnext,ln,&llprev);CHKERRQ(ierr);
for (i=0;i<maxdegree+1;i++) {
degb[i] = -1;
}
for (i=0;i<ln;i++) {
llnext[i] = -1;
llprev[i] = -1;
seen[i] = -1;
}
for (i=0;i<ln;i++) {
idx = rperm[i];
llnext[idx] = degb[degrees[idx]];
if (degb[degrees[idx]] > 0) llprev[degb[degrees[idx]]] = idx;
degb[degrees[idx]] = idx;
}
ierr = PetscFree(rperm);CHKERRQ(ierr);
/* remove the lowest degree one */
i=0;
nin=0;
while (i != maxdegree+1) {
for (i=1;i<maxdegree+1; i++) {
if (degb[i] > 0) {
cur = degb[i];
nin++;
degrees[cur] = 0;
degb[i] = llnext[cur];
bidx=-1;
ncols = Gi[cur+1]-Gi[cur];
cols = &(Gj[Gi[cur]]);
/* place the distance-one neighbors on the queue */
for (j=0;j<ncols;j++) {
if (cols[j] != cur) {
bidx++;
seen[cols[j]] = i;
distbuf[bidx] = 1;
idxbuf[bidx] = cols[j];
}
}
while (bidx >= 0) {
/* pop */
idx = idxbuf[bidx];
dist = distbuf[bidx];
bidx--;
nxt=llnext[idx];
prv=llprev[idx];
if (degrees[idx] > 0) {
/* change up the degree of the neighbors still in the graph */
if (lweights[idx] <= lweights[cur]) lweights[idx] = lweights[cur]+1;
if (nxt > 0) {
llprev[nxt] = prv;
}
if (prv > 0) {
llnext[prv] = nxt;
} else {
degb[degrees[idx]] = nxt;
}
degrees[idx]--;
llnext[idx] = degb[degrees[idx]];
llprev[idx] = -1;
if (degb[degrees[idx]] >= 0) {
llprev[degb[degrees[idx]]] = idx;
}
degb[degrees[idx]] = idx;
if (dist < distance) {
ncols = Gi[idx+1]-Gi[idx];
cols = &(Gj[Gi[idx]]);
for (j=0;j<ncols;j++) {
if (seen[cols[j]] != i) {
bidx++;
seen[cols[j]] = i;
idxbuf[bidx] = cols[j];
distbuf[bidx] = dist+1;
}
}
}
}
}
break;
}
}
}
for (i=0;i<lm;i++) {
if (gidx[i] >= s && gidx[i] < e) {
weights[gidx[i]-s] = lweights[i];
}
}
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = PetscFree(degb);CHKERRQ(ierr);
ierr = PetscFree2(llnext,llprev);CHKERRQ(ierr);
ierr = PetscFree(degrees);CHKERRQ(ierr);
ierr = PetscFree(lweights);CHKERRQ(ierr);
ierr = ISRestoreIndices(ris,&gidx);CHKERRQ(ierr);
ierr = ISDestroy(&ris);CHKERRQ(ierr);
ierr = PetscFree3(seen,idxbuf,distbuf);CHKERRQ(ierr);
ierr = MatDestroyMatrices(1,&lGs);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
