Actual source code: spectral.c
petsc-3.15.0 2021-03-30
1: #include <petscmat.h>
2: #include <petscblaslapack.h>
4: /*@
5: MatCreateLaplacian - Create the matrix Laplacian, with all values in the matrix less than the tolerance set to zero
7: Input Parameters:
8: + A - The matrix
9: . tol - The zero tolerance
10: - weighted - Flag for using edge weights
12: Output Parameters:
13: . L - The graph Laplacian matrix
15: Level: intermediate
17: .seealso: MatChop()
18: @*/
19: PetscErrorCode MatCreateLaplacian(Mat A, PetscReal tol, PetscBool weighted, Mat *L)
20: {
21: PetscScalar *newVals;
22: PetscInt *newCols;
23: PetscInt rStart, rEnd, r, colMax = 0;
24: PetscInt *dnnz, *onnz;
25: PetscInt m, n, M, N;
29: if (weighted) SETERRQ(PetscObjectComm((PetscObject) A), PETSC_ERR_SUP, "Will get to this soon");
30: MatCreate(PetscObjectComm((PetscObject) A), L);
31: MatGetSize(A, &M, &N);
32: MatGetLocalSize(A, &m, &n);
33: MatSetSizes(*L, m, n, M, N);
34: MatGetOwnershipRange(A, &rStart, &rEnd);
35: PetscMalloc2(m,&dnnz,m,&onnz);
36: for (r = rStart; r < rEnd; ++r) {
37: const PetscScalar *vals;
38: const PetscInt *cols;
39: PetscInt ncols, newcols, c;
40: PetscBool hasdiag = PETSC_FALSE;
42: dnnz[r-rStart] = onnz[r-rStart] = 0;
43: MatGetRow(A, r, &ncols, &cols, &vals);
44: for (c = 0, newcols = 0; c < ncols; ++c) {
45: if (cols[c] == r) {
46: ++newcols;
47: hasdiag = PETSC_TRUE;
48: ++dnnz[r-rStart];
49: } else if (PetscAbsScalar(vals[c]) >= tol) {
50: if ((cols[c] >= rStart) && (cols[c] < rEnd)) ++dnnz[r-rStart];
51: else ++onnz[r-rStart];
52: ++newcols;
53: }
54: }
55: if (!hasdiag) {++newcols; ++dnnz[r-rStart];}
56: colMax = PetscMax(colMax, newcols);
57: MatRestoreRow(A, r, &ncols, &cols, &vals);
58: }
59: MatSetFromOptions(*L);
60: MatXAIJSetPreallocation(*L, 1, dnnz, onnz, NULL, NULL);
61: MatSetUp(*L);
62: PetscMalloc2(colMax,&newCols,colMax,&newVals);
63: for (r = rStart; r < rEnd; ++r) {
64: const PetscScalar *vals;
65: const PetscInt *cols;
66: PetscInt ncols, newcols, c;
67: PetscBool hasdiag = PETSC_FALSE;
69: MatGetRow(A, r, &ncols, &cols, &vals);
70: for (c = 0, newcols = 0; c < ncols; ++c) {
71: if (cols[c] == r) {
72: newCols[newcols] = cols[c];
73: newVals[newcols] = dnnz[r-rStart]+onnz[r-rStart]-1;
74: ++newcols;
75: hasdiag = PETSC_TRUE;
76: } else if (PetscAbsScalar(vals[c]) >= tol) {
77: newCols[newcols] = cols[c];
78: newVals[newcols] = -1.0;
79: ++newcols;
80: }
81: if (newcols > colMax) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Overran work space");
82: }
83: if (!hasdiag) {
84: newCols[newcols] = r;
85: newVals[newcols] = dnnz[r-rStart]+onnz[r-rStart]-1;
86: ++newcols;
87: }
88: MatRestoreRow(A, r, &ncols, &cols, &vals);
89: MatSetValues(*L, 1, &r, newcols, newCols, newVals, INSERT_VALUES);
90: }
91: PetscFree2(dnnz,onnz);
92: MatAssemblyBegin(*L, MAT_FINAL_ASSEMBLY);
93: MatAssemblyEnd(*L, MAT_FINAL_ASSEMBLY);
94: PetscFree2(newCols,newVals);
95: return(0);
96: }
98: /*
99: MatGetOrdering_Spectral - Find the symmetric reordering of the graph by .
100: */
101: PETSC_INTERN PetscErrorCode MatGetOrdering_Spectral(Mat A, MatOrderingType type, IS *row, IS *col)
102: {
103: Mat L;
104: #if !defined(PETSC_USE_COMPLEX) && !defined(PETSC_HAVE_ESSL)
105: PetscInt *perm, tmp;
106: #endif
107: const PetscReal eps = 1.0e-12;
108: PetscErrorCode ierr;
111: MatCreateLaplacian(A, eps, PETSC_FALSE, &L);
112: {
113: /* Check Laplacian */
114: PetscReal norm;
115: Vec x, y;
117: MatCreateVecs(L, &x, NULL);
118: VecDuplicate(x, &y);
119: VecSet(x, 1.0);
120: MatMult(L, x, y);
121: VecNorm(y, NORM_INFINITY, &norm);
122: if (norm > 1.0e-10) SETERRQ(PetscObjectComm((PetscObject) y), PETSC_ERR_PLIB, "Invalid graph Laplacian");
123: VecDestroy(&x);
124: VecDestroy(&y);
125: }
126: /* Compute Fiedler vector (right now, all eigenvectors) */
127: #ifdef PETSC_USE_COMPLEX
128: SETERRQ(PetscObjectComm((PetscObject) A), PETSC_ERR_SUP, "Spectral partitioning does not support complex numbers");
129: #elif defined(PETSC_HAVE_ESSL)
130: SETERRQ(PetscObjectComm((PetscObject) A), PETSC_ERR_SUP, "Spectral partitioning does not support ESSL Lapack Routines");
131: #else
132: {
133: Mat LD;
134: PetscScalar *a;
135: PetscReal *realpart, *imagpart, *eigvec, *work;
136: PetscReal sdummy;
137: PetscBLASInt bn, bN, lwork = 0, lierr, idummy;
138: PetscInt n, i, evInd;
140: MatConvert(L, MATDENSE, MAT_INITIAL_MATRIX, &LD);
141: MatGetLocalSize(LD, &n, NULL);
142: MatDenseGetArray(LD, &a);
143: PetscBLASIntCast(n, &bn);
144: PetscBLASIntCast(n, &bN);
145: PetscBLASIntCast(5*n,&lwork);
146: PetscBLASIntCast(1,&idummy);
147: PetscMalloc4(n,&realpart,n,&imagpart,n*n,&eigvec,lwork,&work);
148: PetscFPTrapPush(PETSC_FP_TRAP_OFF);
149: PetscStackCallBLAS("LAPACKgeev", LAPACKgeev_("N","V",&bn,a,&bN,realpart,imagpart,&sdummy,&idummy,eigvec,&bN,work,&lwork,&lierr));
150: if (lierr) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Error in LAPACK routine %d", (int) lierr);
151: PetscFPTrapPop();
152: MatDenseRestoreArray(LD,&a);
153: MatDestroy(&LD);
154: /* Check lowest eigenvalue and eigenvector */
155: PetscMalloc1(n, &perm);
156: for (i = 0; i < n; ++i) perm[i] = i;
157: PetscSortRealWithPermutation(n,realpart,perm);
158: evInd = perm[0];
159: if ((realpart[evInd] > 1.0e-12) || (imagpart[evInd] > 1.0e-12)) SETERRQ(PetscObjectComm((PetscObject) L), PETSC_ERR_PLIB, "Graph Laplacian must have lowest eigenvalue 0");
160: evInd = perm[1];
161: if ((realpart[evInd] < 1.0e-12) && (imagpart[evInd] < 1.0e-12)) SETERRQ(PetscObjectComm((PetscObject) L), PETSC_ERR_PLIB, "Graph Laplacian must have only one zero eigenvalue");
162: evInd = perm[0];
163: for (i = 0; i < n; ++i) {
164: if (PetscAbsReal(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]);
165: }
166: /* Construct Fiedler partition */
167: evInd = perm[1];
168: for (i = 0; i < n; ++i) perm[i] = i;
169: PetscSortRealWithPermutation(n, &eigvec[evInd*n], perm);
170: for (i = 0; i < n/2; ++i) {
171: tmp = perm[n-1-i];
172: perm[n-1-i] = perm[i];
173: perm[i] = tmp;
174: }
175: ISCreateGeneral(PETSC_COMM_SELF, n, perm, PETSC_OWN_POINTER, row);
176: PetscObjectReference((PetscObject) *row);
177: *col = *row;
179: PetscFree4(realpart,imagpart,eigvec,work);
180: MatDestroy(&L);
181: return(0);
182: }
183: #endif
184: }