Actual source code: schurm.c
2: #include <private/matimpl.h> /*I "petscmat.h" I*/
3: #include <petscksp.h> /*I "petscksp.h" I*/
5: typedef struct {
6: Mat A,Ap,B,C,D;
7: KSP ksp;
8: Vec work1,work2;
9: } Mat_SchurComplement;
14: PetscErrorCode MatView_SchurComplement(Mat N,PetscViewer viewer)
15: {
16: Mat_SchurComplement *Na = (Mat_SchurComplement*)N->data;
17: PetscErrorCode ierr;
20: PetscViewerASCIIPrintf(viewer,"Schur complement A11 - A10 inv(A00) A01\n");
21: if (Na->D) {
22: PetscViewerASCIIPrintf(viewer,"A11\n");
23: PetscViewerASCIIPushTab(viewer);
24: MatView(Na->D,viewer);
25: PetscViewerASCIIPopTab(viewer);
26: } else {
27: PetscViewerASCIIPrintf(viewer,"A11 = 0\n");
28: }
29: PetscViewerASCIIPrintf(viewer,"A10\n");
30: PetscViewerASCIIPushTab(viewer);
31: MatView(Na->C,viewer);
32: PetscViewerASCIIPopTab(viewer);
33: PetscViewerASCIIPrintf(viewer,"KSP of A00\n");
34: PetscViewerASCIIPushTab(viewer);
35: KSPView(Na->ksp,viewer);
36: PetscViewerASCIIPopTab(viewer);
37: PetscViewerASCIIPrintf(viewer,"A01\n");
38: PetscViewerASCIIPushTab(viewer);
39: MatView(Na->B,viewer);
40: PetscViewerASCIIPopTab(viewer);
41: return(0);
42: }
45: /*
46: A11 - A10 ksp(A00,Ap00) A01
47: */
50: PetscErrorCode MatMult_SchurComplement(Mat N,Vec x,Vec y)
51: {
52: Mat_SchurComplement *Na = (Mat_SchurComplement*)N->data;
53: PetscErrorCode ierr;
56: if (!Na->work1) {MatGetVecs(Na->A,&Na->work1,PETSC_NULL);}
57: if (!Na->work2) {MatGetVecs(Na->A,&Na->work2,PETSC_NULL);}
58: MatMult(Na->B,x,Na->work1);
59: KSPSolve(Na->ksp,Na->work1,Na->work2);
60: MatMult(Na->C,Na->work2,y);
61: VecScale(y,-1.0);
62: if (Na->D) {
63: MatMultAdd(Na->D,x,y,y);
64: }
65: return(0);
66: }
70: PetscErrorCode MatSetFromOptions_SchurComplement(Mat N)
71: {
72: Mat_SchurComplement *Na = (Mat_SchurComplement*)N->data;
73: PetscErrorCode ierr;
76: KSPSetFromOptions(Na->ksp);
77: return(0);
78: }
79:
82: PetscErrorCode MatDestroy_SchurComplement(Mat N)
83: {
84: Mat_SchurComplement *Na = (Mat_SchurComplement*)N->data;
85: PetscErrorCode ierr;
88: MatDestroy(&Na->A);
89: MatDestroy(&Na->Ap);
90: MatDestroy(&Na->B);
91: MatDestroy(&Na->C);
92: MatDestroy(&Na->D);
93: VecDestroy(&Na->work1);
94: VecDestroy(&Na->work2);
95: KSPDestroy(&Na->ksp);
96: PetscFree(N->data);
97: return(0);
98: }
102: /*@
103: MatCreateSchurComplement - Creates a new matrix object that behaves like the Schur complement of a matrix
105: Collective on Mat
107: Input Parameter:
108: . A00,A01,A10,A11 - the four parts of the original matrix (D is optional)
110: Output Parameter:
111: . N - the matrix that the Schur complement A11 - A10 ksp(A00) A01
113: Level: intermediate
115: Notes: The Schur complement is NOT actually formed! Rather this
116: object performs the matrix-vector product by using the the formula for
117: the Schur complement and a KSP solver to approximate the action of inv(A)
119: All four matrices must have the same MPI communicator
121: A00 and A11 must be square matrices
123: .seealso: MatCreateNormal(), MatMult(), MatCreate(), MatSchurComplementGetKSP(), MatSchurComplementUpdate(), MatCreateTranspose(), MatGetSchurComplement()
125: @*/
126: PetscErrorCode MatCreateSchurComplement(Mat A00,Mat Ap00,Mat A01,Mat A10,Mat A11,Mat *N)
127: {
128: PetscErrorCode ierr;
129: PetscInt m,n;
130: Mat_SchurComplement *Na;
140: if (A00->rmap->n != A00->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of A00 %D do not equal local columns %D",A00->rmap->n,A00->cmap->n);
141: if (A00->rmap->n != Ap00->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of A00 %D do not equal local rows of Ap00 %D",A00->rmap->n,Ap00->rmap->n);
142: if (Ap00->rmap->n != Ap00->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of Ap00 %D do not equal local columns %D",Ap00->rmap->n,Ap00->cmap->n);
143: if (A00->cmap->n != A01->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local columns of A00 %D do not equal local rows of A01 %D",A00->cmap->n,A01->rmap->n);
144: if (A10->cmap->n != A00->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local columns of A10 %D do not equal local rows of A00 %D",A10->cmap->n,A00->rmap->n);
145: if (A11) {
148: if (A11->rmap->n != A11->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of A11 %D do not equal local columns %D",A11->rmap->n,A11->cmap->n);
149: if (A10->rmap->n != A11->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of A10 %D do not equal local rows A11 %D",A10->rmap->n,A11->rmap->n);
150: }
152: MatGetLocalSize(A01,PETSC_NULL,&n);
153: MatGetLocalSize(A10,&m,PETSC_NULL);
154: MatCreate(((PetscObject)A00)->comm,N);
155: MatSetSizes(*N,m,n,PETSC_DECIDE,PETSC_DECIDE);
156: PetscObjectChangeTypeName((PetscObject)*N,MATSCHURCOMPLEMENT);
157:
158: PetscNewLog(*N,Mat_SchurComplement,&Na);
159: (*N)->data = (void*) Na;
160: PetscObjectReference((PetscObject)A00);
161: PetscObjectReference((PetscObject)Ap00);
162: PetscObjectReference((PetscObject)A01);
163: PetscObjectReference((PetscObject)A10);
164: Na->A = A00;
165: Na->Ap = Ap00;
166: Na->B = A01;
167: Na->C = A10;
168: Na->D = A11;
169: if (A11) {
170: PetscObjectReference((PetscObject)A11);
171: }
173: (*N)->ops->destroy = MatDestroy_SchurComplement;
174: (*N)->ops->view = MatView_SchurComplement;
175: (*N)->ops->mult = MatMult_SchurComplement;
176: (*N)->ops->setfromoptions = MatSetFromOptions_SchurComplement;
177: (*N)->assembled = PETSC_TRUE;
179: /* treats the new matrix as having block size of 1 which is most likely the case */
180: PetscLayoutSetBlockSize((*N)->rmap,1);
181: PetscLayoutSetBlockSize((*N)->cmap,1);
182: PetscLayoutSetUp((*N)->rmap);
183: PetscLayoutSetUp((*N)->cmap);
185: KSPCreate(((PetscObject)A00)->comm,&Na->ksp);
186: KSPSetOperators(Na->ksp,A00,Ap00,SAME_NONZERO_PATTERN);
187: return(0);
188: }
192: /*@
193: MatSchurComplementGetKSP - Creates gets the KSP object that is used in the Schur complement matrix
195: Not Collective
197: Input Parameter:
198: . A - matrix created with MatCreateSchurComplement()
200: Output Parameter:
201: . ksp - the linear solver object
203: Options Database:
204: - -fieldsplit_0_XXX sets KSP and PC options for the A block solver inside the Schur complement
206: Level: intermediate
208: Notes:
209: .seealso: MatCreateNormal(), MatMult(), MatCreate(), MatSchurComplementGetKSP(), MatCreateSchurComplement()
211: @*/
212: PetscErrorCode MatSchurComplementGetKSP(Mat A,KSP *ksp)
213: {
214: Mat_SchurComplement *Na;
219: Na = (Mat_SchurComplement*)A->data;
220: *ksp = Na->ksp;
221: return(0);
222: }
226: /*@
227: MatSchurComplementUpdate - Updates the Schur complement matrix object with new submatrices
229: Collective on Mat
231: Input Parameters:
232: + N - the matrix obtained with MatCreateSchurComplement()
233: . A,B,C,D - the four parts of the original matrix (D is optional)
234: - str - either SAME_NONZERO_PATTERN,DIFFERENT_NONZERO_PATTERN,SAME_PRECONDITIONER
236:
237: Level: intermediate
239: Notes: All four matrices must have the same MPI communicator
241: A and D must be square matrices
243: All of the matrices provided must have the same sizes as was used with MatCreateSchurComplement()
244: though they need not be the same matrices
246: .seealso: MatCreateNormal(), MatMult(), MatCreate(), MatSchurComplementGetKSP(), MatCreateSchurComplement()
248: @*/
249: PetscErrorCode MatSchurComplementUpdate(Mat N,Mat A,Mat Ap,Mat B,Mat C,Mat D,MatStructure str)
250: {
251: PetscErrorCode ierr;
252: Mat_SchurComplement *Na = (Mat_SchurComplement*)N->data;
261: if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of A %D do not equal local columns %D",A->rmap->n,A->cmap->n);
262: if (A->rmap->n != Ap->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of A %D do not equal local rows of Ap %D",A->rmap->n,Ap->rmap->n);
263: if (Ap->rmap->n != Ap->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of Ap %D do not equal local columns %D",Ap->rmap->n,Ap->cmap->n);
264: if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local columns of A %D do not equal local rows of B %D",A->cmap->n,B->rmap->n);
265: if (C->cmap->n != A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local columns of C %D do not equal local rows of A %D",C->cmap->n,A->rmap->n);
266: if (D) {
269: if (D->rmap->n != D->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of D %D do not equal local columns %D",D->rmap->n,D->cmap->n);
270: if (C->rmap->n != D->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local rows of C %D do not equal local rows D %D",C->rmap->n,D->rmap->n);
271: }
273: MatDestroy(&Na->A);
274: MatDestroy(&Na->Ap);
275: MatDestroy(&Na->B);
276: MatDestroy(&Na->C);
277: MatDestroy(&Na->D);
279: PetscObjectReference((PetscObject)A);
280: PetscObjectReference((PetscObject)Ap);
281: PetscObjectReference((PetscObject)B);
282: PetscObjectReference((PetscObject)C);
283: Na->A = A;
284: Na->Ap = Ap;
285: Na->B = B;
286: Na->C = C;
287: Na->D = D;
288: if (D) {
289: PetscObjectReference((PetscObject)D);
290: }
292: KSPSetOperators(Na->ksp,A,Ap,str);
293: return(0);
294: }
299: /*@C
300: MatSchurComplementGetSubmatrices - Get the individual submatrices in the Schur complement
302: Collective on Mat
304: Input Parameters:
305: + N - the matrix obtained with MatCreateSchurComplement()
306: - A,B,C,D - the four parts of the original matrix (D is optional)
308: Note:
309: D is optional, and thus can be PETSC_NULL
311: Level: intermediate
313: .seealso: MatCreateNormal(), MatMult(), MatCreate(), MatSchurComplementGetKSP(), MatCreateSchurComplement(), MatSchurComplementUpdate()
314: @*/
315: PetscErrorCode MatSchurComplementGetSubmatrices(Mat N,Mat *A,Mat *Ap,Mat *B,Mat *C,Mat *D)
316: {
317: Mat_SchurComplement *Na = (Mat_SchurComplement *) N->data;
318: PetscErrorCode ierr;
319: PetscBool flg;
323: PetscTypeCompare((PetscObject)N,MATSCHURCOMPLEMENT,&flg);
324: if (flg) {
325: if (A) *A = Na->A;
326: if (Ap) *Ap = Na->Ap;
327: if (B) *B = Na->B;
328: if (C) *C = Na->C;
329: if (D) *D = Na->D;
330: } else {
331: if (A) *A = 0;
332: if (Ap) *Ap = 0;
333: if (B) *B = 0;
334: if (C) *C = 0;
335: if (D) *D = 0;
336: }
337: return(0);
338: }
342: /* Developer Notes: This should be implemented with a MatCreate_SchurComplement() as that is the standard design for new Mat classes. */
343: PetscErrorCode MatGetSchurComplement_Basic(Mat mat,IS isrow0,IS iscol0,IS isrow1,IS iscol1,MatReuse mreuse,Mat *newmat,MatReuse preuse,Mat *newpmat)
344: {
346: Mat A=0,Ap=0,B=0,C=0,D=0;
357: if (mat->factortype) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
359: if (mreuse != MAT_IGNORE_MATRIX) {
360: /* Use MatSchurComplement */
361: if (mreuse == MAT_REUSE_MATRIX) {
362: MatSchurComplementGetSubmatrices(*newmat,&A,&Ap,&B,&C,&D);
363: if (!A || !Ap || !B || !C) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_ARG_WRONGSTATE,"Attempting to reuse matrix but Schur complement matrices unset");
364: if (A != Ap) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_ARG_WRONGSTATE,"Preconditioning matrix does not match operator");
365: MatDestroy(&Ap); /* get rid of extra reference */
366: }
367: MatGetSubMatrix(mat,isrow0,iscol0,mreuse,&A);
368: MatGetSubMatrix(mat,isrow0,iscol1,mreuse,&B);
369: MatGetSubMatrix(mat,isrow1,iscol0,mreuse,&C);
370: MatGetSubMatrix(mat,isrow1,iscol1,mreuse,&D);
371: switch (mreuse) {
372: case MAT_INITIAL_MATRIX:
373: MatCreateSchurComplement(A,A,B,C,D,newmat);
374: break;
375: case MAT_REUSE_MATRIX:
376: MatSchurComplementUpdate(*newmat,A,A,B,C,D,DIFFERENT_NONZERO_PATTERN);
377: break;
378: default:
379: SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_SUP,"Unrecognized value of mreuse");
380: }
381: }
382: if (preuse != MAT_IGNORE_MATRIX) {
383: /* Use the diagonal part of A to form D - C inv(diag(A)) B */
384: Mat Ad,AdB,S;
385: Vec diag;
386: PetscInt i,m,n,mstart,mend;
387: PetscScalar *x;
389: /* We could compose these with newpmat so that the matrices can be reused. */
390: if (!A) {MatGetSubMatrix(mat,isrow0,iscol0,MAT_INITIAL_MATRIX,&A);}
391: if (!B) {MatGetSubMatrix(mat,isrow0,iscol1,MAT_INITIAL_MATRIX,&B);}
392: if (!C) {MatGetSubMatrix(mat,isrow1,iscol0,MAT_INITIAL_MATRIX,&C);}
393: if (!D) {MatGetSubMatrix(mat,isrow1,iscol1,MAT_INITIAL_MATRIX,&D);}
395: MatGetVecs(A,&diag,PETSC_NULL);
396: MatGetDiagonal(A,diag);
397: VecReciprocal(diag);
398: MatGetLocalSize(A,&m,&n);
399: /* We need to compute S = D - C inv(diag(A)) B. For row-oriented formats, it is easy to scale the rows of B and
400: * for column-oriented formats the columns of C can be scaled. Would skip creating a silly diagonal matrix. */
401: MatCreate(((PetscObject)A)->comm,&Ad);
402: MatSetSizes(Ad,m,n,PETSC_DETERMINE,PETSC_DETERMINE);
403: MatSetOptionsPrefix(Ad,((PetscObject)mat)->prefix);
404: MatAppendOptionsPrefix(Ad,"diag_");
405: MatSetFromOptions(Ad);
406: MatSeqAIJSetPreallocation(Ad,1,PETSC_NULL);
407: MatMPIAIJSetPreallocation(Ad,1,PETSC_NULL,0,PETSC_NULL);
408: MatGetOwnershipRange(Ad,&mstart,&mend);
409: VecGetArray(diag,&x);
410: for (i=mstart; i<mend; i++) {
411: MatSetValue(Ad,i,i,x[i-mstart],INSERT_VALUES);
412: }
413: VecRestoreArray(diag,&x);
414: MatAssemblyBegin(Ad,MAT_FINAL_ASSEMBLY);
415: MatAssemblyEnd(Ad,MAT_FINAL_ASSEMBLY);
416: VecDestroy(&diag);
418: MatMatMult(Ad,B,MAT_INITIAL_MATRIX,1,&AdB);
419: S = (preuse == MAT_REUSE_MATRIX) ? *newpmat : 0;
420: MatMatMult(C,AdB,preuse,PETSC_DEFAULT,&S);
421: MatAYPX(S,-1,D,DIFFERENT_NONZERO_PATTERN);
422: *newpmat = S;
423: MatDestroy(&Ad);
424: MatDestroy(&AdB);
425: }
426: MatDestroy(&A);
427: MatDestroy(&B);
428: MatDestroy(&C);
429: MatDestroy(&D);
430: return(0);
431: }
435: /*@
436: MatGetSchurComplement - Obtain the Schur complement from eliminating part of the matrix in another part.
438: Collective on Mat
440: Input Parameters:
441: + mat - Matrix in which the complement is to be taken
442: . isrow0 - rows to eliminate
443: . iscol0 - columns to eliminate, (isrow0,iscol0) should be square and nonsingular
444: . isrow1 - rows in which the Schur complement is formed
445: . iscol1 - columns in which the Schur complement is formed
446: . mreuse - MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX, use MAT_IGNORE_MATRIX to put nothing in newmat
447: - preuse - MAT_INITIAL_MATRIX or MAT_REUSE_MATRIX, use MAT_IGNORE_MATRIX to put nothing in newpmat
449: Output Parameters:
450: + newmat - exact Schur complement, often of type MATSCHURCOMPLEMENT which is difficult to use for preconditioning
451: - newpmat - approximate Schur complement suitable for preconditioning
453: Note:
454: Since the real Schur complement is usually dense, providing a good approximation to newpmat usually requires
455: application-specific information. The default for assembled matrices is to use the diagonal of the (0,0) block
456: which will rarely produce a scalable algorithm.
458: Sometimes users would like to provide problem-specific data in the Schur complement, usually only for special row
459: and column index sets. In that case, the user should call PetscObjectComposeFunctionDynamic() to set
460: "MatNestGetSubMat_C" to their function. If their function needs to fall back to the default implementation, it
461: should call MatGetSchurComplement_Basic().
463: Level: advanced
465: Concepts: matrices^submatrices
467: .seealso: MatGetSubMatrix(), PCFIELDSPLIT, MatCreateSchurComplement()
468: @*/
469: PetscErrorCode MatGetSchurComplement(Mat mat,IS isrow0,IS iscol0,IS isrow1,IS iscol1,MatReuse mreuse,Mat *newmat,MatReuse preuse,Mat *newpmat)
470: {
471: PetscErrorCode ierr,(*f)(Mat,IS,IS,IS,IS,MatReuse,Mat*,MatReuse,Mat*);
482: if (mat->factortype) SETERRQ(((PetscObject)mat)->comm,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix");
484: PetscObjectQueryFunction((PetscObject)mat,"MatGetSchurComplement_C",(void(**)(void))&f);
485: if (f) {
486: (*f)(mat,isrow0,iscol0,isrow1,iscol1,mreuse,newmat,preuse,newpmat);
487: } else {
488: MatGetSchurComplement_Basic(mat,isrow0,iscol0,isrow1,iscol1,mreuse,newmat,preuse,newpmat);
489: }
490: return(0);
491: }