xref: /petsc/src/ksp/pc/impls/bddc/bddcnullspace.c (revision 030f984af8d8bb4c203755d35bded3c05b3d83ce) 
1 #include <../src/ksp/pc/impls/bddc/bddc.h>
2 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
3 #include <../src/mat/impls/dense/seq/dense.h>
4 
5 /* E + small_solve */
6 static PetscErrorCode PCBDDCNullSpaceCorrPreSolve(KSP ksp,Vec y,Vec x, void* ctx)
7 {
8   NullSpaceCorrection_ctx corr_ctx = (NullSpaceCorrection_ctx)ctx;
9   Mat                     K;
10   PetscErrorCode          ierr;
11 
12   PetscFunctionBegin;
13   ierr = PetscLogEventBegin(corr_ctx->evapply,ksp,0,0,0);CHKERRQ(ierr);
14   ierr = MatMultTranspose(corr_ctx->basis_mat,y,corr_ctx->sw[0]);CHKERRQ(ierr);
15   if (corr_ctx->symm) {
16     ierr = MatMult(corr_ctx->inv_smat,corr_ctx->sw[0],corr_ctx->sw[1]);CHKERRQ(ierr);
17   } else {
18     ierr = MatMultTranspose(corr_ctx->inv_smat,corr_ctx->sw[0],corr_ctx->sw[1]);CHKERRQ(ierr);
19   }
20   ierr = VecScale(corr_ctx->sw[1],-1.0);CHKERRQ(ierr);
21   ierr = MatMult(corr_ctx->basis_mat,corr_ctx->sw[1],corr_ctx->fw[0]);CHKERRQ(ierr);
22   ierr = VecScale(corr_ctx->sw[1],-1.0);CHKERRQ(ierr);
23   ierr = KSPGetOperators(ksp,&K,NULL);CHKERRQ(ierr);
24   ierr = MatMultAdd(K,corr_ctx->fw[0],y,y);CHKERRQ(ierr);
25   ierr = PetscLogEventEnd(corr_ctx->evapply,ksp,0,0,0);CHKERRQ(ierr);
26   PetscFunctionReturn(0);
27 }
28 
29 /* E^t + small */
30 static PetscErrorCode PCBDDCNullSpaceCorrPostSolve(KSP ksp,Vec y,Vec x, void* ctx)
31 {
32   NullSpaceCorrection_ctx corr_ctx = (NullSpaceCorrection_ctx)ctx;
33   PetscErrorCode          ierr;
34   Mat                     K;
35 
36   PetscFunctionBegin;
37   ierr = PetscLogEventBegin(corr_ctx->evapply,ksp,0,0,0);CHKERRQ(ierr);
38   ierr = KSPGetOperators(ksp,&K,NULL);CHKERRQ(ierr);
39   if (corr_ctx->symm) {
40     ierr = MatMult(K,x,corr_ctx->fw[0]);CHKERRQ(ierr);
41   } else {
42     ierr = MatMultTranspose(K,x,corr_ctx->fw[0]);CHKERRQ(ierr);
43   }
44   ierr = MatMultTranspose(corr_ctx->basis_mat,corr_ctx->fw[0],corr_ctx->sw[0]);CHKERRQ(ierr);
45   ierr = VecScale(corr_ctx->sw[0],-1.0);CHKERRQ(ierr);
46   ierr = MatMult(corr_ctx->inv_smat,corr_ctx->sw[0],corr_ctx->sw[2]);CHKERRQ(ierr);
47   ierr = MatMultAdd(corr_ctx->basis_mat,corr_ctx->sw[2],x,corr_ctx->fw[0]);CHKERRQ(ierr);
48   ierr = VecScale(corr_ctx->fw[0],corr_ctx->scale);CHKERRQ(ierr);
49   /* Sum contributions from approximate solver and projected system */
50   ierr = MatMultAdd(corr_ctx->basis_mat,corr_ctx->sw[1],corr_ctx->fw[0],x);CHKERRQ(ierr);
51   ierr = PetscLogEventEnd(corr_ctx->evapply,ksp,0,0,0);CHKERRQ(ierr);
52   PetscFunctionReturn(0);
53 }
54 
55 static PetscErrorCode PCBDDCNullSpaceCorrDestroy(void * ctx)
56 {
57   NullSpaceCorrection_ctx corr_ctx = (NullSpaceCorrection_ctx)ctx;
58   PetscErrorCode          ierr;
59 
60   PetscFunctionBegin;
61   ierr = VecDestroyVecs(3,&corr_ctx->sw);CHKERRQ(ierr);
62   ierr = VecDestroyVecs(1,&corr_ctx->fw);CHKERRQ(ierr);
63   ierr = MatDestroy(&corr_ctx->basis_mat);CHKERRQ(ierr);
64   ierr = MatDestroy(&corr_ctx->inv_smat);CHKERRQ(ierr);
65   ierr = PetscFree(corr_ctx);CHKERRQ(ierr);
66   PetscFunctionReturn(0);
67 }
68 
69 PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc, PetscBool isdir, PetscBool needscaling)
70 {
71   PC_BDDC                  *pcbddc = (PC_BDDC*)pc->data;
72   MatNullSpace             NullSpace = NULL;
73   KSP                      local_ksp;
74   NullSpaceCorrection_ctx  shell_ctx;
75   Mat                      local_mat,local_pmat,dmat,Kbasis_mat;
76   Vec                      v;
77   PetscContainer           c;
78   PetscInt                 basis_size;
79   IS                       zerorows;
80   PetscBool                iscusp;
81   PetscErrorCode           ierr;
82 
83   PetscFunctionBegin;
84   if (isdir) local_ksp = pcbddc->ksp_D; /* Dirichlet solver */
85   else local_ksp = pcbddc->ksp_R; /* Neumann solver */
86   ierr = KSPGetOperators(local_ksp,&local_mat,&local_pmat);CHKERRQ(ierr);
87   ierr = MatGetNearNullSpace(local_pmat,&NullSpace);CHKERRQ(ierr);
88   if (!NullSpace) {
89     if (pcbddc->dbg_flag) {
90       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d doesn't have local (near) nullspace: no need for correction in %s solver \n",PetscGlobalRank,isdir ? "Dirichlet" : "Neumann");CHKERRQ(ierr);
91     }
92     PetscFunctionReturn(0);
93   }
94   ierr = PetscObjectQuery((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject*)&dmat);CHKERRQ(ierr);
95   if (!dmat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing dense matrix");
96   ierr = PetscLogEventBegin(PC_BDDC_ApproxSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
97 
98   ierr = PetscNew(&shell_ctx);CHKERRQ(ierr);
99   shell_ctx->scale = 1.0;
100   ierr = PetscObjectReference((PetscObject)dmat);CHKERRQ(ierr);
101   shell_ctx->basis_mat = dmat;
102   ierr = MatGetSize(dmat,NULL,&basis_size);CHKERRQ(ierr);
103   shell_ctx->evapply = PC_BDDC_ApproxApply[pcbddc->current_level];
104 
105   ierr = MatGetOption(local_mat,MAT_SYMMETRIC,&shell_ctx->symm);CHKERRQ(ierr);
106 
107   /* explicit construct (Phi^T K Phi)^-1 */
108   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQAIJCUSPARSE,&iscusp);CHKERRQ(ierr);
109   if (iscusp) {
110     ierr = MatConvert(shell_ctx->basis_mat,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&shell_ctx->basis_mat);CHKERRQ(ierr);
111   }
112   ierr = MatMatMult(local_mat,shell_ctx->basis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&Kbasis_mat);CHKERRQ(ierr);
113   ierr = MatTransposeMatMult(Kbasis_mat,shell_ctx->basis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->inv_smat);CHKERRQ(ierr);
114   ierr = MatDestroy(&Kbasis_mat);CHKERRQ(ierr);
115   ierr = MatBindToCPU(shell_ctx->inv_smat,PETSC_TRUE);CHKERRQ(ierr);
116   ierr = MatFindZeroRows(shell_ctx->inv_smat,&zerorows);CHKERRQ(ierr);
117   if (zerorows) { /* linearly dependent basis */
118     const PetscInt *idxs;
119     PetscInt       i,nz;
120 
121     ierr = ISGetLocalSize(zerorows,&nz);CHKERRQ(ierr);
122     ierr = ISGetIndices(zerorows,&idxs);CHKERRQ(ierr);
123     for (i=0;i<nz;i++) {
124       ierr = MatSetValue(shell_ctx->inv_smat,idxs[i],idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
125     }
126     ierr = ISRestoreIndices(zerorows,&idxs);CHKERRQ(ierr);
127     ierr = MatAssemblyBegin(shell_ctx->inv_smat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
128     ierr = MatAssemblyEnd(shell_ctx->inv_smat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
129   }
130   ierr = MatLUFactor(shell_ctx->inv_smat,NULL,NULL,NULL);CHKERRQ(ierr);
131   ierr = MatSeqDenseInvertFactors_Private(shell_ctx->inv_smat);CHKERRQ(ierr);
132   if (zerorows) { /* linearly dependent basis */
133     const PetscInt *idxs;
134     PetscInt       i,nz;
135 
136     ierr = ISGetLocalSize(zerorows,&nz);CHKERRQ(ierr);
137     ierr = ISGetIndices(zerorows,&idxs);CHKERRQ(ierr);
138     for (i=0;i<nz;i++) {
139       ierr = MatSetValue(shell_ctx->inv_smat,idxs[i],idxs[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
140     }
141     ierr = ISRestoreIndices(zerorows,&idxs);CHKERRQ(ierr);
142     ierr = MatAssemblyBegin(shell_ctx->inv_smat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
143     ierr = MatAssemblyEnd(shell_ctx->inv_smat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
144   }
145   ierr = ISDestroy(&zerorows);CHKERRQ(ierr);
146 
147   /* Create work vectors in shell context */
148   ierr = MatCreateVecs(shell_ctx->inv_smat,&v,NULL);CHKERRQ(ierr);
149   ierr = KSPCreateVecs(local_ksp,1,&shell_ctx->fw,0,NULL);CHKERRQ(ierr);
150   ierr = VecDuplicateVecs(v,3,&shell_ctx->sw);CHKERRQ(ierr);
151   ierr = VecDestroy(&v);CHKERRQ(ierr);
152 
153   /* add special pre/post solve to KSP (see [1], eq. 48) */
154   ierr = KSPSetPreSolve(local_ksp,PCBDDCNullSpaceCorrPreSolve,shell_ctx);CHKERRQ(ierr);
155   ierr = KSPSetPostSolve(local_ksp,PCBDDCNullSpaceCorrPostSolve,shell_ctx);CHKERRQ(ierr);
156   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)local_ksp),&c);CHKERRQ(ierr);
157   ierr = PetscContainerSetPointer(c,shell_ctx);CHKERRQ(ierr);
158   ierr = PetscContainerSetUserDestroy(c,PCBDDCNullSpaceCorrDestroy);CHKERRQ(ierr);
159   ierr = PetscObjectCompose((PetscObject)local_ksp,"_PCBDDC_Null_PrePost_ctx",(PetscObject)c);CHKERRQ(ierr);
160   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
161 
162   /* Create ksp object suitable for extreme eigenvalues' estimation */
163   if (needscaling || pcbddc->dbg_flag) {
164     KSP         check_ksp;
165     PC          local_pc;
166     Vec         work1,work2;
167     const char* prefix;
168     PetscReal   test_err,lambda_min,lambda_max;
169     PetscInt    k,maxit;
170 
171     ierr = VecDuplicate(shell_ctx->fw[0],&work1);CHKERRQ(ierr);
172     ierr = VecDuplicate(shell_ctx->fw[0],&work2);CHKERRQ(ierr);
173     ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr);
174     if (local_mat->spd) {
175       ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr);
176     }
177     ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)local_ksp,0);CHKERRQ(ierr);
178     ierr = KSPGetOptionsPrefix(local_ksp,&prefix);CHKERRQ(ierr);
179     ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
180     ierr = KSPAppendOptionsPrefix(check_ksp,"approximate_scale_");CHKERRQ(ierr);
181     ierr = KSPSetErrorIfNotConverged(check_ksp,PETSC_FALSE);CHKERRQ(ierr);
182     ierr = KSPSetOperators(check_ksp,local_mat,local_pmat);CHKERRQ(ierr);
183     ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
184     ierr = KSPSetPreSolve(check_ksp,PCBDDCNullSpaceCorrPreSolve,shell_ctx);CHKERRQ(ierr);
185     ierr = KSPSetPostSolve(check_ksp,PCBDDCNullSpaceCorrPostSolve,shell_ctx);CHKERRQ(ierr);
186     ierr = KSPSetTolerances(check_ksp,PETSC_SMALL,PETSC_SMALL,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
187     ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
188     /* setup with default maxit, then set maxit to min(10,any_set_from_command_line) (bug in computing eigenvalues when chaning the number of iterations */
189     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
190     ierr = KSPGetPC(local_ksp,&local_pc);CHKERRQ(ierr);
191     ierr = KSPSetPC(check_ksp,local_pc);CHKERRQ(ierr);
192     ierr = KSPGetTolerances(check_ksp,NULL,NULL,NULL,&maxit);CHKERRQ(ierr);
193     ierr = KSPSetTolerances(check_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,PetscMin(10,maxit));CHKERRQ(ierr);
194     ierr = VecSetRandom(work2,NULL);CHKERRQ(ierr);
195     ierr = MatMult(local_mat,work2,work1);CHKERRQ(ierr);
196     ierr = KSPSolve(check_ksp,work1,work1);CHKERRQ(ierr);
197     ierr = KSPCheckSolve(check_ksp,pc,work1);CHKERRQ(ierr);
198     ierr = VecAXPY(work1,-1.,work2);CHKERRQ(ierr);
199     ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
200     ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
201     ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
202     if (pcbddc->dbg_flag) {
203       if (isdir) {
204         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet adapted solver (no scale) %1.14e (it %D, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
205       } else {
206         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann adapted solver (no scale) %1.14e (it %D, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
207       }
208     }
209     if (needscaling) shell_ctx->scale = 1.0/lambda_max;
210 
211     if (needscaling && pcbddc->dbg_flag) { /* test for scaling factor */
212       PC new_pc;
213 
214       ierr = VecSetRandom(work2,NULL);CHKERRQ(ierr);
215       ierr = MatMult(local_mat,work2,work1);CHKERRQ(ierr);
216       ierr = PCCreate(PetscObjectComm((PetscObject)check_ksp),&new_pc);CHKERRQ(ierr);
217       ierr = PCSetType(new_pc,PCKSP);CHKERRQ(ierr);
218       ierr = PCSetOperators(new_pc,local_mat,local_pmat);CHKERRQ(ierr);
219       ierr = PCKSPSetKSP(new_pc,local_ksp);CHKERRQ(ierr);
220       ierr = KSPSetPC(check_ksp,new_pc);CHKERRQ(ierr);
221       ierr = PCDestroy(&new_pc);CHKERRQ(ierr);
222       ierr = KSPSetTolerances(check_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,maxit);CHKERRQ(ierr);
223       ierr = KSPSetPreSolve(check_ksp,NULL,NULL);CHKERRQ(ierr);
224       ierr = KSPSetPostSolve(check_ksp,NULL,NULL);CHKERRQ(ierr);
225       ierr = KSPSolve(check_ksp,work1,work1);CHKERRQ(ierr);
226       ierr = KSPCheckSolve(check_ksp,pc,work1);CHKERRQ(ierr);
227       ierr = VecAXPY(work1,-1.,work2);CHKERRQ(ierr);
228       ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
229       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
230       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
231       if (pcbddc->dbg_flag) {
232         if (isdir) {
233           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet adapted solver (scale %g) %1.14e (it %D, eigs %1.6e %1.6e)\n",PetscGlobalRank,(double)PetscRealPart(shell_ctx->scale),test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
234         } else {
235           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann adapted solver (scale %g) %1.14e (it %D, eigs %1.6e %1.6e)\n",PetscGlobalRank,(double)PetscRealPart(shell_ctx->scale),test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
236         }
237       }
238     }
239     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
240     ierr = VecDestroy(&work1);CHKERRQ(ierr);
241     ierr = VecDestroy(&work2);CHKERRQ(ierr);
242   }
243   ierr = PetscLogEventEnd(PC_BDDC_ApproxSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
244 
245   if (pcbddc->dbg_flag) {
246     Vec       work1,work2,work3;
247     PetscReal test_err;
248 
249     /* check nullspace basis is solved exactly */
250     ierr = VecDuplicate(shell_ctx->fw[0],&work1);CHKERRQ(ierr);
251     ierr = VecDuplicate(shell_ctx->fw[0],&work2);CHKERRQ(ierr);
252     ierr = VecDuplicate(shell_ctx->fw[0],&work3);CHKERRQ(ierr);
253     ierr = VecSetRandom(shell_ctx->sw[0],NULL);CHKERRQ(ierr);
254     ierr = MatMult(shell_ctx->basis_mat,shell_ctx->sw[0],work1);CHKERRQ(ierr);
255     ierr = VecCopy(work1,work2);CHKERRQ(ierr);
256     ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr);
257     ierr = KSPSolve(local_ksp,work3,work1);CHKERRQ(ierr);
258     ierr = VecAXPY(work1,-1.,work2);CHKERRQ(ierr);
259     ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
260     if (isdir) {
261       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet nullspace correction solver: %1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
262     } else {
263       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann nullspace correction solver: %1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
264     }
265     ierr = VecDestroy(&work1);CHKERRQ(ierr);
266     ierr = VecDestroy(&work2);CHKERRQ(ierr);
267     ierr = VecDestroy(&work3);CHKERRQ(ierr);
268   }
269   PetscFunctionReturn(0);
270 }
271