PetscErrorCode SNESMonitorJacUpdateSpectrum(SNES snes,PetscInt it,PetscReal fnorm,void *ctx) { #if defined(PETSC_MISSING_LAPACK_GEEV) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values."); #elif defined(PETSC_HAVE_ESSL) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"GEEV - No support for ESSL Lapack Routines"); #else Vec X; Mat J,dJ,dJdense; PetscErrorCode ierr; PetscErrorCode (*func)(SNES,Vec,Mat*,Mat*,MatStructure*,void*); PetscInt n,i; PetscBLASInt nb,lwork; PetscReal *eigr,*eigi; MatStructure flg = DIFFERENT_NONZERO_PATTERN; PetscScalar *work; PetscScalar *a; PetscFunctionBegin; if (it == 0) PetscFunctionReturn(0); /* create the difference between the current update and the current jacobian */ ierr = SNESGetSolution(snes,&X);CHKERRQ(ierr); ierr = SNESGetJacobian(snes,&J,NULL,&func,NULL);CHKERRQ(ierr); ierr = MatDuplicate(J,MAT_COPY_VALUES,&dJ);CHKERRQ(ierr); ierr = SNESComputeJacobian(snes,X,&dJ,&dJ,&flg);CHKERRQ(ierr); ierr = MatAXPY(dJ,-1.0,J,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* compute the spectrum directly */ ierr = MatConvert(dJ,MATSEQDENSE,MAT_INITIAL_MATRIX,&dJdense);CHKERRQ(ierr); ierr = MatGetSize(dJ,&n,NULL);CHKERRQ(ierr); ierr = PetscBLASIntCast(n,&nb);CHKERRQ(ierr); lwork = 3*nb; ierr = PetscMalloc(n*sizeof(PetscReal),&eigr);CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscReal),&eigi);CHKERRQ(ierr); ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); ierr = MatDenseGetArray(dJdense,&a);CHKERRQ(ierr); #if !defined(PETSC_USE_COMPLEX) { PetscBLASInt lierr; ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); PetscStackCall("LAPACKgeev",LAPACKgeev_("N","N",&nb,a,&nb,eigr,eigi,NULL,&nb,NULL,&nb,work,&lwork,&lierr)); if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"geev() error %d",lierr); ierr = PetscFPTrapPop();CHKERRQ(ierr); } #else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not coded for complex"); #endif PetscPrintf(PetscObjectComm((PetscObject)snes),"Eigenvalues of J_%d - J_%d:\n",it,it-1);CHKERRQ(ierr); for (i=0;i<n;i++) { PetscPrintf(PetscObjectComm((PetscObject)snes),"%5d: %20.5g + %20.5gi\n",i,eigr[i],eigi[i]);CHKERRQ(ierr); } ierr = MatDenseRestoreArray(dJdense,&a);CHKERRQ(ierr); ierr = MatDestroy(&dJ);CHKERRQ(ierr); ierr = MatDestroy(&dJdense);CHKERRQ(ierr); ierr = PetscFree(eigr);CHKERRQ(ierr); ierr = PetscFree(eigi);CHKERRQ(ierr); ierr = PetscFree(work);CHKERRQ(ierr); PetscFunctionReturn(0); #endif }
/*@ 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); }
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; }